diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 7c3f75da491..b2444a21621 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -223,14 +223,12 @@ jobs:
strategy:
fail-fast: false
matrix:
- target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
+ target: [macro, js, hl, cpp, jvm, php, python, flash, neko]
include:
- target: hl
APT_PACKAGES: cmake ninja-build libturbojpeg-dev
- target: cpp
APT_PACKAGES: gcc-multilib g++-multilib
- - target: lua
- APT_PACKAGES: ncurses-dev
- target: flash
APT_PACKAGES: libglib2.0-0 libgtk2.0-0 libfreetype6 xvfb
steps:
@@ -470,10 +468,7 @@ jobs:
strategy:
fail-fast: false
matrix:
- target: [macro, js, cpp, jvm, php, python, lua, neko]
- include:
- - target: lua
- APT_PACKAGES: ncurses-dev
+ target: [macro, js, cpp, jvm, php, python, neko]
steps:
- uses: actions/checkout@main
with:
diff --git a/.gitignore b/.gitignore
index 1148a80b950..7a3fb70a367 100644
--- a/.gitignore
+++ b/.gitignore
@@ -133,3 +133,4 @@ lib.sexp
src/compiler/version.ml
tests/party
tests/misc/projects/Issue10863/error.log
+tests/misc/coroutines/dump
diff --git a/README.md b/README.md
index 9c2131de1a1..1f6016317ad 100644
--- a/README.md
+++ b/README.md
@@ -1,99 +1,9 @@
-
- 
-
-
-
- 
- 
- 
- 
-
-
-#
-
-Haxe is an open source toolkit that allows you to easily build cross-platform tools and applications that target many mainstream platforms. The Haxe toolkit includes:
-
- * **The Haxe programming language**, a modern, high-level, strictly-typed programming language
- * **The Haxe cross-compiler**, a state-of-the-art, lightning-speed compiler for many targets
- * **The Haxe standard library**, a complete, cross-platform library of common functionality
-
-Haxe allows you to compile for the following targets:
-
- * JavaScript
- * C++
- * JVM
- * Lua
- * PHP 7
- * Python 3
- * [HashLink](https://hashlink.haxe.org/)
- * [NekoVM](https://nekovm.org/)
- * Flash (SWF Bytecode)
- * And its own [interpreter](https://haxe.org/blog/eval/)
-
-You can try Haxe directly from your browser at [try.haxe.org](https://try.haxe.org)!
-
-For more information about Haxe, head to the [official Haxe website](https://haxe.org).
-
-## License
-
-The Haxe project has several licenses, covering different parts of the projects.
-
- * The Haxe compiler is released under the GNU General Public License version 2 or any later version.
- * The Haxe standard library is released under the MIT license.
- * The Neko virtual machine is released under the MIT license. Its bundled runtime libraries (ndll) and tools are released under open source licenses as described in https://github.com/HaxeFoundation/neko/blob/master/LICENSE
-
-For the complete Haxe licenses, please see https://haxe.org/foundation/open-source.html or [./LICENSE](./LICENSE).
-
-## Installing Haxe
-
-The latest stable release is available at [https://haxe.org/download/](https://haxe.org/download/). Pre-built binaries are available for your platform:
-
- * **[Windows installer](https://haxe.org/download/file/latest/haxe-latest-win.exe/)**
- * **[Windows binaries](https://haxe.org/download/file/latest/haxe-latest-win.zip/)**
- * **[OSX installer](https://haxe.org/download/file/latest/haxe-latest-osx-installer.pkg/)**
- * **[OSX binaries](https://haxe.org/download/file/latest/haxe-latest-osx.tar.gz/)**
- * **[Linux Software Packages](https://haxe.org/download/linux/)**
- * **[Linux 32-bit binaries](https://haxe.org/download/file/latest/haxe-latest-linux32.tar.gz/)**
- * **[Linux 64-bit binaries](https://haxe.org/download/file/latest/haxe-latest-linux64.tar.gz/)**
-
-Automated development builds are available from [build.haxe.org](http://build.haxe.org).
-
-## Building from source
-
-See [extra/BUILDING.md](extra/BUILDING.md).
-
-## Using Haxe
-
-For information on using Haxe, consult the [Haxe documentation](https://haxe.org/documentation/):
-
- * [Haxe Introduction](https://haxe.org/documentation/introduction/), an introduction to the Haxe toolkit
- * [The Haxe Manual](https://haxe.org/manual/), the reference manual for the Haxe language
- * [Haxe Code Cookbook](https://code.haxe.org), code snippets / learning resource
- * [Haxe API](https://api.haxe.org), documentation for the Haxe standard and native APIs
- * [Haxelib](https://lib.haxe.org), Haxelib is the package manager for the Haxe Toolkit.
-
-## Community
-
-You can get help and talk with fellow Haxers from around the world via:
-
- * [Haxe Community Forum](http://community.haxe.org)
- * [Haxe on Stack Overflow](https://stackoverflow.com/questions/tagged/haxe)
- * [Haxe Gitter chatroom](https://gitter.im/HaxeFoundation/haxe/)
- * [Haxe Discord server](https://discordapp.com/invite/0uEuWH3spjck73Lo)
-
-:+1: Get notified of the latest Haxe news, don't forget to read the [Haxe roundups](https://haxe.io/).
-
-## Version compatibility
-
-Haxe | Neko | SWF | Python | HL | PHP | Lua |
---------------- | ----- | ----- | ------ | ---- | ---- | --- |
-2.* | 1.* | 8-10 | - | - | - | - |
-3.0.0 | 2.0.0 | | - | - | 5.1+ | - |
-3.2.0 | | 12-14 | 3.2+ | - | | - |
-3.3.0 | 2.1.0 | 21 | | - | | 5.1, 5.2, 5.3, LuaJIT 2.0, 2.1 |
-3.4.0 | | | | 1.1 | 5.4+ and 7.0+ (with `-D php7`) | |
-4.0.0 | 2.3.0 | | | 1.11 | 7.0+ | |
-
-## Contributing
-
-See [CONTRIBUTING.md](CONTRIBUTING.md) for more. Thank you!
+* First PR: https://github.com/HaxeFoundation/haxe/pull/10128
+* Second PR: https://github.com/HaxeFoundation/haxe/pull/11554
+* Third PR: https://github.com/HaxeFoundation/haxe/pull/12168
+
+* Original design repo: https://github.com/nadako/haxe-coroutines/
+* Related Kotlin document: https://github.com/Kotlin/KEEP/blob/master/proposals/coroutines.md
+* Coroutines under the hood: https://kt.academy/article/cc-under-the-hood
+* Design of Kotlin coroutines: https://www.droidcon.com/2022/09/22/design-of-kotlin-coroutines/
+* Mega document: https://github.com/JetBrains/kotlin/blob/master/compiler/backend/src/org/jetbrains/kotlin/codegen/coroutines/coroutines-codegen.md
\ No newline at end of file
diff --git a/extra/haxelib_src b/extra/haxelib_src
index 20199d4e6c1..8c4199b8257 160000
--- a/extra/haxelib_src
+++ b/extra/haxelib_src
@@ -1 +1 @@
-Subproject commit 20199d4e6c1eec17286efdc52067ad6ff94bb3d7
+Subproject commit 8c4199b8257e34d59799dfa5086c1008c3124669
diff --git a/src-json/meta.json b/src-json/meta.json
index 5c236f1d950..93f3936e195 100644
--- a/src-json/meta.json
+++ b/src-json/meta.json
@@ -142,6 +142,18 @@
"targets": ["TAbstract"],
"links": ["https://haxe.org/manual/types-abstract-core-type.html"]
},
+ {
+ "name": "Coroutine",
+ "metadata": ":coroutine",
+ "doc": "Transform function into a coroutine",
+ "targets": ["TClassField"]
+ },
+ {
+ "name": "CoroutineTransformed",
+ "metadata": ":coroutine.transformed",
+ "doc": "Marks a field as being a coroutine that has already been transformed",
+ "targets": ["TClassField"]
+ },
{
"name": "CppFileCode",
"metadata": ":cppFileCode",
diff --git a/src/codegen/fixOverrides.ml b/src/codegen/fixOverrides.ml
index 12d6514b02e..88bbc2d1c94 100644
--- a/src/codegen/fixOverrides.ml
+++ b/src/codegen/fixOverrides.ml
@@ -41,7 +41,11 @@ let fix_override com c f fd =
let f2 = (try Some (find_field com c f) with Not_found -> None) in
match f2,fd with
| Some (f2), Some(fd) ->
- let targs, tret = (match follow f2.cf_type with TFun (args,ret) -> args, ret | _ -> die "" __LOC__) in
+ let targs, tret =
+ match follow_with_coro f2.cf_type with
+ | Coro (args,ret) -> Common.expand_coro_type com.basic args ret
+ | NotCoro (TFun(args, ret)) -> args, ret
+ | _ -> die "" __LOC__ in
let changed_args = ref [] in
let prefix = "_tmp_" in
let nargs = List.map2 (fun ((v,ct) as cur) (_,_,t2) ->
@@ -86,7 +90,11 @@ let fix_override com c f fd =
f.cf_expr <- Some { fde with eexpr = TFunction fd2 };
f.cf_type <- TFun(targs,tret);
| Some(f2), None when (has_class_flag c CInterface) ->
- let targs, tret = (match follow f2.cf_type with TFun (args,ret) -> args, ret | _ -> die "" __LOC__) in
+ let targs, tret =
+ match follow_with_coro f2.cf_type with
+ | Coro (args,ret) -> Common.expand_coro_type com.basic args ret
+ | NotCoro (TFun(args, ret)) -> args, ret
+ | _ -> die "" __LOC__ in
f.cf_type <- TFun(targs,tret)
| _ ->
()
diff --git a/src/context/common.ml b/src/context/common.ml
index 799717e826f..9c72e0fe710 100644
--- a/src/context/common.ml
+++ b/src/context/common.ml
@@ -790,9 +790,16 @@ let create timer_ctx compilation_step cs version args display_mode =
tfloat = mk_mono();
tbool = mk_mono();
tstring = mk_mono();
+ texception = mk_mono();
tnull = (fun _ -> die "Could use locate abstract Null (was it redefined?)" __LOC__);
tarray = (fun _ -> die "Could not locate class Array (was it redefined?)" __LOC__);
titerator = (fun _ -> die "Could not locate typedef Iterator (was it redefined?)" __LOC__);
+ tunit = mk_mono();
+ tcoro = {
+ tcoro = lazy (fun _ -> die "Could not locate abstract Coroutine (was it redefined?)" __LOC__);
+ continuation = lazy (mk_mono());
+ suspension_result_class = lazy null_class;
+ }
};
std = null_class;
file_keys = new file_keys;
@@ -923,6 +930,13 @@ let clone com is_macro_context =
tnull = (fun _ -> die "Could use locate abstract Null (was it redefined?)" __LOC__);
tarray = (fun _ -> die "Could not locate class Array (was it redefined?)" __LOC__);
titerator = (fun _ -> die "Could not locate typedef Iterator (was it redefined?)" __LOC__);
+ texception = mk_mono();
+ tunit = mk_mono();
+ tcoro = {
+ tcoro = lazy (fun _ -> die "Could not locate abstract Coroutine (was it redefined?)" __LOC__);
+ continuation = lazy (mk_mono());
+ suspension_result_class = lazy null_class;
+ };
};
local_wrapper = LocalWrapper.null_wrapper;
std = null_class;
@@ -1134,6 +1148,12 @@ let get_entry_point com =
(snd path, c, e)
) com.main.main_path
+let expand_coro_type basic args ret =
+ let args = args @ [("_hx_continuation",false,Lazy.force basic.tcoro.continuation)] in
+ let ret = if ExtType.is_void (follow ret) then basic.tunit else ret in
+ let c = Lazy.force basic.tcoro.suspension_result_class in
+ (args,TInst(c,[ret]))
+
let make_unforced_lazy t_proc f where =
let r = ref (lazy_available t_dynamic) in
r := lazy_wait (fun() ->
diff --git a/src/context/typecore.ml b/src/context/typecore.ml
index fc807447a76..557791ca0b9 100644
--- a/src/context/typecore.ml
+++ b/src/context/typecore.ml
@@ -92,6 +92,7 @@ type typer_pass_tasks = {
type function_mode =
| FunFunction
+ | FunCoroutine
| FunNotFunction
type typer_globals = {
@@ -113,6 +114,7 @@ type typer_globals = {
mutable delayed_display : DisplayTypes.display_exception_kind option;
root_typer : typer;
(* api *)
+ mutable continuation_api : ContTypes.continuation_api option;
do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result;
do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
do_load_module : ?origin:module_dep_origin -> typer -> path -> pos -> module_def;
@@ -288,8 +290,11 @@ module TyperManager = struct
let e = create_ctx_e ctx.e.curfun FunNotFunction in
create ctx ctx.m ctx.c f e PTypeField ctx.type_params
+ let is_coroutine_context ctx =
+ ctx.e.function_mode = FunCoroutine
+
let is_function_context ctx = match ctx.e.function_mode with
- | FunFunction ->
+ | FunFunction | FunCoroutine ->
true
| FunNotFunction ->
false
diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml
index 91893c5e81d..3b874182cbd 100644
--- a/src/core/tFunctions.ml
+++ b/src/core/tFunctions.ml
@@ -649,6 +649,21 @@ let rec follow_lazy_and_mono t = match t with
| _ ->
t
+type maybe_coro =
+ | Coro of tsignature
+ | NotCoro of t
+
+let follow_with_coro t = match follow t with
+ | TAbstract({a_path = (["haxe";"coro"],"Coroutine")},[t]) ->
+ begin match follow t with
+ | TFun(args,ret) ->
+ Coro (args,ret)
+ | t ->
+ NotCoro t
+ end
+ | t ->
+ NotCoro t
+
let rec ambiguate_funs t =
match follow t with
| TFun _ -> TFun ([], t_dynamic)
diff --git a/src/core/tType.ml b/src/core/tType.ml
index 4f05604142c..09b73c1a6f2 100644
--- a/src/core/tType.ml
+++ b/src/core/tType.ml
@@ -482,6 +482,12 @@ and build_state =
exception Type_exception of t
+type coro_types = {
+ mutable tcoro : ((string * bool * t) list -> t -> t) Lazy.t;
+ mutable continuation : t Lazy.t;
+ mutable suspension_result_class : tclass Lazy.t;
+}
+
type basic_types = {
mutable tvoid : t;
mutable tany : t;
@@ -491,7 +497,10 @@ type basic_types = {
mutable tnull : t -> t;
mutable tstring : t;
mutable tarray : t -> t;
- mutable titerator : t -> t
+ mutable texception : t;
+ mutable titerator : t -> t;
+ mutable tunit : t;
+ mutable tcoro : coro_types;
}
type class_field_scope =
diff --git a/src/core/texpr.ml b/src/core/texpr.ml
index 6447cb1a077..9e8e029f934 100644
--- a/src/core/texpr.ml
+++ b/src/core/texpr.ml
@@ -649,6 +649,24 @@ let for_remap basic v etype e1 e2 p =
mk (TWhile((mk (TParenthesis ehasnext) ehasnext.etype ehasnext.epos),ebody,NormalWhile)) basic.tvoid e1.epos;
]) basic.tvoid p
+let not_while_true_to_while_true basic e1 e2 flag t p =
+ let e_break = mk TBreak t_dynamic p in
+ let e_not = mk (TUnop(Not,Prefix,Builder.mk_parent e1)) e1.etype e1.epos in
+ let e_if eo = mk (TIf(e_not,e_break,eo)) basic.tvoid p in
+ let rec map_continue e = match e.eexpr with
+ | TContinue ->
+ duplicate_tvars e_identity (e_if (Some e))
+ | TWhile _ ->
+ e
+ | _ ->
+ map_expr map_continue e
+ in
+ let e2 = if flag = NormalWhile then e2 else map_continue e2 in
+ let e_if = e_if None in
+ let e_block = if flag = NormalWhile then concat e_if e2 else concat e2 e_if in
+ let e_true = mk (TConst (TBool true)) basic.tbool p in
+ mk (TWhile(e_true,e_block,NormalWhile)) t p
+
(* -------------------------------------------------------------------------- *)
(* BUILD META DATA OBJECT *)
diff --git a/src/coro/contTypes.ml b/src/coro/contTypes.ml
new file mode 100644
index 00000000000..64d2e6fd13c
--- /dev/null
+++ b/src/coro/contTypes.ml
@@ -0,0 +1,37 @@
+open Type
+
+type continuation_api = {
+ base_continuation_class : tclass;
+ immediate_suspension_result_class : tclass;
+ suspension_state : Type.t;
+ suspension_result : t -> t;
+ suspension_result_class : tclass;
+ continuation : Type.t;
+ state : tclass_field;
+ result : tclass_field;
+ error : tclass_field;
+ completion : tclass_field;
+ context : tclass_field;
+ goto_label : tclass_field;
+ recursing : tclass_field;
+ immediate_result : texpr -> texpr;
+ immediate_error : texpr -> Type.t -> texpr;
+}
+
+let create_continuation_api base_continuation_class immediate_suspension_result_class suspension_state suspension_result_class continuation immediate_result immediate_error state result error completion context goto_label recursing = {
+ base_continuation_class;
+ immediate_suspension_result_class;
+ suspension_state;
+ suspension_result = (fun t -> TInst(suspension_result_class,[t]));
+ suspension_result_class;
+ continuation;
+ immediate_result;
+ immediate_error;
+ state;
+ result;
+ error;
+ completion;
+ context;
+ goto_label;
+ recursing;
+}
\ No newline at end of file
diff --git a/src/coro/coro.ml b/src/coro/coro.ml
new file mode 100644
index 00000000000..14c8b3cda74
--- /dev/null
+++ b/src/coro/coro.ml
@@ -0,0 +1,562 @@
+open Globals
+open Type
+open CoroTypes
+open CoroFunctions
+open Texpr
+open ContTypes
+
+let next_closure_id = Hashtbl.create 0;
+
+type coro_for =
+ | LocalFunc of tfunc * tvar
+ | ClassField of tclass * tclass_field * tfunc * pos (* expr pos *)
+
+type coro_cls = {
+ params : typed_type_param list;
+ param_types : Type.t list;
+ cls_t : Type.t;
+ result_type : Type.t;
+ cont_type : Type.t;
+}
+
+let substitute_type_params subst t =
+ let rec loop t = match t with
+ | TInst({cl_kind = KTypeParameter ttp}, []) ->
+ (try List.assq ttp subst with Not_found -> t)
+ | _ ->
+ Type.map loop t
+ in
+ loop t
+
+module ContinuationClassBuilder = struct
+ type coro_class = {
+ cls : tclass;
+ name_pos : pos;
+ (* inside = inside the continuation class *)
+ inside : coro_cls;
+ (* outside = in the original function *)
+ outside : coro_cls;
+ type_param_subst : (typed_type_param * Type.t) list;
+ coro_type : coro_for;
+ continuation_api : ContTypes.continuation_api;
+ (* Some coroutine classes (member functions, local functions) need to capture state, this field stores that *)
+ captured : tclass_field option;
+ }
+
+ let create ctx coro_type =
+ let basic = ctx.typer.t in
+ (* Mangle class names to hopefully get unique names and avoid collisions *)
+ let name, cf_captured, result_type, name_pos =
+ let captured_field_name = "captured" in
+ let managled_class_name = Printf.sprintf "HxCoro_%s_%s" (ctx.typer.c.curclass.cl_path |> fst |> String.concat "_") (ctx.typer.c.curclass.cl_path |> snd) in
+ match coro_type with
+ | ClassField (_, field, tf, _) ->
+ Printf.sprintf "%s_%s" managled_class_name field.cf_name,
+ (if has_class_field_flag field CfStatic then
+ None
+ else
+ Some (mk_field captured_field_name ctx.typer.c.tthis field.cf_name_pos field.cf_name_pos)),
+ tf.tf_type,
+ field.cf_name_pos
+ | LocalFunc(f,v) ->
+ let next_id =
+ match Hashtbl.find_opt next_closure_id managled_class_name with
+ | Some id ->
+ Hashtbl.replace next_closure_id managled_class_name (id + 1);
+ id
+ | _ ->
+ Hashtbl.replace next_closure_id managled_class_name 1;
+ 0
+ in
+ let n = Printf.sprintf "%s_AnonFunc%i" managled_class_name next_id in
+
+ let args = List.map (fun (v, _) -> (v.v_name, false, v.v_type)) f.tf_args in
+ let t = TFun (Common.expand_coro_type basic args f.tf_type) in
+
+ n, Some (mk_field captured_field_name t v.v_pos v.v_pos), f.tf_type, v.v_pos
+ in
+
+ let result_type = if ExtType.is_void (follow result_type) then ctx.typer.t.tunit else result_type in
+ (* Is there a pre-existing function somewhere to a valid path? *)
+ let cls_path = ((fst ctx.typer.m.curmod.m_path) @ [ Printf.sprintf "_%s" (snd ctx.typer.m.curmod.m_path) ]), name in
+ let cls = mk_class ctx.typer.m.curmod cls_path name_pos name_pos in
+ let params_outside = ctx.typer.type_params in
+ let params_inside = List.map (fun ttp ->
+ (* TODO: this duplicates clone_type_parameter *)
+ let c = ttp.ttp_class in
+ let map = fun t -> t in (* TODO: ? *)
+ let c = {c with cl_path = ([],ttp.ttp_name)} in
+ let def = Option.map map ttp.ttp_default in
+ let constraints = match ttp.ttp_constraints with
+ | None -> None
+ | Some constraints -> Some (lazy (List.map map (Lazy.force constraints)))
+ in
+ mk_type_param c TPHType (* !!! *) def constraints
+ ) params_outside in
+ cls.cl_params <- params_inside;
+
+ let continuation_api = match ctx.typer.g.continuation_api with
+ | Some api ->
+ api
+ | None ->
+ CoroInit.make_continuation_api ctx.typer
+ in
+
+ let param_types_inside = extract_param_types params_inside in
+ let param_types_outside = extract_param_types params_outside in
+ let subst = List.combine params_outside param_types_inside in
+ let result_type_inside = substitute_type_params subst result_type in
+ cls.cl_super <- Some (continuation_api.base_continuation_class, [result_type_inside]);
+ cf_captured |> Option.may (fun cf -> cf.cf_type <- substitute_type_params subst cf.cf_type);
+
+ {
+ cls = cls;
+ name_pos;
+ inside = {
+ params = params_inside;
+ param_types = param_types_inside;
+ cls_t = TInst(cls,param_types_inside);
+ result_type = result_type_inside;
+ cont_type = TInst(continuation_api.base_continuation_class,[result_type_inside]);
+ };
+ outside = {
+ params = params_outside;
+ param_types = param_types_outside;
+ cls_t = TInst(cls,param_types_outside);
+ result_type = result_type;
+ cont_type = TInst(continuation_api.base_continuation_class,[result_type]);
+ };
+ type_param_subst = subst;
+ coro_type = coro_type;
+ continuation_api;
+ captured = cf_captured;
+ }
+
+ let mk_ctor ctx cont coro_class initial_state =
+ let basic = ctx.typer.t in
+ let b = ctx.builder in
+ let name = "completion" in
+ let ethis = mk (TConst TThis) coro_class.inside.cls_t coro_class.name_pos in
+
+ let vargcompletion = alloc_var VGenerated name cont.continuation coro_class.name_pos in
+ let evarargcompletion = b#local vargcompletion coro_class.name_pos in
+ let einitialstate = b#int initial_state coro_class.name_pos in
+ let esuper = b#call (b#super coro_class.inside.cont_type coro_class.name_pos) [ evarargcompletion; einitialstate ] basic.tvoid in
+
+ let this_field cf =
+ b#instance_field ethis coro_class.cls coro_class.inside.param_types cf cf.cf_type
+ in
+
+ let captured =
+ coro_class.captured
+ |> Option.map
+ (fun field ->
+ let vargcaptured = alloc_var VGenerated "captured" field.cf_type coro_class.name_pos in
+ let eargcaptured = b#local vargcaptured coro_class.name_pos in
+ let ecapturedfield = this_field field in
+ vargcaptured, b#assign ecapturedfield eargcaptured)
+ 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 =
+ let extra_exprs, extra_tfun_args, extra_tfunction_args =
+ captured |>
+ Option.map_default
+ (fun (v, expr) ->
+ [ expr ],
+ [ (v.v_name, false, v.v_type) ],
+ [ (v, None) ])
+ ([], [], [])
+ in
+
+ b#void_block (esuper :: extra_exprs),
+ extra_tfun_args @ [ (name, false, cont.continuation) ],
+ extra_tfunction_args @ [ (vargcompletion, None) ]
+ in
+
+ let field = mk_field "new" (TFun (tfun_args, basic.tvoid)) coro_class.name_pos coro_class.name_pos in
+ let func = TFunction { tf_type = basic.tvoid; tf_args = tfunction_args; tf_expr = eblock } in
+ let expr = mk func field.cf_type coro_class.name_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_invoke_resume ctx coro_class =
+ let basic = ctx.typer.t in
+ let b = ctx.builder in
+ let tret_invoke_resume = coro_class.inside.cls_t in
+ let ethis = b#this coro_class.inside.cls_t coro_class.name_pos in
+ let ecorocall =
+ let this_field cf =
+ b#instance_field ethis coro_class.cls coro_class.inside.param_types cf cf.cf_type
+ in
+ let map_args =
+ List.map (fun (v, _) ->
+ let t = substitute_type_params coro_class.type_param_subst v.v_type in
+
+ Texpr.Builder.default_value (Abstract.follow_with_abstracts t) coro_class.name_pos
+ )
+ in
+ match coro_class.coro_type with
+ | ClassField (cls, field, f, _) when has_class_field_flag field CfStatic ->
+ let args = (f.tf_args |> map_args) @ [ ethis ] in
+ let estaticthis = Builder.make_static_this cls coro_class.name_pos in
+ let tcf = substitute_type_params coro_class.type_param_subst field.cf_type in
+ let efunction = b#static_field estaticthis cls field tcf in
+ b#call efunction args tret_invoke_resume
+ | ClassField (cls, field,f, _) ->
+ let args = (f.tf_args |> map_args) @ [ ethis ] in
+ let captured = coro_class.captured |> Option.get in
+ let ecapturedfield = this_field captured in
+ let efunction = b#instance_field ecapturedfield cls [] (* TODO: check *) field field.cf_type in
+ b#call efunction args tret_invoke_resume
+ | LocalFunc(f,_) ->
+ let args = (f.tf_args |> map_args) @ [ ethis ] in
+ let captured = coro_class.captured |> Option.get in
+ let ecapturedfield = this_field captured in
+ b#call ecapturedfield args tret_invoke_resume
+ in
+
+ let field = mk_field "invokeResume" (TFun ([], tret_invoke_resume)) coro_class.name_pos coro_class.name_pos in
+ add_class_field_flag field CfOverride;
+ let block = b#void_block [ b#return ecorocall ] in
+ let func = TFunction { tf_type = tret_invoke_resume; tf_args = []; tf_expr = block } in
+ let expr = mk (func) basic.tvoid coro_class.name_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
+end
+
+let create_continuation_class ctx cont coro_class initial_state =
+ let ctor = ContinuationClassBuilder.mk_ctor ctx cont coro_class initial_state in
+ 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;
+ coro_class.cls.cl_constructor <- Some ctor;
+ if ctx.coro_debug then
+ Printer.s_tclass "\t" coro_class.cls |> Printf.printf "%s\n";
+
+ ctx.typer.m.curmod.m_types <- ctx.typer.m.curmod.m_types @ [ TClassDecl coro_class.cls ]
+
+let coro_to_state_machine ctx coro_class cb_root exprs args vtmp_result vtmp_error vtmp_error_unwrapped vcompletion vcontinuation stack_item_inserter start_exception =
+ let basic = ctx.typer.t in
+ let b = ctx.builder in
+ let cont = coro_class.ContinuationClassBuilder.continuation_api in
+ let eloop, initial_state, fields = CoroToTexpr.block_to_texpr_coroutine ctx cb_root cont coro_class.cls coro_class.outside.param_types args [ vcompletion.v_id; vcontinuation.v_id ] exprs coro_class.name_pos stack_item_inserter start_exception in
+ (* update cf_type to use inside type parameters *)
+ List.iter (fun cf ->
+ cf.cf_type <- substitute_type_params coro_class.type_param_subst cf.cf_type;
+ TClass.add_field coro_class.cls cf
+ ) fields;
+ create_continuation_class ctx cont coro_class initial_state;
+ let continuation_var = b#var_init_null vcontinuation in
+
+ let std_is e t =
+ let type_expr = mk (TTypeExpr (module_type_of_type t)) t_dynamic coro_class.name_pos in
+ Texpr.Builder.resolve_and_make_static_call ctx.typer.com.std "isOfType" [e;type_expr] coro_class.name_pos
+ in
+
+ let prefix_arg =
+ match coro_class.coro_type with
+ | ClassField (_, field, _, _) when has_class_field_flag field CfStatic ->
+ []
+ | ClassField _ ->
+ [ b#this ctx.typer.c.tthis coro_class.name_pos ]
+ | LocalFunc(f,v) ->
+ [ b#local v coro_class.name_pos ]
+ in
+
+ let {CoroToTexpr.econtinuation;ecompletion;estate;eresult;egoto;eerror} = exprs in
+
+ let continuation_assign =
+ let t = coro_class.outside.cls_t in
+
+ let ecastedcompletion = mk_cast ecompletion t coro_class.name_pos in
+
+ let tcond =
+ let erecursingfield = b#instance_field ecastedcompletion coro_class.cls coro_class.outside.param_types cont.recursing basic.tbool in
+ let estdis = std_is ecompletion t in
+ let erecursingcheck = b#op_eq erecursingfield (b#bool false coro_class.name_pos) in
+ b#op_bool_and estdis erecursingcheck
+ in
+ let tif = b#assign econtinuation ecastedcompletion in
+ let tif = b#void_block [tif] in
+ let ctor_args = prefix_arg @ [ ecompletion ] in
+ let telse = b#assign econtinuation (mk (TNew (coro_class.cls, coro_class.outside.param_types, ctor_args)) t coro_class.name_pos) in
+ b#if_then_else tcond tif telse basic.tvoid
+ in
+
+ let continuation_field cf t =
+ b#instance_field econtinuation coro_class.cls coro_class.outside.param_types cf t
+ in
+ let el = [
+ continuation_var;
+ continuation_assign;
+ b#assign
+ (continuation_field cont.recursing basic.tbool)
+ (b#bool true coro_class.name_pos);
+ b#var_init vtmp_result eresult;
+ b#var_init_null vtmp_error;
+ ] in
+ let el = if Lazy.is_val vtmp_error_unwrapped then
+ el @ [b#var_init_null (Lazy.force vtmp_error_unwrapped)]
+ else
+ el
+ in
+ let el = el @ [
+ eloop;
+ b#return (b#null basic.tany coro_class.name_pos);
+ ] in
+ b#void_block el
+
+let coro_to_normal ctx cont coro_class cb_root exprs vcontinuation =
+ let open ContinuationClassBuilder in
+ let open CoroToTexpr in
+ let basic = ctx.typer.t in
+ let b = ctx.builder in
+ create_continuation_class ctx cont coro_class 0;
+ let rec loop cb previous_el =
+ let bad_pos = coro_class.name_pos in
+ let loop cb el =
+ if not (has_block_flag cb CbGenerated) then begin
+ add_block_flag cb CbGenerated;
+ loop cb el
+ end else
+ el,false
+ in
+ let loop_as_block cb =
+ let el,term = loop cb [] in
+ b#void_block el,term
+ in
+ let current_el = ref (previous_el @ (get_block_exprs cb)) in
+ let continue cb_next e =
+ loop cb_next (!current_el @ [e])
+ in
+ let maybe_continue cb_next term e = match cb_next with
+ | Some cb_next when not term ->
+ continue cb_next e
+ | _ ->
+ (!current_el @ [e]),true
+ in
+ let add e = current_el := !current_el @ [e] in
+ let terminate e =
+ add e;
+ !current_el,true
+ in
+ begin match cb.cb_next with
+ | NextSub(cb_sub,cb_next) ->
+ let e_next,term = loop_as_block cb_sub in
+ maybe_continue cb_next term e_next
+ | NextReturn e1 ->
+ let e1 = coro_class.continuation_api.immediate_result e1 in
+ terminate (b#return e1);
+ | NextThrow e1 ->
+ let e1 = coro_class.continuation_api.immediate_error e1 coro_class.inside.result_type in
+ terminate (b#return e1);
+ | NextUnknown | NextReturnVoid ->
+ let e1 = coro_class.continuation_api.immediate_result (b#null t_dynamic coro_class.name_pos) in
+ terminate (b#return e1);
+ | NextBreak _ ->
+ terminate (b#break bad_pos);
+ | NextContinue _ ->
+ terminate (b#continue bad_pos);
+ | NextIfThen(e1,cb_then,cb_next) ->
+ let e_then,_ = loop_as_block cb_then in
+ let e_if = b#if_then e1 e_then in
+ continue cb_next e_if
+ | NextIfThenElse(e1,cb_then,cb_else,cb_next) ->
+ let e_then,term_then = loop_as_block cb_then in
+ let e_else,term_else = loop_as_block cb_else in
+ let e_if = b#if_then_else e1 e_then e_else basic.tvoid in
+ maybe_continue cb_next (term_then && term_else) e_if
+ | NextSwitch(switch,cb_next) ->
+ let term = ref true in
+ let p = ref switch.cs_subject.epos in
+ let switch_cases = List.map (fun (el,cb) ->
+ let e,term' = loop_as_block cb in
+ term := !term && term';
+ p := Ast.punion !p e.epos;
+ {
+ case_patterns = el;
+ case_expr = e;
+ }
+ ) switch.cs_cases in
+ let switch_default = Option.map (fun cb ->
+ let e,term' = loop_as_block cb in
+ p := Ast.punion !p e.epos;
+ term := !term && term';
+ e
+ ) switch.cs_default in
+ let switch = {
+ switch_subject = switch.cs_subject;
+ switch_cases;
+ switch_default;
+ switch_exhaustive = switch.cs_exhaustive
+ } in
+ maybe_continue cb_next (switch.switch_exhaustive && !term) (mk (TSwitch switch) basic.tvoid !p)
+ | NextWhile(e1,cb_body,cb_next) ->
+ let e_body,_ = loop_as_block cb_body in
+ let e_while = mk (TWhile(e1,e_body,NormalWhile)) basic.tvoid (Ast.punion e1.epos e_body.epos) in
+ maybe_continue cb_next false e_while
+ | NextTry(cb_try,catches,cb_next) ->
+ let e_try,term = loop_as_block cb_try in
+ let p = ref e_try.epos in
+ let term = ref term in
+ let catches = List.map (fun (v,cb) ->
+ let e,term' = loop_as_block cb in
+ p := Ast.punion !p e.epos;
+ term := !term && term';
+ (v,e)
+ ) catches.cc_catches in
+ let e_try = mk (TTry(e_try,catches)) basic.tvoid !p in
+ maybe_continue cb_next !term e_try
+ | NextFallThrough _ | NextGoto _ ->
+ !current_el,false
+ | NextSuspend(suspend,cb_next) ->
+ let e_sus = CoroToTexpr.make_suspending_call basic cont suspend {exprs.ecompletion with epos = suspend.cs_pos} in
+ add (mk (TReturn (Some e_sus)) t_dynamic e_sus.epos);
+ !current_el,true
+ end
+ in
+ let el,_ = loop cb_root [] in
+ let e = b#void_block el in
+ let e = if ctx.nothrow then
+ e
+ else begin
+ let catch =
+ let v = alloc_var VGenerated "e" t_dynamic e.epos in
+ let ev = b#local v e.epos in
+ let eerr = coro_class.continuation_api.immediate_error ev coro_class.inside.result_type in
+ let eret = b#return eerr in
+ (v,eret)
+ in
+ mk (TTry(e,[catch])) basic.tvoid e.epos
+ end in
+ b#void_block [e]
+
+let fun_to_coro ctx coro_type =
+ let basic = ctx.typer.t in
+ let b = ctx.builder in
+
+ let coro_class = ContinuationClassBuilder.create ctx coro_type in
+ let cont = coro_class.continuation_api in
+
+ (* Generate and assign the continuation variable *)
+ let vcompletion = alloc_var VGenerated "_hx_completion" cont.continuation coro_class.name_pos in
+ let ecompletion = b#local vcompletion coro_class.name_pos in
+
+ let vcontinuation = alloc_var VGenerated "_hx_continuation" coro_class.outside.cls_t coro_class.name_pos in
+ let econtinuation = b#local vcontinuation coro_class.name_pos in
+
+ let continuation_field c cf t =
+ b#instance_field econtinuation c coro_class.outside.param_types cf t
+ in
+
+ let estate = continuation_field cont.suspension_result_class cont.state cont.suspension_state in
+ let eresult = continuation_field cont.suspension_result_class cont.result basic.tany in
+ let eerror = continuation_field cont.suspension_result_class cont.error basic.texception in
+
+ let continuation_field cf t =
+ b#instance_field econtinuation cont.base_continuation_class coro_class.outside.param_types cf t
+ in
+
+ let egoto = continuation_field cont.goto_label basic.tint in
+
+ let vtmp_result = alloc_var VGenerated "_hx_result" basic.tany coro_class.name_pos in
+ let etmp_result = b#local vtmp_result coro_class.name_pos in
+ let vtmp_error = alloc_var VGenerated "_hx_error" basic.texception coro_class.name_pos in
+ let etmp_error = b#local vtmp_error coro_class.name_pos in
+ let vtmp_error_unwrapped = lazy (alloc_var VGenerated "_hx_error_unwrapped" basic.tany coro_class.name_pos) in
+ let etmp_error_unwrapped = lazy (b#local (Lazy.force vtmp_error_unwrapped) coro_class.name_pos) in
+
+ let expr, args, name =
+ match coro_type with
+ | ClassField (_, cf, f, p) ->
+ f.tf_expr, f.tf_args, cf.cf_name
+ | LocalFunc(f,v) ->
+ f.tf_expr, f.tf_args, v.v_name
+ in
+
+ let cb_root = make_block ctx (Some(expr.etype, coro_class.name_pos)) in
+
+ ignore(CoroFromTexpr.expr_to_coro ctx etmp_result etmp_error_unwrapped cb_root expr);
+ let exprs = {CoroToTexpr.econtinuation;ecompletion;estate;eresult;egoto;eerror;etmp_result;etmp_error;etmp_error_unwrapped} in
+ let stack_item_inserter pos =
+ let field, eargs =
+ match coro_type with
+ | ClassField (cls, field, _, _) ->
+ PMap.find "setClassFuncStackItem" cont.base_continuation_class.cl_fields,
+ [
+ b#string (s_class_path cls) coro_class.name_pos;
+ b#string field.cf_name coro_class.name_pos;
+ ]
+ | LocalFunc (f, v) ->
+ PMap.find "setLocalFuncStackItem" cont.base_continuation_class.cl_fields,
+ [
+ b#int v.v_id coro_class.name_pos;
+ ]
+ in
+ let eaccess = continuation_field field field.cf_type in
+ let l1,c1,_,_ = Lexer.get_pos_coords pos in
+ let eargs = eargs @ [
+ b#string pos.pfile coro_class.name_pos;
+ b#int l1 coro_class.name_pos;
+ b#int c1 coro_class.name_pos;
+ b#int pos.pmin coro_class.name_pos;
+ b#int pos.pmax coro_class.name_pos;
+ ] in
+ mk (TCall (eaccess, eargs)) basic.tvoid coro_class.name_pos
+ in
+ let start_exception =
+ let cf = PMap.find "startException" cont.base_continuation_class.cl_fields in
+ let ef = continuation_field cf cf.cf_type in
+ (fun e ->
+ mk (TCall(ef,[e])) basic.tvoid coro_class.name_pos
+ )
+ in
+ let tf_expr,cb_root = try
+ let cb_root = if ctx.optimize then CoroFromTexpr.optimize_cfg ctx cb_root else cb_root in
+ coro_to_state_machine ctx coro_class cb_root exprs args vtmp_result vtmp_error vtmp_error_unwrapped vcompletion vcontinuation stack_item_inserter start_exception, cb_root
+ with CoroTco cb_root ->
+ coro_to_normal ctx cont coro_class cb_root exprs vcontinuation,cb_root
+ in
+
+ let tf_args = args @ [ (vcompletion,None) ] in
+ (* I'm not sure what this should be, but let's stick to the widest one for now.
+ Cpp dies if I try to use coro_class.outside.cls_t here, which might be something
+ to investigate independently. *)
+ let tf_type = cont.suspension_result coro_class.outside.result_type in
+ if ctx.coro_debug then begin
+ print_endline ("BEFORE:\n" ^ (s_expr_debug expr));
+ CoroDebug.create_dotgraph (DotGraph.get_dump_path (SafeCom.of_com ctx.typer.com) (ctx.typer.c.curclass.cl_path) name) cb_root
+ end;
+ let e = mk (TFunction {tf_args; tf_expr; tf_type}) (TFun (tf_args |> List.map (fun (v, _) -> (v.v_name, false, v.v_type)), tf_type)) tf_expr.epos in
+ if ctx.coro_debug then print_endline ("AFTER:\n" ^ (s_expr_debug e));
+ e
+
+let create_coro_context typer meta =
+ (* let optimize = not (Define.raw_defined typer.Typecore.com.defines "coroutine.noopt") in *)
+ let optimize = false in
+ let builder = new CoroElsewhere.texpr_builder typer.Typecore.t in
+ let ctx = {
+ builder;
+ typer;
+ coro_debug = Meta.has (Meta.Custom ":coroutine.debug") meta;
+ optimize;
+ allow_tco = optimize && not (Meta.has (Meta.Custom ":coroutine.notco") meta);
+ nothrow = Meta.has (Meta.Custom ":coroutine.nothrow") meta;
+ vthis = None;
+ next_block_id = 0;
+ current_catch = None;
+ has_catch = false;
+ } in
+ ctx
diff --git a/src/coro/coroControl.ml b/src/coro/coroControl.ml
new file mode 100644
index 00000000000..fcd58308d31
--- /dev/null
+++ b/src/coro/coroControl.ml
@@ -0,0 +1,33 @@
+open Globals
+open Type
+open Texpr
+
+type coro_control =
+ | CoroPending
+ | CoroReturned
+ | CoroThrown
+
+let mk_int basic i = Texpr.Builder.make_int basic i null_pos
+
+let mk_control basic (c : coro_control) = mk_int basic (Obj.magic c)
+
+let make_custom_control_switch basic e_subject cases p =
+ let cases = List.map (fun (l,e) -> {
+ case_patterns = List.map (mk_control basic) l;
+ case_expr = e;
+ }) cases in
+ let switch = {
+ switch_subject = e_subject;
+ switch_cases = cases;
+ switch_default = None;
+ switch_exhaustive = true;
+ } in
+ mk (TSwitch switch) basic.tvoid p
+
+let make_control_switch basic e_subject e_pending e_returned e_thrown p =
+ let cases = [
+ [CoroPending],e_pending;
+ [CoroReturned],e_returned;
+ [CoroThrown],e_thrown;
+ ] in
+ make_custom_control_switch basic e_subject cases p
\ No newline at end of file
diff --git a/src/coro/coroDebug.ml b/src/coro/coroDebug.ml
new file mode 100644
index 00000000000..12ff8bc1f3a
--- /dev/null
+++ b/src/coro/coroDebug.ml
@@ -0,0 +1,94 @@
+
+open CoroTypes
+open CoroFunctions
+open Type
+
+let create_dotgraph path cb =
+ print_endline (String.concat "." path);
+ let ch,close = DotGraph.start_graph path ".coro" in
+ let pctx = print_context() in
+ let st = s_type pctx in
+ let se = s_expr_pretty true "" false st in
+ let edges = DynArray.create () in
+ let rec block cb =
+ let edge_block label cb_target =
+ block cb_target;
+ DynArray.add edges (cb.cb_id,cb_target.cb_id,label,true);
+ in
+ let maybe_edge_block label = Option.may (edge_block label) in
+ let s = String.concat "\n" (DynArray.to_list (DynArray.map se cb.cb_el)) in
+ let flags = if has_block_flag cb CbResumeState then " resume" else if has_block_flag cb CbSuspendState then " suspend" else "" in
+ let s = if s = "" then Printf.sprintf "(%i%s)" cb.cb_id flags else Printf.sprintf "(%i%s)\n%s" cb.cb_id flags s in
+ let snext = match cb.cb_next with
+ | NextUnknown ->
+ None
+ | NextSub(cb_sub,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ edge_block "sub" cb_sub;
+ None
+ | NextBreak cb_break ->
+ DynArray.add edges (cb.cb_id,cb_break.cb_id,"goto",false);
+ Some "break"
+ | NextContinue cb_continue ->
+ DynArray.add edges (cb.cb_id,cb_continue.cb_id,"goto",false);
+ Some "continue"
+ | NextReturnVoid ->
+ Some "return"
+ | NextReturn e ->
+ Some ("return " ^ se e)
+ | NextThrow e ->
+ Some ("throw " ^ se e)
+ | NextIfThen(e,cb_then,cb_next) ->
+ edge_block "next" cb_next;
+ edge_block "then" cb_then;
+ Some ("if " ^ se e)
+ | NextIfThenElse(e,cb_then,cb_else,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ edge_block "then" cb_then;
+ edge_block "else" cb_else;
+ Some ("if " ^ se e)
+ | NextSwitch(switch,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ List.iter (fun (el,cb_case) ->
+ edge_block (String.concat " | " (List.map se el)) cb_case
+ ) switch.cs_cases;
+ Option.may (fun cb_default -> edge_block "default" cb_default) switch.cs_default;
+ Some ("switch " ^ se switch.cs_subject)
+ | NextWhile(e,cb_body,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ edge_block "body" cb_body;
+ Some ("while " ^ se e)
+ | NextTry(cb_try,catch,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ edge_block "try" cb_try;
+ DynArray.add edges (cb_try.cb_id,catch.cc_cb.cb_id,"catch",true);
+ Printf.fprintf ch "n%i [shape=box,label=\"(%i)\"];\n" catch.cc_cb.cb_id catch.cc_cb.cb_id;
+ List.iter (fun (v,cb_catch) ->
+ block cb_catch;
+ DynArray.add edges (catch.cc_cb.cb_id,cb_catch.cb_id,(st v.v_type),true);
+ ) catch.cc_catches;
+ None
+ | NextSuspend(suspend,cb_next) ->
+ maybe_edge_block "next" cb_next;
+ Some (Printf.sprintf "%s(%s)" (se suspend.cs_fun) (String.concat ", " (List.map se suspend.cs_args)))
+ | NextFallThrough cb_next ->
+ DynArray.add edges (cb.cb_id,cb_next.cb_id,"fall-through",false);
+ None
+ | NextGoto cb_next ->
+ DynArray.add edges (cb.cb_id,cb_next.cb_id,"goto",false);
+ None
+ in
+ let s = match snext with
+ | None ->
+ s
+ | Some snext ->
+ if s = "" then snext else s ^ "\n" ^ snext
+ in
+ Printf.fprintf ch "n%i [shape=box,label=\"%s\"];\n" cb.cb_id (StringHelper.s_escape s);
+ in
+ ignore(block cb);
+ DynArray.iter (fun (id_from,id_to,label,tree_edge) ->
+ let style = if tree_edge then "style=\"solid\",color=\"black\"" else "style=\"dashed\", color=\"lightgray\"" in
+ Printf.fprintf ch "n%i -> n%i[%s label=\"%s\"];\n" id_from id_to style (StringHelper.s_escape label);
+ ) edges;
+ close();
\ No newline at end of file
diff --git a/src/coro/coroElsewhere.ml b/src/coro/coroElsewhere.ml
new file mode 100644
index 00000000000..b68f36ad590
--- /dev/null
+++ b/src/coro/coroElsewhere.ml
@@ -0,0 +1,80 @@
+(*
+ Code that should eventually be moved elsewhere.
+*)
+
+open Globals
+open Ast
+open Type
+
+class texpr_builder (basic : basic_types) =
+object(self)
+ method assign (lhs : texpr) (rhs : texpr) =
+ mk (TBinop(OpAssign,lhs,rhs)) lhs.etype (punion lhs.epos rhs.epos)
+
+ method binop (op : binop) (lhs : texpr) (rhs : texpr) (t : Type.t) =
+ mk (TBinop(op,lhs,rhs)) t (punion lhs.epos rhs.epos)
+
+ method bool (b : bool) (p : pos) =
+ mk (TConst (TBool b)) basic.tbool p
+
+ method break (p : pos) =
+ mk TBreak t_dynamic p
+
+ method call (e1 : texpr) (el : texpr list) (tret : Type.t) =
+ mk (TCall(e1,el)) tret (punion e1.epos (punion_el e1.epos el))
+
+ method continue (p : pos) =
+ mk TContinue t_dynamic p
+
+ method local (v : tvar) (p : pos) =
+ mk (TLocal v) v.v_type p
+
+ method if_then (eif : texpr) (ethen : texpr) =
+ mk (TIf(eif,ethen,None)) basic.tvoid (punion eif.epos ethen.epos)
+
+ method if_then_else (eif : texpr) (ethen : texpr) (eelse : texpr) (t : Type.t) =
+ mk (TIf(eif,ethen,Some eelse)) t (punion eif.epos eelse.epos)
+
+ method instance_field (e : texpr) (c : tclass) (params : Type.t list) (cf : tclass_field) (t : Type.t) =
+ mk (TField(e,FInstance(c,params,cf))) t e.epos
+
+ method int (i : int) (p : pos) =
+ mk (TConst (TInt (Int32.of_int i))) basic.tint p
+
+ method null (t : Type.t) (p : pos) =
+ mk (TConst TNull) t p
+
+ method op_bool_and (e1 : texpr) (e2 : texpr) =
+ self#binop OpBoolAnd e1 e2 basic.tbool
+
+ method op_eq (e1 : texpr) (e2 : texpr) =
+ self#binop OpEq e1 e2 basic.tbool
+
+ method return (e : texpr) =
+ mk (TReturn (Some e)) t_dynamic e.epos
+
+ method static_field (e : texpr) (c : tclass) (cf : tclass_field) (t : Type.t) =
+ mk (TField(e,FStatic(c,cf))) t e.epos
+
+ method string (s : string) (p : pos) =
+ mk (TConst (TString s)) basic.tstring p
+
+ method super (t: Type.t) (p : pos) =
+ mk (TConst TSuper) t p
+
+ method this (t : Type.t) (p : pos) =
+ mk (TConst TThis) t p
+
+ method throw (e : texpr) =
+ mk (TThrow e) t_dynamic e.epos
+
+ method var_init (v : tvar) (e : texpr) =
+ mk (TVar(v,Some e)) basic.tvoid (punion v.v_pos e.epos)
+
+ method var_init_null (v : tvar) =
+ self#var_init v (self#null v.v_type v.v_pos)
+
+ method void_block (el : texpr list) =
+ mk (TBlock el) basic.tvoid (Texpr.punion_el null_pos el)
+
+end
\ No newline at end of file
diff --git a/src/coro/coroFromTexpr.ml b/src/coro/coroFromTexpr.ml
new file mode 100644
index 00000000000..4b8ad2e2308
--- /dev/null
+++ b/src/coro/coroFromTexpr.ml
@@ -0,0 +1,514 @@
+open Globals
+open Type
+open CoroTypes
+open CoroFunctions
+
+let e_no_value = Texpr.Builder.make_null t_dynamic null_pos
+
+type coro_ret =
+ | RLocal of tvar
+ | RTerminate of (coro_block -> texpr -> unit)
+ | RValue
+ | RBlock
+ | RMapExpr of coro_ret * (texpr -> texpr)
+
+let expr_to_coro ctx etmp_result etmp_error_unwrapped cb_root e =
+ let make_block typepos =
+ make_block ctx typepos
+ in
+ let block_from_e e =
+ make_block (Some(e.etype,e.epos))
+ in
+ let has_side_effect e = match e.eexpr with
+ | TVar _ ->
+ (* has_side_effect doesn't consider var declarations a side effect which may just be wrong *)
+ true
+ | _ ->
+ OptimizerTexpr.has_side_effect e
+ in
+ let add_expr cb e =
+ if cb.cb_next = NextUnknown && e != e_no_value && has_side_effect e then
+ DynArray.add cb.cb_el e
+ in
+ let terminate cb kind t p =
+ if cb.cb_next = NextUnknown then
+ cb.cb_next <- kind;
+ in
+ let fall_through cb_from cb_to =
+ terminate cb_from (NextFallThrough cb_to) t_dynamic null_pos
+ in
+ let goto cb_from cb_to =
+ terminate cb_from (NextGoto cb_to) t_dynamic null_pos
+ in
+ let tmp_local cb t p =
+ let v = alloc_var VGenerated "tmp" t p in
+ add_expr cb (mk (TVar(v,None)) ctx.typer.t.tvoid p);
+ v
+ in
+ let check_complex cb ret t p = match ret with
+ | RValue ->
+ let v = tmp_local cb t p in
+ let ev = Texpr.Builder.make_local v v.v_pos in
+ ev,RLocal v
+ | RLocal v ->
+ let ev = Texpr.Builder.make_local v v.v_pos in
+ ev,ret
+ | _ ->
+ e_no_value,ret
+ in
+ let ret_map_expr ret f =
+ let ret = RMapExpr(ret,f) in
+ (ret,(fun e -> if e == e_no_value then e else f e))
+ in
+ let loop_stack = ref [] in
+ let rec loop cb ret e = match e.eexpr with
+ (* special cases *)
+ | TConst TThis | TBlock [] ->
+ Some (cb,e)
+ (* simple values *)
+ | TConst _ | TLocal _ | TTypeExpr _ | TIdent _ ->
+ Some (cb,e)
+ (* compound values *)
+ | TBlock [e1] ->
+ loop cb ret e1
+ | TBlock el ->
+ let cb_sub = block_from_e e in
+ let ret = match ret,el with
+ | RValue,_ :: _ ->
+ (*
+ If we have a multi-element block in a value-place we might need a temp var
+ because the result expression might reference local variables declared in
+ that block (https://github.com/Aidan63/haxe/issues/79).
+ *)
+ let v = tmp_local cb e.etype e.epos in
+ RLocal v
+ | _ ->
+ ret
+ in
+ let sub_next = loop_block cb_sub ret e in
+ let cb_next = match sub_next with
+ | None ->
+ None
+ | Some (cb_sub_next,e1) ->
+ let cb_next = make_block None in
+ fall_through cb_sub_next cb_next;
+ Some (cb_next,e1)
+ in
+ terminate cb (NextSub(cb_sub,Option.map fst cb_next)) e.etype e.epos;
+ cb_next
+ | TArray(e1,e2) ->
+ let cb = ordered_loop cb [e1;e2] in
+ Option.map (fun (cb,el) -> match el with
+ | [e1;e2] ->
+ (cb,{e with eexpr = TArray(e1,e2)})
+ | _ ->
+ die "" __LOC__
+ ) cb
+ | TArrayDecl el ->
+ let cb = ordered_loop cb el in
+ Option.map (fun (cb,el) -> (cb,{e with eexpr = TArrayDecl el})) cb
+ | TObjectDecl fl ->
+ let cb = ordered_loop cb (List.map snd fl) in
+ Option.map (fun (cb,el) ->
+ let fl = List.map2 (fun (f,_) e -> (f,e)) fl el in
+ (cb,{e with eexpr = TObjectDecl fl})
+ ) cb
+ | TField(e1,fa) ->
+ let cb = loop cb RValue e1 in
+ Option.map (fun (cb,e1) -> (cb,{e with eexpr = TField(e1,fa)})) cb
+ | TEnumParameter(e1,ef,i) ->
+ let cb = loop cb RValue e1 in
+ Option.map (fun (cb,e1) -> (cb,{e with eexpr = TEnumParameter(e1,ef,i)})) cb
+ | TEnumIndex e1 ->
+ let cb = loop cb RValue e1 in
+ Option.map (fun (cb,e1) -> (cb,{e with eexpr = TEnumIndex e1})) cb
+ | TNew(c,tl,el) ->
+ let cb = ordered_loop cb el in
+ Option.map (fun (cb,e1) -> cb,{e with eexpr = TNew(c,tl,el)}) cb
+ (* rewrites & forwards *)
+ | TCast(e1,o) ->
+ let (ret,map) = ret_map_expr ret (fun e1 -> {e with eexpr = TCast(e1,o)}) in
+ let cb = loop cb ret e1 in
+ Option.map (fun (cb,e1) -> (cb,map e1)) cb
+ | TParenthesis e1 ->
+ let (ret,map) = ret_map_expr ret (fun e1 -> {e with eexpr = TParenthesis e1}) in
+ let cb = loop cb ret e1 in
+ Option.map (fun (cb,e1) -> (cb,map e1)) cb
+ | TMeta(meta,e1) ->
+ let cb = loop cb ret e1 in
+ Option.map (fun (cb,e1) -> (cb,{e with eexpr = TMeta(meta,e1)})) cb
+ | TUnop(op,flag,e1) ->
+ let cb = loop cb ret (* TODO: is this right? *) e1 in
+ Option.map (fun (cb,e1) -> (cb,{e with eexpr = TUnop(op,flag,e1)})) cb
+ | TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) ->
+ let cb = loop_assign cb (RLocal v) e2 in
+ Option.map (fun (cb,e2) -> (cb,{e with eexpr = TBinop(OpAssign,e1,e2)})) cb
+ (* TODO: OpAssignOp and other OpAssign *)
+ | TBinop(op,e1,e2) ->
+ let cb = loop cb RValue e1 in
+ begin match cb with
+ | None ->
+ None
+ | Some (cb,e1) ->
+ let cb2 = loop cb RValue e2 in
+ begin match cb2 with
+ | None ->
+ add_expr cb e1;
+ None
+ | Some (cb,e2) ->
+ Some (cb,{e with eexpr = TBinop(op,e1,e2)})
+ end
+ end
+ (* variables *)
+ | TVar(v,None) ->
+ add_expr cb e;
+ Some (cb,e_no_value)
+ | TVar(v,Some e1) ->
+ add_expr cb {e with eexpr = TVar(v,None)};
+ let cb = loop_assign cb (RLocal v) e1 in
+ cb
+ (* calls *)
+ | TCall(e1,el) ->
+ let cb = ordered_loop cb (e1 :: el) in
+ Option.map (fun (cb,el) ->
+ begin match el with
+ | e1 :: el ->
+ begin match follow_with_coro e1.etype with
+ | Coro _ ->
+ let cb_next = block_from_e e1 in
+ add_block_flag cb_next CbResumeState;
+ add_block_flag cb CbSuspendState;
+ let eres,res = match ret with
+ | RValue ->
+ let v = tmp_local cb e.etype e.epos in
+ let ev = Texpr.Builder.make_local v v.v_pos in
+ cb_next.cb_stack_value <- Some ev;
+ ev,SusResult
+ | RTerminate _ | RMapExpr _ | RLocal _ ->
+ etmp_result,SusResult
+ | RBlock ->
+ e_no_value,SusBlock
+ in
+ let suspend = {
+ cs_fun = e1;
+ cs_args = el;
+ cs_pos = e.epos;
+ cs_result = res;
+ } in
+ terminate cb (NextSuspend(suspend,Some cb_next)) t_dynamic null_pos;
+ cb_next,eres
+ | _ ->
+ cb,{e with eexpr = TCall(e1,el)}
+ end
+ | [] ->
+ die "" __LOC__
+ end
+ ) cb
+ (* terminators *)
+ | TBreak ->
+ terminate cb (NextBreak (Lazy.force (snd (List.hd !loop_stack)))) e.etype e.epos;
+ None
+ | TContinue ->
+ terminate cb (NextContinue (fst (List.hd !loop_stack))) e.etype e.epos;
+ None
+ | TReturn None ->
+ terminate cb NextReturnVoid e.etype e.epos;
+ None
+ | TReturn (Some e1) ->
+ let f_terminate cb e1 =
+ terminate cb (NextReturn e1) e.etype e.epos;
+ in
+ let ret = RTerminate f_terminate in
+ let cb_ret = loop_assign cb ret e1 in
+ Option.may (fun (cb_ret,e1) -> terminate cb_ret (NextReturn e1) e.etype e.epos) cb_ret;
+ None
+ | TThrow e1 ->
+ let f_terminate cb e1 =
+ terminate cb (NextThrow e1) e.etype e.epos;
+ in
+ let ret = RTerminate f_terminate in
+ let cb_ret = loop_assign cb ret e1 in
+ Option.may (fun (cb_ret,e1) -> terminate cb_ret (NextThrow e1) e.etype e.epos) cb_ret;
+ None
+ (* branching *)
+ | TIf(e1,e2,None) ->
+ let cb = loop cb RValue e1 in
+ Option.map (fun (cb,e1) ->
+ let cb_then = block_from_e e2 in
+ let cb_then_next = loop_block cb_then RBlock e2 in
+ let cb_next = make_block None in
+ Option.may (fun (cb_then_next,_) -> fall_through cb_then_next cb_next) cb_then_next;
+ terminate cb (NextIfThen(e1,cb_then,cb_next)) e.etype e.epos;
+ cb_next,e_no_value
+ ) cb
+ | TIf(e1,e2,Some e3) ->
+ let e_value,ret = check_complex cb ret e.etype e.epos in
+ let cb = loop cb RValue e1 in
+ begin match cb with
+ | None ->
+ None
+ | Some(cb,e1) ->
+ let cb_then = block_from_e e2 in
+ let cb_then_next = loop_block cb_then ret e2 in
+ let cb_else = block_from_e e3 in
+ let cb_else_next = loop_block cb_else ret e3 in
+ let cb_next = match cb_then_next,cb_else_next with
+ | Some (cb_then_next,_),Some(cb_else_next,_) ->
+ let cb_next = make_block None in
+ fall_through cb_then_next cb_next;
+ fall_through cb_else_next cb_next;
+ Some cb_next
+ | (Some (cb_branch_next,_),None) | (None,Some (cb_branch_next,_)) ->
+ let cb_next = make_block None in
+ fall_through cb_branch_next cb_next;
+ Some cb_next
+ | None,None ->
+ None
+ in
+ terminate cb (NextIfThenElse(e1,cb_then,cb_else,cb_next)) e.etype e.epos;
+ Option.map (fun cb_next -> (cb_next,e_value)) cb_next
+ end
+ | TSwitch switch ->
+ let e_value,ret = check_complex cb ret e.etype e.epos in
+ let e1 = switch.switch_subject in
+ let cb = loop cb RValue e1 in
+ begin match cb with
+ | None ->
+ None
+ | Some(cb,e1) ->
+ let cb_next = lazy (make_block None) in
+ let cases = List.map (fun case ->
+ let cb_case = block_from_e case.case_expr in
+ let cb_case_next = loop_block cb_case ret case.case_expr in
+ Option.may (fun (cb_case_next,_) ->
+ fall_through cb_case_next (Lazy.force cb_next);
+ ) cb_case_next;
+ (case.case_patterns,cb_case)
+ ) switch.switch_cases in
+ let def = match switch.switch_default with
+ | None ->
+ None
+ | Some e ->
+ let cb_default = block_from_e e in
+ let cb_default_next = loop_block cb_default ret e in
+ Option.may (fun (cb_default_next,_) ->
+ fall_through cb_default_next (Lazy.force cb_next);
+ ) cb_default_next;
+ Some cb_default
+ in
+ let switch = {
+ cs_subject = e1;
+ cs_cases = cases;
+ cs_default = def;
+ cs_exhaustive = switch.switch_exhaustive
+ } in
+ let cb_next = if Lazy.is_val cb_next || not switch.cs_exhaustive then Some (Lazy.force cb_next) else None in
+ terminate cb (NextSwitch(switch,cb_next)) e.etype e.epos;
+ Option.map (fun cb_next -> (cb_next,e_value)) cb_next
+ end
+ | TWhile(e1,e2,flag) when not (is_true_expr e1) ->
+ loop cb ret (Texpr.not_while_true_to_while_true ctx.typer.com.Common.basic e1 e2 flag e.etype e.epos)
+ | TWhile(e1,e2,flag) (* always while(true) *) ->
+ let cb_next = lazy (make_block None) in
+ let cb_body = block_from_e e2 in
+ loop_stack := (cb_body,cb_next) :: !loop_stack;
+ let cb_body_next = loop_block cb_body RBlock e2 in
+ Option.may (fun (cb_body_next,_) -> goto cb_body_next cb_body) cb_body_next;
+ loop_stack := List.tl !loop_stack;
+ let cb_next = if Lazy.is_val cb_next then Some (Lazy.force cb_next) else None in
+ terminate cb (NextWhile(e1,cb_body,cb_next)) e.etype e.epos;
+ Option.map (fun cb_next -> (cb_next,e_no_value)) cb_next
+ | TTry(e1,catches) ->
+ let e_value,ret = check_complex cb ret e.etype e.epos in
+ ctx.has_catch <- true;
+ let cb_next = lazy (make_block None) in
+ let catches = List.map (fun (v,e) ->
+ let cb_catch = block_from_e e in
+ add_expr cb_catch (mk (TVar(v,Some (Lazy.force etmp_error_unwrapped))) ctx.typer.t.tvoid null_pos);
+ let cb_catch_next = loop_block cb_catch ret e in
+ Option.may (fun (cb_catch_next,_) ->
+ fall_through cb_catch_next (Lazy.force cb_next);
+ ) cb_catch_next;
+ v,cb_catch
+ ) catches in
+ let catch = make_block None in
+ (* This block is handled in a special way in the texpr transformer, let's mark it as
+ already generated so we don't generate it twice. *)
+ add_block_flag catch CbGenerated;
+ let old = ctx.current_catch in
+ ctx.current_catch <- Some catch;
+ let catch = {
+ cc_cb = catch;
+ cc_catches = catches;
+ } in
+ let cb_try = block_from_e e1 in
+ let cb_try_next = loop_block cb_try ret e1 in
+ ctx.current_catch <- old;
+ Option.may (fun (cb_try_next,_) ->
+ fall_through cb_try_next (Lazy.force cb_next)
+ ) cb_try_next;
+ let cb_next = if Lazy.is_val cb_next then Some (Lazy.force cb_next) else None in
+ terminate cb (NextTry(cb_try,catch,cb_next)) e.etype e.epos;
+ Option.map (fun cb_next -> (cb_next,e_value)) cb_next
+ | TFunction tf ->
+ Some (cb,e)
+ and ordered_loop cb el =
+ let rec aux' cb acc el = match el with
+ | [] ->
+ Some (cb,List.rev acc)
+ | e :: el ->
+ let cb' = loop cb RValue e in
+ match cb' with
+ | None ->
+ List.iter (fun e ->
+ add_expr cb e
+ ) (List.rev acc);
+ None
+ | Some (cb,e) ->
+ aux' cb (e :: acc) el
+ in
+ aux' cb [] el
+ and loop_assign cb ret e =
+ let cb = loop cb ret e in
+ let rec aux ret cb = match cb with
+ | Some (cb,e) when e != e_no_value ->
+ begin match ret with
+ | RBlock ->
+ add_expr cb e;
+ Some (cb,e_no_value)
+ | RValue ->
+ Some (cb,e)
+ | RLocal v ->
+ let ev = Texpr.Builder.make_local v v.v_pos in
+ let eass = Texpr.Builder.binop OpAssign ev e ev.etype ev.epos in
+ add_expr cb eass;
+ Some (cb,ev)
+ | RTerminate f ->
+ f cb e;
+ None
+ | RMapExpr(ret,f) ->
+ aux ret (Some(cb,f e))
+ end
+ | Some(cb,e) ->
+ Some(cb,e)
+ | None ->
+ None
+ in
+ aux ret cb
+ and loop_block cb ret e =
+ let el = match e.eexpr with
+ | TBlock el ->
+ el
+ | _ ->
+ [e]
+ in
+ let rec aux' cb el = match el with
+ | [] ->
+ assert false
+ | [e] ->
+ loop_assign cb ret e
+ | e :: el ->
+ let cb = loop cb RBlock e in
+ begin match cb with
+ | None ->
+ None
+ | Some(cb,e) ->
+ add_expr cb e;
+ aux' cb el
+ end
+ in
+ match el with
+ | [] ->
+ None
+ | _ ->
+ aux' cb el
+ in
+ loop_block cb_root RBlock e
+
+let optimize_cfg ctx cb =
+ let forward_el cb_from cb_to =
+ if DynArray.length cb_from.cb_el > 0 then begin
+ if DynArray.length cb_to.cb_el = 0 then begin
+ DynArray.iter (fun e -> DynArray.add cb_to.cb_el e) cb_from.cb_el
+ end else begin
+ let e = mk (TBlock (DynArray.to_list cb_from.cb_el)) ctx.typer.t.tvoid null_pos in
+ DynArray.set cb_to.cb_el 0 (concat e (DynArray.get cb_to.cb_el 0))
+ end
+ end
+ in
+ (* first pass: find empty blocks and store their replacement*)
+ let forward = Array.make ctx.next_block_id None in
+ let rec loop cb =
+ if not (has_block_flag cb CbEmptyMarked) then begin
+ add_block_flag cb CbEmptyMarked;
+ match cb.cb_next with
+ | NextSub(cb_sub,None) ->
+ loop cb_sub;
+ forward_el cb cb_sub;
+ if has_block_flag cb CbResumeState then add_block_flag cb_sub CbResumeState;
+ forward.(cb.cb_id) <- Some cb_sub
+ | NextFallThrough cb_next | NextGoto cb_next when DynArray.empty cb.cb_el && not (has_block_flag cb CbResumeState) ->
+ loop cb_next;
+ forward.(cb.cb_id) <- Some cb_next
+ | _ ->
+ coro_iter loop cb
+ end
+ in
+ loop cb;
+ (* second pass: map graph to skip forwarding block *)
+ let rec loop cb = match forward.(cb.cb_id) with
+ | Some cb ->
+ loop cb
+ | None ->
+ if not (has_block_flag cb CbForwardMarked) then begin
+ add_block_flag cb CbForwardMarked;
+ coro_next_map loop cb;
+ end;
+ cb
+ in
+ let cb = loop cb in
+ let is_empty_termination_block cb = match cb with
+ | None ->
+ true
+ | Some cb ->
+ DynArray.empty cb.cb_el && match cb.cb_next with
+ | NextReturnVoid | NextUnknown ->
+ true
+ | _ ->
+ false
+ in
+ let rec loop cb =
+ if not (has_block_flag cb CbTcoChecked) then begin
+ add_block_flag cb CbTcoChecked;
+ begin match cb.cb_next with
+ | NextSuspend(_,cb_next) ->
+ if not (is_empty_termination_block cb_next) then
+ raise Exit;
+ | _ ->
+ ()
+ end;
+ coro_iter loop cb;
+ end
+ in
+ if ctx.allow_tco && not ctx.has_catch then
+ (try loop cb; raise (CoroTco cb) with Exit -> ());
+ (* third pass: reindex cb_id for tighter switches. Breadth-first because that makes the numbering more natural, maybe. *)
+ let i = ref 0 in
+ let queue = Queue.create () in
+ Queue.push cb queue;
+ let rec loop () =
+ if not (Queue.is_empty queue) then begin
+ let cb = Queue.pop queue in
+ if not (has_block_flag cb CbReindexed) then begin
+ add_block_flag cb CbReindexed;
+ cb.cb_id <- !i;
+ incr i;
+ coro_iter (fun cb -> Queue.add cb queue) cb;
+ Option.may (fun cb -> Queue.add cb queue) cb.cb_catch;
+ end;
+ loop ()
+ end
+ in
+ loop ();
+ ctx.next_block_id <- !i;
+ cb
\ No newline at end of file
diff --git a/src/coro/coroFunctions.ml b/src/coro/coroFunctions.ml
new file mode 100644
index 00000000000..68329c2d564
--- /dev/null
+++ b/src/coro/coroFunctions.ml
@@ -0,0 +1,123 @@
+open Globals
+open Type
+open CoroTypes
+
+let make_block ctx typepos =
+ let id = ctx.next_block_id in
+ ctx.next_block_id <- ctx.next_block_id + 1;
+ {
+ cb_id = id;
+ cb_el = DynArray.create ();
+ cb_typepos = typepos;
+ cb_next = NextUnknown;
+ cb_catch = ctx.current_catch;
+ cb_flags = 0;
+ cb_stack_value = None;
+ }
+
+let add_block_flag cb (flag : cb_flag) =
+ cb.cb_flags <- set_flag cb.cb_flags (Obj.magic flag)
+
+let has_block_flag cb (flag : cb_flag) =
+ has_flag cb.cb_flags (Obj.magic flag)
+
+let get_block_exprs cb =
+ let rec loop idx acc =
+ if idx < 0 then
+ acc
+ else begin
+ let acc = match DynArray.unsafe_get cb.cb_el idx with
+ | {eexpr = TBlock el} ->
+ el @ acc
+ | e ->
+ e :: acc
+ in
+ loop (idx - 1) acc
+ end in
+ loop (DynArray.length cb.cb_el - 1) []
+
+let coro_iter f cb =
+ let fo = Option.may f in
+ fo cb.cb_catch;
+ match cb.cb_next with
+ | NextSub(cb_sub,cb_next) ->
+ f cb_sub;
+ fo cb_next
+ | NextIfThen(_,cb_then,cb_next) ->
+ f cb_then;
+ f cb_next;
+ | NextIfThenElse(_,cb_then,cb_else,cb_next) ->
+ f cb_then;
+ f cb_else;
+ fo cb_next;
+ | NextSwitch(switch,cb_next) ->
+ List.iter (fun (_,cb) -> f cb) switch.cs_cases;
+ Option.may f switch.cs_default;
+ fo cb_next;
+ | NextWhile(e,cb_body,cb_next) ->
+ f cb_body;
+ fo cb_next;
+ | NextTry(cb_try,catch,cb_next) ->
+ f cb_try;
+ f catch.cc_cb;
+ List.iter (fun (_,cb) -> f cb) catch.cc_catches;
+ fo cb_next;
+ | NextSuspend(call,cb_next) ->
+ fo cb_next
+ | NextBreak cb_next | NextContinue cb_next | NextFallThrough cb_next | NextGoto cb_next ->
+ f cb_next;
+ | NextUnknown | NextReturnVoid | NextReturn _ | NextThrow _ ->
+ ()
+
+let coro_next_map f cb =
+ Option.may (fun cb_catch -> cb.cb_catch <- Some (f cb_catch)) cb.cb_catch;
+ let fo = Option.map f in
+ match cb.cb_next with
+ | NextSub(cb_sub,cb_next) ->
+ let cb_sub = f cb_sub in
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextSub(cb_sub,cb_next);
+ | NextIfThen(e,cb_then,cb_next) ->
+ let cb_then = f cb_then in
+ let cb_next = f cb_next in
+ cb.cb_next <- NextIfThen(e,cb_then,cb_next);
+ | NextIfThenElse(e,cb_then,cb_else,cb_next) ->
+ let cb_then = f cb_then in
+ let cb_else = f cb_else in
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextIfThenElse(e,cb_then,cb_else,cb_next);
+ | NextSwitch(switch,cb_next) ->
+ let cases = List.map (fun (el,cb) -> (el,f cb)) switch.cs_cases in
+ let def = Option.map f switch.cs_default in
+ let switch = {
+ switch with cs_cases = cases; cs_default = def
+ } in
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextSwitch(switch,cb_next);
+ | NextWhile(e,cb_body,cb_next) ->
+ let cb_body = f cb_body in
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextWhile(e,cb_body,cb_next);
+ | NextTry(cb_try,catch,cb_next) ->
+ let cb_try = f cb_try in
+ let cc_cb = f catch.cc_cb in
+ let catches = List.map (fun (v,cb) -> (v,f cb)) catch.cc_catches in
+ let catch = {
+ cc_cb;
+ cc_catches = catches
+ } in
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextTry(cb_try,catch,cb_next);
+ | NextSuspend(call,cb_next) ->
+ let cb_next = fo cb_next in
+ cb.cb_next <- NextSuspend(call,cb_next);
+ | NextBreak cb_next ->
+ cb.cb_next <- NextBreak (f cb_next);
+ | NextContinue cb_next ->
+ cb.cb_next <- NextContinue (f cb_next);
+ | NextGoto cb_next ->
+ cb.cb_next <- NextGoto (f cb_next);
+ | NextFallThrough cb_next ->
+ cb.cb_next <- NextFallThrough (f cb_next);
+ | NextReturnVoid | NextReturn _ | NextThrow _ | NextUnknown ->
+ ()
\ No newline at end of file
diff --git a/src/coro/coroInit.ml b/src/coro/coroInit.ml
new file mode 100644
index 00000000000..3b10bbb1d87
--- /dev/null
+++ b/src/coro/coroInit.ml
@@ -0,0 +1,47 @@
+open Globals
+open Type
+open Typecore
+
+let load_module_class ctx path =
+ let m = ctx.g.do_load_module ctx path null_pos in
+ ExtList.List.find_map_exn (function
+ | TClassDecl({ cl_path = path' } as cl) when path = path' ->
+ Some cl
+ | _ ->
+ None
+ ) m.m_types
+
+let load_module_abstract ctx path =
+ let m = ctx.g.do_load_module ctx path null_pos in
+ ExtList.List.find_map_exn (function
+ | TAbstractDecl({ a_path = path' } as a) when path = path' ->
+ Some a
+ | _ ->
+ None
+ ) m.m_types
+
+let make_continuation_api ctx =
+ let base_continuation_class = load_module_class ctx (["haxe";"coro"], "BaseContinuation") in
+ let immediate_suspension_result_class = load_module_class ctx (["haxe";"coro"],"ImmediateSuspensionResult") in
+ let suspension_state = TAbstract(load_module_abstract ctx (["haxe";"coro"],"SuspensionState"),[]) in
+ let suspension_result_class = Lazy.force ctx.t.tcoro.suspension_result_class in
+ let cf_state = PMap.find "state" suspension_result_class.cl_fields in
+ let cf_result = PMap.find "result" suspension_result_class.cl_fields in
+ let cf_error = PMap.find "error" suspension_result_class.cl_fields in
+ let cf_completion = PMap.find "completion" base_continuation_class.cl_fields in
+ let cf_context = PMap.find "context" base_continuation_class.cl_fields in
+ let cf_goto_label = PMap.find "gotoLabel" base_continuation_class.cl_fields in
+ let cf_recursing = PMap.find "recursing" base_continuation_class.cl_fields in
+ let immediate_result,immediate_error =
+ let c = immediate_suspension_result_class in
+ let cf_result = PMap.find "withResult" c.cl_statics in
+ let cf_error = PMap.find "withError" c.cl_statics in
+ (fun e ->
+ CallUnification.make_static_call_better ctx c cf_result [e.etype] [e] (TInst(c,[e.etype])) e.epos
+ ), (fun e t ->
+ CallUnification.make_static_call_better ctx c cf_error [] [e] (TInst(c,[t])) e.epos
+ )
+ in
+ let api = ContTypes.create_continuation_api base_continuation_class immediate_suspension_result_class suspension_state suspension_result_class (Lazy.force ctx.t.tcoro.continuation) immediate_result immediate_error cf_state cf_result cf_error cf_completion cf_context cf_goto_label cf_recursing in
+ ctx.g.continuation_api <- Some api;
+ api
\ No newline at end of file
diff --git a/src/coro/coroToTexpr.ml b/src/coro/coroToTexpr.ml
new file mode 100644
index 00000000000..7ae000d1f0e
--- /dev/null
+++ b/src/coro/coroToTexpr.ml
@@ -0,0 +1,436 @@
+open Globals
+open CoroTypes
+open CoroFunctions
+open Type
+open ContTypes
+open Texpr
+open CoroControl
+
+type coro_state = {
+ cs_id : int;
+ mutable cs_el : texpr list;
+}
+
+type coro_to_texpr_exprs = {
+ econtinuation : texpr;
+ ecompletion : texpr;
+ estate : texpr;
+ eresult : texpr;
+ egoto : texpr;
+ eerror : texpr;
+ etmp_result : texpr;
+ etmp_error : texpr;
+ etmp_error_unwrapped : texpr Lazy.t;
+}
+
+let make_suspending_call basic cont call econtinuation =
+ (* lose Coroutine type for the called function not to confuse further filters and generators *)
+ let tfun = match follow_with_coro call.cs_fun.etype with
+ | Coro (args, ret) ->
+ let args,ret = Common.expand_coro_type basic args ret in
+ TFun (args, ret)
+ | NotCoro _ ->
+ die "Unexpected coroutine type" __LOC__
+ in
+ let efun = { call.cs_fun with etype = tfun } in
+ let args = call.cs_args @ [ econtinuation ] in
+ mk (TCall (efun, args)) (cont.suspension_result basic.tany) call.cs_pos
+
+let handle_locals ctx b cls states tf_args forbidden_vars econtinuation =
+ let module IntSet = Set.Make(struct
+ let compare a b = b - a
+ type t = int
+ end) in
+
+ (* function arguments are accessible from the initial state without hoisting needed, so set that now *)
+ let arg_state_set = IntSet.of_list [ (List.hd states).cs_id ] in
+ let var_usages = tf_args |> List.map (fun (v, _) -> v.v_id, arg_state_set) |> List.to_seq |> Hashtbl.of_seq in
+
+ (* First iteration, just add newly discovered local variables *)
+ (* After this var_usages will contain all arguments and local vars and the states sets will be just the creation state *)
+ (* We don't handle locals here so we don't poison the var_usage hashtbl with non local var data *)
+ List.iter (fun state ->
+ let rec loop e =
+ match e.eexpr with
+ | TVar (v, eo) ->
+ Option.may loop eo;
+ Hashtbl.replace var_usages v.v_id (IntSet.of_list [ state.cs_id ])
+ | _ ->
+ Type.iter loop e
+ in
+ List.iter loop state.cs_el
+ ) states;
+
+ (* Second interation, visit all locals and update any local variable state sets *)
+ List.iter (fun state ->
+ let rec loop e =
+ match e.eexpr with
+ | TLocal (v) ->
+ (match Hashtbl.find_opt var_usages v.v_id with
+ | Some set ->
+ Hashtbl.replace var_usages v.v_id (IntSet.add state.cs_id set)
+ | None ->
+ ())
+ | _ ->
+ Type.iter loop e
+ in
+ List.iter loop state.cs_el
+ ) states;
+
+ let is_used_across_states v_id =
+ let many_states set v_id =
+ IntSet.elements set |> List.length > 1 in
+ (* forbidden vars are things like the _hx_continuation variable, they should not be hoisted *)
+ let non_coro_var v_id =
+ forbidden_vars |> List.exists (fun id -> id = v_id) |> not in
+
+ match Hashtbl.find_opt var_usages v_id with
+ | Some set when many_states set v_id && non_coro_var v_id ->
+ true
+ | _ ->
+ false
+ in
+
+ let fields =
+ tf_args
+ |> List.filter_map (fun (v, _) ->
+ if is_used_across_states v.v_id then
+ Some (v.v_id, mk_field (Printf.sprintf "_hx_hoisted%i" v.v_id) v.v_type v.v_pos v.v_pos)
+ else
+ None)
+ |> List.to_seq
+ |> Hashtbl.of_seq in
+
+ (* Third iteration, create fields for vars used across states and remap access to those fields *)
+ List.iter (fun state ->
+ let rec loop e =
+ match e.eexpr with
+ | TVar (v, eo) when is_used_across_states v.v_id ->
+ let name = Printf.sprintf "_hx_hoisted%i" v.v_id in
+ let field = mk_field name v.v_type v.v_pos v.v_pos in
+
+ Hashtbl.replace fields v.v_id field;
+
+ begin match eo with
+ | None ->
+ (* We need an expression, so let's just emit `null`. The analyzer will clean this up. *)
+ b#null t_dynamic e.epos
+ | Some e ->
+ let efield = b#instance_field econtinuation cls [] field field.cf_type in
+ let einit =
+ match eo with
+ | None -> Builder.default_value v.v_type v.v_pos
+ | Some e -> Type.map_expr loop e in
+ b#assign efield einit
+ end
+ (* A local of a var should never appear before its declaration, right? *)
+ | TLocal (v) when is_used_across_states v.v_id ->
+ let field = Hashtbl.find fields v.v_id in
+
+ b#instance_field econtinuation cls [] field field.cf_type
+ | _ ->
+ Type.map_expr loop e
+ in
+ state.cs_el <- List.map loop state.cs_el
+ ) states;
+
+ (* We need to do this argument copying as the last thing we do *)
+ (* Doing it when the initial fields hashtbl is created will cause the third iterations TLocal to re-write them... *)
+ List.iter (fun (v, _) ->
+ if is_used_across_states v.v_id then
+ let initial = List.hd states in
+ let field = Hashtbl.find fields v.v_id in
+ let efield = b#instance_field econtinuation cls [] field field.cf_type in
+ let assign = b#assign efield (b#local v v.v_pos) in
+
+ initial.cs_el <- assign :: initial.cs_el) tf_args;
+ fields
+
+let block_to_texpr_coroutine ctx cb cont cls params tf_args forbidden_vars exprs p stack_item_inserter start_exception =
+ let {econtinuation;ecompletion;estate;eresult;egoto;eerror;etmp_result;etmp_error;etmp_error_unwrapped} = exprs in
+ let com = ctx.typer.com in
+ let b = ctx.builder in
+
+ let set_state id = b#assign egoto (b#int id p) in
+
+ let set_control (c : coro_control) = b#assign estate (CoroControl.mk_control com.basic c) in
+
+ let std_is e t =
+ let type_expr = mk (TTypeExpr (module_type_of_type t)) t_dynamic p in
+ Texpr.Builder.resolve_and_make_static_call com.std "isOfType" [e;type_expr] p
+ in
+
+ let ereturn = b#return econtinuation in
+
+ let mk_suspending_call call =
+ let p = call.cs_pos in
+ let base_continuation_field_on e cf t =
+ b#instance_field e cont.suspension_result_class [com.basic.tany] cf t
+ in
+ let ecreatecoroutine = make_suspending_call com.basic cont call {econtinuation with epos = p} in
+
+ let vcororesult = alloc_var VGenerated "_hx_tmp" (cont.suspension_result com.basic.tany) p in
+ let ecororesult = b#local vcororesult p in
+ let cororesult_var = b#var_init vcororesult ecreatecoroutine in
+ let open ContTypes in
+ let esubject = base_continuation_field_on ecororesult cont.state cont.state.cf_type in
+ let esuspended = b#void_block [
+ set_control CoroPending;
+ ereturn;
+ ] in
+ let eres = base_continuation_field_on ecororesult cont.result com.basic.tany in
+ let ereturned = match call.cs_result with
+ | SusBlock ->
+ b#void_block []
+ | SusResult ->
+ b#assign etmp_result eres
+ in
+ let eerror = base_continuation_field_on ecororesult cont.error cont.error.cf_type in
+ let ethrown = b#void_block [
+ b#assign etmp_error eerror;
+ b#break p;
+ ] in
+ let estate_switch = CoroControl.make_control_switch com.basic esubject esuspended ereturned ethrown p in
+ [
+ stack_item_inserter call.cs_pos;
+ cororesult_var;
+ estate_switch;
+ ]
+ in
+
+ let states = ref [] in
+
+ let init_state = cb.cb_id in
+
+ let make_state id el = {
+ cs_id = id;
+ cs_el = el;
+ } in
+
+ let get_caught,unwrap_exception = match com.basic.texception with
+ | TInst(c,_) ->
+ let unwrap =
+ let cf = PMap.find "unwrap" c.cl_fields in
+ (fun e ->
+ let e = b#instance_field e c [] cf cf.cf_type in
+ b#call e [] com.basic.tany
+ )
+ in
+ (fun e -> Texpr.Builder.resolve_and_make_static_call c "caught" [e] e.epos),
+ unwrap
+ | _ ->
+ die "" __LOC__
+ in
+ let eif_error cb =
+ let el = [
+ b#assign etmp_error eerror;
+ b#break p;
+ ] in
+ let e_then = b#void_block el in
+ let e_if = b#binop OpNotEq eerror (b#null eerror.etype p) com.basic.tbool in
+ match cb.cb_stack_value with
+ | None ->
+ b#if_then e_if e_then
+ | Some e ->
+ let e_assign = b#assign e etmp_result in
+ b#if_then_else e_if e_then e_assign com.basic.tvoid
+ in
+
+ let exc_state_map = Array.init ctx.next_block_id (fun _ -> ref []) in
+ let generate cb =
+ let el = get_block_exprs cb in
+
+ let add_state next_id extra_el =
+ let el = el in
+ let el = match next_id with
+ | None ->
+ el
+ | Some id ->
+ el @ [set_state id]
+ in
+ let el = if has_block_flag cb CbResumeState then
+ eif_error cb :: el
+ else
+ el
+ in
+ let el = el @ extra_el in
+ states := (make_state cb.cb_id el) :: !states;
+ begin match cb.cb_catch with
+ | None ->
+ ()
+ | Some cb' ->
+ let r = exc_state_map.(cb'.cb_id) in
+ r := cb.cb_id :: !r
+ end;
+ cb.cb_id
+ in
+ match cb.cb_next with
+ | NextSuspend (call, cb_next) ->
+ let ecallcoroutine = mk_suspending_call call in
+ add_state (Option.map (fun cb_next -> cb_next.cb_id) cb_next) ecallcoroutine;
+ | NextUnknown ->
+ add_state (Some (-1)) [set_control CoroReturned; ereturn]
+ | NextFallThrough cb_next | NextGoto cb_next | NextBreak cb_next | NextContinue cb_next ->
+ add_state (Some cb_next.cb_id) []
+ | NextReturnVoid ->
+ add_state (Some (-1)) [ set_control CoroReturned; ereturn ]
+ | NextReturn e ->
+ add_state (Some (-1)) [ set_control CoroReturned; b#assign eresult e; ereturn ]
+ | NextThrow e1 ->
+ add_state None ([b#assign etmp_error (get_caught e1); stack_item_inserter e1.epos; start_exception etmp_error; b#break p ])
+ | NextSub (cb_sub,cb_next) ->
+ add_state (Some cb_sub.cb_id) []
+
+ | NextIfThen (econd,cb_then,cb_next) ->
+ let eif = b#if_then_else econd (set_state cb_then.cb_id) (set_state cb_next.cb_id) com.basic.tint in
+ add_state None [eif]
+
+ | NextIfThenElse (econd,cb_then,cb_else,cb_next) ->
+ let eif = b#if_then_else econd (set_state cb_then.cb_id) (set_state cb_else.cb_id) com.basic.tint in
+ add_state None [eif]
+
+ | NextSwitch(switch,cb_next) ->
+ let esubj = switch.cs_subject in
+ let ecases = List.map (fun (patterns,cb) ->
+ {case_patterns = patterns;case_expr = set_state cb.cb_id}
+ ) switch.cs_cases in
+ let next_id = match switch.cs_default with
+ | Some cb ->
+ Some (set_state cb.cb_id)
+ | None ->
+ Option.map (fun cb_next -> set_state cb_next.cb_id) cb_next
+ in
+ let eswitch = mk_switch esubj ecases next_id true in
+ let eswitch = mk (TSwitch eswitch) com.basic.tvoid p in
+
+ add_state None [eswitch]
+
+ | NextWhile (e_cond,cb_body,cb_next) ->
+ add_state (Some cb_body.cb_id) []
+
+ | NextTry (cb_try,catch,cb_next) ->
+ let new_exc_state_id = catch.cc_cb.cb_id in
+ let erethrow = match catch.cc_cb.cb_catch with
+ | Some cb ->
+ set_state cb.cb_id
+ | None ->
+ b#void_block [
+ b#break p
+ ]
+ in
+ let eif =
+ List.fold_left (fun enext (vcatch,cb_catch) ->
+ match follow vcatch.v_type with
+ | TDynamic _ ->
+ set_state cb_catch.cb_id (* no next *)
+ | t ->
+ let etypecheck = std_is (Lazy.force etmp_error_unwrapped) vcatch.v_type in
+ b#if_then_else etypecheck (set_state cb_catch.cb_id) enext com.basic.tvoid
+ ) erethrow (List.rev catch.cc_catches)
+ in
+ let el = if Lazy.is_val etmp_error_unwrapped then
+ [b#assign (Lazy.force etmp_error_unwrapped) (unwrap_exception etmp_error);eif]
+ else
+ [eif]
+ in
+ states := (make_state new_exc_state_id el) :: !states;
+ add_state (Some cb_try.cb_id) []
+ in
+ let rec loop cb =
+ if not (has_block_flag cb CbGenerated) then begin
+ add_block_flag cb CbGenerated;
+ ignore(generate cb);
+ coro_iter loop cb;
+ end
+ in
+ loop cb;
+
+ let states = !states in
+ let states = states |> List.sort (fun state1 state2 -> state1.cs_id - state2.cs_id) in
+
+ let fields = handle_locals ctx b cls states tf_args forbidden_vars econtinuation in
+
+ let ethrow = b#void_block [
+ b#assign etmp_error (get_caught (b#string "Invalid coroutine state" p));
+ b#break p
+ ] in
+
+ let switch =
+ let cases = List.map (fun state ->
+ {case_patterns = [b#int state.cs_id p];
+ case_expr = b#void_block state.cs_el;
+ }) states in
+ mk_switch egoto cases (Some ethrow) true
+ in
+ let eswitch = mk (TSwitch switch) com.basic.tvoid p in
+
+ let eloop = mk (TWhile (b#bool true p, eswitch, NormalWhile)) com.basic.tvoid p in
+
+ let etry = if ctx.nothrow then
+ eloop
+ else
+ mk (TTry (
+ eloop,
+ [
+ let vcaught = alloc_var VGenerated "e" t_dynamic p in
+ let ecaught = b#local vcaught p in
+ let ecaught = get_caught ecaught in
+ let e = b#void_block [
+ start_exception ecaught;
+ b#assign etmp_error ecaught
+ ] in
+ (vcaught,e)
+ ]
+ )) com.basic.tvoid p
+ in
+
+ let eexchandle =
+ let cases = DynArray.create () in
+ Array.iteri (fun i l -> match !l with
+ | [] ->
+ ()
+ | l ->
+ let patterns = List.map (fun i -> b#int i p) l in
+ let expr = b#void_block [
+ set_state i;
+ ] in
+ DynArray.add cases {case_patterns = patterns; case_expr = expr};
+ ) exc_state_map;
+ let el =
+ let field = PMap.find "buildCallStack" cont.base_continuation_class.cl_fields in
+ let eaccess = b#instance_field econtinuation cont.base_continuation_class params field field.cf_type in
+ let ewrapped_call = mk (TCall (eaccess, [ ])) com.basic.tvoid p in
+ [
+ b#assign eerror etmp_error;
+ ewrapped_call;
+ set_control CoroThrown;
+ ereturn;
+ ]
+ in
+ let default = b#void_block el in
+ if DynArray.empty cases then
+ default
+ else begin
+ let switch = {
+ switch_subject = egoto;
+ switch_cases = DynArray.to_list cases;
+ switch_default = Some default;
+ switch_exhaustive = true
+ } in
+ mk (TSwitch switch) com.basic.tvoid p
+ end
+ in
+
+ let etry = b#void_block [
+ etry;
+ eexchandle;
+ ] in
+
+ let eloop = if ctx.has_catch then
+ mk (TWhile (b#bool true p, etry, NormalWhile)) com.basic.tvoid p
+ else
+ (* If there is no catch we don't need to pseudo-goto back into the state loop, so we don't need a control loop. *)
+ etry
+ in
+
+ eloop, init_state, fields |> Hashtbl.to_seq_values |> List.of_seq
diff --git a/src/coro/coroTypes.ml b/src/coro/coroTypes.ml
new file mode 100644
index 00000000000..e8a208339a7
--- /dev/null
+++ b/src/coro/coroTypes.ml
@@ -0,0 +1,79 @@
+open Globals
+open Type
+
+type suspend_expr =
+ | SusBlock
+ | SusResult
+
+type coro_block = {
+ mutable cb_id : int;
+ cb_el : texpr DynArray.t;
+ cb_typepos : (Type.t * pos) option;
+ mutable cb_catch : coro_block option;
+ mutable cb_next : coro_next;
+ mutable cb_flags : int;
+ mutable cb_stack_value : texpr option;
+}
+
+and coro_block_next = coro_block option
+
+and coro_next =
+ | NextUnknown
+ | NextSub of coro_block * coro_block_next
+ | NextReturnVoid
+ | NextReturn of texpr
+ | NextThrow of texpr
+ | NextIfThen of texpr * coro_block * coro_block
+ | NextIfThenElse of texpr * coro_block * coro_block * coro_block_next
+ | NextSwitch of coro_switch * coro_block_next
+ | NextWhile of texpr * coro_block * coro_block_next
+ | NextTry of coro_block * coro_catch * coro_block_next
+ | NextSuspend of coro_suspend * coro_block_next
+ (* graph connections from here on, careful with traversal *)
+ | NextBreak of coro_block
+ | NextContinue of coro_block
+ | NextFallThrough of coro_block
+ | NextGoto of coro_block
+
+and coro_switch = {
+ cs_subject : texpr;
+ cs_cases : (texpr list * coro_block) list;
+ cs_default : coro_block option;
+ cs_exhaustive : bool;
+}
+
+and coro_catch = {
+ cc_cb : coro_block;
+ cc_catches : (tvar * coro_block) list;
+}
+
+and coro_suspend = {
+ cs_fun : texpr;
+ cs_args : texpr list;
+ cs_pos : pos;
+ cs_result : suspend_expr;
+}
+
+type coro_ctx = {
+ builder : CoroElsewhere.texpr_builder;
+ typer : Typecore.typer;
+ coro_debug : bool;
+ optimize : bool;
+ allow_tco : bool;
+ nothrow : bool;
+ mutable vthis : tvar option;
+ mutable next_block_id : int;
+ mutable current_catch : coro_block option;
+ mutable has_catch : bool;
+}
+
+type cb_flag =
+ | CbEmptyMarked
+ | CbForwardMarked
+ | CbTcoChecked
+ | CbReindexed
+ | CbGenerated
+ | CbSuspendState
+ | CbResumeState
+
+exception CoroTco of coro_block
\ No newline at end of file
diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml
index b53b1b2c0c8..3e705c69c2c 100644
--- a/src/generators/cpp/gen/cppGenClassImplementation.ml
+++ b/src/generators/cpp/gen/cppGenClassImplementation.ml
@@ -831,8 +831,8 @@ let generate_managed_class base_ctx tcpp_class =
output_cpp "#endif\n\n");
let generate_script_function isStatic field scriptName callName =
- match follow field.cf_type with
- | TFun (args, return_type) when not (is_data_member field) ->
+ if not (is_data_member field) then
+ let gen (args, return_type) =
let isTemplated = not isStatic in
if isTemplated then output_cpp "\ntemplate";
output_cpp
@@ -880,43 +880,51 @@ let generate_managed_class base_ctx tcpp_class =
if ret <> "v" then output_cpp ")";
output_cpp ";\n}\n";
signature
- | _ -> ""
+ in
+ match follow_with_coro field.cf_type with
+ | Coro (args, return) -> Common.expand_coro_type ctx.ctx_common.basic args return |> gen
+ | NotCoro TFun (args, return) -> gen (args, return)
+ | _ -> ""
+ else
+ ""
in
if scriptable then (
let dump_script_func idx func =
- match func.tcf_field.cf_type with
- | TFun (f_args, _) ->
- let args = print_tfun_arg_list true f_args in
- let return_type = type_to_string func.tcf_func.tf_type in
- let ret = if return_type = "Void" || return_type = "void" then " " else "return " in
- let vtable = Printf.sprintf "__scriptVTable[%i]" (idx + 1) in
-
- Printf.sprintf "\t%s %s(%s) {\n" return_type func.tcf_name args |> output_cpp;
- Printf.sprintf ("\tif (%s) {\n") vtable |> output_cpp;
- output_cpp "\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n";
- output_cpp "\t\t::hx::AutoStack __as(__ctx);\n";
- output_cpp ("\t\t__ctx->pushObject( this );\n");
-
- List.iter
- (fun (name, opt, t) ->
- Printf.sprintf "\t\t__ctx->push%s(%s);\n" (CppCppia.script_type t opt) (keyword_remap name) |> output_cpp)
- f_args;
+ let f_args =
+ match follow_with_coro func.tcf_field.cf_type with
+ | Coro (args, return) -> Common.expand_coro_type ctx.ctx_common.basic args return |> fst
+ | NotCoro TFun (args, _) -> args
+ | _ -> abort "expected function type to be tfun" func.tcf_field.cf_pos
+ in
+ let args = print_tfun_arg_list true f_args in
+ let return_type = type_to_string func.tcf_func.tf_type in
+ let ret = if return_type = "Void" || return_type = "void" then " " else "return " in
+ let vtable = Printf.sprintf "__scriptVTable[%i]" (idx + 1) in
- output_cpp
- ("\t\t" ^ ret ^ "__ctx->run" ^ CppCppia.script_type func.tcf_func.tf_type false ^ "(" ^ vtable ^ ");\n");
- output_cpp ("\t} else " ^ ret);
+ Printf.sprintf "\t%s %s(%s) {\n" return_type func.tcf_name args |> output_cpp;
+ Printf.sprintf ("\tif (%s) {\n") vtable |> output_cpp;
+ output_cpp "\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n";
+ output_cpp "\t\t::hx::AutoStack __as(__ctx);\n";
+ output_cpp ("\t\t__ctx->pushObject( this );\n");
+
+ List.iter
+ (fun (name, opt, t) ->
+ Printf.sprintf "\t\t__ctx->push%s(%s);\n" (CppCppia.script_type t opt) (keyword_remap name) |> output_cpp)
+ f_args;
- let names = List.map (fun (n, _, _) -> keyword_remap n) f_args in
+ output_cpp
+ ("\t\t" ^ ret ^ "__ctx->run" ^ CppCppia.script_type func.tcf_func.tf_type false ^ "(" ^ vtable ^ ");\n");
+ output_cpp ("\t} else " ^ ret);
- output_cpp
- (class_name ^ "::" ^ func.tcf_name ^ "(" ^ String.concat "," names ^ ");");
+ let names = List.map (fun (n, _, _) -> keyword_remap n) f_args in
- if return_type <> "void" then output_cpp "return null();";
+ output_cpp
+ (class_name ^ "::" ^ func.tcf_name ^ "(" ^ String.concat "," names ^ ");");
- output_cpp "}\n";
- | _ ->
- abort "expected function type to be tfun" func.tcf_field.cf_pos
+ if return_type <> "void" then output_cpp "return null();";
+
+ output_cpp "}\n"
in
let script_name = class_name ^ "__scriptable" in
diff --git a/src/generators/cpp/gen/cppReferences.ml b/src/generators/cpp/gen/cppReferences.ml
index 294a72febaa..1e3d8e7bbde 100644
--- a/src/generators/cpp/gen/cppReferences.ml
+++ b/src/generators/cpp/gen/cppReferences.ml
@@ -89,39 +89,45 @@ let find_referenced_types_flags ctx obj filter super_deps constructor_deps heade
let rec visit_type in_type =
if not (List.exists (fun t2 -> Type.fast_eq in_type t2) !visited) then (
visited := in_type :: !visited;
- (match follow in_type with
- | TMono r -> ( match r.tm_type with None -> () | Some t -> visit_type t)
- | TEnum (enum, _) -> (
- match is_extern_enum enum with
- | true -> add_extern_enum enum
- | false -> add_type enum.e_path)
- (* If a class has a template parameter, then we treat it as dynamic - except
- for the Array, Class, FastIterator or Pointer classes, for which we do a fully typed object *)
- | TInst (klass, params) -> (
- match klass.cl_path with
- | [], "Array"
- | [], "Class"
- | [ "cpp" ], "FastIterator"
- | [ "cpp" ], "Pointer"
- | [ "cpp" ], "ConstPointer"
- | [ "cpp" ], "Function"
- | [ "cpp" ], "RawPointer"
- | [ "cpp" ], "RawConstPointer" ->
- List.iter visit_type params
- | _ when is_native_gen_class klass -> add_native_gen_class klass
- | _ when is_extern_class klass ->
- add_extern_class klass;
- List.iter visit_type params
- | _ -> (
- match klass.cl_kind with
- | KTypeParameter _ -> ()
- | _ -> add_type klass.cl_path))
- | TAbstract (a, params) when is_scalar_abstract a ->
- add_extern_type (TAbstractDecl a)
- | TFun (args, haxe_type) ->
- visit_type haxe_type;
- List.iter (fun (_, _, t) -> visit_type t) args
- | _ -> ());
+ (match follow_with_coro in_type with
+ | Coro (args, return) ->
+ let args, return = Common.expand_coro_type ctx.ctx_common.basic args return in
+ visit_type return;
+ List.iter (fun (_, _, t) -> visit_type t) args
+ | NotCoro t ->
+ (match follow t with
+ | TMono r -> ( match r.tm_type with None -> () | Some t -> visit_type t)
+ | TEnum (enum, _) -> (
+ match is_extern_enum enum with
+ | true -> add_extern_enum enum
+ | false -> add_type enum.e_path)
+ (* If a class has a template parameter, then we treat it as dynamic - except
+ for the Array, Class, FastIterator or Pointer classes, for which we do a fully typed object *)
+ | TInst (klass, params) -> (
+ match klass.cl_path with
+ | [], "Array"
+ | [], "Class"
+ | [ "cpp" ], "FastIterator"
+ | [ "cpp" ], "Pointer"
+ | [ "cpp" ], "ConstPointer"
+ | [ "cpp" ], "Function"
+ | [ "cpp" ], "RawPointer"
+ | [ "cpp" ], "RawConstPointer" ->
+ List.iter visit_type params
+ | _ when is_native_gen_class klass -> add_native_gen_class klass
+ | _ when is_extern_class klass ->
+ add_extern_class klass;
+ List.iter visit_type params
+ | _ -> (
+ match klass.cl_kind with
+ | KTypeParameter _ -> ()
+ | _ -> add_type klass.cl_path))
+ | TAbstract (a, params) when is_scalar_abstract a ->
+ add_extern_type (TAbstractDecl a)
+ | TFun (args, haxe_type) ->
+ visit_type haxe_type;
+ List.iter (fun (_, _, t) -> visit_type t) args
+ | _ -> ()));
visited := List.tl !visited)
in
let visit_params expression =
diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml
index 2306d1a8043..c0bcac39980 100644
--- a/src/generators/genhl.ml
+++ b/src/generators/genhl.ml
@@ -470,6 +470,14 @@ let rec to_type ?tref ctx t =
| ["hl"], "GUID" -> HGUID
| ["hl"], "NativeArray" -> HArray (to_type ctx (List.hd pl))
| ["haxe";"macro"], "Position" -> HAbstract ("macro_pos", alloc_string ctx "macro_pos")
+ | ["haxe";"coro"], "Coroutine" ->
+ begin match pl with
+ | [TFun(args,ret)] ->
+ let args,ret = Common.expand_coro_type ctx.com.basic args ret in
+ to_type ctx (TFun(args,ret))
+ | _ ->
+ die "" __LOC__
+ end
| _ -> failwith ("Unknown core type " ^ s_type_path a.a_path))
else
get_rec_cache ctx t
diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml
index 01ca8df003f..5d746b1e800 100644
--- a/src/generators/genjvm.ml
+++ b/src/generators/genjvm.ml
@@ -168,6 +168,14 @@ let rec jsignature_of_type gctx stack t =
end
| [],"EnumValue" ->
java_enum_sig object_sig
+ | ["haxe";"coro"],"Coroutine" ->
+ begin match tl with
+ | [TFun(args,ret)] ->
+ let args,ret = Common.expand_coro_type gctx.gctx.basic args ret in
+ jsignature_of_type (TFun(args,ret))
+ | _ ->
+ die "" __LOC__
+ end
| _ ->
if Meta.has Meta.CoreType a.a_meta then
TObject(a.a_path,List.map jtype_argument_of_type tl)
@@ -197,11 +205,12 @@ let rec jsignature_of_type gctx stack t =
| TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl)
| TEnum(en,tl) ->
TObject(en.e_path,List.map jtype_argument_of_type tl)
- | TFun(tl,tr) -> method_sig (List.map (fun (_,o,t) ->
- let jsig = jsignature_of_type t in
- let jsig = if o then get_boxed_type jsig else jsig in
- jsig
- ) tl) (return_of_type gctx stack tr)
+ | TFun(tl,tr) ->
+ method_sig (List.map (fun (_,o,t) ->
+ let jsig = jsignature_of_type t in
+ let jsig = if o then get_boxed_type jsig else jsig in
+ jsig
+ ) tl) (return_of_type gctx stack tr)
| TAnon an -> object_sig
| TType(td,tl) ->
begin match gctx.typedef_interfaces#get_interface_class td.t_path with
@@ -765,8 +774,11 @@ class texpr_to_jvm
method read cast e1 fa =
let read_static_closure path cf =
- let args,ret = match follow cf.cf_type with
- | TFun(tl,tr) -> List.map (fun (n,_,t) -> n,self#vtype t) tl,(return_of_type gctx tr)
+ let args,ret = match follow_with_coro cf.cf_type with
+ | NotCoro TFun(tl,tr) -> List.map (fun (n,_,t) -> n,self#vtype t) tl,(return_of_type gctx tr)
+ | Coro (tl,tr) ->
+ let tl,tr = Common.expand_coro_type gctx.gctx.basic tl tr in
+ List.map (fun (n,_,t) -> n,self#vtype t) tl,(return_of_type gctx tr)
| _ -> die "" __LOC__
in
self#read_static_closure path cf.cf_name args ret cf.cf_type
@@ -1558,9 +1570,12 @@ class texpr_to_jvm
(* calls *)
method call_arguments ?(cast=true) t el =
- let tl,tr = match follow t with
- | TFun(tl,tr) ->
+ let tl,tr = match follow_with_coro t with
+ | NotCoro (TFun(tl,tr)) ->
tl,return_of_type gctx tr
+ | Coro(args,ret) ->
+ let args,ret = Common.expand_coro_type gctx.gctx.basic args ret in
+ args,return_of_type gctx ret
| _ ->
List.map (fun e -> ("",false,e.etype)) el,Some (object_sig)
in
@@ -1963,7 +1978,8 @@ class texpr_to_jvm
if not jm#is_terminated then self#texpr' ret e
method texpr' ret e =
- code#set_line (Lexer.get_error_line e.epos);
+ if e.epos.pmin >= 0 then
+ code#set_line (Lexer.get_error_line e.epos);
match e.eexpr with
| TVar(v,Some e1) ->
self#texpr (rvalue_type gctx v.v_type (Some v.v_name)) e1;
@@ -2428,8 +2444,9 @@ class tclass_to_jvm gctx c = object(self)
maybe_make_bridge cf_impl.cf_name jsig_super jsig_impl
in
let find_overload map_type c cf =
- let tl = match follow (map_type cf.cf_type) with
- | TFun(tl,_) -> tl
+ let tl = match follow_with_coro (map_type cf.cf_type) with
+ | Coro (tl, _) -> tl
+ | NotCoro TFun(tl,_) -> tl
| _ -> die "" __LOC__
in
OverloadResolution.resolve_instance_overload false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl)
diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml
index 217cbf941c4..b534423dd17 100644
--- a/src/generators/genneko.ml
+++ b/src/generators/genneko.ml
@@ -235,9 +235,7 @@ and gen_expr ctx e =
| TBinop (op,e1,e2) ->
gen_binop ctx p op e1 e2
| TField (e2,FClosure (_,f)) ->
- (match follow e.etype with
- | TFun (args,_) ->
- let n = List.length args in
+ let emit n =
if n > 5 then Error.abort "Cannot create closure with more than 5 arguments" e.epos;
let tmp = ident p "@tmp" in
EBlock [
@@ -247,6 +245,14 @@ and gen_expr ctx e =
else
call p (ident p ("@closure" ^ string_of_int n)) [tmp;ident p "@fun"]
] , p
+ in
+ (match follow_with_coro e.etype with
+ | NotCoro TFun (args,_) ->
+ let n = List.length args in
+ emit n
+ | Coro (args,_) ->
+ let n = List.length args in
+ emit (n + 1)
| _ -> die "" __LOC__)
| TEnumParameter (e,_,i) ->
EArray (field p (gen_expr ctx e) "args",int p i),p
diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml
index 3cf39db34fa..24e3d0b2439 100644
--- a/src/generators/genphp7.ml
+++ b/src/generators/genphp7.ml
@@ -410,9 +410,10 @@ let rec needs_temp_var expr =
(**
@return (arguments_list, return_type)
*)
-let get_function_signature (field:tclass_field) : (string * bool * Type.t) list * Type.t =
- match follow field.cf_type with
- | TFun (args, return_type) -> (args, return_type)
+let get_function_signature basic (field:tclass_field) : (string * bool * Type.t) list * Type.t =
+ match follow_with_coro field.cf_type with
+ | Coro (args, return_type) -> Common.expand_coro_type basic args return_type
+ | NotCoro TFun (args, return_type) -> args, return_type
| _ -> fail field.cf_pos __LOC__
(**
@@ -598,9 +599,16 @@ let fix_tsignature_args args =
(**
Inserts `null`s if there are missing optional args before empty rest arguments.
*)
-let fix_call_args callee_type exprs =
- match follow callee_type with
- | TFun (args,_) ->
+let fix_call_args basic callee_type exprs =
+ let args =
+ match follow_with_coro callee_type with
+ | Coro (args, return_type) -> Some (Common.expand_coro_type basic args return_type |> fst)
+ | NotCoro TFun (args,_) -> Some args
+ | _ -> None
+ in
+
+ match args with
+ | Some args ->
(match List.rev args with
| (_,_,t) :: args_rev when is_rest_type t && List.length args_rev > List.length exprs ->
let rec loop args exprs =
@@ -612,7 +620,7 @@ let fix_call_args callee_type exprs =
loop args exprs
| _ -> exprs
)
- | _ -> exprs
+ | None -> exprs
(**
Escapes all "$" chars and encloses `str` into double quotes
@@ -1490,8 +1498,15 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
| current :: _ ->
match self#parent_expr with
| Some { eexpr = TCall (target, params) } when current != (reveal_expr target) ->
- (match follow target.etype with
- | TFun (args,_) ->
+ let args =
+ match follow_with_coro target.etype with
+ | Coro (args, return_type) -> Some (Common.expand_coro_type ctx.pgc_common.basic args return_type |> fst)
+ | NotCoro TFun (args,_) -> Some args
+ | _ -> None
+ in
+
+ (match args with
+ | Some args ->
let rec check args params =
match args, params with
| (_, _, t) :: _, param :: _ when current == (reveal_expr param) ->
@@ -2302,7 +2317,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
| FInstance (_, _, ({ cf_kind = Method _ } as field))
| FClosure (_, ({ cf_kind = Method _ } as field)) ->
self#write ((self#use hxstring_type_path) ^ "::" ^ (field_name field) ^ "(");
- write_args self#write self#write_expr (fix_call_args field.cf_type (expr :: args));
+ write_args self#write self#write_expr (fix_call_args ctx.pgc_common.basic field.cf_type (expr :: args));
self#write ")"
| _ ->
let msg =
@@ -2651,7 +2666,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
if not !no_call then
begin
self#write "(";
- write_args self#write self#write_expr (fix_call_args target_expr.etype args);
+ write_args self#write self#write_expr (fix_call_args ctx.pgc_common.basic target_expr.etype args);
self#write ")"
end
(**
@@ -2718,7 +2733,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
self#write ("new " ^ (self#use ~prefix:needs_php_prefix inst_class.cl_path) ^ "(");
let args =
match inst_class.cl_constructor with
- | Some field -> fix_call_args field.cf_type args
+ | Some field -> fix_call_args ctx.pgc_common.basic field.cf_type args
| None -> args
in
write_args self#write self#write_expr args;
@@ -3455,8 +3470,15 @@ class class_builder ctx (cls:tclass) =
| Some (cls, _) ->
let fields = if is_static then cls.cl_statics else cls.cl_fields in
try
- match (PMap.find name fields).cf_type with
- | TFun (args,_) ->
+ let args =
+ match follow_with_coro (PMap.find name fields).cf_type with
+ | Coro (args, return_type) -> Some (Common.expand_coro_type ctx.pgc_common.basic args return_type |> fst)
+ | NotCoro TFun (args,_) -> Some args
+ | _ -> None
+ in
+
+ match args with
+ | Some args ->
let rec count args mandatory total =
match args with
| [] ->
@@ -3793,7 +3815,7 @@ class class_builder ctx (cls:tclass) =
self#validate_method_name field;
writer#reset;
writer#indent 1;
- let (args, return_type) = get_function_signature field in
+ let (args, return_type) = get_function_signature ctx.pgc_common.basic field in
List.iter (fun (arg_name, _, _) -> writer#declared_local_var arg_name) args;
self#write_doc (DocMethod (args, return_type, (gen_doc_text_opt field.cf_doc))) field.cf_meta;
writer#write_indentation;
@@ -3820,13 +3842,14 @@ class class_builder ctx (cls:tclass) =
self#validate_method_name field;
writer#reset;
writer#indent 1;
- let (args, return_type) = get_function_signature field in
+ let (args, return_type) = get_function_signature ctx.pgc_common.basic field in
List.iter (fun (arg_name, _, _) -> writer#declared_local_var arg_name) args;
self#write_doc (DocMethod (args, return_type, (gen_doc_text_opt field.cf_doc))) field.cf_meta;
let visibility_kwd = get_visibility field.cf_meta in
writer#write_with_indentation (visibility_kwd ^ " function " ^ (field_name field));
(match field.cf_expr with
| None -> (* interface *)
+ (* let args, _ = Common.expand_coro_type ctx.pgc_common.basic args return_type in *)
writer#write " (";
write_args writer#write (writer#write_arg true) (fix_tsignature_args args);
writer#write ");\n";
diff --git a/src/optimization/analyzerTypes.ml b/src/optimization/analyzerTypes.ml
index 5ad70b6d7f2..acec94b0328 100644
--- a/src/optimization/analyzerTypes.ml
+++ b/src/optimization/analyzerTypes.ml
@@ -83,20 +83,14 @@ module BasicBlock = struct
ss_exhaustive : bool;
}
- and suspend_call = {
- efun : texpr; (* coroutine function expression *)
- args : texpr list; (* call arguments without the continuation *)
- pos : pos; (* call position *)
- }
-
and terminator_kind =
- | TermNone
- | TermCondBranch of texpr
- | TermReturn of pos
- | TermReturnValue of texpr * pos
- | TermBreak of pos
- | TermContinue of pos
- | TermThrow of texpr * pos
+ | TermNone
+ | TermCondBranch of texpr
+ | TermReturn of pos
+ | TermReturnValue of texpr * pos
+ | TermBreak of pos
+ | TermContinue of pos
+ | TermThrow of texpr * pos
and t = {
bb_id : int; (* The unique ID of the block *)
diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml
index 3d21561100a..66a91491f23 100644
--- a/src/typing/callUnification.ml
+++ b/src/typing/callUnification.ml
@@ -177,7 +177,7 @@ let unify_call_args ctx el args r callp inline force_inline in_overload =
in
let el = try loop el args with exc -> restore(); raise exc; in
restore();
- el,TFun(args,r)
+ el
type overload_kind =
| OverloadProper (* @:overload or overload *)
@@ -286,10 +286,9 @@ let unify_field_call ctx fa el_typed el p inline =
let attempt_call cf in_overload =
let monos = Monomorph.spawn_constrained_monos map cf.cf_params in
let t = map (apply_params cf.cf_params monos cf.cf_type) in
- match follow t with
- | TFun(args,ret) ->
+ let make args ret coro =
let args_typed,args = unify_typed_args ctx tmap args el_typed p in
- let el,_ =
+ let el =
try
unify_call_args ctx el args ret p inline is_forced_inline in_overload
with DisplayException.DisplayException de ->
@@ -297,13 +296,23 @@ let unify_field_call ctx fa el_typed el p inline =
in
(* here *)
let el = el_typed @ el in
- let tf = TFun(args_typed @ args,ret) in
+ let args = (args_typed @ args) in
+ let tf = if coro then (Lazy.force ctx.t.tcoro.tcoro) args ret else TFun(args,ret) in
let mk_call () =
let ef = mk (TField(fa.fa_on,FieldAccess.apply_fa cf fa.fa_host)) t fa.fa_pos in
!make_call_ref ctx ef el ret ~force_inline:inline p
in
make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display())
- | t ->
+ in
+ match follow_with_coro t with
+ | Coro(args,ret) when not (TyperManager.is_coroutine_context ctx) ->
+ let args, ret = expand_coro_type ctx.com.basic args ret in
+ make args ret false
+ | Coro(args,ret) ->
+ make args ret true
+ | NotCoro (TFun(args,ret)) ->
+ make args ret false
+ | NotCoro t ->
raise_typing_error (s_type (print_context()) t ^ " cannot be called") p
in
let unknown_ident_error = ref None in
@@ -541,14 +550,21 @@ object(self)
in
mk (TCall (e,el)) t p
in
- let rec loop t = match follow t with
- | TFun (args,r) ->
+ let make args ret =
let args_typed,args_left = unify_typed_args ctx (fun t -> t) args el_typed p in
- let el, tfunc = unify_call_args ctx el args_left r p false false false in
+ let el = unify_call_args ctx el args_left ret p false false false in
let el = el_typed @ el in
- let r = match tfunc with TFun(_,r) -> r | _ -> die "" __LOC__ in
- mk (TCall (e,el)) r p
- | TAbstract(a,tl) as t ->
+ mk (TCall (e,el)) ret p
+ in
+ let rec loop t = match follow_with_coro t with
+ | Coro(args,ret) when not (TyperManager.is_coroutine_context ctx) ->
+ let args, ret = expand_coro_type ctx.com.basic args ret in
+ make args ret
+ | Coro(args,ret) ->
+ make args ret
+ | NotCoro(TFun(args,ret)) ->
+ make args ret
+ | NotCoro(TAbstract(a,tl) as t) ->
let check_callable () =
if Meta.has Meta.Callable a.a_meta then
loop (Abstract.get_underlying_type a tl)
@@ -563,12 +579,12 @@ object(self)
| _ ->
check_callable();
end
- | TMono _ ->
+ | NotCoro (TMono _)->
let t = mk_mono() in
let el = el_typed @ List.map (fun e -> type_expr ctx e WithType.value) el in
unify ctx (tfun (List.map (fun e -> e.etype) el) t) e.etype e.epos;
mk (TCall (e,el)) t p
- | t ->
+ | NotCoro t ->
default t
in
loop e.etype
diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml
index 01361ee0436..c6a24a0a79c 100644
--- a/src/typing/macroContext.ml
+++ b/src/typing/macroContext.ml
@@ -950,7 +950,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
incr index;
(EArray ((EArrayDecl [e],p),(EConst (Int (string_of_int (!index), None)),p)),p)
) el in
- let elt = fst (CallUnification.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false false) in
+ let elt = CallUnification.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false false in
List.map2 (fun ((n,_,t),mct) e ->
let e, et = (match e.eexpr with
(* get back our index and real expression *)
@@ -1024,7 +1024,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
e
let call_macro mctx args margs call p =
- let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
+ let el = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
call (List.map (fun e -> try Interp.make_const e with Exit -> raise_typing_error "Argument should be a constant" e.epos) el)
let resolve_init_macro com e =
diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml
index b9a267dbfec..5aaf3b68d99 100644
--- a/src/typing/typeload.ml
+++ b/src/typing/typeload.ml
@@ -864,8 +864,13 @@ let init_core_api ctx c =
| _ ->
raise_typing_error ("Field " ^ f.cf_name ^ " has different property access than core type") p;
end;
- (match follow f.cf_type, follow f2.cf_type with
- | TFun (pl1,_), TFun (pl2,_) ->
+ (match follow_with_coro f.cf_type, follow_with_coro f2.cf_type with
+ | Coro _,NotCoro _ ->
+ raise_typing_error "Method should be coroutine" p
+ | NotCoro _,Coro _ ->
+ raise_typing_error "Method should not be coroutine" p;
+ | NotCoro (TFun (pl1,_)), NotCoro(TFun (pl2,_))
+ | Coro (pl1,_), Coro(pl2,_) ->
if List.length pl1 != List.length pl2 then raise_typing_error "Argument count mismatch" p;
List.iter2 (fun (n1,_,_) (n2,_,_) ->
if n1 <> n2 then raise_typing_error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml
index 60329a68437..c1b04e0f0ff 100644
--- a/src/typing/typeloadCheck.ml
+++ b/src/typing/typeloadCheck.ml
@@ -64,8 +64,13 @@ let valid_redefinition map1 map2 f1 t1 f2 t2 = (* child, parent *)
end;
begin match f1.cf_kind,f2.cf_kind with
| Method m1, Method m2 when not (m1 = MethDynamic) && not (m2 = MethDynamic) ->
- begin match follow t1, follow t2 with
- | TFun (args1,r1) , TFun (args2,r2) ->
+ begin match follow_with_coro t1, follow_with_coro t2 with
+ | Coro _,NotCoro _ ->
+ raise (Unify_error [Unify_custom "Method should be coroutine"])
+ | NotCoro _,Coro _ ->
+ raise (Unify_error [Unify_custom "Method should not be coroutine"]);
+ | NotCoro (TFun (args1,r1)), NotCoro(TFun (args2,r2))
+ | Coro (args1,r1), Coro(args2,r2) ->
if not (List.length args1 = List.length args2) then raise (Unify_error [Unify_custom "Different number of function arguments"]);
let i = ref 0 in
begin try
diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml
index ec87c225279..00b06b98330 100644
--- a/src/typing/typeloadFields.ml
+++ b/src/typing/typeloadFields.ml
@@ -869,7 +869,9 @@ module TypeBinding = struct
(match e.eexpr with
| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
| _ -> TClass.set_cl_init c e);
- cf.cf_expr <- Some (mk (TFunction tf) t p);
+ let e = mk (TFunction tf) t p in
+ let e = if TyperManager.is_coroutine_context ctx && not (Meta.has Meta.CoroutineTransformed cf.cf_meta) then Coro.fun_to_coro (Coro.create_coro_context ctx cf.cf_meta) (ClassField(c, cf, tf, p)) else e in
+ cf.cf_expr <- Some e;
cf.cf_type <- t;
check_field_display ctx fctx c cf;
end;
@@ -1257,9 +1259,21 @@ let create_method (ctx,cctx,fctx) c f cf fd p =
ctx.type_params <- params @ ctx.type_params;
let args,ret = setup_args_ret ctx cctx fctx (fst f.cff_name) fd p in
- let function_mode = FunFunction in
+ let is_coroutine = Meta.has Meta.Coroutine f.cff_meta in
+ let function_mode = if is_coroutine then FunCoroutine else FunFunction in
let targs = args#for_type in
- let t = TFun (targs,ret) in
+ let t = if not is_coroutine then
+ TFun (targs,ret)
+ else if Meta.has Meta.CoroutineTransformed cf.cf_meta then begin
+ match List.rev targs with
+ | _ :: targs ->
+ (* Ignore trailing continuation for actual signature *)
+ (Lazy.force ctx.t.tcoro.tcoro) (List.rev targs) ret
+ | _ ->
+ die "" __LOC__
+ end else
+ (Lazy.force ctx.t.tcoro.tcoro) targs ret
+ in
cf.cf_type <- t;
cf.cf_kind <- Method (if fctx.is_macro then MethMacro else if fctx.is_inline then MethInline else if dynamic then MethDynamic else MethNormal);
cf.cf_params <- params;
diff --git a/src/typing/typer.ml b/src/typing/typer.ml
index 60585390022..0f0e92c6f02 100644
--- a/src/typing/typer.ml
+++ b/src/typing/typer.ml
@@ -935,7 +935,7 @@ and type_new ctx ptp el with_type force_inline p =
| None ->
raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
| Some(tl,tr) ->
- let el,_ = unify_call_args ctx el tl tr p false false false in
+ let el = unify_call_args ctx el tl tr p false false false in
mk (TNew (c,params,el)) t p
end
| TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
@@ -1106,7 +1106,7 @@ and type_map_declaration ctx e1 el with_type p =
let el = (mk (TVar (v,Some enew)) t_dynamic p) :: (List.rev el) in
mk (TBlock el) tmap p
-and type_local_function ctx_from kind f with_type p =
+and type_local_function ctx_from kind f with_type want_coroutine p =
let name,inline = match kind with FKNamed (name,inline) -> Some name,inline | _ -> None,false in
let params = TypeloadFunction.type_function_params ctx_from f TPHLocal (match name with None -> "localfun" | Some (n,_) -> n) in
let curfun = match ctx_from.e.curfun with
@@ -1115,11 +1115,21 @@ and type_local_function ctx_from kind f with_type p =
| FunMemberAbstractLocal -> FunMemberAbstractLocal
| _ -> FunMemberClassLocal
in
- let function_mode = FunFunction in
+ let is_coroutine = match name, with_type with
+ | None, WithType.WithType (texpected,_) when not (ExtType.is_mono (follow texpected)) ->
+ (match follow_with_coro texpected with
+ | Coro _ ->
+ true
+ | _ ->
+ false)
+ | _ ->
+ want_coroutine
+ in
+ let function_mode = if is_coroutine then FunCoroutine else FunFunction in
let ctx = TyperManager.clone_for_expr ctx_from curfun function_mode in
let vname,pname= match name with
| None ->
- if params <> [] then begin
+ if params <> [] || is_coroutine then begin
Some(gen_local_prefix,VGenerated),null_pos
end else
None,p
@@ -1153,8 +1163,9 @@ and type_local_function ctx_from kind f with_type p =
let m = new unification_matrix (arity + 1) in
let rec loop l = match l with
| t :: l ->
- begin match follow t with
- | TFun(args,ret) when List.length args = arity ->
+ begin match follow_with_coro t with
+ | NotCoro(TFun(args,ret))
+ | Coro(args,ret) when List.length args = arity ->
List.iteri (fun i (_,_,t) ->
(* We don't want to bind monomorphs because we want the widest type *)
let t = dynamify_monos t in
@@ -1187,14 +1198,15 @@ and type_local_function ctx_from kind f with_type p =
(match with_type with
| WithType.WithType(t,_) ->
let rec loop stack t =
- (match follow t with
- | TFun (args2,tr) when List.length args2 = List.length targs ->
+ (match follow_with_coro t with
+ | NotCoro (TFun (args2,tr))
+ | Coro(args2,tr) when List.length args2 = List.length targs ->
List.iter2 (fun (_,_,t1) (_,_,t2) ->
maybe_unify_arg t1 t2
) targs args2;
(* unify for top-down inference unless we are expecting Void *)
maybe_unify_ret tr
- | TAbstract(a,tl) ->
+ | NotCoro (TAbstract(a,tl)) ->
begin match get_abstract_froms ctx a tl with
| [(_,t2)] ->
if not (List.exists (shallow_eq t) stack) then loop (t :: stack) t2
@@ -1221,8 +1233,9 @@ and type_local_function ctx_from kind f with_type p =
| WithType.NoValue ->
if name = None then display_error ctx.com "Unnamed lvalue functions are not supported" p
| _ ->
- ());
- let ft = TFun (targs,rt) in
+ ()
+ );
+ let ft = if is_coroutine then (Lazy.force ctx.t.tcoro.tcoro) targs rt else TFun(targs,rt) in
let ft = match with_type with
| WithType.NoValue ->
ft
@@ -1245,8 +1258,10 @@ and type_local_function ctx_from kind f with_type p =
tf_expr = e;
} in
let e = mk (TFunction tf) ft p in
+ let e = if TyperManager.is_coroutine_context ctx then Coro.fun_to_coro (Coro.create_coro_context ctx ctx.f.meta) (LocalFunc(tf,Option.get v)) else e in
match v with
- | None -> e
+ | None ->
+ e
| Some v ->
Typeload.generate_args_meta ctx.com None (fun m -> v.v_meta <- m :: v.v_meta) f.f_args;
let open LocalUsage in
@@ -1545,6 +1560,20 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
| (EReturn e, p) -> type_return ~implicit:true ctx e with_type p
| _ -> e()
end
+ | (Meta.Coroutine,_,_) ->
+ let old = ctx.f.meta in
+ let rec loop e1 = match fst e1 with
+ | EMeta(m,e1) ->
+ ctx.f.meta <- m :: ctx.f.meta;
+ loop e1
+ | EFunction (kind, f) ->
+ type_local_function ctx kind f with_type true p
+ | _ ->
+ e ()
+ in
+ let e = loop e1 in
+ ctx.f.meta <- old;
+ e
(* Allow `${...}` reification because it's a noop and happens easily with macros *)
| (Meta.Dollar "",_,p) ->
e()
@@ -1892,7 +1921,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
| EUnop (op,flag,e) ->
type_unop ctx op flag e with_type p
| EFunction (kind,f) ->
- type_local_function ctx kind f with_type p
+ type_local_function ctx kind f with_type false p
| EUntyped e ->
let old = ctx.f.untyped in
ctx.f.untyped <- true;
diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml
index e6cb480d21d..21209f50064 100644
--- a/src/typing/typerBase.ml
+++ b/src/typing/typerBase.ml
@@ -172,6 +172,16 @@ let get_this ctx p =
| FunMemberAbstract ->
let v = (try PMap.find "this" ctx.f.locals with Not_found -> raise_typing_error "Cannot reference this abstract here" p) in
mk (TLocal v) v.v_type p
+ | FunConstructor | FunMember when TyperManager.is_coroutine_context ctx ->
+ let v = match ctx.f.vthis with
+ | None ->
+ let v = add_local ctx VGenerated (Printf.sprintf "%sthis" gen_local_prefix) ctx.c.tthis p in
+ ctx.f.vthis <- Some v;
+ v
+ | Some v ->
+ v
+ in
+ mk (TLocal v) ctx.c.tthis p
| FunConstructor | FunMember ->
mk (TConst TThis) ctx.c.tthis p
diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml
index f7b78a08336..2078b0b35fc 100644
--- a/src/typing/typerEntry.ml
+++ b/src/typing/typerEntry.ml
@@ -114,7 +114,8 @@ let load_unit ctx =
| TEnumDecl en ->
(match snd en.e_path with
| "Unit" ->
- ctx.m.import_resolution#add (module_type_resolution mt None null_pos);
+ ctx.t.tunit <- TEnum(en,[]);
+ (* ctx.m.import_resolution#add (module_type_resolution mt None null_pos); *)
| _ -> ())
| _ -> ()
) m.m_types
@@ -184,6 +185,45 @@ let load_local_wrapper ctx =
mk (TVar (av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos))) t.tvoid pos
end
+let load_coro ctx =
+ ctx.t.tcoro.tcoro <- lazy begin
+ let m = TypeloadModule.load_module ctx (["haxe";"coro"],"Coroutine") null_pos in
+ ExtList.List.find_map_exn (function
+ | TAbstractDecl({a_path = (["haxe";"coro"],"Coroutine")} as a) ->
+ let mk_coro args ret =
+ TAbstract(a,[TFun(args,ret)])
+ in
+ Some mk_coro
+ | _ ->
+ None
+ ) m.m_types;
+ end;
+ ctx.t.tcoro.continuation <- lazy begin
+ let m = TypeloadModule.load_module ctx (["haxe";"coro"],"IContinuation") null_pos in
+ ExtList.List.find_map_exn (function
+ | TClassDecl({ cl_path = (["haxe";"coro"], "IContinuation") } as cl) ->
+ Some (TInst(cl, [ ctx.t.tany ]))
+ | _ ->
+ None
+ ) m.m_types;
+ end;
+ ctx.t.tcoro.suspension_result_class <- lazy begin
+ let m = TypeloadModule.load_module ctx (["haxe";"coro"],"SuspensionResult") null_pos in
+ ExtList.List.find_map_exn (function
+ | TClassDecl({ cl_path = (["haxe";"coro"], "SuspensionResult") } as cl) ->
+ Some cl
+ | _ ->
+ None;
+ ) m.m_types;
+ end;
+ let m = TypeloadModule.load_module ctx (["haxe"],"Exception") null_pos in
+ List.iter (function
+ | TClassDecl({ cl_path = (["haxe"], "Exception") } as cl) ->
+ ctx.t.texception <- TInst(cl, [])
+ | _ ->
+ ()
+ ) m.m_types
+
let create com macros =
let rec ctx = {
com = com;
@@ -203,6 +243,7 @@ let create com macros =
return_partial_type = false;
build_count = 0;
t_dynamic_def = t_dynamic;
+ continuation_api = None;
do_macro = MacroContext.type_macro;
do_load_macro = MacroContext.load_macro';
do_load_module = TypeloadModule.load_module;
@@ -239,10 +280,10 @@ let create com macros =
load_string ctx;
load_std ctx;
load_any ctx;
- (* load_unit ctx; *)
+ load_unit ctx;
load_array ctx;
load_enum_tools ctx;
- ignore(TypeloadModule.load_module ctx (["haxe"],"Exception") null_pos);
+ load_coro ctx;
ctx.com.local_wrapper <- load_local_wrapper ctx;
ctx.g.complete <- true;
ctx
diff --git a/std/StdTypes.hx b/std/StdTypes.hx
index b67e3c45556..37e18ac524b 100644
--- a/std/StdTypes.hx
+++ b/std/StdTypes.hx
@@ -20,7 +20,6 @@
* DEALINGS IN THE SOFTWARE.
*/
// standard Haxe types
-
/**
The standard `Void` type. Only `null` values can be of the type `Void`.
@@ -169,4 +168,4 @@ typedef KeyValueIterable = {
@see https://haxe.org/manual/types-abstract-array-access.html
**/
-extern interface ArrayAccess {}
+extern interface ArrayAccess {}
\ No newline at end of file
diff --git a/std/eval/_std/haxe/coro/EventLoopImpl.hx b/std/eval/_std/haxe/coro/EventLoopImpl.hx
new file mode 100644
index 00000000000..319e9ad0760
--- /dev/null
+++ b/std/eval/_std/haxe/coro/EventLoopImpl.hx
@@ -0,0 +1,221 @@
+package haxe.coro;
+
+import sys.thread.Mutex;
+
+/**
+ When an event loop has an available event to execute.
+**/
+private enum NextEventTime {
+ /** There's already an event waiting to be executed */
+ Now;
+ /** No new events are expected. */
+ Never;
+ /** An event is expected to be ready for execution at `time`. */
+ At(time:Float);
+}
+
+private class SimpleEventLoop {
+ final mutex = new Mutex();
+ final oneTimeEvents = new ArrayVoid>>();
+ var oneTimeEventsIdx = 0;
+ var regularEvents:Null;
+
+ public function new():Void {}
+
+ /**
+ Schedule event for execution every `intervalMs` milliseconds in current loop.
+ **/
+ public function repeat(event:()->Void, intervalMs:Int):EventHandler {
+ var interval = 0.001 * intervalMs;
+ var event = new RegularEvent(event, haxe.Timer.stamp() + interval, interval);
+ mutex.acquire();
+ insertEventByTime(event);
+ mutex.release();
+ return event;
+ }
+
+ function insertEventByTime(event:RegularEvent):Void {
+ switch regularEvents {
+ case null:
+ regularEvents = event;
+ case current:
+ var previous = null;
+ while(true) {
+ if(current == null) {
+ previous.next = event;
+ event.previous = previous;
+ break;
+ } else if(event.nextRunTime < current.nextRunTime) {
+ event.next = current;
+ current.previous = event;
+ switch previous {
+ case null:
+ regularEvents = event;
+ case _:
+ event.previous = previous;
+ previous.next = event;
+ current.previous = event;
+ }
+ break;
+ } else {
+ previous = current;
+ current = current.next;
+ }
+ }
+ }
+ }
+
+ /**
+ Prevent execution of a previously scheduled event in current loop.
+ **/
+ public function cancel(eventHandler:EventHandler):Void {
+ var event:RegularEvent = eventHandler;
+ mutex.acquire();
+ event.cancelled = true;
+ if(regularEvents == event) {
+ regularEvents = event.next;
+ }
+ switch event.next {
+ case null:
+ case e: e.previous = event.previous;
+ }
+ switch event.previous {
+ case null:
+ case e: e.next = event.next;
+ }
+ event.next = event.previous = null;
+ mutex.release();
+ }
+
+ /**
+ Execute `event` as soon as possible.
+ **/
+ public function run(event:()->Void):Void {
+ mutex.acquire();
+ oneTimeEvents[oneTimeEventsIdx++] = event;
+ mutex.release();
+ }
+
+ /**
+ Executes all pending events.
+
+ The returned time stamps can be used with `Sys.time()` for calculations.
+
+ Depending on a target platform this method may be non-reentrant. It must
+ not be called from event callbacks.
+ **/
+ public function progress():NextEventTime {
+ return switch __progress(haxe.Timer.stamp(), [], []) {
+ case -2: Now;
+ case -1: Never;
+ case time: At(time);
+ }
+ }
+
+ /**
+ Execute all pending events.
+ Wait and execute as many events as the number of times `promise()` was called.
+ Runs until all repeating events are cancelled and no more events are expected.
+
+ Depending on a target platform this method may be non-reentrant. It must
+ not be called from event callbacks.
+ **/
+ public function loop():Void {
+ var recycleRegular = [];
+ var recycleOneTimers = [];
+ while(true) {
+ var r = __progress(haxe.Timer.stamp(), recycleRegular, recycleOneTimers);
+ switch r {
+ case -1:
+ case -2:
+ break;
+ case time:
+ var timeout = time - haxe.Timer.stamp();
+ }
+ }
+ }
+
+ /**
+ `.progress` implementation with a reusable array for internal usage.
+ The `nextEventAt` field of the return value denotes when the next event
+ is expected to run:
+ * -1 - never
+ * -2 - now
+ * other values - at specified time
+ **/
+ inline function __progress(now:Float, recycleRegular:Array, recycleOneTimers:Array<()->Void>):Float {
+ var regularsToRun = recycleRegular;
+ var eventsToRunIdx = 0;
+ // When the next event is expected to run
+ var nextEventAt:Float = -1;
+
+ mutex.acquire();
+ // Collect regular events to run
+ var current = regularEvents;
+ while(current != null) {
+ if(current.nextRunTime <= now) {
+ regularsToRun[eventsToRunIdx++] = current;
+ current.nextRunTime += current.interval;
+ nextEventAt = -2;
+ } else if(nextEventAt == -1 || current.nextRunTime < nextEventAt) {
+ nextEventAt = current.nextRunTime;
+ }
+ current = current.next;
+ }
+ mutex.release();
+
+ // Run regular events
+ for(i in 0...eventsToRunIdx) {
+ if(!regularsToRun[i].cancelled)
+ regularsToRun[i].run();
+ regularsToRun[i] = null;
+ }
+ eventsToRunIdx = 0;
+
+ var oneTimersToRun = recycleOneTimers;
+ mutex.acquire();
+ // Collect pending one-time events
+ for(i => event in oneTimeEvents) {
+ switch event {
+ case null:
+ break;
+ case _:
+ oneTimersToRun[eventsToRunIdx++] = event;
+ oneTimeEvents[i] = null;
+ }
+ }
+ oneTimeEventsIdx = 0;
+ mutex.release();
+
+ //run events
+ for(i in 0...eventsToRunIdx) {
+ oneTimersToRun[i]();
+ oneTimersToRun[i] = null;
+ }
+
+ // Some events were executed. They could add new events to run.
+ if(eventsToRunIdx > 0) {
+ nextEventAt = -2;
+ }
+ return nextEventAt;
+ }
+}
+
+abstract EventHandler(RegularEvent) from RegularEvent to RegularEvent {}
+
+private class RegularEvent {
+ public var nextRunTime:Float;
+ public final interval:Float;
+ public final run:()->Void;
+ public var next:Null;
+ public var previous:Null;
+ public var cancelled:Bool = false;
+
+ public function new(run:()->Void, nextRunTime:Float, interval:Float) {
+ this.run = run;
+ this.nextRunTime = nextRunTime;
+ this.interval = interval;
+ }
+}
+
+typedef EventLoopImpl = SimpleEventLoop;
\ No newline at end of file
diff --git a/std/haxe/coro/BaseContinuation.hx b/std/haxe/coro/BaseContinuation.hx
new file mode 100644
index 00000000000..b817c9bf125
--- /dev/null
+++ b/std/haxe/coro/BaseContinuation.hx
@@ -0,0 +1,187 @@
+package haxe.coro;
+
+import haxe.coro.context.Context;
+import haxe.coro.context.Key;
+import haxe.coro.context.IElement;
+import haxe.coro.schedulers.Scheduler;
+import haxe.coro.schedulers.IScheduleObject;
+import haxe.CallStack.StackItem;
+import haxe.Exception;
+
+class StackTraceManager implements IElement {
+ public static final key = new Key('StackTraceManager');
+
+ public var insertIndex:Null;
+
+ public function new() {
+
+ }
+
+ public function getKey() {
+ return key;
+ }
+}
+
+abstract class BaseContinuation extends SuspensionResult implements IContinuation implements IStackFrame implements IScheduleObject {
+ public final completion:IContinuation;
+
+ public var context(get, null):Context;
+
+ public var gotoLabel:Int;
+
+ public var recursing:Bool;
+
+ var resumeResult:Null>;
+ #if debug
+ var stackItem:Null;
+ var startedException:Bool;
+ #end
+
+ function new(completion:IContinuation, initialLabel:Int) {
+ this.completion = completion;
+
+ gotoLabel = initialLabel;
+ error = null;
+ result = null;
+ recursing = false;
+ context = completion.context;
+ #if debug
+ startedException = false;
+ #end
+ }
+
+ inline function get_context() {
+ return context;
+ }
+
+ public final function resume(result:Any, error:Exception):Void {
+ this.result = result;
+ this.error = error;
+ recursing = false;
+ resumeResult = invokeResume();
+ context.get(Scheduler).scheduleObject(this);
+ }
+
+ public function callerFrame():Null {
+ return if (completion is IStackFrame) {
+ cast completion;
+ } else {
+ null;
+ }
+ }
+
+ public function getStackItem():Null {
+ #if debug
+ return stackItem;
+ #else
+ return null;
+ #end
+ }
+
+ public function setClassFuncStackItem(cls:String, func:String, file:String, line:Int, pos:Int, pmin:Int, pmax:Int) {
+ #if debug
+ stackItem = StackItem.FilePos(StackItem.Method(cls, func), file, line, pos);
+ #if eval
+ eval.vm.Context.callMacroApi("associate_enum_value_pos")(stackItem, haxe.macro.Context.makePosition({file: file, min: pmin, max: pmax}));
+ #end
+ #end
+ }
+
+ public function setLocalFuncStackItem(id:Int, file:String, line:Int, pos:Int, pmin:Int, pmax:Int) {
+ #if debug
+ stackItem = StackItem.FilePos(StackItem.LocalFunction(id), file, line, pos);
+ #if eval
+ eval.vm.Context.callMacroApi("associate_enum_value_pos")(stackItem, haxe.macro.Context.makePosition({file: file, min: pmin, max: pmax}));
+ #end
+ #end
+ }
+
+ public function startException(exception:Exception) {
+ #if js
+ return;
+ #end
+ #if debug
+ var stack = [];
+ var skipping = 0;
+ var insertIndex = 0;
+ var stackItem = stackItem;
+ startedException = true;
+
+ /*
+ Find first coro stack element
+ */
+ while (stackItem == null) {
+ var callerFrame = callerFrame();
+ if (callerFrame != null) {
+ stackItem = callerFrame.getStackItem();
+ }
+ }
+
+ switch (stackItem) {
+ case null:
+ return;
+ case FilePos(_, file, line, _):
+ for (index => item in exception.stack.asArray()) {
+ switch (item) {
+ case FilePos(_, file2, line2, _) if (skipping == 0 && file == file2 && line == line2):
+ stack.push(item);
+ skipping = 0;
+ // TODO: this is silly
+ case FilePos(Method("hxcoro.CoroRun", "run"), _) if (skipping == 1):
+ skipping = 2;
+ // this is a hack
+ case FilePos(Method(_, "invokeResume"), _) if (skipping == 0):
+ skipping = 1;
+ insertIndex = index;
+ case _:
+ if (skipping != 1) {
+ stack.push(item);
+ }
+ }
+ }
+ case _:
+ return;
+ }
+ exception.stack = stack;
+ context.get(StackTraceManager).insertIndex = insertIndex;
+ #end
+ }
+
+ public function buildCallStack() {
+ #if js
+ return;
+ #end
+ #if debug
+ if (startedException) {
+ return;
+ }
+ var stackTraceManager = context.get(StackTraceManager);
+ // Can happen in the case of ImmediateSuspensionResult.withError
+ if (stackTraceManager.insertIndex == null) {
+ startException(error);
+ }
+ if (stackItem != null) {
+ final stack = error.stack.asArray();
+ stack.insert(stackTraceManager.insertIndex++, stackItem);
+ error.stack = stack;
+ }
+ #end
+ }
+
+ abstract function invokeResume():SuspensionResult;
+
+ override function toString() {
+ return '[BaseContinuation ${state.toString()}, $result]';
+ }
+
+ public function onSchedule() {
+ switch (resumeResult.state) {
+ case Pending:
+ return;
+ case Returned:
+ completion.resume(resumeResult.result, null);
+ case Thrown:
+ completion.resume(null, resumeResult.error);
+ }
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/Coroutine.hx b/std/haxe/coro/Coroutine.hx
new file mode 100644
index 00000000000..41510594637
--- /dev/null
+++ b/std/haxe/coro/Coroutine.hx
@@ -0,0 +1,5 @@
+package haxe.coro;
+
+@:callable
+@:coreType
+abstract Coroutine { }
diff --git a/std/haxe/coro/ICancellableContinuation.hx b/std/haxe/coro/ICancellableContinuation.hx
new file mode 100644
index 00000000000..e74273dc454
--- /dev/null
+++ b/std/haxe/coro/ICancellableContinuation.hx
@@ -0,0 +1,20 @@
+package haxe.coro;
+
+import haxe.exceptions.CancellationException;
+
+/**
+ * Cancellable continuations are continuations which supports asynchronous cancellation.
+ * Like standard continuations they can be explicitly resumed by the user, but unlike standard
+ * continuations they will be automatically resumed with a `haxe.exceptions.CancellationException` when cancelled.
+ *
+ * This interface provides a callback property which if set will be invoked when cancellation is requested
+ * allowing you to cleanup resources. The callback will only be invoked on cancellation, not resuming with a result or exception.
+ */
+interface ICancellableContinuation extends IContinuation {
+ /**
+ * Register a function to be invoked upon cancellation of the continuation.
+ * If the continuation is already cancelled the function will be invoked immediately.
+ * Attempting to set this property multiple times will result in an exception being raised.
+ */
+ var onCancellationRequested (never, set) : CancellationException->Void;
+}
\ No newline at end of file
diff --git a/std/haxe/coro/IContinuation.hx b/std/haxe/coro/IContinuation.hx
new file mode 100644
index 00000000000..1f4331c710e
--- /dev/null
+++ b/std/haxe/coro/IContinuation.hx
@@ -0,0 +1,22 @@
+package haxe.coro;
+
+import haxe.Exception;
+import haxe.coro.context.Context;
+
+/**
+ This interface represents an object which can be resumed via its `resume` function.
+**/
+interface IContinuation {
+ /**
+ The immutable context of this object.
+ **/
+ var context(get, never):Context;
+
+ /**
+ Resumes execution with result value `result` or exception `error`.
+
+ Generally, if `error != null`, the result value is ignoried and execution
+ continues as if `error` had been thrown as an exception.
+ **/
+ function resume(result:T, error:Exception):Void;
+}
diff --git a/std/haxe/coro/IStackFrame.hx b/std/haxe/coro/IStackFrame.hx
new file mode 100644
index 00000000000..8bbd0c1ac1c
--- /dev/null
+++ b/std/haxe/coro/IStackFrame.hx
@@ -0,0 +1,8 @@
+package haxe.coro;
+
+import haxe.CallStack.StackItem;
+
+interface IStackFrame {
+ function getStackItem():Null;
+ function callerFrame():Null;
+}
\ No newline at end of file
diff --git a/std/haxe/coro/ImmediateSuspensionResult.hx b/std/haxe/coro/ImmediateSuspensionResult.hx
new file mode 100644
index 00000000000..371cd4468dc
--- /dev/null
+++ b/std/haxe/coro/ImmediateSuspensionResult.hx
@@ -0,0 +1,32 @@
+package haxe.coro;
+
+import haxe.Exception;
+
+/**
+ Represents a suspension result which immediately has either a result or an error value.
+**/
+class ImmediateSuspensionResult extends SuspensionResult {
+ function new(result:T, error:Exception) {
+ this.result = result;
+ this.error = error;
+ this.state = error == null ? Returned : Thrown;
+ }
+
+ /**
+ Creates a new `ImmediateSuspensionResult` instance with result `result`.
+ **/
+ static public function withResult(result:T) {
+ return new ImmediateSuspensionResult(result, null);
+ }
+
+ /**
+ Creates a new `ImmediateSuspensionResult` instance with error `error`.
+ **/
+ static public function withError(error:T) {
+ return new ImmediateSuspensionResult(null, @:privateAccess haxe.Exception.thrown(error));
+ }
+
+ public override function toString() {
+ return '[ImmediateSuspensionResult ${state.toString()}, $result]';
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/Mutex.hx b/std/haxe/coro/Mutex.hx
new file mode 100644
index 00000000000..0916454feae
--- /dev/null
+++ b/std/haxe/coro/Mutex.hx
@@ -0,0 +1,45 @@
+package haxe.coro;
+
+#if (target.threaded)
+typedef Mutex = sys.thread.Mutex;
+#else
+typedef Mutex = StubMutex;
+
+/**
+ This is a stub version.
+ Creates a mutex, which can be used to acquire a temporary lock
+ to access some resource. The main difference with a lock is
+ that a mutex must always be released by the owner thread.
+**/
+class StubMutex {
+ /**
+ Creates a stub mutex on non threaded target.
+ **/
+ public function new():Void {}
+
+ /**
+ This is a stub version.
+ The current thread acquire the mutex or wait if not available.
+ The same thread can acquire several times the same mutex but
+ must release it as many times it has been acquired.
+ **/
+ public function acquire():Void {}
+
+ /**
+ This is a stub version.
+ Try to acquire the mutex, returns true if acquire or false
+ if it's already locked by another thread.
+ **/
+ public function tryAcquire():Bool {
+ return true;
+ }
+
+ /**
+ This is a stub version.
+ Release a mutex that has been acquired by the current thread.
+ The behavior is undefined if the current thread does not own
+ the mutex.
+ **/
+ public function release():Void {}
+}
+#end
diff --git a/std/haxe/coro/SuspensionResult.hx b/std/haxe/coro/SuspensionResult.hx
new file mode 100644
index 00000000000..b2d7efa7d14
--- /dev/null
+++ b/std/haxe/coro/SuspensionResult.hx
@@ -0,0 +1,27 @@
+package haxe.coro;
+
+import haxe.Exception;
+
+/**
+ `SuspensionResult` is the return type of coroutine calls.
+**/
+abstract class SuspensionResult {
+ /**
+ The current state of the suspension.
+ **/
+ public var state:SuspensionState;
+
+ /**
+ The result value of the coroutine, if any.
+ **/
+ public var result:T;
+
+ /**
+ The error value of the coroutine, is any.
+ **/
+ public var error:Exception;
+
+ public function toString() {
+ return '[SuspensionResult ${state.toString()}, $result]';
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/SuspensionState.hx b/std/haxe/coro/SuspensionState.hx
new file mode 100644
index 00000000000..3e580271590
--- /dev/null
+++ b/std/haxe/coro/SuspensionState.hx
@@ -0,0 +1,32 @@
+package haxe.coro;
+
+/**
+ The state of a coroutine.
+**/
+@:using(SuspensionState.SuspensionStateTools)
+enum abstract SuspensionState(Int) {
+ /**
+ The coroutine is still running.
+ **/
+ final Pending;
+
+ /**
+ The coroutine has returned a value.
+ **/
+ final Returned;
+
+ /**
+ The coroutine has thrown an exception.
+ **/
+ final Thrown;
+}
+
+class SuspensionStateTools {
+ static public function toString(c:SuspensionState) {
+ return switch (c) {
+ case Pending: "Pending";
+ case Returned: "Returned";
+ case Thrown: "Thrown";
+ }
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/cancellation/CancellationToken.hx b/std/haxe/coro/cancellation/CancellationToken.hx
new file mode 100644
index 00000000000..144847ab921
--- /dev/null
+++ b/std/haxe/coro/cancellation/CancellationToken.hx
@@ -0,0 +1,33 @@
+package haxe.coro.cancellation;
+
+import haxe.exceptions.CancellationException;
+import haxe.coro.context.Key;
+
+private class NoOpCancellationHandle implements ICancellationHandle {
+ public function new() {}
+ public function close() {}
+}
+
+private class NoOpCancellationToken implements ICancellationToken {
+ static final handle = new NoOpCancellationHandle();
+
+ public var cancellationException (get, never) : Null;
+
+ public function new() {}
+
+ public function onCancellationRequested(_:ICancellationCallback):ICancellationHandle {
+ return handle;
+ }
+ public function get_cancellationException() {
+ return null;
+ }
+}
+
+class CancellationToken {
+ public static final key = new Key('CancellationToken');
+
+ /**
+ * Returns a cancellation token which will never be cancelled.
+ */
+ public static final none : ICancellationToken = new NoOpCancellationToken();
+}
\ No newline at end of file
diff --git a/std/haxe/coro/cancellation/ICancellationCallback.hx b/std/haxe/coro/cancellation/ICancellationCallback.hx
new file mode 100644
index 00000000000..ff5f5afebfd
--- /dev/null
+++ b/std/haxe/coro/cancellation/ICancellationCallback.hx
@@ -0,0 +1,7 @@
+package haxe.coro.cancellation;
+
+import haxe.exceptions.CancellationException;
+
+interface ICancellationCallback {
+ function onCancellation(cause:CancellationException):Void;
+}
diff --git a/std/haxe/coro/cancellation/ICancellationHandle.hx b/std/haxe/coro/cancellation/ICancellationHandle.hx
new file mode 100644
index 00000000000..6ead68d4391
--- /dev/null
+++ b/std/haxe/coro/cancellation/ICancellationHandle.hx
@@ -0,0 +1,13 @@
+package haxe.coro.cancellation;
+
+/**
+ * Handle to a callback which has been registered with a cancellation token.
+ */
+interface ICancellationHandle {
+ /**
+ * Stops the callback from being executed when the token is cancelled.
+ * If the token is already cancelled this function does nothing.
+ * This function is safe to call multiple times and is thread safe.
+ */
+ function close():Void;
+}
diff --git a/std/haxe/coro/cancellation/ICancellationToken.hx b/std/haxe/coro/cancellation/ICancellationToken.hx
new file mode 100644
index 00000000000..5005c37f0bc
--- /dev/null
+++ b/std/haxe/coro/cancellation/ICancellationToken.hx
@@ -0,0 +1,23 @@
+package haxe.coro.cancellation;
+
+import haxe.exceptions.CancellationException;
+
+/**
+ * A cancellation token enables cooperative cancellation between units of work (threads, coroutines, etc).
+ * The token cannot be used to initiate cancellation, only to poll for a cancellation request or register a callback for when cancellation is requested.
+ * Cancellation is cooperative which means it is up to the caller to respond to a cancellation request in a manner it deems best.
+ * Access to this interface is thread safe.
+ */
+interface ICancellationToken {
+ var cancellationException (get, never) : Null;
+
+ /**
+ * Register a callback which will be executed when this token is cancelled.
+ *
+ * If this token has already been cancelled the function will be executed immediately and synchronously, any exception raised will not be caught.
+ * The thread the callback is executed on is implementation defined if cancellation has not been yet been requested.
+ * @param func Callback to be executed when the token is cancelled.
+ * @return Cancellation handle which can be used to cancel the callback from executing.
+ */
+ function onCancellationRequested(handle : ICancellationCallback) : ICancellationHandle;
+}
diff --git a/std/haxe/coro/context/Context.hx b/std/haxe/coro/context/Context.hx
new file mode 100644
index 00000000000..eaeb8967984
--- /dev/null
+++ b/std/haxe/coro/context/Context.hx
@@ -0,0 +1,51 @@
+package haxe.coro.context;
+
+typedef ElementTree = Array;
+
+abstract Context(ElementTree) {
+ public inline function new(tree:ElementTree) {
+ this = tree;
+ }
+
+ public inline function clone() {
+ return new AdjustableContext(this.copy());
+ }
+
+ public inline function get(key:Key):T {
+ return cast this[key.id];
+ }
+
+ public inline function toString() {
+ return this.toString();
+ }
+
+ static public inline function create(...elements:IElement) {
+ return new AdjustableContext(new ElementTree()).with(...elements);
+ }
+}
+
+abstract AdjustableContext(ElementTree) {
+ public inline function new(tree:ElementTree) {
+ this = tree;
+ }
+
+ public inline function add(key:Key, element:T) {
+ this[key.id] = element;
+ return abstract;
+ }
+
+ public inline function get(key:Key):T {
+ return cast this[key.id];
+ }
+
+ public function with(...elements:IElement) {
+ for (element in elements) {
+ this[element.getKey().id] = element;
+ }
+ return abstract;
+ }
+
+ @:to inline function toContext():Context {
+ return new Context(this);
+ }
+}
diff --git a/std/haxe/coro/context/IElement.hx b/std/haxe/coro/context/IElement.hx
new file mode 100644
index 00000000000..e082ab68ac3
--- /dev/null
+++ b/std/haxe/coro/context/IElement.hx
@@ -0,0 +1,5 @@
+package haxe.coro.context;
+
+interface IElement {
+ public function getKey():Key;
+}
diff --git a/std/haxe/coro/context/Key.hx b/std/haxe/coro/context/Key.hx
new file mode 100644
index 00000000000..ec70b0da82c
--- /dev/null
+++ b/std/haxe/coro/context/Key.hx
@@ -0,0 +1,37 @@
+package haxe.coro.context;
+
+class KeyImpl {
+ static var counter = 0;
+ static var counterMutex = new Mutex();
+
+ public final name:String;
+ public final id:Int;
+
+ function new(id:Int, name:String) {
+ this.name = name;
+ this.id = id;
+ }
+
+ static public function createNew(name:String) {
+ counterMutex.acquire();
+ var id = counter++;
+ counterMutex.release();
+ return new KeyImpl(id, name);
+ }
+}
+
+private typedef WithKey = {
+ final key:Key;
+}
+
+@:forward
+@:forward.statics
+extern abstract Key(KeyImpl) {
+ public inline function new(name:String) {
+ this = KeyImpl.createNew(name);
+ }
+
+ @:from static public inline function fromClass & WithKey)>(c:C):Key {
+ return c.key;
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/continuations/RacingContinuation.hx b/std/haxe/coro/continuations/RacingContinuation.hx
new file mode 100644
index 00000000000..d2a44a25193
--- /dev/null
+++ b/std/haxe/coro/continuations/RacingContinuation.hx
@@ -0,0 +1,56 @@
+package haxe.coro.continuations;
+
+import hxcoro.concurrent.AtomicInt;
+import haxe.coro.context.Context;
+import haxe.coro.schedulers.Scheduler;
+import haxe.coro.schedulers.IScheduleObject;
+
+private enum abstract State(Int) to Int {
+ var Active;
+ var Resumed;
+ var Resolved;
+}
+
+class RacingContinuation extends SuspensionResult implements IContinuation implements IScheduleObject {
+ final inputCont:IContinuation;
+
+ var resumeState:AtomicInt;
+
+ public var context(get, never):Context;
+
+ final scheduler:Scheduler;
+
+ public function new(inputCont:IContinuation) {
+ this.inputCont = inputCont;
+ resumeState = new AtomicInt(Active);
+ scheduler = context.get(Scheduler);
+ }
+
+ inline function get_context() {
+ return inputCont.context;
+ }
+
+ public function resume(result:T, error:Exception):Void {
+ this.result = result;
+ this.error = error;
+ if (resumeState.compareExchange(Active, Resumed) != Active) {
+ scheduler.scheduleObject(this);
+ }
+ }
+
+ public function resolve():Void {
+ if (resumeState.compareExchange(Active, Resolved) == Active) {
+ state = Pending;
+ } else {
+ if (error != null) {
+ state = Thrown;
+ } else {
+ state = Returned;
+ }
+ }
+ }
+
+ public function onSchedule() {
+ inputCont.resume(result, error);
+ }
+}
diff --git a/std/haxe/coro/schedulers/EventLoopScheduler.hx b/std/haxe/coro/schedulers/EventLoopScheduler.hx
new file mode 100644
index 00000000000..2e7fd8fd866
--- /dev/null
+++ b/std/haxe/coro/schedulers/EventLoopScheduler.hx
@@ -0,0 +1,249 @@
+package haxe.coro.schedulers;
+
+import haxe.exceptions.ArgumentException;
+
+private typedef Lambda = ()->Void;
+private typedef CloseClosure = (handle:ISchedulerHandle)->Void;
+
+private class ScheduledEvent implements ISchedulerHandle {
+ final closure : CloseClosure;
+ final func : Lambda;
+ var closed : Bool;
+ public final runTime : Int64;
+ public var next : Null;
+ public var previous : Null;
+
+ public function new(closure, func, runTime) {
+ this.closure = closure;
+ this.func = func;
+ this.runTime = runTime;
+
+ closed = false;
+ next = null;
+ previous = null;
+ }
+
+ public inline function run() {
+ func();
+
+ closed = true;
+ }
+
+ public function close() {
+ if (closed) {
+ return;
+ }
+
+ closure(this);
+
+ closed = true;
+ }
+}
+
+private class NoOpHandle implements ISchedulerHandle {
+ public function new() {}
+ public function close() {}
+}
+
+private class DoubleBuffer {
+ final a : Array;
+ final b : Array;
+
+ var current : Array;
+
+ public function new() {
+ a = [];
+ b = [];
+ current = a;
+ }
+
+ public function flip() {
+ final returning = current;
+
+ current = if (current == a) b else a;
+ current.resize(0);
+
+ return returning;
+ }
+
+ public function push(l : T) {
+ current.push(l);
+ }
+
+ public function empty() {
+ return current.length == 0;
+ }
+}
+
+class FunctionScheduleObject implements IScheduleObject {
+ var func:() -> Void;
+
+ public function new(func:() -> Void) {
+ this.func = func;
+ }
+
+ public function onSchedule() {
+ func();
+ }
+}
+
+class EventLoopScheduler extends Scheduler {
+ var first : Null;
+ var last : Null;
+
+ final noOpHandle : NoOpHandle;
+ final zeroEvents : DoubleBuffer;
+ final zeroMutex : Mutex;
+ final futureMutex : Mutex;
+ final closeClosure : CloseClosure;
+
+ public function new() {
+ super();
+
+ first = null;
+ last = null;
+ noOpHandle = new NoOpHandle();
+ zeroEvents = new DoubleBuffer();
+ zeroMutex = new Mutex();
+ futureMutex = new Mutex();
+ closeClosure = close;
+ }
+
+ public function schedule(ms:Int64, func:()->Void):ISchedulerHandle {
+ if (ms < 0) {
+ throw new ArgumentException("Time must be greater or equal to zero");
+ } else if (ms == 0) {
+ zeroMutex.acquire();
+ zeroEvents.push(new FunctionScheduleObject(func));
+ zeroMutex.release();
+ return noOpHandle;
+ }
+
+ final event = new ScheduledEvent(closeClosure, func, now() + ms);
+
+ futureMutex.acquire();
+ if (first == null) {
+ first = event;
+ last = event;
+ futureMutex.release();
+ return event;
+ }
+
+ var currentLast = last;
+ var currentFirst = first;
+ while (true) {
+ if (event.runTime >= currentLast.runTime) {
+ final next = currentLast.next;
+ currentLast.next = event;
+ event.previous = currentLast;
+ if (next != null) {
+ event.next = next;
+ next.previous = event;
+ } else {
+ last = event;
+ }
+ futureMutex.release();
+ return event;
+ }
+ else if (event.runTime < currentFirst.runTime) {
+ final previous = currentFirst.previous;
+ currentFirst.previous = event;
+ event.next = currentFirst;
+ if (previous != null) {
+ event.previous = previous;
+ previous.next = event;
+ } else {
+ first = event;
+ }
+ futureMutex.release();
+ return event;
+ } else {
+ currentFirst = currentLast.next;
+ currentLast = currentLast.previous;
+ // if one of them is null, set to the other so the next iteration will definitely
+ // hit one of the two branches above
+ if (currentFirst == null) {
+ currentFirst = currentLast;
+ } else if (currentLast == null) {
+ currentLast = currentFirst;
+ }
+ }
+ }
+ }
+
+ public function scheduleObject(obj:IScheduleObject) {
+ zeroMutex.acquire();
+ zeroEvents.push(obj);
+ zeroMutex.release();
+ }
+
+ public function now() {
+ return Timer.milliseconds();
+ }
+
+ function runZeroEvents() {
+ zeroMutex.acquire();
+ final events = zeroEvents.flip();
+ // no need to hold onto the mutex because it's a double buffer and run itself is single-threaded
+ zeroMutex.release();
+ for (obj in events) {
+ obj.onSchedule();
+ }
+ }
+
+ public function run() {
+ runZeroEvents();
+
+ final currentTime = now();
+
+ futureMutex.acquire();
+ while (true) {
+ if (first == null) {
+ last = null;
+ break;
+ }
+ if (first.runTime <= currentTime) {
+ final toRun = first;
+ first = first.next;
+ if (first != null) {
+ first.previous = null;
+ }
+ futureMutex.release();
+ toRun.run();
+ futureMutex.acquire();
+ } else {
+ break;
+ }
+ }
+ futureMutex.release();
+ }
+
+ public function toString() {
+ return '[EventLoopScheduler]';
+ }
+
+ function close(handle : ISchedulerHandle) {
+ var current = first;
+ while (true) {
+ if (null == current) {
+ return;
+ }
+
+ if (current == handle) {
+ if (first == current) {
+ first = current.next;
+ } else {
+ final a = current.previous;
+ final b = current.next;
+
+ a.next = b;
+ b?.previous = a;
+ }
+
+ return;
+ } else {
+ current = current.next;
+ }
+ }
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/coro/schedulers/IScheduleObject.hx b/std/haxe/coro/schedulers/IScheduleObject.hx
new file mode 100644
index 00000000000..fd00afde5f1
--- /dev/null
+++ b/std/haxe/coro/schedulers/IScheduleObject.hx
@@ -0,0 +1,5 @@
+package haxe.coro.schedulers;
+
+interface IScheduleObject {
+ function onSchedule():Void;
+}
\ No newline at end of file
diff --git a/std/haxe/coro/schedulers/ISchedulerHandle.hx b/std/haxe/coro/schedulers/ISchedulerHandle.hx
new file mode 100644
index 00000000000..7455b30d700
--- /dev/null
+++ b/std/haxe/coro/schedulers/ISchedulerHandle.hx
@@ -0,0 +1,13 @@
+package haxe.coro.schedulers;
+
+/**
+ * Handle representing a scheduled function.
+ */
+interface ISchedulerHandle {
+ /**
+ * Close the handle thereby cancelleting future execution of the scheduled function.
+ * If the function is currently executing or has already executed nothing happens.
+ * This function is thread safe and allowed to be called multiple times.
+ */
+ function close() : Void;
+}
\ No newline at end of file
diff --git a/std/haxe/coro/schedulers/Scheduler.hx b/std/haxe/coro/schedulers/Scheduler.hx
new file mode 100644
index 00000000000..5052c02f6f3
--- /dev/null
+++ b/std/haxe/coro/schedulers/Scheduler.hx
@@ -0,0 +1,20 @@
+package haxe.coro.schedulers;
+
+import haxe.coro.context.Key;
+import haxe.coro.context.IElement;
+
+abstract class Scheduler implements IElement {
+ public static final key = new Key('Scheduler');
+
+ function new() {}
+
+ public abstract function schedule(ms:Int64, func:() -> Void):ISchedulerHandle;
+
+ public abstract function scheduleObject(obj:IScheduleObject):Void;
+
+ public abstract function now():Int64;
+
+ public function getKey() {
+ return key;
+ }
+}
diff --git a/std/haxe/coro/schedulers/VirtualTimeScheduler.hx b/std/haxe/coro/schedulers/VirtualTimeScheduler.hx
new file mode 100644
index 00000000000..e4e5419a03c
--- /dev/null
+++ b/std/haxe/coro/schedulers/VirtualTimeScheduler.hx
@@ -0,0 +1,65 @@
+package haxe.coro.schedulers;
+
+import haxe.exceptions.ArgumentException;
+
+class VirtualTimeScheduler extends EventLoopScheduler {
+ var currentTime : Int64;
+
+ public function new() {
+ super();
+
+ currentTime = 0i64;
+ }
+
+ public override function now() {
+ return currentTime;
+ }
+
+ public function advanceBy(ms:Int) {
+ if (ms < 0) {
+ throw new ArgumentException("Time must be greater or equal to zero");
+ }
+
+ virtualRun(currentTime + ms);
+ }
+
+ public function advanceTo(ms:Int) {
+ if (ms < 0) {
+ throw new ArgumentException("Time must be greater or equal to zero");
+ }
+ if (ms < currentTime) {
+ throw new ArgumentException("Cannot travel back in time");
+ }
+
+ virtualRun(ms);
+ }
+
+ function virtualRun(endTime : Int64) {
+ while (true) {
+ runZeroEvents();
+
+ while (true) {
+ if (first == null) {
+ last = null;
+ break;
+ }
+ if (first.runTime <= endTime) {
+ final toRun = first;
+ currentTime = first.runTime;
+ first = first.next;
+ if (first != null) {
+ first.previous = null;
+ }
+ toRun.run();
+ } else {
+ break;
+ }
+ }
+ if (zeroEvents.empty()) {
+ break;
+ }
+ }
+
+ currentTime = endTime;
+ }
+}
\ No newline at end of file
diff --git a/std/haxe/exceptions/CancellationException.hx b/std/haxe/exceptions/CancellationException.hx
new file mode 100644
index 00000000000..eb3c5c44458
--- /dev/null
+++ b/std/haxe/exceptions/CancellationException.hx
@@ -0,0 +1,7 @@
+package haxe.exceptions;
+
+class CancellationException extends CoroutineException {
+ public function new() {
+ super("Cancellation");
+ }
+}
diff --git a/std/haxe/exceptions/CoroutineException.hx b/std/haxe/exceptions/CoroutineException.hx
new file mode 100644
index 00000000000..6e96b6ddef7
--- /dev/null
+++ b/std/haxe/exceptions/CoroutineException.hx
@@ -0,0 +1,5 @@
+package haxe.exceptions;
+
+import haxe.Exception;
+
+class CoroutineException extends Exception {}
diff --git a/std/hxcoro/Coro.hx b/std/hxcoro/Coro.hx
new file mode 100644
index 00000000000..1c9e4ab17db
--- /dev/null
+++ b/std/hxcoro/Coro.hx
@@ -0,0 +1,112 @@
+package hxcoro;
+
+import hxcoro.continuations.CancellingContinuation;
+import haxe.coro.IContinuation;
+import haxe.coro.ICancellableContinuation;
+import haxe.coro.schedulers.Scheduler;
+import haxe.coro.cancellation.CancellationToken;
+import haxe.exceptions.CancellationException;
+import haxe.exceptions.ArgumentException;
+import hxcoro.task.NodeLambda;
+import hxcoro.task.CoroTask;
+import hxcoro.exceptions.TimeoutException;
+import hxcoro.continuations.TimeoutContinuation;
+
+class Coro {
+ @:coroutine @:coroutine.transformed
+ public static function suspend(func:IContinuation->Void, completion:IContinuation):T {
+ var safe = new haxe.coro.continuations.RacingContinuation(completion);
+ func(safe);
+ safe.resolve();
+ return cast safe;
+ }
+
+ /**
+ * Suspends a coroutine which will be automatically resumed with a `haxe.exceptions.CancellationException` when cancelled.
+ * The `ICancellableContinuation` passed to the function allows registering a callback which is invoked on cancellation
+ * allowing the easy cleanup of resources.
+ */
+ @:coroutine @:coroutine.transformed public static function suspendCancellable(func:ICancellableContinuation->Void, completion:IContinuation):T {
+ var safe = new CancellingContinuation(completion);
+ func(safe);
+ return cast safe;
+ }
+
+ static function cancellationRequested(cont:IContinuation) {
+ return cont.context.get(CancellationToken)?.isCancellationRequested();
+ }
+
+ static function delayImpl(ms:Int, cont:ICancellableContinuation) {
+ final handle = cont.context.get(Scheduler).schedule(ms, () -> {
+ cont.callSync();
+ });
+
+ cont.onCancellationRequested = _ -> {
+ handle.close();
+ }
+ }
+
+ @:coroutine @:coroutine.nothrow public static function delay(ms:Int):Void {
+ suspendCancellable(cont -> delayImpl(ms, cont));
+ }
+
+ @:coroutine @:coroutine.nothrow public static function yield():Void {
+ suspendCancellable(cont -> delayImpl(0, cont));
+ }
+
+ @:coroutine static public function scope(lambda:NodeLambda):T {
+ return suspend(cont -> {
+ final context = cont.context;
+ final scope = new CoroTask(context, CoroTask.CoroScopeStrategy);
+ scope.runNodeLambda(lambda);
+ scope.awaitContinuation(cont);
+ });
+ }
+
+ /**
+ Executes `lambda` in a new task, ignoring all child exceptions.
+
+ The task itself can still raise an exception. This is also true when calling
+ `child.await()` on a child that raises an exception.
+ **/
+ @:coroutine static public function supervisor(lambda:NodeLambda):T {
+ return suspend(cont -> {
+ final context = cont.context;
+ final scope = new CoroTask(context, CoroTask.CoroSupervisorStrategy);
+ scope.runNodeLambda(lambda);
+ scope.awaitContinuation(cont);
+ });
+ }
+
+ /**
+ * Runs the provided lambda with a timeout, if the timeout is exceeded this functions throws `hxcoro.exceptions.TimeoutException`.
+ * If a timeout of zero is provided the function immediately throws `hxcoro.exceptions.TimeoutException`.
+ * @param ms Timeout in milliseconds.
+ * @param lambda Lambda function to execute.
+ * @throws `hxcoro.exceptions.TimeoutException` If the timeout is exceeded.
+ * @throws `haxe.ArgumentException` If the `ms` parameter is less than zero.
+ */
+ @:coroutine public static function timeout(ms:Int, lambda:NodeLambda):T {
+ return suspend(cont -> {
+ if (ms < 0) {
+ cont.failSync(new ArgumentException('timeout must be positive'));
+
+ return;
+ }
+ if (ms == 0) {
+ cont.failSync(new TimeoutException());
+
+ return;
+ }
+
+ final context = cont.context;
+ final scope = new CoroTask(context, CoroTask.CoroScopeStrategy);
+ final handle = context.get(Scheduler).schedule(ms, () -> {
+ scope.cancel(new TimeoutException());
+ });
+
+ scope.runNodeLambda(lambda);
+ scope.awaitContinuation(new TimeoutContinuation(cont, handle));
+ });
+ }
+}
diff --git a/std/hxcoro/CoroRun.hx b/std/hxcoro/CoroRun.hx
new file mode 100644
index 00000000000..e9df4e8215e
--- /dev/null
+++ b/std/hxcoro/CoroRun.hx
@@ -0,0 +1,72 @@
+package hxcoro;
+
+import haxe.coro.Coroutine;
+import haxe.coro.context.Context;
+import haxe.coro.context.IElement;
+import haxe.coro.schedulers.EventLoopScheduler;
+import hxcoro.task.ICoroTask;
+import hxcoro.task.CoroTask;
+import hxcoro.task.StartableCoroTask;
+import hxcoro.task.NodeLambda;
+
+private abstract RunnableContext(ElementTree) {
+ inline function new(tree:ElementTree) {
+ this = tree;
+ }
+
+ public function create(lambda:NodeLambda):IStartableCoroTask {
+ return new StartableCoroTask(new Context(this), lambda, CoroTask.CoroScopeStrategy);
+ }
+
+ public function run(lambda:NodeLambda):T {
+ return CoroRun.runWith(new Context(this), lambda);
+ }
+
+ @:from static function fromAdjustableContext(context:AdjustableContext) {
+ return new RunnableContext(cast context);
+ }
+
+ public function with(...elements:IElement):RunnableContext {
+ return new AdjustableContext(this.copy()).with(...elements);
+ }
+}
+
+class CoroRun {
+ static var defaultContext(get, null):Context;
+
+ static function get_defaultContext() {
+ if (defaultContext != null) {
+ return defaultContext;
+ }
+ final stackTraceManagerComponent = new haxe.coro.BaseContinuation.StackTraceManager();
+ defaultContext = Context.create(stackTraceManagerComponent);
+ return defaultContext;
+ }
+
+ public static function with(...elements:IElement):RunnableContext {
+ return defaultContext.clone().with(...elements);
+ }
+
+ static public function run(lambda:Coroutine<() -> T>):T {
+ return runScoped(_ -> lambda());
+ }
+
+ static public function runScoped(lambda:NodeLambda):T {
+ return runWith(defaultContext, lambda);
+ }
+
+ static public function runWith(context:Context, lambda:NodeLambda):T {
+ final schedulerComponent = new EventLoopScheduler();
+ final scope = new CoroTask(context.clone().with(schedulerComponent), CoroTask.CoroScopeStrategy);
+ scope.runNodeLambda(lambda);
+ while (scope.isActive()) {
+ schedulerComponent.run();
+ }
+ switch (scope.getError()) {
+ case null:
+ return scope.get();
+ case error:
+ throw error;
+ }
+ }
+}
diff --git a/std/hxcoro/components/CoroName.hx b/std/hxcoro/components/CoroName.hx
new file mode 100644
index 00000000000..5c2d2c96ed9
--- /dev/null
+++ b/std/hxcoro/components/CoroName.hx
@@ -0,0 +1,18 @@
+package hxcoro.components;
+
+import haxe.coro.context.Key;
+import haxe.coro.context.IElement;
+
+class CoroName implements IElement {
+ static public final key = new Key("Name");
+
+ public final name:String;
+
+ public function new(name:String) {
+ this.name = name;
+ }
+
+ public function getKey() {
+ return key;
+ }
+}
\ No newline at end of file
diff --git a/std/hxcoro/concurrent/AtomicInt.hx b/std/hxcoro/concurrent/AtomicInt.hx
new file mode 100644
index 00000000000..b42106db15a
--- /dev/null
+++ b/std/hxcoro/concurrent/AtomicInt.hx
@@ -0,0 +1,58 @@
+package hxcoro.concurrent;
+
+import haxe.coro.Mutex;
+
+#if (cpp || hl || js || jvm || eval)
+typedef AtomicInt = haxe.atomic.AtomicInt;
+#else
+typedef AtomicInt = AtomicIntImpl;
+
+private class AtomicIntData {
+ public final mutex:Mutex;
+ public var value:Int;
+
+ public function new(value:Int) {
+ this.value = value;
+ mutex = new Mutex();
+ }
+}
+
+abstract AtomicIntImpl(AtomicIntData) {
+ public function new(v:Int) {
+ this = new AtomicIntData(v);
+ }
+
+ public function load() {
+ return this.value;
+ }
+
+ public function compareExchange(expected:Int, replacement:Int) {
+ this.mutex.acquire();
+ if (this.value == expected) {
+ this.value = replacement;
+ this.mutex.release();
+ return expected;
+ } else {
+ final value = this.value;
+ this.mutex.release();
+ return value;
+ }
+ }
+
+ public function sub(b:Int) {
+ this.mutex.acquire();
+ final value = this.value;
+ this.value -= b;
+ this.mutex.release();
+ return value;
+ }
+
+ public function add(b:Int) {
+ this.mutex.acquire();
+ final value = this.value;
+ this.value += b;
+ this.mutex.release();
+ return value;
+ }
+}
+#end
diff --git a/std/hxcoro/concurrent/CoroMutex.hx b/std/hxcoro/concurrent/CoroMutex.hx
new file mode 100644
index 00000000000..000fdce225a
--- /dev/null
+++ b/std/hxcoro/concurrent/CoroMutex.hx
@@ -0,0 +1,7 @@
+package hxcoro.concurrent;
+
+class CoroMutex extends CoroSemaphore {
+ public function new() {
+ super(1);
+ }
+}
diff --git a/std/hxcoro/concurrent/CoroSemaphore.hx b/std/hxcoro/concurrent/CoroSemaphore.hx
new file mode 100644
index 00000000000..ca1fb73229e
--- /dev/null
+++ b/std/hxcoro/concurrent/CoroSemaphore.hx
@@ -0,0 +1,75 @@
+package hxcoro.concurrent;
+
+import haxe.coro.Mutex;
+import hxcoro.task.CoroTask;
+import hxcoro.ds.PagedDeque;
+import haxe.coro.IContinuation;
+import haxe.coro.cancellation.CancellationToken;
+
+class CoroSemaphore {
+ final maxFree:Int;
+ final dequeMutex:Mutex;
+ var deque:Null>>;
+ var free:AtomicInt;
+
+ public function new(free:Int) {
+ maxFree = free;
+ dequeMutex = new Mutex();
+ this.free = new AtomicInt(free);
+ }
+
+ @:coroutine public function acquire() {
+ if (free.sub(1) > 0) {
+ return;
+ }
+ suspendCancellable(cont -> {
+ final task = cont.context.get(CoroTask);
+ dequeMutex.acquire();
+ if (deque == null) {
+ deque = new PagedDeque();
+ }
+ deque.push(cont);
+ task.putOnHold(); // TODO: condition this on some heuristic?
+ dequeMutex.release();
+ });
+ }
+
+ public function tryAcquire() {
+ while (true) {
+ var free = free.load();
+ if (free <= 0) {
+ return false;
+ }
+ if (this.free.compareExchange(free, free - 1) == free) {
+ return true;
+ }
+ }
+ }
+
+ public function release() {
+ free.add(1);
+ dequeMutex.acquire();
+ if (deque == null) {
+ dequeMutex.release();
+ return;
+ }
+ while (true) {
+ if (deque.isEmpty()) {
+ // nobody else wants it right now, return
+ dequeMutex.release();
+ return;
+ }
+ // a continuation waits for this mutex, wake it up now
+ final cont = deque.pop();
+ final ct = cont.context.get(CancellationToken);
+ if (ct.isCancellationRequested()) {
+ // ignore, back to the loop
+ } else {
+ // continue normally
+ dequeMutex.release();
+ cont.callAsync();
+ return;
+ }
+ }
+ }
+}
diff --git a/std/hxcoro/continuations/CancellingContinuation.hx b/std/hxcoro/continuations/CancellingContinuation.hx
new file mode 100644
index 00000000000..93c2500e354
--- /dev/null
+++ b/std/hxcoro/continuations/CancellingContinuation.hx
@@ -0,0 +1,86 @@
+package hxcoro.continuations;
+
+import haxe.coro.SuspensionResult;
+import haxe.coro.schedulers.IScheduleObject;
+import hxcoro.concurrent.AtomicInt;
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+import haxe.coro.IContinuation;
+import haxe.coro.ICancellableContinuation;
+import haxe.coro.context.Context;
+import haxe.coro.schedulers.Scheduler;
+import haxe.coro.cancellation.ICancellationHandle;
+import haxe.coro.cancellation.CancellationToken;
+import haxe.coro.cancellation.ICancellationCallback;
+
+private enum abstract State(Int) to Int {
+ var Active;
+ var Resumed;
+ var Cancelled;
+}
+
+class CancellingContinuation extends SuspensionResult implements ICancellableContinuation implements ICancellationCallback implements IScheduleObject {
+ final resumeState : AtomicInt;
+
+ final cont : IContinuation;
+
+ final handle : ICancellationHandle;
+
+ public var context (get, never) : Context;
+
+ function get_context() {
+ return cont.context;
+ }
+
+ public var onCancellationRequested (default, set) : CancellationException->Void;
+
+ function set_onCancellationRequested(f : CancellationException->Void) {
+ return switch (cont.context.get(CancellationToken).cancellationException) {
+ case null:
+ if (null != onCancellationRequested) {
+ throw new Exception("Callback already registered");
+ }
+
+ onCancellationRequested = f;
+ case exc:
+ f(exc);
+
+ f;
+ }
+ }
+
+ public function new(cont) {
+ this.resumeState = new AtomicInt(Active);
+ this.cont = cont;
+ this.handle = this.cont.context.get(CancellationToken).onCancellationRequested(this);
+ this.state = Pending;
+ }
+
+ public function resume(result:T, error:Exception) {
+ this.result = result;
+ this.error = error;
+ if (resumeState.compareExchange(Active, Resumed) == Active) {
+ handle.close();
+ context.get(Scheduler).scheduleObject(this);
+ } else {
+ cont.failAsync(error.orCancellationException());
+ }
+
+ }
+
+ public function onCancellation(cause:CancellationException) {
+ handle?.close();
+
+ if (resumeState.compareExchange(Active, Cancelled) == Active) {
+ if (null != onCancellationRequested) {
+ onCancellationRequested(cause);
+ }
+
+ cont.failAsync(cause);
+ }
+ }
+
+ public function onSchedule() {
+ cont.resume(result, error);
+ }
+}
\ No newline at end of file
diff --git a/std/hxcoro/continuations/TimeoutContinuation.hx b/std/hxcoro/continuations/TimeoutContinuation.hx
new file mode 100644
index 00000000000..6c74dddf5ca
--- /dev/null
+++ b/std/hxcoro/continuations/TimeoutContinuation.hx
@@ -0,0 +1,28 @@
+package hxcoro.continuations;
+
+import haxe.Exception;
+import haxe.coro.IContinuation;
+import haxe.coro.context.Context;
+import haxe.coro.schedulers.ISchedulerHandle;
+
+class TimeoutContinuation implements IContinuation {
+ final cont : IContinuation;
+ final handle : ISchedulerHandle;
+
+ public var context (get, never) : Context;
+
+ inline function get_context() {
+ return cont.context;
+ }
+
+ public function new(cont, handle) {
+ this.cont = cont;
+ this.handle = handle;
+ }
+
+ public function resume(value:T, error:Exception) {
+ handle.close();
+
+ cont.resumeAsync(value, error);
+ }
+}
\ No newline at end of file
diff --git a/std/hxcoro/ds/Channel.hx b/std/hxcoro/ds/Channel.hx
new file mode 100644
index 00000000000..8f5573e57d3
--- /dev/null
+++ b/std/hxcoro/ds/Channel.hx
@@ -0,0 +1,155 @@
+package hxcoro.ds;
+
+import haxe.coro.ICancellableContinuation;
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+import haxe.coro.cancellation.CancellationToken;
+import haxe.coro.context.Context;
+import haxe.coro.IContinuation;
+import hxcoro.Coro.suspendCancellable;
+import hxcoro.ds.PagedDeque;
+
+private class SuspendedWrite implements IContinuation {
+ final continuation : IContinuation;
+
+ public final value : T;
+
+ public var context (get, never) : Context;
+
+ final suspendedWrites:PagedDeque;
+ final hostPage:Page;
+
+ inline function get_context() {
+ return continuation.context;
+ }
+
+ public function new(continuation:ICancellableContinuation, value, suspendedWrites:PagedDeque) {
+ this.continuation = continuation;
+ this.value = value;
+ // writeMutex.acquire();
+ this.suspendedWrites = suspendedWrites;
+ hostPage = suspendedWrites.push(this);
+ // writeMutex.release();
+ continuation.onCancellationRequested = onCancellation;
+ }
+
+ public function resume(v:T, error:Exception) {
+ switch (context.get(CancellationToken).cancellationException) {
+ case null:
+ continuation.resume(v, error);
+ case exc:
+ continuation.failAsync(exc);
+ }
+ }
+
+ function onCancellation(cause:CancellationException) {
+ // writeMutex.acquire();
+ suspendedWrites.remove(hostPage, this);
+ // writeMutex.release();
+ continuation.failSync(cause);
+ }
+}
+
+class SuspendedRead implements IContinuation {
+ final continuation : IContinuation;
+
+ public var context (get, never) : Context;
+
+ final suspendedReads:PagedDeque;
+ final hostPage:Page;
+
+ inline function get_context() {
+ return continuation.context;
+ }
+
+ public function new(continuation:ICancellableContinuation, suspendedReads:PagedDeque) {
+ this.continuation = continuation;
+
+ // readMutex.acquire();
+ this.suspendedReads = suspendedReads;
+ hostPage = suspendedReads.push(this);
+ // readMutex.release();
+ continuation.onCancellationRequested = onCancellation;
+ }
+
+ public function resume(v:T, error:Exception) {
+ switch (context.get(CancellationToken).cancellationException) {
+ case null:
+ continuation.resume(v, error);
+ case exc:
+ continuation.failAsync(exc);
+ }
+ }
+
+ function onCancellation(cause:CancellationException) {
+ // readMutex.acquire();
+ suspendedReads.remove(hostPage, this);
+ // readMutex.release();
+ this.failSync(cause);
+ }
+}
+
+class Channel {
+ final bufferSize : Int;
+ final writeQueue : Array;
+ final suspendedWrites : PagedDeque>;
+ final suspendedReads : PagedDeque>;
+
+ /**
+ Creates a new empty Channel.
+ **/
+ public function new(bufferSize = 3) {
+ this.bufferSize = bufferSize;
+
+ writeQueue = [];
+ suspendedWrites = new PagedDeque();
+ suspendedReads = new PagedDeque();
+ }
+
+ /**
+ Writes `v` to this channel. If the operation cannot be completed immediately, execution is
+ suspended. It can be resumed by a later call to `read`.
+ **/
+ @:coroutine public function write(v:T) {
+ while (true) {
+ if (suspendedReads.isEmpty()) {
+ if (writeQueue.length < bufferSize) {
+ writeQueue.push(v);
+ } else {
+ suspendCancellable(cont -> {
+ new SuspendedWrite(cont, v, suspendedWrites);
+ });
+ }
+ break;
+ } else {
+ final suspendedRead = suspendedReads.pop();
+ suspendedRead.succeedAsync(v);
+ break;
+ }
+ }
+ }
+
+ /**
+ Reads an element from this channel. If the operation cannot be completed immediately,
+ execution is suspended. It can be resumed by a later call to `write`.
+ **/
+ @:coroutine public function read():T {
+ if ((bufferSize == 0 || writeQueue.length < bufferSize) && !suspendedWrites.isEmpty()) {
+ final resuming = suspendedWrites.pop();
+ resuming.callSync();
+ if (writeQueue.length == 0) {
+ return resuming.value;
+ } else {
+ writeQueue.push(resuming.value);
+ }
+ }
+ switch writeQueue.shift() {
+ case null:
+ return suspendCancellable(cont -> {
+ new SuspendedRead(cont, suspendedReads);
+ });
+ case v:
+ return v;
+ }
+ }
+}
diff --git a/std/hxcoro/ds/PagedDeque.hx b/std/hxcoro/ds/PagedDeque.hx
new file mode 100644
index 00000000000..e4945501ddd
--- /dev/null
+++ b/std/hxcoro/ds/PagedDeque.hx
@@ -0,0 +1,181 @@
+package hxcoro.ds;
+
+import haxe.ds.Vector;
+import haxe.Exception;
+
+class Page {
+ public final data:Vector;
+ public var numDeleted:Int;
+ public var next:Null>;
+
+ public function new(size:Int) {
+ this.data = new Vector(size);
+ numDeleted = 0;
+ }
+
+ function removeFrom(element:T, startIndex:Int) {
+ for (i in startIndex...data.length - numDeleted) {
+ if (data[i] == element) {
+ blitAt(i);
+ return true;
+ }
+ }
+ return false;
+ }
+
+ public function reset() {
+ numDeleted = 0;
+ next = null;
+ }
+
+ public inline function freeSpace() {
+ return data.length - numDeleted;
+ }
+
+ function blitAt(index:Int) {
+ final toBlit = freeSpace() - index - 1;
+ if (toBlit > 0) {
+ Vector.blit(data, index + 1, data, index, toBlit);
+ }
+ numDeleted++;
+ }
+}
+
+class PagedDeque {
+ final vectorSize:Int;
+ var currentPage:Page;
+ var currentIndex:Int;
+ var lastPage:Page;
+ public var lastIndex(default, null):Int;
+
+ public function new(vectorSize = 8) {
+ this.vectorSize = vectorSize;
+ currentPage = new Page(vectorSize);
+ currentIndex = 0;
+ lastPage = currentPage;
+ lastIndex = 0;
+ }
+
+ inline function getPageDataAt(page:Page, index:Int) {
+ return page.data[index];
+ }
+
+ inline function setPageDataAt(page:Page, index:Int, value:T) {
+ page.data[index - page.numDeleted] = value;
+ }
+
+ public function forEach(f:T->Void) {
+ var currentPage = currentPage;
+ var currentIndex = currentIndex;
+ while (currentPage != lastPage) {
+ while (currentIndex < currentPage.freeSpace()) {
+ f(getPageDataAt(currentPage, currentIndex++));
+ }
+ currentIndex = 0;
+ currentPage = currentPage.next;
+ }
+ while (currentIndex < lastIndex - currentPage.numDeleted) {
+ f(getPageDataAt(currentPage, currentIndex++));
+ }
+ }
+
+ public function mapInPlace(f:T->T) {
+ var currentPage = currentPage;
+ var currentIndex = currentIndex;
+ while (currentPage != lastPage) {
+ while (currentIndex < currentPage.freeSpace()) {
+ setPageDataAt(currentPage, currentIndex, f(getPageDataAt(currentPage, currentIndex++)));
+ }
+ currentIndex = 0;
+ currentPage = currentPage.next;
+ }
+ while (currentIndex < lastIndex) {
+ setPageDataAt(currentPage, currentIndex, f(getPageDataAt(currentPage, currentIndex++)));
+ }
+ }
+
+ public function fold(acc:A, f:(acc:A, elt:T) -> A) {
+ var currentPage = currentPage;
+ var currentIndex = currentIndex;
+ while (currentPage != lastPage) {
+ while (currentIndex < currentPage.freeSpace()) {
+ acc = f(acc, getPageDataAt(currentPage, currentIndex++));
+ }
+ currentIndex = 0;
+ currentPage = currentPage.next;
+ }
+ while (currentIndex < lastIndex) {
+ acc = f(acc, getPageDataAt(currentPage, currentIndex++));
+ }
+ return acc;
+ }
+
+ public function push(x:T) {
+ if (lastIndex == lastPage.freeSpace()) {
+ // current page is full
+ if (lastPage.next == null) {
+ // we have no next page, allocate one
+ lastPage.next = new Page(vectorSize);
+ }
+ lastPage = lastPage.next;
+ lastPage.next = null;
+ lastIndex = 1;
+ setPageDataAt(lastPage, 0, x);
+ return lastPage;
+ }
+ setPageDataAt(lastPage, lastIndex++, x);
+ return lastPage;
+ }
+
+ public function pop() {
+ if (currentIndex == currentPage.freeSpace()) {
+ // end of page, need to swap
+ var nextPage = currentPage.next;
+ if (nextPage == null) {
+ throw new Exception("pop() was called on empty PagedDeque");
+ }
+ if (lastPage.next == null) {
+ // reuse current page as next last page
+ lastPage.next = currentPage;
+ currentPage.next = null;
+ currentPage.reset();
+ }
+ currentPage = nextPage;
+ currentIndex = 1;
+ return getPageDataAt(currentPage, 0);
+ } else if (currentIndex == currentPage.freeSpace() - 1 && currentPage.next == null) {
+ // deque is empty, reset to reuse current page
+ resetCurrent();
+ return getPageDataAt(currentPage, currentPage.freeSpace() - 1);
+ } else {
+ return getPageDataAt(currentPage, currentIndex++);
+ }
+ }
+
+ public function remove(page:Page, element:T) {
+ return if (page == currentPage) {
+ @:privateAccess page.removeFrom(element, currentIndex);
+ } else {
+ @:privateAccess page.removeFrom(element, 0);
+ }
+ }
+
+ public function isEmpty() {
+ while (currentIndex == currentPage.freeSpace()) {
+ if (currentPage.next == null || currentPage == lastPage) {
+ resetCurrent();
+ return true;
+ }
+ currentPage = currentPage.next;
+ currentIndex = 0;
+ }
+
+ return currentPage == lastPage && currentIndex == lastIndex - currentPage.numDeleted;
+ }
+
+ function resetCurrent() {
+ currentIndex = 0;
+ lastIndex = 0;
+ currentPage.reset();
+ }
+}
diff --git a/std/hxcoro/exceptions/TimeoutException.hx b/std/hxcoro/exceptions/TimeoutException.hx
new file mode 100644
index 00000000000..40dd78d76b5
--- /dev/null
+++ b/std/hxcoro/exceptions/TimeoutException.hx
@@ -0,0 +1,5 @@
+package hxcoro.exceptions;
+
+import haxe.exceptions.CancellationException;
+
+class TimeoutException extends CancellationException {}
\ No newline at end of file
diff --git a/std/hxcoro/import.hx b/std/hxcoro/import.hx
new file mode 100644
index 00000000000..95ac50507e3
--- /dev/null
+++ b/std/hxcoro/import.hx
@@ -0,0 +1,4 @@
+package hxcoro;
+
+using hxcoro.util.Convenience;
+import hxcoro.Coro.*;
\ No newline at end of file
diff --git a/std/hxcoro/task/AbstractTask.hx b/std/hxcoro/task/AbstractTask.hx
new file mode 100644
index 00000000000..0d8538046aa
--- /dev/null
+++ b/std/hxcoro/task/AbstractTask.hx
@@ -0,0 +1,324 @@
+package hxcoro.task;
+
+import hxcoro.concurrent.AtomicInt;
+import haxe.coro.cancellation.ICancellationToken;
+import haxe.coro.cancellation.ICancellationHandle;
+import haxe.coro.cancellation.ICancellationCallback;
+import haxe.exceptions.CancellationException;
+import haxe.Exception;
+
+enum abstract TaskState(Int) {
+ final Created;
+ final Running;
+ final Completing;
+ final Completed;
+ final Cancelling;
+ final Cancelled;
+}
+
+private class TaskException extends Exception {}
+
+private class CancellationHandle implements ICancellationHandle {
+ final callback:ICancellationCallback;
+ final task:AbstractTask;
+
+ var closed:Bool;
+
+ public function new(callback, task) {
+ this.callback = callback;
+ this.task = task;
+
+ closed = false;
+ }
+
+ public function run() {
+ if (closed) {
+ return;
+ }
+
+ final error = task.getError();
+ callback.onCancellation(error.orCancellationException());
+
+ closed = true;
+ }
+
+ public function close() {
+ if (closed) {
+ return;
+ }
+ final all = @:privateAccess task.cancellationCallbacks;
+
+ if (all != null) {
+ if (all.length == 1 && all[0] == this) {
+ all.resize(0);
+ } else {
+ all.remove(this);
+ }
+ }
+
+ closed = true;
+ }
+}
+
+private class NoOpCancellationHandle implements ICancellationHandle {
+ public function new() {}
+
+ public function close() {}
+}
+
+/**
+ AbstractTask is the base class for tasks which manages its `TaskState` and children.
+
+ Developer note: it should have no knowledge of any asynchronous behavior or anything related to coroutines,
+ and should be kept in a state where it could even be moved outside the hxcoro package. Also, `state` should
+ be treated like a truly private variable and only be modified from within this class.
+**/
+abstract class AbstractTask implements ICancellationToken {
+ static final atomicId = new AtomicInt(1); // start with 1 so we can use 0 for "no task" situations
+ static final noOpCancellationHandle = new NoOpCancellationHandle();
+
+ final parent:AbstractTask;
+
+ var children:Null>;
+ var cancellationCallbacks:Null>;
+ var state:TaskState;
+ var error:Null;
+ var numCompletedChildren:Int;
+ var indexInParent:Int;
+ var allChildrenCompleted:Bool;
+
+ public var id(get, null):Int;
+ public var cancellationException(get, never):Null;
+
+ inline function get_cancellationException() {
+ return switch state {
+ case Cancelling | Cancelled:
+ error.orCancellationException();
+ case _:
+ null;
+ }
+ }
+
+ public inline function get_id() {
+ return id;
+ }
+
+ /**
+ Creates a new task.
+ **/
+ public function new(parent:Null, initialState:TaskState) {
+ id = atomicId.add(1);
+ this.parent = parent;
+ state = Created;
+ children = null;
+ cancellationCallbacks = null;
+ numCompletedChildren = 0;
+ indexInParent = -1;
+ allChildrenCompleted = false;
+ if (parent != null) {
+ parent.addChild(this);
+ }
+ switch (initialState) {
+ case Created:
+ case Running:
+ start();
+ case _:
+ throw new TaskException('Invalid initial state $initialState');
+ }
+ }
+
+ /**
+ Returns the task's error value, if any/
+ **/
+ public function getError() {
+ return error;
+ }
+
+ /**
+ Initiates cancellation of this task and all its children.
+
+ If `cause` is provided, it is set as this task's error value and used to cancel all children.
+
+ If the task cannot be cancelled or has already been cancelled, this function only checks if the
+ task has completed and initiates the appropriate behavior.
+ **/
+ public function cancel(?cause:CancellationException) {
+ switch (state) {
+ case Created | Running | Completing:
+ cause ??= new CancellationException();
+ if (error == null) {
+ error = cause;
+ }
+ state = Cancelling;
+
+ if (null != cancellationCallbacks) {
+ for (h in cancellationCallbacks) {
+ h.run();
+ }
+ }
+
+ cancelChildren(cause);
+ checkCompletion();
+ case _:
+ checkCompletion();
+ }
+ }
+
+ /**
+ Returns `true` if the task is still active. Note that an task that was created but not started yet
+ is considered to be active.
+ **/
+ public function isActive() {
+ return switch (state) {
+ case Completed | Cancelled:
+ false;
+ case _:
+ true;
+ }
+ }
+
+ public function onCancellationRequested(callback:ICancellationCallback):ICancellationHandle {
+ return switch state {
+ case Cancelling | Cancelled:
+ callback.onCancellation(error.orCancellationException());
+
+ return noOpCancellationHandle;
+ case _:
+ final container = cancellationCallbacks ??= [];
+ final handle = new CancellationHandle(callback, this);
+
+ container.push(handle);
+
+ handle;
+ }
+ }
+
+ /**
+ Returns this task's value, if any.
+ **/
+ abstract public function get():Null;
+
+ /**
+ Starts executing this task. Has no effect if the task is already active or has completed.
+ **/
+ public function start() {
+ switch (state) {
+ case Created:
+ state = Running;
+ doStart();
+ case _:
+ return;
+ }
+ }
+
+ public function cancelChildren(?cause:CancellationException) {
+ if (null == children || children.length == 0) {
+ return;
+ }
+
+ cause ??= new CancellationException();
+
+ for (child in children) {
+ if (child != null) {
+ child.cancel(cause);
+ }
+ }
+ }
+
+ final inline function beginCompleting() {
+ state = Completing;
+ startChildren();
+ }
+
+ function startChildren() {
+ if (null == children) {
+ return;
+ }
+
+ for (child in children) {
+ if (child == null) {
+ continue;
+ }
+ switch (child.state) {
+ case Created:
+ child.start();
+ case Cancelled | Completed:
+ case Running | Completing | Cancelling:
+ }
+ }
+ }
+
+ function checkCompletion() {
+ updateChildrenCompletion();
+ if (!allChildrenCompleted) {
+ return;
+ }
+ switch (state) {
+ case Created | Running | Completed | Cancelled:
+ return;
+ case _:
+ }
+ switch (state) {
+ case Completing:
+ state = Completed;
+ case Cancelling:
+ state = Cancelled;
+ case _:
+ throw new TaskException('Invalid state $state in checkCompletion');
+ }
+ complete();
+ }
+
+ function updateChildrenCompletion() {
+ if (allChildrenCompleted) {
+ return;
+ }
+ if (children == null) {
+ allChildrenCompleted = true;
+ childrenCompleted();
+ } else if (numCompletedChildren == children.length) {
+ allChildrenCompleted = true;
+ childrenCompleted();
+ }
+ }
+
+ abstract function doStart():Void;
+
+ abstract function complete():Void;
+
+ abstract function childrenCompleted():Void;
+
+ abstract function childSucceeds(child:AbstractTask):Void;
+
+ abstract function childErrors(child:AbstractTask, cause:Exception):Void;
+
+ abstract function childCancels(child:AbstractTask, cause:CancellationException):Void;
+
+ // called from child
+
+ function childCompletes(child:AbstractTask, processResult:Bool) {
+ numCompletedChildren++;
+ if (processResult) {
+ if (child.error != null) {
+ if (child.error is CancellationException) {
+ childCancels(child, cast child.error);
+ } else {
+ childErrors(child, child.error);
+ }
+ } else {
+ childSucceeds(child);
+ }
+ }
+ updateChildrenCompletion();
+ checkCompletion();
+ if (child.indexInParent >= 0) {
+ children[child.indexInParent] = null;
+ }
+ }
+
+ function addChild(child:AbstractTask) {
+ final container = children ??= [];
+ final index = container.push(child);
+ child.indexInParent = index - 1;
+ }
+}
diff --git a/std/hxcoro/task/CoroBaseTask.hx b/std/hxcoro/task/CoroBaseTask.hx
new file mode 100644
index 00000000000..f24691c41b1
--- /dev/null
+++ b/std/hxcoro/task/CoroBaseTask.hx
@@ -0,0 +1,221 @@
+package hxcoro.task;
+
+import hxcoro.task.CoroTask;
+import hxcoro.task.node.INodeStrategy;
+import hxcoro.task.ICoroTask;
+import hxcoro.task.AbstractTask;
+import hxcoro.task.ICoroNode;
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+import haxe.coro.IContinuation;
+import haxe.coro.context.Context;
+import haxe.coro.context.Key;
+import haxe.coro.context.IElement;
+import haxe.coro.schedulers.Scheduler;
+import haxe.coro.cancellation.CancellationToken;
+
+private class CoroTaskWith implements ICoroNodeWith {
+ public var context(get, null):Context;
+
+ final task:CoroBaseTask;
+
+ public function new(context:Context, task:CoroBaseTask) {
+ this.context = context;
+ this.task = task;
+ }
+
+ inline function get_context() {
+ return context;
+ }
+
+ public function async(lambda:NodeLambda):ICoroTask {
+ final child = new CoroTaskWithLambda(context, lambda, CoroTask.CoroChildStrategy);
+ context.get(Scheduler).scheduleObject(child);
+ return child;
+ }
+
+ public function lazy(lambda:NodeLambda):IStartableCoroTask {
+ return new StartableCoroTask(context, lambda, CoroTask.CoroChildStrategy);
+ }
+
+ public function with(...elements:IElement) {
+ return task.with(...elements);
+ }
+}
+
+private class CoroKeys {
+ static public final awaitingChildContinuation = new Key>("AwaitingChildContinuation");
+}
+
+/**
+ CoroTask provides the basic functionality for coroutine tasks.
+**/
+abstract class CoroBaseTask extends AbstractTask implements ICoroNode implements ICoroTask implements ILocalContext implements IElement> {
+ /**
+ This task's immutable `Context`.
+ **/
+ public var context(get, null):Context;
+
+ final nodeStrategy:INodeStrategy;
+ var coroLocalContext:Null;
+ var initialContext:Context;
+ var result:Null;
+ var awaitingContinuations:Null>>;
+
+ /**
+ Creates a new task using the provided `context`.
+ **/
+ public function new(context:Context, nodeStrategy:INodeStrategy, initialState:TaskState) {
+ super(context.get(CoroTask), initialState);
+ initialContext = context;
+ this.nodeStrategy = nodeStrategy;
+ }
+
+ inline function get_context() {
+ if (context == null) {
+ context = initialContext.clone().with(this).add(CancellationToken, this);
+ }
+ return context;
+ }
+
+ public function get() {
+ return result;
+ }
+
+ public function getKey() {
+ return CoroTask.key;
+ }
+
+ public function getLocalElement(key:Key):Null {
+ return coroLocalContext?.get(key);
+ }
+
+ public function setLocalElement(key:Key, element:T) {
+ if (coroLocalContext == null) {
+ coroLocalContext = Context.create();
+ }
+ coroLocalContext.add(key, element);
+ }
+
+ /**
+ Indicates that the task has been suspended, which allows it to clean up some of
+ its internal resources. Has no effect on the observable state of the task.
+
+ This function should be called when it is expected that the task might not be resumed
+ for a while, e.g. when waiting on a sparse `Channel` or a contended `Mutex`.
+ **/
+ public function putOnHold() {
+ context = null;
+ if (awaitingContinuations != null && awaitingContinuations.length == 0) {
+ awaitingContinuations = null;
+ }
+ if (cancellationCallbacks != null && cancellationCallbacks.length == 0) {
+ cancellationCallbacks = null;
+ }
+ if (allChildrenCompleted) {
+ children = null;
+ }
+ }
+
+ /**
+ Creates a lazy child task to execute `lambda`. The child task does not execute until its `start`
+ method is called. This occurrs automatically once this task has finished execution.
+ **/
+ public function lazy(lambda:NodeLambda):IStartableCoroTask {
+ return new StartableCoroTask(context, lambda, CoroTask.CoroChildStrategy);
+ }
+
+ /**
+ Creates a child task to execute `lambda` and starts it automatically.
+ **/
+ public function async(lambda:NodeLambda):ICoroTask {
+ final child = new CoroTaskWithLambda(context, lambda, CoroTask.CoroChildStrategy);
+ context.get(Scheduler).scheduleObject(child);
+ return child;
+ }
+
+ /**
+ Returns a copy of this tasks `Context` with `elements` added, which can be used to start child tasks.
+ **/
+ public function with(...elements:IElement) {
+ return new CoroTaskWith(context.clone().with(...elements), this);
+ }
+
+ /**
+ Resumes `cont` with this task's outcome.
+
+ If this task is no longer active, the continuation is resumed immediately. Otherwise, it is registered
+ to be resumed upon completion.
+
+ This function also starts this task if it has not been started yet.
+ **/
+ public function awaitContinuation(cont:IContinuation) {
+ switch state {
+ case Completed:
+ cont.succeedSync(result);
+ case Cancelled:
+ cont.failSync(error);
+ case _:
+ awaitingContinuations ??= [];
+ awaitingContinuations.push(cont);
+ start();
+ }
+ }
+
+ @:coroutine public function awaitChildren() {
+ if (allChildrenCompleted) {
+ getLocalElement(CoroKeys.awaitingChildContinuation)?.callSync();
+ return;
+ }
+ startChildren();
+ Coro.suspend(cont -> setLocalElement(CoroKeys.awaitingChildContinuation, cont));
+ }
+
+ /**
+ Suspends this task until it completes.
+ **/
+ @:coroutine public function await():T {
+ return Coro.suspend(awaitContinuation);
+ }
+
+ function handleAwaitingContinuations() {
+ if (awaitingContinuations == null) {
+ return;
+ }
+ while (awaitingContinuations.length > 0) {
+ final continuations = awaitingContinuations;
+ awaitingContinuations = [];
+ if (error != null) {
+ for (cont in continuations) {
+ cont.failAsync(error);
+ }
+ } else {
+ for (cont in continuations) {
+ cont.succeedAsync(result);
+ }
+ }
+ }
+ }
+
+ function childrenCompleted() {
+ getLocalElement(CoroKeys.awaitingChildContinuation)?.callSync();
+ }
+
+ // strategy dispatcher
+
+ function complete() {
+ nodeStrategy.complete(this);
+ }
+
+ function childSucceeds(child:AbstractTask) {
+ nodeStrategy.childSucceeds(this, child);
+ }
+
+ function childErrors(child:AbstractTask, cause:Exception) {
+ nodeStrategy.childErrors(this, child, cause);
+ }
+
+ function childCancels(child:AbstractTask, cause:CancellationException) {
+ nodeStrategy.childCancels(this, child, cause);
+ }
+}
diff --git a/std/hxcoro/task/CoroTask.hx b/std/hxcoro/task/CoroTask.hx
new file mode 100644
index 00000000000..394b9692985
--- /dev/null
+++ b/std/hxcoro/task/CoroTask.hx
@@ -0,0 +1,88 @@
+package hxcoro.task;
+
+import hxcoro.task.node.CoroChildStrategy;
+import hxcoro.task.node.CoroScopeStrategy;
+import hxcoro.task.node.CoroSupervisorStrategy;
+import hxcoro.task.node.INodeStrategy;
+import hxcoro.task.AbstractTask;
+import haxe.coro.IContinuation;
+import haxe.coro.context.Key;
+import haxe.coro.context.Context;
+import haxe.coro.schedulers.IScheduleObject;
+import haxe.Exception;
+
+class CoroTask extends CoroBaseTask implements IContinuation {
+ public static final key = new Key>('Task');
+
+ static public final CoroChildStrategy = new CoroChildStrategy();
+ static public final CoroScopeStrategy = new CoroScopeStrategy();
+ static public final CoroSupervisorStrategy = new CoroSupervisorStrategy();
+
+ var wasResumed:Bool;
+
+ public function new(context:Context, nodeStrategy:INodeStrategy, initialState:TaskState = Running) {
+ super(context, nodeStrategy, initialState);
+ wasResumed = true;
+ }
+
+ public function doStart() {
+ wasResumed = false;
+ }
+
+ public function runNodeLambda(lambda:NodeLambda) {
+ final result = lambda(this, this);
+ start();
+ switch result.state {
+ case Pending:
+ return;
+ case Returned:
+ this.succeedSync(result.result);
+ case Thrown:
+ this.failSync(result.error);
+ }
+ }
+
+ /**
+ Resumes the task with the provided `result` and `error`.
+ **/
+ public function resume(result:T, error:Exception) {
+ wasResumed = true;
+ if (error == null) {
+ switch (state) {
+ case Running:
+ this.result = result;
+ beginCompleting();
+ case _:
+ }
+ checkCompletion();
+ } else {
+ if (this.error == null) {
+ this.error = error;
+ }
+ cancel();
+ }
+ }
+
+ override function checkCompletion() {
+ if (!wasResumed) {
+ return;
+ }
+ super.checkCompletion();
+ }
+}
+
+class CoroTaskWithLambda extends CoroTask implements IScheduleObject {
+ final lambda:NodeLambda;
+
+ /**
+ Creates a new task using the provided `context` in order to execute `lambda`.
+ **/
+ public function new(context:Context, lambda:NodeLambda, nodeStrategy:INodeStrategy) {
+ super(context, nodeStrategy);
+ this.lambda = lambda;
+ }
+
+ public function onSchedule() {
+ runNodeLambda(lambda);
+ }
+}
\ No newline at end of file
diff --git a/std/hxcoro/task/ICoroNode.hx b/std/hxcoro/task/ICoroNode.hx
new file mode 100644
index 00000000000..e1a9c00bdf1
--- /dev/null
+++ b/std/hxcoro/task/ICoroNode.hx
@@ -0,0 +1,20 @@
+package hxcoro.task;
+
+import haxe.exceptions.CancellationException;
+import haxe.coro.context.Context;
+import haxe.coro.context.IElement;
+import hxcoro.task.ICoroTask;
+
+interface ICoroNodeWith {
+ var context(get, null):Context;
+ function async(lambda:NodeLambda):ICoroTask;
+ function lazy(lambda:NodeLambda):IStartableCoroTask;
+ function with(...elements:IElement):ICoroNodeWith;
+}
+
+interface ICoroNode extends ICoroNodeWith extends ILocalContext {
+ var id(get, never):Int;
+ @:coroutine function awaitChildren():Void;
+ function cancel(?cause:CancellationException):Void;
+ function cancelChildren(?cause:CancellationException):Void;
+}
diff --git a/std/hxcoro/task/ICoroTask.hx b/std/hxcoro/task/ICoroTask.hx
new file mode 100644
index 00000000000..6557d3f378d
--- /dev/null
+++ b/std/hxcoro/task/ICoroTask.hx
@@ -0,0 +1,17 @@
+package hxcoro.task;
+
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+
+interface ICoroTask extends ILocalContext {
+ var id(get, never):Int;
+ function cancel(?cause:CancellationException):Void;
+ @:coroutine function await():T;
+ function get():T;
+ function getError():Exception;
+ function isActive():Bool;
+}
+
+interface IStartableCoroTask extends ICoroTask {
+ function start():Void;
+}
diff --git a/std/hxcoro/task/ILocalContext.hx b/std/hxcoro/task/ILocalContext.hx
new file mode 100644
index 00000000000..870d4b771c3
--- /dev/null
+++ b/std/hxcoro/task/ILocalContext.hx
@@ -0,0 +1,8 @@
+package hxcoro.task;
+
+import haxe.coro.context.Key;
+
+interface ILocalContext {
+ function getLocalElement(key:Key):Null;
+ function setLocalElement(key:Key, element:T):Void;
+}
\ No newline at end of file
diff --git a/std/hxcoro/task/NodeLambda.hx b/std/hxcoro/task/NodeLambda.hx
new file mode 100644
index 00000000000..af34f16d6ad
--- /dev/null
+++ b/std/hxcoro/task/NodeLambda.hx
@@ -0,0 +1,5 @@
+package hxcoro.task;
+
+import haxe.coro.Coroutine;
+
+typedef NodeLambda = Coroutine<(node:ICoroNode) -> T>;
diff --git a/std/hxcoro/task/StartableCoroTask.hx b/std/hxcoro/task/StartableCoroTask.hx
new file mode 100644
index 00000000000..d46a9f2ab49
--- /dev/null
+++ b/std/hxcoro/task/StartableCoroTask.hx
@@ -0,0 +1,25 @@
+package hxcoro.task;
+
+import hxcoro.task.node.INodeStrategy;
+import hxcoro.task.ICoroTask;
+import haxe.coro.context.Context;
+
+class StartableCoroTask extends CoroTask implements IStartableCoroTask {
+ final lambda:NodeLambda;
+
+ /**
+ Creates a new task using the provided `context` in order to execute `lambda`.
+ **/
+ public function new(context:Context, lambda:NodeLambda, nodeStrategy:INodeStrategy) {
+ super(context, nodeStrategy, Created);
+ this.lambda = lambda;
+ }
+
+ /**
+ Starts executing this task's `lambda`. Has no effect if the task is already active or has completed.
+ **/
+ override public function doStart() {
+ super.doStart();
+ runNodeLambda(lambda);
+ }
+}
diff --git a/std/hxcoro/task/node/CoroChildStrategy.hx b/std/hxcoro/task/node/CoroChildStrategy.hx
new file mode 100644
index 00000000000..d1da8e4af2d
--- /dev/null
+++ b/std/hxcoro/task/node/CoroChildStrategy.hx
@@ -0,0 +1,35 @@
+package hxcoro.task.node;
+
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+
+@:access(hxcoro.task.AbstractTask)
+@:access(hxcoro.task.CoroTask)
+class CoroChildStrategy implements INodeStrategy {
+ public function new() {}
+
+ public function complete(task:CoroBaseTask) {
+ task.parent?.childCompletes(task, true);
+ task.handleAwaitingContinuations();
+ }
+
+ public function childSucceeds(task:CoroBaseTask, child:AbstractTask) {}
+
+ public function childErrors(task:CoroBaseTask, child:AbstractTask, cause:Exception) {
+ switch (task.state) {
+ case Created | Running | Completing:
+ // inherit child error
+ if (task.error == null) {
+ task.error = cause;
+ }
+ task.cancel();
+ case Cancelling:
+ // not sure about this one, what if we cancel normally and then get a real exception?
+ case Completed | Cancelled:
+ }
+ }
+
+ public function childCancels(task:CoroBaseTask, child:AbstractTask, cause:CancellationException) {
+ task.cancel(cause);
+ }
+}
diff --git a/std/hxcoro/task/node/CoroScopeStrategy.hx b/std/hxcoro/task/node/CoroScopeStrategy.hx
new file mode 100644
index 00000000000..a70d9554f1d
--- /dev/null
+++ b/std/hxcoro/task/node/CoroScopeStrategy.hx
@@ -0,0 +1,33 @@
+package hxcoro.task.node;
+
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+
+@:access(hxcoro.task.AbstractTask)
+@:access(hxcoro.task.CoroTask)
+class CoroScopeStrategy implements INodeStrategy {
+ public function new() {}
+
+ public function complete(task:CoroBaseTask) {
+ task.parent?.childCompletes(task, false);
+ task.handleAwaitingContinuations();
+ }
+
+ public function childSucceeds(task:CoroBaseTask, child:AbstractTask) {}
+
+ public function childErrors(task:CoroBaseTask, child:AbstractTask, cause:Exception) {
+ switch (task.state) {
+ case Created | Running | Completing:
+ // inherit child error
+ if (task.error == null) {
+ task.error = cause;
+ }
+ task.cancel();
+ case Cancelling:
+ // not sure about this one, what if we cancel normally and then get a real exception?
+ case Completed | Cancelled:
+ }
+ }
+
+ public function childCancels(task:CoroBaseTask, child:AbstractTask, cause:CancellationException) {}
+}
diff --git a/std/hxcoro/task/node/CoroSupervisorStrategy.hx b/std/hxcoro/task/node/CoroSupervisorStrategy.hx
new file mode 100644
index 00000000000..535de49028f
--- /dev/null
+++ b/std/hxcoro/task/node/CoroSupervisorStrategy.hx
@@ -0,0 +1,21 @@
+package hxcoro.task.node;
+
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+
+@:access(hxcoro.task.AbstractTask)
+@:access(hxcoro.task.CoroBaseTask)
+class CoroSupervisorStrategy implements INodeStrategy {
+ public function new() {}
+
+ public function complete(task:CoroBaseTask) {
+ task.parent?.childCompletes(task, false);
+ task.handleAwaitingContinuations();
+ }
+
+ public function childSucceeds(task:CoroBaseTask, child:AbstractTask) {}
+
+ public function childErrors(task:CoroBaseTask, child:AbstractTask, cause:Exception) {}
+
+ public function childCancels(task:CoroBaseTask, child:AbstractTask, cause:CancellationException) {}
+}
diff --git a/std/hxcoro/task/node/INodeStrategy.hx b/std/hxcoro/task/node/INodeStrategy.hx
new file mode 100644
index 00000000000..e8edda639a8
--- /dev/null
+++ b/std/hxcoro/task/node/INodeStrategy.hx
@@ -0,0 +1,13 @@
+package hxcoro.task.node;
+
+import haxe.Exception;
+import haxe.exceptions.CancellationException;
+import hxcoro.task.AbstractTask;
+import hxcoro.task.CoroTask;
+
+interface INodeStrategy {
+ function complete(task:CoroBaseTask):Void;
+ function childSucceeds(task:CoroBaseTask, child:AbstractTask):Void;
+ function childErrors(task:CoroBaseTask, child:AbstractTask, cause:Exception):Void;
+ function childCancels(task:CoroBaseTask, child:AbstractTask, cause:CancellationException):Void;
+}
diff --git a/std/hxcoro/util/Convenience.hx b/std/hxcoro/util/Convenience.hx
new file mode 100644
index 00000000000..a1241d74276
--- /dev/null
+++ b/std/hxcoro/util/Convenience.hx
@@ -0,0 +1,81 @@
+package hxcoro.util;
+
+import haxe.coro.cancellation.ICancellationToken;
+import haxe.exceptions.CancellationException;
+import haxe.coro.schedulers.Scheduler;
+import haxe.Exception;
+import haxe.coro.IContinuation;
+
+/**
+ A set of convenience functions for working with hxcoro data.
+**/
+class Convenience {
+ /**
+ Resumes `cont` with `result` immediately.
+ **/
+ static public inline function succeedSync(cont:IContinuation