Quellcode durchsuchen

gimme a windows build

Aidan Lee vor 5 Monaten
Ursprung
Commit
171c66e8ef
5 geänderte Dateien mit 135 neuen und 54 gelöschten Zeilen
  1. 4 0
      src/context/common.ml
  2. 2 0
      src/core/tType.ml
  3. 74 54
      src/coro/coro.ml
  4. 8 0
      src/typing/typerEntry.ml
  5. 47 0
      std/haxe/coro/BaseContinuation.hx

+ 4 - 0
src/context/common.ml

@@ -767,6 +767,8 @@ let create timer_ctx compilation_step cs version args display_mode =
 				tcoro = (fun _ -> die "Could not locate abstract Coroutine<T> (was it redefined?)" __LOC__);
 				continuation = mk_mono();
 				continuation_class = null_class;
+				base_continuation = mk_mono();
+				base_continuation_class = null_class;
 				primitive = mk_mono();
 				context = mk_mono();
 				scheduler = mk_mono();
@@ -830,6 +832,8 @@ let clone com is_macro_context =
 				tcoro = (fun _ -> die "Could not locate abstract Coroutine<T> (was it redefined?)" __LOC__);
 				continuation = mk_mono();
 				continuation_class = null_class;
+				base_continuation = mk_mono();
+				base_continuation_class = null_class;
 				primitive = mk_mono();
 				context = mk_mono();
 				scheduler = mk_mono();

+ 2 - 0
src/core/tType.ml

@@ -476,6 +476,8 @@ type coro_types = {
 	mutable tcoro : (string * bool * t) list -> t -> t;
 	mutable continuation : t;
 	mutable continuation_class : tclass;
+	mutable base_continuation : t;
+	mutable base_continuation_class : tclass;
 	mutable primitive : t;
 	mutable context : t;
 	mutable scheduler : t;

+ 74 - 54
src/coro/coro.ml

@@ -85,14 +85,14 @@ module ContinuationClassBuilder = struct
 		 ) params_outside in
 		cls.cl_params <- params_inside;
 
-		cls.cl_implements <- [ (basic.tcoro.continuation_class, [ basic.tany ]) ];
+		cls.cl_super <- Some (basic.tcoro.base_continuation_class, []);
 
-		let cls_completion = mk_field "_hx_completion" basic.tcoro.continuation null_pos null_pos in
-		let cls_context    = mk_field "_hx_context" basic.tcoro.context null_pos null_pos in
-		let cls_state      = mk_field "_hx_state" basic.tint null_pos null_pos in
-		let cls_result     = mk_field "_hx_result" basic.tany null_pos null_pos in
-		let cls_error      = mk_field "_hx_error" basic.texception null_pos null_pos in
-		let cls_recursing  = mk_field "_hx_recursing" basic.tbool null_pos null_pos in
+		let cls_completion = PMap.find "_hx_completion" basic.tcoro.base_continuation_class.cl_fields in
+		let cls_context    = PMap.find "_hx_context" basic.tcoro.base_continuation_class.cl_fields in
+		let cls_state      = PMap.find "_hx_state" basic.tcoro.base_continuation_class.cl_fields in
+		let cls_result     = PMap.find "_hx_result" basic.tcoro.base_continuation_class.cl_fields in
+		let cls_error      = PMap.find "_hx_error" basic.tcoro.base_continuation_class.cl_fields in
+		let cls_recursing  = PMap.find "_hx_recursing" basic.tcoro.base_continuation_class.cl_fields in
 
 		let param_types_inside = extract_param_types params_inside in
 		let param_types_outside = extract_param_types params_outside in
@@ -124,22 +124,15 @@ module ContinuationClassBuilder = struct
 		let name  = "completion" in
 		let ethis = mk (TConst TThis) coro_class.inside.cls_t null_pos in
 
-		let vargcompletion = alloc_var VGenerated name basic.tcoro.continuation null_pos in
+		let vargcompletion    = alloc_var VGenerated name basic.tcoro.continuation null_pos in
+		let evarargcompletion = Builder.make_local vargcompletion null_pos in
+		let einitialstate     = mk (TConst (TInt (Int32.of_int initial_state) )) basic.tint null_pos in
+		let esuper            = mk (TCall ((mk (TConst TSuper) basic.tcoro.base_continuation null_pos), [ evarargcompletion; einitialstate ])) basic.tcoro.base_continuation null_pos in
 
 		let this_field cf =
 			mk (TField(ethis,FInstance(coro_class.cls, coro_class.inside.param_types, cf))) cf.cf_type null_pos
 		in
 
-		let eassigncompletion =
-			let eargcompletion    = Builder.make_local vargcompletion null_pos in
-			let ecompletionfield  = this_field coro_class.completion in
-			mk_assign ecompletionfield eargcompletion in
-
-		let eassignstate =
-			let estatefield = this_field coro_class.state in
-			mk_assign estatefield (mk (TConst (TInt (Int32.of_int initial_state) )) basic.tint null_pos)
-		in
-
 		let captured =
 			coro_class.captured
 			|> Option.map
@@ -150,21 +143,6 @@ module ContinuationClassBuilder = struct
 					vargcaptured, mk_assign ecapturedfield eargcaptured)
 			in
 
-		let eassigncontext =
-			let eargcompletion = Builder.make_local vargcompletion null_pos in
-			let econtextfield  =
-				match basic.tcoro.continuation with
-				| TInst (cls, _) ->
-					(* let field = PMap.find "_hx_context" cls.cl_fields in *)
-					mk (TField(eargcompletion, FInstance(cls, [], coro_class.context))) coro_class.context.cf_type null_pos
-				| _ ->
-					die "Expected context to be TInst" __LOC__
-			in
-
-			let ecompletionfield = this_field coro_class.context in
-			mk_assign ecompletionfield econtextfield
-		in
-
 		(* If the coroutine field is not static then our HxCoro class needs to capture this for future resuming *)
 
 		let eblock, tfun_args, tfunction_args =
@@ -178,7 +156,7 @@ module ContinuationClassBuilder = struct
 						([], [], [])
 				in
 
-			mk (TBlock (extra_exprs @ [ eassigncompletion; eassignstate; eassigncontext ])) basic.tvoid null_pos,
+			mk (TBlock (esuper :: extra_exprs)) basic.tvoid null_pos,
 			extra_tfun_args @ [ (name, false, basic.tcoro.continuation) ],
 			extra_tfunction_args @ [ (vargcompletion, None) ]
 		in
@@ -194,7 +172,64 @@ module ContinuationClassBuilder = struct
 
 		field
 
-	let mk_resume ctx coro_class =
+	let mk_invoke_resume ctx coro_class =
+		let basic     = ctx.typer.t in
+		let ethis     = mk (TConst TThis) coro_class.inside.cls_t null_pos in
+		let ecorocall =
+			let this_field cf =
+				mk (TField(ethis,FInstance(coro_class.cls, coro_class.inside.param_types, cf))) cf.cf_type null_pos
+			in
+			match coro_class.coro_type with
+			| ClassField (cls, field, f, _) when has_class_field_flag field CfStatic ->
+				let args      = (f.tf_args |> List.map (fun (v, _) -> Texpr.Builder.default_value v.v_type null_pos)) @ [ ethis ] in
+				let efunction = Builder.make_static_field cls field null_pos in
+				mk (TCall (efunction, args)) basic.tany null_pos
+			| ClassField (cls, field,f, _) ->
+				let args      = (f.tf_args |> List.map (fun (v, _) -> Texpr.Builder.default_value v.v_type null_pos)) @ [ ethis ] in
+				let captured  = coro_class.captured |> Option.get in
+				let ecapturedfield = this_field captured in
+				let efunction      = mk (TField(ecapturedfield,FInstance(cls, [] (* TODO: check *), field))) field.cf_type null_pos in
+				mk (TCall (efunction, args)) basic.tany null_pos
+			| LocalFunc f ->
+				let args      = [ ethis ] in
+				let captured  = coro_class.captured |> Option.get in
+				let ecapturedfield = this_field captured in
+				mk (TCall (ecapturedfield, args)) basic.tany null_pos
+		in
+		(* TODO: this is awkward, it would be better to avoid the entire expression and work with the correct types right away *)
+		let rec map_expr_type e =
+			Type.map_expr_type map_expr_type (substitute_type_params coro_class.type_param_subst) (fun v -> v) e
+		in
+		let ecorocall = map_expr_type ecorocall in
+
+		let field = mk_field "invokeResume" (TFun ([], basic.tany)) null_pos null_pos in
+		let block = mk (TBlock [ Builder.mk_return ecorocall ]) basic.tany null_pos in
+		let func  = TFunction { tf_type = basic.tany; tf_args = []; tf_expr = block } in
+		let expr  = mk (func) basic.tvoid null_pos in
+		field.cf_expr <- Some expr;
+		field.cf_kind <- Method MethNormal;
+
+		if ctx.coro_debug then
+			s_expr_debug expr |> Printf.printf "%s\n";
+
+		field
+
+	(* let mk_resume_completion ctx coro_class =
+		let basic   = ctx.typer.t in
+		let field   = mk_field "resumeCompletion" (TFun ([ ("result", false, basic.tany); ("error", false, basic.texception) ], basic.tvoid)) null_pos null_pos in
+		let ethis   = mk (TConst TThis) coro_class.inside.cls_t null_pos in
+		let vresult = alloc_var VGenerated "result" basic.tany null_pos in
+		let eresult = Builder.make_local vresult null_pos in
+		let verror  = alloc_var VGenerated "error" basic.tany null_pos in
+		let eerror  = Builder.make_local vresult null_pos in
+
+		let this_field cf =
+			mk (TField(ethis,FInstance(coro_class.cls, coro_class.inside.param_types, cf))) cf.cf_type null_pos
+		in
+		let eresumecompletion = mk (TCall (eresumefield, [ eresult; eerror ])) basic.tvoid null_pos in
+		() *)
+
+	(* let mk_resume ctx coro_class =
 		let basic = ctx.typer.t in
 		let result_name = "result" in
 		let error_name  = "error" in
@@ -232,13 +267,7 @@ module ContinuationClassBuilder = struct
 				mk (TField(ethis,FInstance(coro_class.cls, coro_class.inside.param_types, cf))) cf.cf_type null_pos
 			in
 			let eresumefield =
-				let ecompletionfield = this_field coro_class.completion in
-				let completion, resultfield =
-					match coro_class.completion.cf_type with
-					| TInst (completion, _) -> completion, PMap.find "resume" completion.cl_fields
-					| _ -> die "Expected scheduler to be TInst" __LOC__
-				in
-				mk (TField(ecompletionfield,FInstance(completion, coro_class.inside.param_types, resultfield))) (apply_params basic.tcoro.continuation_class.cl_params [basic.tany] resultfield.cf_type) null_pos
+				this_field (PMap.find "resumeCompletion" basic.tcoro.base_continuation_class.cl_fields)
 			in
 			let ecorocall =
 				match coro_class.coro_type with
@@ -293,9 +322,6 @@ module ContinuationClassBuilder = struct
 			mk (TTry (etryblock, [ ecatchblock ])) basic.tvoid null_pos
 		in
 
-		(* if ctx.coro_debug then
-			s_expr_debug try_block |> Printf.printf "%s\n"; *)
-
 		(* Bounce our continuation through the scheduler *)
 		let econtextfield   = this_field coro_class.context in
 		let eschedulerfield =
@@ -333,7 +359,7 @@ module ContinuationClassBuilder = struct
 		if ctx.coro_debug then
 			s_expr_debug expr |> Printf.printf "%s\n";
 
-		field
+		field *)
 end
 
 let fun_to_coro ctx coro_type =
@@ -374,14 +400,8 @@ let fun_to_coro ctx coro_type =
 		TClass.add_field coro_class.cls cf
 	) fields;
 	let ctor   = ContinuationClassBuilder.mk_ctor ctx coro_class initial_state in
-	let resume = ContinuationClassBuilder.mk_resume ctx coro_class in
-
-	TClass.add_field coro_class.cls coro_class.completion;
-	TClass.add_field coro_class.cls coro_class.context;
-	TClass.add_field coro_class.cls coro_class.state;
-	TClass.add_field coro_class.cls coro_class.result;
-	TClass.add_field coro_class.cls coro_class.error;
-	TClass.add_field coro_class.cls coro_class.recursing;
+	let resume = ContinuationClassBuilder.mk_invoke_resume ctx coro_class in
+
 	TClass.add_field coro_class.cls resume;
 	Option.may (TClass.add_field coro_class.cls) coro_class.captured;
 

+ 8 - 0
src/typing/typerEntry.ml

@@ -154,6 +154,14 @@ let load_coro ctx =
 		| _ ->
 			()
 	) m.m_types;
+	let m = TypeloadModule.load_module ctx (["haxe";"coro"],"BaseContinuation") null_pos in
+	List.iter (function
+		| TClassDecl({ cl_path = (["haxe";"coro"], "BaseContinuation") } as cl) ->
+			ctx.t.tcoro.base_continuation <- TInst(cl, [ ctx.t.tany ]);
+			ctx.t.tcoro.base_continuation_class <- cl;
+		| _ ->
+			()
+	) m.m_types;
 	let m = TypeloadModule.load_module ctx (["haxe";"coro"],"Primitive") null_pos in
 	List.iter (function
 		| TClassDecl({ cl_path = (["haxe";"coro"], "Primitive") } as cl) ->

+ 47 - 0
std/haxe/coro/BaseContinuation.hx

@@ -0,0 +1,47 @@
+package haxe.coro;
+
+import haxe.Exception;
+
+abstract class BaseContinuation implements IContinuation<Any> {
+    public final _hx_completion:IContinuation<Any>;
+
+	public final _hx_context:CoroutineContext;
+
+    public var _hx_state:Int;
+
+    public var _hx_result:Any;
+
+    public var _hx_error:Exception;
+
+    public var _hx_recursing:Bool;
+
+    function new(completion:IContinuation<Any>, initialState:Int) {
+        _hx_completion = completion;
+        _hx_context    = completion._hx_context;
+        _hx_state      = initialState;
+        _hx_error      = null;
+        _hx_result     = null;
+        _hx_recursing  = false;
+    }
+
+    public final function resume(result:Any, error:Exception):Void {
+        _hx_result = result;
+        _hx_error  = error;
+        _hx_context.scheduler.schedule(() -> {
+            try
+            {
+                final result = invokeResume();
+                if (result is Primitive) {
+                    return;
+                }
+
+                _hx_completion.resume(result, null);
+            }
+            catch (exn:Exception) {
+                _hx_completion.resume(null, exn);
+            }
+        });
+    }
+
+    abstract function invokeResume():Any;
+}