Browse Source

handle enum constructor closure construction (close #4953)

Nicolas Cannasse 9 years ago
parent
commit
38a0e3211b
2 changed files with 47 additions and 5 deletions
  1. 26 5
      src/generators/genhl.ml
  2. 21 0
      tests/unit/src/unit/issues/Issue4953.hx

+ 26 - 5
src/generators/genhl.ml

@@ -296,7 +296,7 @@ type access =
 	| AArray of reg * (ttype * ttype) * reg
 	| AVirtualMethod of texpr * field index
 	| ADynamic of texpr * string index
-	| AEnum of field index
+	| AEnum of tenum * field index
 	| ACaptured of field index
 
 let null_proto =
@@ -1374,7 +1374,7 @@ and get_access ctx e =
 			ADynamic (ethis, alloc_string ctx name)
 		| FEnum (e,ef), _ ->
 			(match follow ef.ef_type with
-			| TFun _ -> AEnum ef.ef_index
+			| TFun _ -> AEnum (e,ef.ef_index)
 			| t -> AGlobal (alloc_global ctx (efield_name e ef) (to_type ctx t))))
 	| TLocal v ->
 		(match captured_index ctx v with
@@ -1827,6 +1827,10 @@ and eval_expr ctx e =
 				op ctx (OIncr ridx);
 			) res;
 			arr
+		| "$rethrow", [v] ->
+			let r = alloc_tmp ctx HVoid in
+			op ctx (ORethrow (eval_to ctx v HDyn));
+			r
 		| "$allTypes", [] ->
 			let r = alloc_tmp ctx (to_type ctx e.etype) in
 			op ctx (OGetGlobal (r, alloc_global ctx "__types__" (rtype ctx r)));
@@ -1877,7 +1881,7 @@ and eval_expr ctx e =
 		| AInstanceProto (ethis, fid) | AVirtualMethod (ethis, fid) ->
 			let el = eval_null_check ctx ethis :: el() in
 			op ctx (OCallMethod (ret, fid, el))
-		| AEnum index ->
+		| AEnum (_,index) ->
 			op ctx (OMakeEnum (ret, index, el()))
 		| AArray (a,t,idx) ->
 			let r = array_read ctx a t idx ec.epos in
@@ -1919,8 +1923,25 @@ and eval_expr ctx e =
 		| ADynamic (ethis, f) ->
 			let robj = eval_null_check ctx ethis in
 			op ctx (ODynGet (r,robj,f))
-		| AEnum index ->
-			op ctx (OMakeEnum (r,index,[]))
+		| AEnum (en,index) ->
+			let cur_fid = DynArray.length ctx.cfids.arr in
+			let name = List.nth en.e_names index in
+			let fid = alloc_fun_path ctx en.e_path name in
+			if fid = cur_fid then begin
+				let ef = PMap.find name en.e_constrs in
+				let eargs, et = (match follow ef.ef_type with TFun (args,ret) -> args, ret | _ -> assert false) in
+				let ct = ctx.com.basic in
+				let p = ef.ef_pos in
+				let eargs = List.map (fun (n,o,t) -> alloc_var n t, if o then Some TNull else None) eargs in
+				let ecall = mk (TCall (e,List.map (fun (v,_) -> mk (TLocal v) v.v_type p) eargs)) et p in
+				let f = {
+					tf_args = eargs;
+					tf_type = et;
+					tf_expr = mk (TReturn (Some ecall)) ct.tvoid p;
+				} in
+				ignore(make_fun ctx ("","") fid f None None);
+			end;
+			op ctx (OStaticClosure (r,fid));
 		| ANone | ALocal _ | AArray _ | ACaptured _ ->
 			error "Invalid access" e.epos);
 		unsafe_cast_to ctx r (to_type ctx e.etype) e.epos

+ 21 - 0
tests/unit/src/unit/issues/Issue4953.hx

@@ -0,0 +1,21 @@
+package unit.issues;
+
+private enum E {
+	Foo( v : Int );
+	Other;
+}
+
+class Issue4953 extends Test {
+
+	function foo() {
+		return Foo;
+	}
+
+    function test() {
+        switch( foo()(5) ) {
+		case Foo(v): eq(v,5);
+		default: t(false);
+		}
+    }
+
+}