TPConst -> TPExpr

added haxe.macro.MacroType
added Context.allocMonomorph + TMono now has a Ref<Null<Type>>
added Dispatch.getParams (late params check)

ast.ml

@@ -144,7 +144,7 @@ type type_path = {
 
 and type_param_or_const =
 	| TPType of complex_type
-	| TPConst of constant
+	| TPExpr of expr
 
 and complex_type =
 	| CTPath of type_path

codegen.ml

@@ -347,6 +347,37 @@ let build_metadata com t =
 		let meta_obj = (try ("obj", make_meta_field (List.assoc "" meta)) :: meta_obj with Not_found -> meta_obj) in
 		Some (mk (TObjectDecl meta_obj) t_dynamic p)
 
+(* -------------------------------------------------------------------------- *)
+(* MACRO TYPE *)
+
+let build_macro_type ctx pl p =
+	let path, field, args = (match pl with
+		| [TInst ({ cl_kind = KExpr e },_)] ->
+			let e = (match e with (EBlock [e],_) -> e | _ -> e) in
+			(match fst e with
+			| ECall (e,args) ->
+				let rec loop e =
+					match fst e with
+					| EField (e,f) | EType (e,f) -> f :: loop e
+					| EConst (Ident i | Type i) -> [i]
+					| _ -> error "Invalid macro call" p
+				in
+				(match loop e with
+				| meth :: cl :: path -> (List.rev path,cl), meth, args
+				| _ -> error "Invalid macro call" p)
+			| _ ->
+				error "Invalid macro call" p)
+		| _ ->
+			error "MacroType require a single expression parameter" p
+	) in
+	let old = ctx.ret in
+	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
+		| None -> mk_mono() 
+		| Some _ -> ctx.ret
+	) in
+	ctx.ret <- old;
+	t
+
 (* -------------------------------------------------------------------------- *)
 (* API EVENTS *)
 
@@ -364,6 +395,15 @@ let build_instance ctx mtype p =
 				) in
 				delay ctx (fun() -> ignore ((!r)()));
 				TLazy r
+			| KMacroType ->
+				let r = exc_protect (fun r ->
+					let t = mk_mono() in
+					r := (fun() -> t);
+					unify_raise ctx (build_macro_type ctx pl p) t p;
+					t
+				) in
+				delay ctx (fun() -> ignore ((!r)()));
+				TLazy r				
 			| _ ->
 				TInst (c,pl)
 		) in
@@ -387,7 +427,7 @@ let on_inherit ctx c p h =
 	| HImplements { tpackage = ["haxe";"rtti"]; tname = "Generic"; tparams = [] } ->
 		c.cl_kind <- KGeneric;
 		false
-	| HExtends { tpackage = ["haxe";"xml"]; tname = "Proxy"; tparams = [TPConst(String file);TPType t] } ->
+	| HExtends { tpackage = ["haxe";"xml"]; tname = "Proxy"; tparams = [TPExpr(EConst (String file),p);TPType t] } ->
 		extend_xml_proxy ctx c t file p;
 		true
 	| _ ->

doc/CHANGES.txt

@@ -34,6 +34,7 @@
 	js : added js.Storage
 	all : allow this + member variables access in local functions
 		added untyped __this__ support and transition error
+	all : added haxe.macro.MacroType
 
 2011-01-30: 2.07
 	all : fixed completion support with --remap

genas3.ml

@@ -207,7 +207,7 @@ let rec type_str ctx t p =
 	| TInst (c,_) ->
 		(match c.cl_kind with
 		| KNormal | KGeneric | KGenericInstance _ -> s_path ctx false c.cl_path p
-		| KTypeParameter | KExtension _ | KConstant _  -> "*")
+		| KTypeParameter | KExtension _ | KExpr _ | KMacroType -> "*")
 	| TFun _ ->
 		"Function"
 	| TMono r ->

gencpp.ml

@@ -2841,8 +2841,9 @@ let kind_string = function
 	| KNormal -> "KNormal"
 	| KTypeParameter -> "KTypeParameter"
 	| KExtension _ -> "KExtension"
-	| KConstant _ -> "KConstant"
+	| KExpr _ -> "KExpr"
 	| KGeneric -> "KGeneric"
+	| KMacroType -> "KMacroType"
 	| KGenericInstance _ -> "KGenericInstance";;
 
 

interp.ml

@@ -1924,6 +1924,9 @@ let macro_lib =
 		"build_fields", Fun0 (fun() ->
 			(get_ctx()).curapi.get_build_fields()
 		);
+		"alloc_mono", Fun0 (fun() ->
+			encode_type (mk_mono())
+		);
 	]
 
 (* ---------------------------------------------------------------------- *)
@@ -2946,7 +2949,7 @@ let rec encode_path t =
 
 and encode_tparam = function
 	| TPType t -> enc_enum ITParam 0 [encode_type t]
-	| TPConst c -> enc_enum ITParam 1 [encode_const c]
+	| TPExpr e -> enc_enum ITParam 1 [encode_expr e]
 
 and encode_access a =
 	let tag = match a with
@@ -3200,7 +3203,7 @@ let rec decode_path t =
 and decode_tparam v =
 	match decode_enum v with
 	| 0,[t] -> TPType (decode_ctype t)
-	| 1,[c] -> TPConst (decode_const c)
+	| 1,[e] -> TPExpr (decode_expr e)
 	| _ -> raise Invalid_expr
 
 and decode_fun v =
@@ -3507,7 +3510,7 @@ and encode_type t =
 	let rec loop = function
 		| TMono r ->
 			(match !r with
-			| None -> 0, []
+			| None -> 0, [encode_ref r (fun r -> match !r with None -> VNull | Some t -> encode_type t) (fun() -> "<mono>")]
 			| Some t -> loop t)
 		| TEnum (e, pl) ->
 			1 , [encode_ref e encode_tenum (fun() -> s_type_path e.e_path); encode_tparams pl]
@@ -3539,7 +3542,7 @@ and encode_type t =
 
 and decode_type t =
 	match decode_enum t with
-	| 0, [] -> TMono (ref None)
+	| 0, [r] -> TMono (decode_ref r)
 	| 1, [e; pl] -> TEnum (decode_ref e, List.map decode_type (dec_array pl))
 	| 2, [c; pl] -> TInst (decode_ref c, List.map decode_type (dec_array pl))
 	| 3, [t; pl] -> TType (decode_ref t, List.map decode_type (dec_array pl))

parser.ml

@@ -344,10 +344,9 @@ and type_name = parser
 		error (Custom "Type name should start with an uppercase letter") p
 
 and parse_type_path_or_const = parser
-	| [< '(Const (String s),_) >] -> TPConst (String s)
-	| [< '(Const (Int i),_) >] -> TPConst (Int i)
-	| [< '(Const (Float f),_) >] -> TPConst (Float f)
 	| [< t = parse_complex_type >] -> TPType t
+	| [< '(Const c,p) >] -> TPExpr (EConst c,p)
+	| [< e = expr >] -> TPExpr e
 
 and parse_complex_type_next t = parser
 	| [< '(Arrow,_); t2 = parse_complex_type >] ->

std/haxe/macro/Context.hx

@@ -184,6 +184,13 @@ class Context {
 		return load("build_fields", 0)();
 	}
 
+	/**
+		Allocate a new monomorphic type (Unknown) that might be inferred later.
+	**/
+	public static function allocMonomorph() : Type {
+		return load("alloc_mono", 0)();
+	}
+
 	static function load( f, nargs ) : Dynamic {
 		#if macro
 		return neko.Lib.load("macro", f, nargs);

std/haxe/macro/Expr.hx

@@ -133,7 +133,7 @@ typedef TypePath = {
 
 enum TypeParam {
 	TPType( t : ComplexType );
-	TPConst( c : Constant );
+	TPExpr( e : Expr );
 }
 
 typedef Function = {

std/haxe/macro/MacroType.hx

@@ -0,0 +1,32 @@
+/*
+ * Copyright (c) 2005-2011, The haXe Project Contributors
+ * All rights reserved.
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ *   - Redistributions of source code must retain the above copyright
+ *     notice, this list of conditions and the following disclaimer.
+ *   - Redistributions in binary form must reproduce the above copyright
+ *     notice, this list of conditions and the following disclaimer in the
+ *     documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE HAXE PROJECT CONTRIBUTORS "AS IS" AND ANY
+ * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE HAXE PROJECT CONTRIBUTORS BE LIABLE FOR
+ * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+ * DAMAGE.
+ */
+package haxe.macro;
+
+/**
+	This type is meant to be used to generate custom types using a macro.
+	For instance by doing MacroType<"my.Class.myMacro(55)">
+**/
+extern class MacroType<Const> {
+}

std/haxe/macro/Type.hx

@@ -30,7 +30,7 @@ typedef Ref<T> = {
 }
 
 enum Type {
-	TMono;
+	TMono( t : Ref<Null<Type>> );
 	TEnum( t : Ref<EnumType>, params : Array<Type> );
 	TInst( t : Ref<ClassType>, params : Array<Type> );
 	TType( t : Ref<DefType>, params : Array<Type> );

std/haxe/web/Dispatch.hx

@@ -79,6 +79,20 @@ class Dispatch {
 		var cfg = makeConfig(obj);
 		return { expr : ECall({ expr : EField(ethis, "runtimeDispatch"), pos : p }, [cfg]), pos : p };
 	}
+	
+	@:macro public function getParams( ethis : Expr ) : Expr {
+		var p = Context.currentPos();
+		if( PARAMS == null ) {
+			PARAMS = new Array();
+			Context.onGenerate(buildParams);
+		}
+		var index = PARAMS.length;
+		var t = Context.allocMonomorph();
+		PARAMS.push( { p : p, t : t } );
+		var call = { expr : ECall( { expr : EField(ethis, "runtimeGetParams"), pos : p }, [ { expr : EConst(CInt(Std.string(index))), pos : p } ]), pos : p };
+		var rt = TPath( { pack : ["haxe", "macro"], name : "MacroType", params : [TPExpr(Context.parse("haxe.web.Dispatch.getRunParam("+index+")",p))], sub : null } );
+		return { expr : EBlock([ { expr : EVars([ { name : "tmp", type : rt, expr : call } ]), pos : p }, { expr : EConst(CIdent("tmp")), pos : p } ]), pos : p };
+	}
 
 	public dynamic function onMeta( v : String, args : Null<Array<Dynamic>> ) {
 	}
@@ -106,6 +120,13 @@ class Dispatch {
 		loop(args, r);
 		Reflect.callMethod(obj, Reflect.field(obj, name), args);
 	}
+	
+	static var GET_RULES;
+	public function runtimeGetParams( cfgIndex : Int ) : Dynamic {
+		if( GET_RULES == null )
+			GET_RULES = haxe.Unserializer.run(haxe.rtti.Meta.getType(Dispatch).getParams[0]);
+		return checkParams(GET_RULES[cfgIndex], true);
+	}
 
 	function match( v : String, r : MatchRule ) : Dynamic {
 		switch( r ) {
@@ -142,24 +163,25 @@ class Dispatch {
 		}
 	}
 
+	function checkParams( params : Array<{ name : String, opt : Bool, rule : MatchRule }>, opt ) {
+		var po = { };
+		for( p in params ) {
+			var v = this.params.get(p.name);
+			if( v == null ) {
+				if( p.opt ) continue;
+				if( opt ) return null;
+				throw DEMissingParam(p.name);
+			}
+			Reflect.setField(po, p.name, match(v, p.rule));
+		}
+		return po;
+	}
+	
 	function loop( args : Array<Dynamic>, r ) {
 		switch( r ) {
 		case DRArgs(r, params, opt):
 			loop(args, r);
-			var po = { };
-			for( p in params ) {
-				var v = this.params.get(p.name);
-				if( v == null ) {
-					if( p.opt ) continue;
-					if( opt ) {
-						po = null;
-						break;
-					}
-					throw DEMissingParam(p.name);
-				}
-				Reflect.setField(po, p.name, match(v, p.rule));
-			}
-			args.push(po);
+			args.push( checkParams(params, opt) );
 		case DRMatch(r):
 			args.push(match(parts.shift(), r));
 		case DRMult(rl):
@@ -216,6 +238,26 @@ class Dispatch {
 		return null;
 	}
 
+	static function makeArgs( t : haxe.macro.Type, p ) {
+		var args = [];
+		switch( Context.follow(t) ) {
+		case TAnonymous(a):
+			for( f in a.get().fields ) {
+				var r = getType(f.type, f.pos);
+				var opt = false;
+				switch( f.type ) {
+				case TType(t, _):
+					if( t.get().name == "Null" ) opt = true;
+				default:
+				}
+				args.push( { name : f.name, rule : r, opt : opt } );
+			}
+		default:
+			Context.error("Arguments should be an anonymous object", p);
+		}
+		return args;
+	}
+	
 	static function makeRule( f : ClassField ) : DispatchRule {
 		switch( Context.follow(f.type) ) {
 		case TFun(pl, _):
@@ -226,23 +268,8 @@ class Dispatch {
 				if( p.name == "args" ) {
 					if( args != null )
 						Context.error("Duplicate arguments", f.pos);
-					args = [];
 					argsOpt = p.opt;
-					switch( Context.follow(p.t) ) {
-					case TAnonymous(a):
-						for( f in a.get().fields ) {
-							var r = getType(f.type, f.pos);
-							var opt = false;
-							switch( f.type ) {
-							case TType(t, _):
-								if( t.get().name == "Null" ) opt = true;
-							default:
-							}
-							args.push( { name : f.name, rule : r, opt : opt } );
-						}
-					default:
-						Context.error("Arguments should be an anonymous object", f.pos);
-					}
+					args = makeArgs(p.t,f.pos);
 					continue;
 				}
 				if( args != null ) Context.error("Arguments should be last parameter", f.pos);
@@ -296,7 +323,7 @@ class Dispatch {
 				}
 				if( Reflect.fields(fields).length == 0 )
 					Context.error("No dispatch method found", p);
-				var str = haxe.Serializer.run(fields);
+				var str = serialize(fields);
 				i.meta.add("dispatchConfig", [ { expr : EConst(CString(str)), pos : p } ], p);
 			}
 			return { expr : EUntyped ({ expr : ECall({ expr : EField(Context.makeExpr(Dispatch,p),"extractConfig"), pos : p },[obj]), pos : p }), pos : p };
@@ -306,6 +333,32 @@ class Dispatch {
 		return null;
 	}
 
+	static var PARAMS = null;
+
+	static function buildParams(_) {
+		var rules = [];
+		for( p in PARAMS )
+			rules.push(makeArgs(p.t, p.p));
+		var str = serialize(rules);
+		switch( Context.getType("haxe.web.Dispatch") ) {
+		case TInst(c, _):
+			var c = c.get();
+			c.meta.add("getParams",[{ expr : EConst(CString(str)), pos : c.pos }],c.pos);
+		default:
+		}
+	}
+	
+	static function serialize( v : Dynamic ) {
+		var s = new haxe.Serializer();
+		s.useEnumIndex = true;
+		s.serialize(v);
+		return s.toString();
+	}
+	
+	public static function getRunParam(i:Int) {
+		return PARAMS[i].t;
+	}
+	
 	public dynamic static function checkMeta( f : ClassField ) {
 	}
 

std/neko/db/SpodData.hx

@@ -670,7 +670,7 @@ class SpodData {
 	function ensureType( e : Expr, rt : SpodType ) {
 		var t = try typeof(e) catch( _ : Dynamic ) throw BuildError.EExpr(e);
 		switch( t ) {
-		case TMono:
+		case TMono(_):
 			// pseudo-cast
 			return { expr : EBlock([
 				{ expr : EVars([ { name : "__tmp", type : convertType(rt), expr : e } ]), pos : e.pos },
@@ -705,8 +705,8 @@ class SpodData {
 			var fi = current.hfields.get(current.key[0]);
 			var t = try typeof(econd) catch( _ : Dynamic ) throw BuildError.EExpr(econd);
 			switch( t ) {
-			case TMono:
-
+			case TMono(_):
+				// will be unified by dynamicGet
 			default:
 				var d = try makeType(t) catch( e : Dynamic ) try makeType(follow(t)) catch( e : Dynamic ) throw BuildError.EExpr(sqlQuoteValue(econd, fi.t));
 				unify(d, fi.t, p);

type.ml

@@ -142,9 +142,10 @@ and tclass_kind =
 	| KNormal
 	| KTypeParameter
 	| KExtension of tclass * tparams
-	| KConstant of tconstant
+	| KExpr of Ast.expr
 	| KGeneric
 	| KGenericInstance of tclass * tparams
+	| KMacroType
 
 and metadata = Ast.metadata
 

typecore.ml

@@ -34,6 +34,7 @@ type current_fun =
 type macro_mode =
 	| MExpr
 	| MBuild
+	| MMacroType
 
 type typer_globals = {
 	types_module : (path, path) Hashtbl.t;

typeload.ml

@@ -130,20 +130,20 @@ let rec load_instance ctx t p allow_no_params =
 			if List.length types <> List.length t.tparams then error ("Invalid number of type parameters for " ^ s_type_path path) p;
 			let tparams = List.map (fun t ->
 				match t with
-				| TPConst c ->
-					let name, const = (match c with
-						| String s -> "S" ^ s, TString s
-						| Int i -> "I" ^ i, TInt (Int32.of_string i)
-						| Float f -> "F" ^ f, TFloat f
-						| _ -> assert false
+				| TPExpr e ->
+					let name = (match fst e with
+						| EConst (String s) -> "S" ^ s
+						| EConst (Int i) -> "I" ^ i
+						| EConst (Float f) -> "F" ^ f
+						| _ -> "Expr"			
 					) in
 					let c = mk_class ([],name) p in
-					c.cl_kind <- KConstant const;
+					c.cl_kind <- KExpr e;
 					TInst (c,[])
 				| TPType t -> load_complex_type ctx p t
 			) t.tparams in
 			let params = List.map2 (fun t (name,t2) ->
-				let isconst = (match t with TInst ({ cl_kind = KConstant _ },_) -> true | _ -> false) in
+				let isconst = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in
 				if isconst <> (name = "Const") && t != t_dynamic then error (if isconst then "Constant value unexpected here" else "Constant value excepted as type parameter") p;
 				match follow t2 with
 				| TInst ({ cl_implements = [] }, []) ->
@@ -710,6 +710,7 @@ let init_class ctx c p herits fields =
 	let ctx = { ctx with type_params = c.cl_types } in
 	c.cl_extern <- List.mem HExtern herits;
 	c.cl_interface <- List.mem HInterface herits;
+	if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
 	set_heritance ctx c herits p;
 	let fields = ref fields in
 	let get_fields() = !fields in
@@ -1168,7 +1169,7 @@ let init_class ctx c p herits fields =
 							| _ :: _ -> true
 						and is_qual_param = function
 							| TPType t -> is_qualified t
-							| TPConst _ -> false (* prevent multiple incompatible types *)
+							| TPExpr _ -> false (* prevent multiple incompatible types *)
 						in
 						let t = (match t with
 							| Some t when is_qualified t -> Some t
@@ -1487,7 +1488,8 @@ let load_module ctx m p =
 				parse_module ctx m p
 			with Not_found ->
 				let rec loop = function
-					| [] -> raise (Error (Module_not_found m,p))
+					| [] -> 
+						raise (Error (Module_not_found m,p))
 					| load :: l ->
 						match load m p with
 						| None -> loop l

typer.ml

@@ -2249,13 +2249,17 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 	let ctx2, (margs,mret,mpos), call_macro = load_macro ctx cpath f p in
 	let ctexpr = { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None } in
 	let expr = Typeload.load_instance ctx2 ctexpr p false in
-	let ctfields = { tpackage = []; tname = "Array"; tparams = [TPType (CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = Some "Field" })]; tsub = None } in
 	(match mode with
 	| MExpr ->
 		unify ctx2 mret expr mpos;
 	| MBuild ->
+		let ctfields = { tpackage = []; tname = "Array"; tparams = [TPType (CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = Some "Field" })]; tsub = None } in
 		let tfields = Typeload.load_instance ctx2 ctfields p false in
 		unify ctx2 mret tfields mpos
+	| MMacroType ->
+		let cttype = { tpackage = ["haxe";"macro"]; tname = "Type"; tparams = []; tsub = None } in
+		let ttype = Typeload.load_instance ctx2 cttype p false in
+		unify ctx2 mret ttype mpos
 	);
 	let args = (try
 		(*
@@ -2320,7 +2324,11 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 						| _ ->
 							List.map Interp.decode_field (Interp.dec_array v)
 					) in
-					(EVars ["fields",Some (CTAnonymous fields),None],p))
+					(EVars ["fields",Some (CTAnonymous fields),None],p)
+				| MMacroType ->
+					ctx.ret <- Interp.decode_type v;
+					(EBlock [],p)
+				)
 			with Interp.Invalid_expr ->
 				error "The macro didn't return a valid result" p
 	in