slight advance on hl macros

src/generators/hlinterp.ml

@@ -74,7 +74,7 @@ and vvirtual = {
 	vtype : virtual_proto;
 	mutable vindexes : vfield array;
 	mutable vtable : value array;
-	vvalue : value;
+	mutable vvalue : value;
 }
 
 and vdynobj = {
@@ -643,7 +643,10 @@ let rec vstr ctx v t =
 	| VUndef -> "undef"
 	| VType t -> tstr t
 	| VRef (r,t) -> "*" ^ (vstr (get_ref ctx r) t)
-	| VVirtual v -> vstr v.vvalue HDyn
+	| VVirtual v ->
+		(match v.vvalue with
+		| VNull -> assert false
+		| _ -> vstr v.vvalue HDyn)
 	| VDynObj d ->
 		(try
 			let fid = Hashtbl.find d.dfields "__string" in
@@ -998,7 +1001,7 @@ let interp ctx f args =
 			set r (VType t)
 		| OGetType (r,v) ->
 			let v = get v in
-			let v = (match v with VVirtual v -> v.vvalue | _ -> v) in
+			let v = (match v with VVirtual { vvalue = VNull } -> assert false | VVirtual v -> v.vvalue | _ -> v) in
 			set r (VType (if v = VNull then HVoid else match get_type v with None -> assert false | Some t -> t));
 		| OGetTID (r,v) ->
 			set r (match get v with
@@ -1169,7 +1172,7 @@ let load_native ctx lib name t =
 	in
 	let no_virtual v =
 		match v with
-		| VVirtual v -> v.vvalue
+		| VVirtual v when v.vvalue <> VNull -> v.vvalue
 		| _ -> v
 	in
 	let set_ref = set_ref ctx in

src/macro/hlmacro.ml

@@ -30,6 +30,7 @@ type context = {
 	mutable gen : Genhl.context option;
 	interp : Hlinterp.context;
 	types : (Type.path,int) Hashtbl.t;
+	cached_protos : (obj_type, (virtual_proto * vfield array)) Hashtbl.t;
 	mutable curapi : value MacroApi.compiler_api;
 	mutable has_error : bool;
 }
@@ -83,6 +84,7 @@ let create com api =
 		curapi = api;
 		types = Hashtbl.create 0;
 		has_error = false;
+		cached_protos = Hashtbl.create 0;
 	} in
 	select ctx;
 	Hlinterp.set_error_handler ctx.interp (error_handler ctx);
@@ -291,7 +293,18 @@ let decode_lazytype = function
 	| _ -> raise Invalid_expr
 
 let enc_obj t fields =
-	assert false
+	let t, idx = try
+		Hashtbl.find (get_ctx()).cached_protos t
+	with Not_found ->
+		let name, field = proto_name t in
+		assert false
+	in
+	VVirtual {
+		vtype = t;
+		vindexes = idx;
+		vtable = Array.map snd (Array.of_list fields);
+		vvalue = VNull;
+	}
 
 let enc_inst path fields =
 	let ctx = get_ctx() in
@@ -323,7 +336,7 @@ let decode_bytes = function
 	| _ -> raise Invalid_expr
 
 let encode_ref v convert tostr =
-	enc_obj [
+	enc_obj ORef [
 		"get", vfun0 (fun() -> convert v);
 		"__string", vfun0 (fun() -> VBytes (caml_to_hl (tostr())));
 		"toString", vfun0 (fun() -> enc_string (tostr()));

src/macro/macroApi.ml

@@ -118,6 +118,7 @@ type obj_type =
 	| OJSGenApi
 	| OContext_getPosInfos
 	| OCompiler_getDisplayPos
+	| ORef
 (* ---- ^^^^^ please exactly match the name of the typedef or use TypeName_field if it's a anonymous *)
 
 (**
@@ -205,6 +206,51 @@ let enum_name = function
 	| IAnonStatus -> "AnonStatus"
 	| IImportMode -> "ImportMode"
 
+let proto_name = function
+	| O__Const -> assert false
+	| OImportExpr -> "ImportExpr", None
+	| OImportExpr_path -> "ImportExpr", Some "path"
+	| OTypePath -> "TypePath", None
+	| OMetadataEntry -> "MetadaEntry", None
+	| OField -> "Field", None
+	| OTypeParamDecl -> "TypeParamDecl", None
+	| OFunction -> "Function", None
+	| OFunctionArg -> "FunctionArg", None
+	| OExprDef_fields -> "ExprDef", Some "fields"
+	| OVar -> "Var", None
+	| OCase -> "Case", None
+	| OCatch -> "Catch", None
+	| OExprDef -> "ExprDef", None
+	| OMetaAccess -> "MetaAccess", None
+	| OTypeParameter -> "TypeParameter", None
+	| OClassType -> "ClassType", None
+	| OAbstractType -> "AbstracType", None
+	| OAnonType -> "AnonType", None
+	| ODefType -> "DefType", None
+	| OEnumType -> "EnumType", None
+	| OClassField -> "ClassField", None
+	| OAbstractType_binops -> "AbstractType", Some "binops"
+	| OAbstractType_unops -> "AbstractType", Some "unops"
+	| OAbstractType_from -> "AbstractType", Some "from"
+	| OAbstractType_to -> "AbstractType", Some "to"
+	| OEnumField -> "EnumField", None
+	| OClassType_superClass -> "ClassType", Some "superClass"
+	| OClassType_interfaces -> "ClassType", Some "interfaces"
+	| OType_args -> "Type", Some "args"
+	| OTVar -> "TVar", None
+	| OTVar_extra -> "TVar", Some "extra"
+	| OTFunc -> "TFunc", None
+	| OTFunc_args -> "TFunc", Some "args"
+	| OFieldAccess_c -> "FieldAccess", Some "c"
+	| OTypedExprDef -> "TypedExprDef", None
+	| OTypedExprDef_fields -> "TypedExprDef", Some "fields"
+	| OTypedExprDef_cases -> "TypedExprDef", Some "cases"
+	| OTypedExprDef_catches -> "TypedExprDef", Some "catches"
+	| OJSGenApi -> "JSGenApi", None
+	| OContext_getPosInfos -> "Context", Some "getPosInfos"
+	| OCompiler_getDisplayPos -> "Compiler", Some "getDisplayPos"
+	| ORef -> "Ref", None
+
 let all_enums =
 	let last = IImportMode in
 	let rec loop i =