فهرست منبع

factor out what `type_access` on EField does

Whatever that is.
Simon Krajewski 9 سال پیش
والد
کامیت
7b9e1c3296
1فایلهای تغییر یافته به همراه38 افزوده شده و 34 حذف شده
  1. 38 34
      typer.ml

+ 38 - 34
typer.ml

@@ -2564,40 +2564,8 @@ and type_ident ctx i p mode =
 			end
 		end
 
-and type_access ctx e p mode =
-	match e with
-	| EConst (Ident s) ->
-		type_ident ctx s p mode
-	| EField (e1,"new") ->
-		let e1 = type_expr ctx e1 Value in
-		begin match e1.eexpr with
-			| TTypeExpr (TClassDecl c) ->
-				if mode = MSet then error "Cannot set constructor" p;
-				if mode = MCall then error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p;
-				let monos = List.map (fun _ -> mk_mono()) c.cl_params in
-				let ct, cf = get_constructor ctx c monos p in
-				let args = match follow ct with TFun(args,ret) -> args | _ -> assert false in
-				let vl = List.map (fun (n,_,t) -> alloc_var n t) args in
-				let vexpr v = mk (TLocal v) v.v_type p in
-				let el = List.map vexpr vl in
-				let ec,t = match c.cl_kind with
-					| KAbstractImpl a ->
-						let e = type_module_type ctx (TClassDecl c) None p in
-						let e = mk (TField (e,(FStatic (c,cf)))) ct p in
-						let t = TAbstract(a,monos) in
-						make_call ctx e el t p,t
-					| _ ->
-						let t = TInst(c,monos) in
-						mk (TNew(c,monos,el)) t p,t
-				in
-				AKExpr(mk (TFunction {
-					tf_args = List.map (fun v -> v,None) vl;
-					tf_type = t;
-					tf_expr = mk (TReturn (Some ec)) t p;
-				}) (tfun (List.map (fun v -> v.v_type) vl) t) p)
-			| _ -> error "Binding new is only allowed on class types" p
-		end;
-	| EField _ ->
+(* MORDOR *)
+and handle_efield ctx e p mode =
 		let fields ?(resume=false) path e =
 			let resume = ref resume in
 			let force = ref false in
@@ -2712,6 +2680,42 @@ and type_access ctx e p mode =
 				fields acc (type_access ctx (fst e) (snd e))
 		in
 		loop [] (e,p) mode
+
+and type_access ctx e p mode =
+	match e with
+	| EConst (Ident s) ->
+		type_ident ctx s p mode
+	| EField (e1,"new") ->
+		let e1 = type_expr ctx e1 Value in
+		begin match e1.eexpr with
+			| TTypeExpr (TClassDecl c) ->
+				if mode = MSet then error "Cannot set constructor" p;
+				if mode = MCall then error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p;
+				let monos = List.map (fun _ -> mk_mono()) c.cl_params in
+				let ct, cf = get_constructor ctx c monos p in
+				let args = match follow ct with TFun(args,ret) -> args | _ -> assert false in
+				let vl = List.map (fun (n,_,t) -> alloc_var n t) args in
+				let vexpr v = mk (TLocal v) v.v_type p in
+				let el = List.map vexpr vl in
+				let ec,t = match c.cl_kind with
+					| KAbstractImpl a ->
+						let e = type_module_type ctx (TClassDecl c) None p in
+						let e = mk (TField (e,(FStatic (c,cf)))) ct p in
+						let t = TAbstract(a,monos) in
+						make_call ctx e el t p,t
+					| _ ->
+						let t = TInst(c,monos) in
+						mk (TNew(c,monos,el)) t p,t
+				in
+				AKExpr(mk (TFunction {
+					tf_args = List.map (fun v -> v,None) vl;
+					tf_type = t;
+					tf_expr = mk (TReturn (Some ec)) t p;
+				}) (tfun (List.map (fun v -> v.v_type) vl) t) p)
+			| _ -> error "Binding new is only allowed on class types" p
+		end;
+	| EField _ ->
+		handle_efield ctx e p mode
 	| EArray (e1,e2) ->
 		let e1 = type_expr ctx e1 Value in
 		let e2 = type_expr ctx e2 Value in