add Context.storeType

Also add CTMono while we're here

src/context/common.ml

@@ -374,6 +374,7 @@ type context = {
 	module_to_file : (path,string) lookup;
 	cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) lookup;
 	stored_typed_exprs : (int, texpr) lookup;
+	stored_types : (int, Type.t) lookup;
 	overload_cache : ((path * string),(Type.t * tclass_field) list) lookup;
 	module_lut : (path,module_def) lookup;
 	module_nonexistent_lut : (path,bool) lookup;
@@ -830,6 +831,7 @@ let create compilation_step cs version args =
 		readdir_cache = new hashtbl_lookup;
 		module_to_file = new hashtbl_lookup;
 		stored_typed_exprs = new hashtbl_lookup;
+		stored_types = new hashtbl_lookup;
 		cached_macros = new hashtbl_lookup;
 		memory_marker = memory_marker;
 		parser_cache = new hashtbl_lookup;

src/context/display/syntaxExplorer.ml

@@ -49,6 +49,9 @@ let find_in_syntax symbols (pack,decls) =
 			List.iter field cffl;
 		| CTIntersection tl ->
 			List.iter type_hint tl
+		| CTMono
+		| CTStoredType _ ->
+			()
 	and type_param tp =
 		List.iter type_param tp.tp_params;
 		Option.may type_hint tp.tp_constraints

src/context/typecore.ml

@@ -715,6 +715,18 @@ let store_typed_expr com te p =
 	let eid = (EConst (Int (string_of_int id, None))), p in
 	(EMeta ((Meta.StoredTypedExpr,[],p), eid)), p
 
+let get_next_stored_type_id =
+	let uid = ref 0 in
+	(fun() -> incr uid; !uid)
+
+let get_stored_type com id =
+	com.stored_types#find id
+
+let store_type com te =
+	let id = get_next_stored_type_id() in
+	com.stored_types#add id te;
+	CTStoredType id
+
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
 (*/*
 

src/core/ast.ml

@@ -174,6 +174,8 @@ and complex_type =
 	| CTOptional of type_hint
 	| CTNamed of placed_name * type_hint
 	| CTIntersection of type_hint list
+	| CTMono
+	| CTStoredType of int
 
 and type_hint = complex_type * pos
 
@@ -326,9 +328,6 @@ and evar = {
 	ev_meta : metadata;
 }
 
-(* TODO: should we introduce CTMono instead? *)
-let ct_mono = CTPath { tpackage = ["$"]; tname = "_hx_mono"; tparams = []; tsub = None }
-
 type enum_flag =
 	| EPrivate
 	| EExtern
@@ -704,6 +703,8 @@ let map_expr loop (e,p) =
 		| CTOptional t -> CTOptional (type_hint t)
 		| CTNamed (n,t) -> CTNamed (n,type_hint t)
 		| CTIntersection tl -> CTIntersection(List.map type_hint tl)
+		| CTMono -> CTMono
+		| CTStoredType i -> CTStoredType i
 		),p
 	and tparamdecl t =
 		let constraints = opt type_hint t.tp_constraints in
@@ -917,6 +918,8 @@ module Printer = struct
 		| CTNamed((n,_),(t,_)) -> n ^ ":" ^ s_complex_type tabs t
 		| CTExtend (tl, fl) -> "{> " ^ String.concat " >, " (List.map (s_complex_type_path tabs) tl) ^ ", " ^ String.concat ", " (List.map (s_class_field tabs) fl) ^ " }"
 		| CTIntersection tl -> String.concat "&" (List.map (fun (t,_) -> s_complex_type tabs t) tl)
+		| CTMono -> "$._hx_mono"
+		| CTStoredType i -> Printf.sprintf "$._hx_type<%i>" i
 	and s_class_field tabs f =
 		let doc = match f.cff_doc with
 			| Some d -> "/**\n\t" ^ tabs ^ (gen_doc_text d) ^ "\n**/\n"

src/macro/macroApi.ml

@@ -28,6 +28,7 @@ type 'value compiler_api = {
 	type_expr : Ast.expr -> Type.texpr;
 	resolve_type  : Ast.complex_type -> Globals.pos -> t;
 	store_typed_expr : Type.texpr -> Ast.expr;
+	store_type : Type.t -> Ast.complex_type;
 	allow_package : string -> unit;
 	type_patch : string -> string -> bool -> string option -> unit;
 	meta_patch : string -> string -> string option -> bool -> pos -> unit;
@@ -340,6 +341,10 @@ and encode_ctype t =
 		6, [encode_placed_name n; encode_ctype t]
 	| CTIntersection tl ->
 		7, [(encode_array (List.map encode_ctype tl))]
+	| CTMono ->
+		8, []
+	| CTStoredType i ->
+		9, [vint i]
 	in
 	encode_enum ~pos:(Some (pos t)) ICType tag pl
 
@@ -722,6 +727,10 @@ and decode_ctype t =
 		CTNamed ((decode_string n,p), decode_ctype t)
 	| 7, [tl] ->
 		CTIntersection (List.map decode_ctype (decode_array tl))
+	| 8, [] ->
+		CTMono
+	| 9, [v] ->
+		CTStoredType (decode_int v)
 	| _ ->
 		raise Invalid_expr),p
 
@@ -1931,6 +1940,11 @@ let macro_api ccom get_api =
 			let e = decode_texpr e in
 			encode_expr ((get_api()).store_typed_expr e)
 		);
+		"store_type", vfun2 (fun t p ->
+			let t = decode_type t in
+			let p = decode_pos p in
+			encode_ctype ((get_api()).store_type t,p)
+		);
 		"type_and_store_expr", vfun1 (fun e ->
 			let api = get_api() in
 			let te = (api.type_expr (decode_expr e)) in

src/syntax/grammar.mly

@@ -1019,7 +1019,7 @@ and parse_fun_param s =
 	| [< '(Question,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),true,meta,t,c)
 	| [< name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),false,meta,t,c)
 	| [< '(Spread,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] ->
-		let t = match t with Some t -> t | None -> (ct_mono,null_pos) in
+		let t = match t with Some t -> t | None -> (CTMono,null_pos) in
 		let t = CTPath (mk_type_path ~params:[TPType t] (["haxe"],"Rest")), snd t in
 		((name,pn),false,meta,Some t,c)
 

src/syntax/reification.ml

@@ -93,6 +93,9 @@ let reify in_macro =
 		| None -> to_null p
 		| Some v -> f v p
 	in
+	let to_int i p =
+		(EConst (Int (string_of_int i,None)),p)
+	in
 	let to_bool o p =
 		(EConst (Ident (if o then "true" else "false")),p)
 	in
@@ -144,6 +147,8 @@ let reify in_macro =
 		| CTOptional t -> ct "TOptional" [to_type_hint t p]
 		| CTNamed (n,t) -> ct "TNamed" [to_placed_name n; to_type_hint t p]
 		| CTIntersection tl -> ct "TIntersection" [to_array to_ctype tl p]
+		| CTMono -> ct "TMono" []
+		| CTStoredType i -> ct "TStoredType" [to_int i p]
 	and to_type_hint (t,p) _ =
 		(* to_obj ["type",to_ctype t p;"pos",to_pos p] p *)
 		to_ctype (t,p) p

src/typing/macroContext.ml

@@ -207,6 +207,9 @@ let make_macro_api ctx p =
 			let p = te.epos in
 			Typecore.store_typed_expr ctx.com te p
 		);
+		MacroApi.store_type = (fun t ->
+			Typecore.store_type ctx.com t
+		);
 		MacroApi.allow_package = (fun v -> Common.allow_package ctx.com v);
 		MacroApi.type_patch = (fun t f s v ->
 			typing_timer ctx false (fun() ->

src/typing/typeload.ml

@@ -447,7 +447,8 @@ and load_instance ctx ?(allow_display=false) ((_,pn) as tp) allow_no_params =
 and load_complex_type' ctx allow_display (t,p) =
 	match t with
 	| CTParent t -> load_complex_type ctx allow_display t
-	| CTPath { tpackage = ["$"]; tname = "_hx_mono" } -> spawn_monomorph ctx p
+	| CTMono -> spawn_monomorph ctx p
+	| CTStoredType i -> get_stored_type ctx.com i
 	| CTPath t -> load_instance ~allow_display ctx (t,p) false
 	| CTOptional _ -> typing_error "Optional type not allowed here" p
 	| CTNamed _ -> typing_error "Named type not allowed here" p

std/haxe/macro/Context.hx

@@ -581,6 +581,13 @@ class Context {
 		return load("store_typed_expr", 1)(t);
 	}
 
+	/**
+		TODO: dorkument
+	**/
+	public static function storeType(t:Type.Type, p:Position):ComplexType {
+		return load("store_type", 2)(t, p);
+	}
+
 	/**
 		Types expression `e`, stores the resulting typed expression internally and
 		returns a syntax-level expression that can be returned from a macro and
@@ -652,7 +659,6 @@ class Context {
 		return load("with_imports", 3)(imports, usings, code);
 	}
 
-
 	/**
 		Executes `code` in a context that has some compiler options set, restore the compiler to its
 		default behavior afterwards.
@@ -662,7 +668,7 @@ class Context {
 		`allowTransform`: when disabled, the code typed with `typeExpr` will be almost exactly the same
 		as the input code. This will disable some abstract types transformations.
 	**/
-	public static function withOptions<X>(options:{?allowInlining:Bool,?allowTransform:Bool}, code : () -> X) : X {
+	public static function withOptions<X>(options:{?allowInlining:Bool, ?allowTransform:Bool}, code:() -> X):X {
 		return load("with_options", 2)(options, code);
 	}
 

std/haxe/macro/Expr.hx

@@ -639,6 +639,17 @@ enum ComplexType {
 		Represents an intersection type `T1 & T2 & ... & TN`.
 	**/
 	TIntersection(tl:Array<ComplexType>);
+
+	/**
+		Represents an unknown type, also known as a monomorph.
+	**/
+	TMono;
+
+	/**
+		Represents a type which is stored in the current context. This value only has
+		meaning within that context and should not be used otherwise.
+	**/
+	TStoredType(i:Int);
 }
 
 /**
@@ -1000,6 +1011,7 @@ enum TypeDefKind {
 		Represents a module-level field.
 	**/
 	TDField(kind:FieldType, ?access:Array<Access>); // ignore TypeDefinition.fields
+
 }
 
 /**

std/haxe/macro/Printer.hx

@@ -137,7 +137,7 @@ class Printer {
 				(wrapArgumentsInParentheses ? '($argStr)' : argStr) + " -> " + (switch ret {
 					// wrap return type in parentheses if it's also a function
 					case TFunction(_): '(${printComplexType(ret)})';
-					default: (printComplexType(ret): String);
+					default: (printComplexType(ret) : String);
 				});
 			case TAnonymous(fields): "{ " + [for (f in fields) printField(f) + "; "].join("") + "}";
 			case TParent(ct): "(" + printComplexType(ct) + ")";
@@ -148,6 +148,8 @@ class Printer {
 				var fields = [for (f in fields) printField(f) + "; "].join("");
 				'{${types}${fields}}';
 			case TIntersection(tl): tl.map(printComplexType).join(" & ");
+			case TMono: '$._hx_mono';
+			case TStoredType(i): '$._hx_type<$i>';
 		}
 
 	public function printMetadata(meta:MetadataEntry)
@@ -169,7 +171,7 @@ class Printer {
 		}
 
 	public function printField(field:Field) {
-		inline function orderAccess(access: Array<Access>) {
+		inline function orderAccess(access:Array<Access>) {
 			// final should always be printed last
 			// (does not modify input array)
 			return access.has(AFinal) ? access.filter(a -> !a.match(AFinal)).concat([AFinal]) : access;
@@ -186,11 +188,14 @@ class Printer {
 			+ (field.meta != null && field.meta.length > 0 ? field.meta.map(printMetadata).join('\n$tabs') + '\n$tabs' : "")
 			+ (field.access != null && field.access.length > 0 ? orderAccess(field.access).map(printAccess).join(" ") + " " : "")
 			+ switch (field.kind) {
-				case FVar(t, eo): ((field.access != null && field.access.has(AFinal)) ? '' : 'var ') + '${field.name}' + opt(t, printComplexType, " : ") + opt(eo, printExpr, " = ");
+				case FVar(t,
+					eo): ((field.access != null && field.access.has(AFinal)) ? '' : 'var ')
+						+ '${field.name}'
+						+ opt(t, printComplexType, " : ")
+						+ opt(eo, printExpr, " = ");
 				case FProp(get, set, t, eo): 'var ${field.name}($get, $set)' + opt(t, printComplexType, " : ") + opt(eo, printExpr, " = ");
 				case FFun(func): 'function ${field.name}' + printFunction(func);
-			}
-	}
+			}}
 
 	public function printTypeParamDecl(tpd:TypeParamDecl)
 		return (tpd.meta != null && tpd.meta.length > 0 ? tpd.meta.map(printMetadata).join(" ") + " " : "")
@@ -204,7 +209,7 @@ class Printer {
 
 	public function printFunction(func:Function, ?kind:FunctionKind) {
 		var skipParentheses = switch func.args {
-			case [{ type:null }]: kind == FArrow;
+			case [{type: null}]: kind == FArrow;
 			case _: false;
 		}
 		return (func.params == null ? "" : func.params.length > 0 ? "<" + func.params.map(printTypeParamDecl).join(", ") + ">" : "")
@@ -219,7 +224,7 @@ class Printer {
 	public function printVar(v:Var) {
 		var s = v.name + opt(v.type, printComplexType, ":") + opt(v.expr, printExpr, " = ");
 		return switch v.meta {
-			case null|[]: s;
+			case null | []: s;
 			case meta: meta.map(printMetadata).join(" ") + " " + s;
 		}
 	}
@@ -249,7 +254,7 @@ class Printer {
 			case ENew(tp, el): 'new ${printTypePath(tp)}(${printExprs(el, ", ")})';
 			case EUnop(op, true, e1): printExpr(e1) + printUnop(op);
 			case EUnop(op, false, e1): printUnop(op) + printExpr(e1);
-			case EFunction(FNamed(no,inlined), func): (inlined ? 'inline ' : '') + 'function $no' + printFunction(func);
+			case EFunction(FNamed(no, inlined), func): (inlined ? 'inline ' : '') + 'function $no' + printFunction(func);
 			case EFunction(kind, func): (kind != FArrow ? "function" : "") + printFunction(func, kind);
 			case EVars([]): "var ";
 			case EVars(vl): ((vl[0].isStatic) ? "static " : "") + ((vl[0].isFinal) ? "final " : "var ") + vl.map(printVar).join(", ");
@@ -277,7 +282,9 @@ class Printer {
 				tabs = old;
 				s + '\n$tabs}';
 			case ETry(e1, cl):
-				'try ${printExpr(e1)}' + cl.map(function(c) return ' catch(${c.name}${c.type == null ? '' : (':' + printComplexType(c.type))}) ${printExpr(c.expr)}').join("");
+				'try ${printExpr(e1)}' + cl.map(function(c) return
+					' catch(${c.name}${c.type == null ? '' : (':' + printComplexType(c.type))}) ${printExpr(c.expr)}')
+					.join("");
 			case EReturn(eo): "return" + opt(eo, printExpr, " ");
 			case EBreak: "break";
 			case EContinue: "continue";
@@ -289,7 +296,7 @@ class Printer {
 			case EDisplay(e1, _): '#DISPLAY(${printExpr(e1)})';
 			case ETernary(econd, eif, eelse): '${printExpr(econd)} ? ${printExpr(eif)} : ${printExpr(eelse)}';
 			case ECheckType(e1, ct): '(${printExpr(e1)} : ${printComplexType(ct)})';
-			case EMeta({ name:":implicitReturn" }, { expr:EReturn(e1) }): printExpr(e1);
+			case EMeta({name: ":implicitReturn"}, {expr: EReturn(e1)}): printExpr(e1);
 			case EMeta(meta, e1): printMetadata(meta) + " " + printExpr(e1);
 		}
 
@@ -340,8 +347,7 @@ class Printer {
 								case FProp(_, _, _, _): throw "FProp is invalid for TDEnum.";
 								case FFun(func): field.name + printFunction(func);
 							})
-							+ ";"].join("\n")
-					+ "\n}";
+							+ ";"].join("\n") + "\n}";
 				case TDStructure:
 					"typedef "
 					+ t.name
@@ -351,8 +357,7 @@ class Printer {
 						for (f in t.fields) {
 							tabs + printField(f) + ";";
 						}
-					].join("\n")
-					+ "\n}";
+					].join("\n") + "\n}";
 				case TDClass(superClass, interfaces, isInterface, isFinal, isAbstract):
 					(isFinal ? "final " : "")
 						+ (isAbstract ? "abstract " : "")
@@ -369,8 +374,7 @@ class Printer {
 							for (f in t.fields) {
 								tabs + printFieldWithDelimiter(f);
 							}
-						].join("\n")
-						+ "\n}";
+						].join("\n") + "\n}";
 				case TDAlias(ct):
 					"typedef "
 					+ t.name
@@ -394,15 +398,21 @@ class Printer {
 						for (f in t.fields) {
 							tabs + printFieldWithDelimiter(f);
 						}
-					].join("\n")
-					+ "\n}";
+					].join("\n") + "\n}";
 				case TDField(kind, access):
 					tabs = old;
-					(access != null && access.length > 0 ? access.map(printAccess).join(" ") + " " : "")
-					+ switch (kind) {
-						case FVar(type, eo): ((access != null && access.has(AFinal)) ? '' : 'var ') + '${t.name}' + opt(type, printComplexType, " : ") + opt(eo, printExpr, " = ") + ";";
-						case FProp(get, set, type, eo): 'var ${t.name}($get, $set)' + opt(type, printComplexType, " : ") + opt(eo, printExpr, " = ") + ";";
-						case FFun(func): 'function ${t.name}' + printFunction(func) + switch func.expr { case {expr: EBlock(_)}: ""; case _: ";"; };
+					(access != null && access.length > 0 ? access.map(printAccess).join(" ") + " " : "") + switch (kind) {
+						case FVar(type,
+							eo): ((access != null && access.has(AFinal)) ? '' : 'var ') + '${t.name}' + opt(type, printComplexType, " : ")
+								+ opt(eo, printExpr, " = ") + ";";
+						case FProp(get, set, type, eo): 'var ${t.name}($get, $set)'
+							+ opt(type, printComplexType, " : ")
+							+ opt(eo, printExpr, " = ")
+							+ ";";
+						case FFun(func): 'function ${t.name}' + printFunction(func) + switch func.expr {
+								case {expr: EBlock(_)}: "";
+								case _: ";";
+							};
 					}
 			} tabs = old;