semantic renames

ast.ml

@@ -142,24 +142,24 @@ type type_path_normal = {
 }
 
 and type_param_or_const =
-	| TPType of type_path
+	| TPType of complex_type
 	| TPConst of constant
 
 and anonymous_field =
-	| AFVar of type_path
-	| AFProp of type_path * string * string
-	| AFFun of (string * bool * type_path) list * type_path
+	| AFVar of complex_type
+	| AFProp of complex_type * string * string
+	| AFFun of (string * bool * complex_type) list * complex_type
 
-and type_path =
-	| TPNormal of type_path_normal
-	| TPFunction of type_path list * type_path
-	| TPAnonymous of (string * bool option * anonymous_field * pos) list
-	| TPParent of type_path
-	| TPExtend of type_path_normal * (string * bool option * anonymous_field * pos) list
+and complex_type =
+	| CTPath of type_path_normal
+	| CTFunction of complex_type list * complex_type
+	| CTAnonymous of (string * bool option * anonymous_field * pos) list
+	| CTParent of complex_type
+	| CTExtend of type_path_normal * (string * bool option * anonymous_field * pos) list
 
 type func = {
-	f_args : (string * bool * type_path option * expr option) list;
-	f_type : type_path option;
+	f_args : (string * bool * complex_type option * expr option) list;
+	f_type : complex_type option;
 	f_expr : expr;
 }
 
@@ -175,20 +175,20 @@ and expr_def =
 	| ECall of expr * expr list
 	| ENew of type_path_normal * expr list
 	| EUnop of unop * unop_flag * expr
-	| EVars of (string * type_path option * expr option) list
+	| EVars of (string * complex_type option * expr option) list
 	| EFunction of func
 	| EBlock of expr list
 	| EFor of string * expr * expr
 	| EIf of expr * expr * expr option
 	| EWhile of expr * expr * while_flag
 	| ESwitch of expr * (expr list * expr) list * expr option
-	| ETry of expr * (string * type_path * expr) list
+	| ETry of expr * (string * complex_type * expr) list
 	| EReturn of expr option
 	| EBreak
 	| EContinue
 	| EUntyped of expr
 	| EThrow of expr
-	| ECast of expr * type_path option
+	| ECast of expr * complex_type option
 	| EDisplay of expr * bool
 	| EDisplayNew of type_path_normal
 	| ETernary of expr * expr * expr
@@ -210,9 +210,9 @@ type access =
 	| AInline
 
 type class_field =
-	| FVar of string * documentation * metadata * access list * type_path option * expr option
+	| FVar of string * documentation * metadata * access list * complex_type option * expr option
 	| FFun of string * documentation * metadata * access list * type_param list * func
-	| FProp of string * documentation * metadata * access list * string * string * type_path
+	| FProp of string * documentation * metadata * access list * string * string * complex_type
 
 type enum_flag =
 	| EPrivate
@@ -225,7 +225,7 @@ type class_flag =
 	| HExtends of type_path_normal
 	| HImplements of type_path_normal
 
-type enum_constructor = string * documentation * metadata * (string * bool * type_path) list * pos
+type enum_constructor = string * documentation * metadata * (string * bool * complex_type) list * pos
 
 type ('a,'b) definition = {
 	d_name : string;
@@ -239,7 +239,7 @@ type ('a,'b) definition = {
 type type_def =
 	| EClass of (class_flag, (class_field * pos) list) definition
 	| EEnum of (enum_flag, enum_constructor list) definition
-	| ETypedef of (enum_flag, type_path) definition
+	| ETypedef of (enum_flag, complex_type) definition
 	| EImport of type_path_normal
 	| EUsing of type_path_normal
 

codegen.ml

@@ -71,10 +71,10 @@ let extend_remoting ctx c t p async prot =
 	let decls = (try Typeload.parse_module ctx path p with e -> ctx.com.package_rules <- rules; raise e) in
 	ctx.com.package_rules <- rules;
 	let base_fields = [
-		(FVar ("__cnx",None,[],[],Some (TPNormal { tpackage = ["haxe";"remoting"]; tname = if async then "AsyncConnection" else "Connection"; tparams = []; tsub = None }),None),p);
+		(FVar ("__cnx",None,[],[],Some (CTPath { tpackage = ["haxe";"remoting"]; tname = if async then "AsyncConnection" else "Connection"; tparams = []; tsub = None }),None),p);
 		(FFun ("new",None,[],[APublic],[],{ f_args = ["c",false,None,None]; f_type = None; f_expr = (EBinop (OpAssign,(EConst (Ident "__cnx"),p),(EConst (Ident "c"),p)),p) }),p);
 	] in
-	let tvoid = TPNormal { tpackage = []; tname = "Void"; tparams = []; tsub = None } in
+	let tvoid = CTPath { tpackage = []; tname = "Void"; tparams = []; tsub = None } in
 	let build_field is_public acc (f,p) =
 		match f with
 		| FFun ("new",_,_,_,_,_) ->
@@ -82,9 +82,9 @@ let extend_remoting ctx c t p async prot =
 		| FFun (name,doc,meta,acl,pl,f) when (is_public || List.mem APublic acl) && not (List.mem AStatic acl) ->
 			if List.exists (fun (_,_,t,_) -> t = None) f.f_args then error ("Field " ^ name ^ " type is not complete and cannot be used by RemotingProxy") p;
 			let eargs = [EArrayDecl (List.map (fun (a,_,_,_) -> (EConst (Ident a),p)) f.f_args),p] in
-			let ftype = (match f.f_type with Some (TPNormal { tpackage = []; tname = "Void" }) -> None | _ -> f.f_type) in
+			let ftype = (match f.f_type with Some (CTPath { tpackage = []; tname = "Void" }) -> None | _ -> f.f_type) in
 			let fargs, eargs = if async then match ftype with
-				| Some tret -> f.f_args @ ["__callb",true,Some (TPFunction ([tret],tvoid)),None], eargs @ [EConst (Ident "__callb"),p]
+				| Some tret -> f.f_args @ ["__callb",true,Some (CTFunction ([tret],tvoid)),None], eargs @ [EConst (Ident "__callb"),p]
 				| _ -> f.f_args, eargs @ [EConst (Ident "null"),p]
 			else
 				f.f_args, eargs
@@ -324,13 +324,13 @@ let build_instance ctx mtype p =
 
 let on_inherit ctx c p h =
 	match h with
-	| HExtends { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [TPType(TPNormal t)] } ->
+	| HExtends { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [TPType(CTPath t)] } ->
 		extend_remoting ctx c t p false true;
 		false
-	| HExtends { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPType(TPNormal t)] } ->
+	| HExtends { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPType(CTPath t)] } ->
 		extend_remoting ctx c t p true true;
 		false
-	| HExtends { tpackage = ["mt"]; tname = "AsyncProxy"; tparams = [TPType(TPNormal t)] } ->
+	| HExtends { tpackage = ["mt"]; tname = "AsyncProxy"; tparams = [TPType(CTPath t)] } ->
 		extend_remoting ctx c t p true false;
 		false
 	| HImplements { tpackage = ["haxe";"rtti"]; tname = "Generic"; tparams = [] } ->

genswf.ml

@@ -158,7 +158,7 @@ let rec make_tpath = function
 		{
 			tpackage = pack;
 			tname = name;
-			tparams = if !pdyn then [TPType (TPNormal { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; })] else[];
+			tparams = if !pdyn then [TPType (CTPath { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; })] else[];
 			tsub = None;
 		}
 	| HMName (id,_) ->
@@ -186,18 +186,18 @@ let rec make_tpath = function
 	| HMAttrib _ ->
 		assert false
 	| HMParams (t,params) ->
-		let params = List.map (fun t -> TPType (TPNormal (make_tpath t))) params in
+		let params = List.map (fun t -> TPType (CTPath (make_tpath t))) params in
 		{ (make_tpath t) with tparams = params }
 
 let make_param cl p =
-	{ tpackage = fst cl; tname = snd cl; tparams = [TPType (TPNormal { tpackage = fst p; tname = snd p; tparams = []; tsub = None })]; tsub = None }
+	{ tpackage = fst cl; tname = snd cl; tparams = [TPType (CTPath { tpackage = fst p; tname = snd p; tparams = []; tsub = None })]; tsub = None }
 
 let make_topt = function
 	| None -> { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None }
 	| Some t -> make_tpath t
 
 let make_type f t = 
-	TPNormal (match f, t with
+	CTPath (match f, t with
 	| "opaqueBackground", Some (HMPath ([],"Object")) -> make_param ([],"Null") ([],"UInt")
 	| "getObjectsUnderPoint", Some (HMPath ([],"Array")) -> make_param ([],"Array") (["flash";"display"],"DisplayObject")
 	| "blendMode", Some (HMPath ([],"String")) -> { tpackage = ["flash";"display"]; tname = "BlendMode"; tparams = []; tsub = None }

interp.ml

@@ -42,6 +42,7 @@ and vabstract =
 	| AHash of (value, value) Hashtbl.t
 	| ARandom of Random.State.t
 	| ABuffer of Buffer.t
+	| APos of Ast.pos
 
 and vfunction =
 	| Fun0 of (unit -> value)
@@ -1434,3 +1435,219 @@ let add_types ctx types =
 	t();
 
 
+open Ast
+
+type enum_index =
+	| IExpr
+	| IBinop
+	| IUnop
+	| IConst
+	| ITParam
+	| IType
+	| IField
+
+let null f = function
+	| None -> VNull
+	| Some v -> f v
+
+let encode_pos p =
+	VAbstract (APos p)	
+
+let enc_array l = VArray (Array.of_list l)
+
+let enc_obj l = VObject (obj l)
+
+let enc_enum (i:enum_index) tag pl =
+	let eindex : int = Obj.magic i in
+	enc_array (VInt eindex :: VInt tag :: pl)
+
+let encode_const c =
+	let tag, pl = match c with
+	| Int s -> 0, [VString s]
+	| Float s -> 1, [VString s]
+	| String s -> 2, [VString s]
+	| Ident s -> 3, [VString s]
+	| Type s -> 4, [VString s]
+	| Regexp (s,opt) -> 5, [VString s;VString opt]
+	in
+	enc_enum IConst tag pl
+
+let rec encode_binop op =
+	let tag, pl = match op with
+	| OpAdd -> 0, []
+	| OpMult -> 1, []
+	| OpDiv -> 2, []
+	| OpSub -> 3, []
+	| OpAssign -> 4, []
+	| OpEq -> 5, []
+	| OpNotEq -> 6, []
+	| OpGt -> 7, []
+	| OpGte -> 8, []
+	| OpLt -> 9, []
+	| OpLte -> 10, []
+	| OpAnd -> 11, []
+	| OpOr -> 12, []
+	| OpXor -> 13, []
+	| OpBoolAnd -> 14, []
+	| OpBoolOr -> 15, []
+	| OpShl -> 16, []
+	| OpShr -> 17, []
+	| OpUShr -> 18, []
+	| OpMod -> 19, []
+	| OpAssignOp op -> 20, [encode_binop op]
+	| OpInterval -> 21, []
+	in
+	enc_enum IBinop tag pl
+
+let encode_unop op =
+	let tag = match op with
+	| Increment -> 0
+	| Decrement -> 1
+	| Not -> 2
+	| Neg -> 3
+	| NegBits -> 4
+	in
+	enc_enum IUnop tag []
+
+let rec encode_path t =
+	enc_obj [
+		"pack", enc_array (List.map (fun s -> VString s) t.tpackage);
+		"name", VString t.tname;
+		"params", enc_array (List.map encode_tparam t.tparams);
+		"sub", null (fun s -> VString s) t.tsub;
+	]
+
+and encode_tparam = function
+	| TPType t -> enc_enum ITParam 0 [encode_type t]
+	| TPConst c -> enc_enum ITParam 1 [encode_const c]
+
+and encode_field (f,pub,field,pos) =
+	let tag, pl = match field with
+		| AFVar t -> 0, [encode_type t]
+		| AFProp (t,get,set) -> 1, [encode_type t; VString get; VString set]
+		| AFFun (pl,t) -> 2, [enc_array (List.map (fun (n,opt,t) ->
+			enc_obj [
+				"name", VString n;
+				"opt", VBool opt;
+				"type", encode_type t
+			]
+		) pl); encode_type t]
+	in
+	enc_obj [
+		"name",VString f;
+		"isPublic",null (fun b -> VBool b) pub;
+		"type", enc_enum IField tag pl;
+		"pos", encode_pos pos;
+	]
+
+and encode_type t =
+	let tag, pl = match t with
+	| CTPath p ->
+		0, [encode_path p]
+	| CTFunction (pl,r) ->
+		1, [enc_array (List.map encode_type pl);encode_type r]
+	| CTAnonymous fl -> 
+		2, [enc_array (List.map encode_field fl)]
+	| CTParent t -> 
+		3, [encode_type t]
+	| CTExtend (t,fields) ->
+		4, [encode_path t; enc_array (List.map encode_field fields)]
+	in
+	enc_enum IType tag pl
+
+let encode_expr e =
+	let rec loop (e,p) =
+		let tag, pl = match e with
+			| EConst c ->
+				0, [encode_const c]
+			| EArray (e1,e2) ->
+				1, [loop e1;loop e2]
+			| EBinop (op,e1,e2) ->
+				2, [encode_binop op;loop e1;loop e2]
+			| EField (e,f) ->
+				3, [VString f]
+			| EType (e,f) ->
+				4, [VString f]
+			| EParenthesis e ->
+				5, [loop e]
+			| EObjectDecl fl ->
+				6, [enc_array (List.map (fun (f,e) -> enc_obj [
+					"field",VString f;
+					"expr",loop e;
+				]) fl)]
+			| EArrayDecl el ->
+				7, [enc_array (List.map loop el)]
+			| ECall (e,el) ->
+				8, [loop e;enc_array (List.map loop el)]
+			| ENew (p,el) ->
+				9, [encode_path p; enc_array (List.map loop el)]
+			| EUnop (op,flag,e) ->
+				10, [encode_unop op; VBool (match flag with Prefix -> false | Postfix -> true); loop e]
+			| EVars vl ->
+				11, [enc_array (List.map (fun (v,t,eo) ->
+					enc_obj [
+						"name",VString v;
+						"ret",null encode_type t;
+						"expr",null loop eo;
+					]
+				) vl)]
+			| EFunction f ->
+				12, [enc_obj [
+					"args", enc_array (List.map (fun (n,opt,t,e) ->
+						enc_obj [
+							"name", VString n;
+							"opt", VBool opt;
+							"type", null encode_type t;
+							"value", null loop e;
+						]
+					) f.f_args);
+					"ret", null encode_type f.f_type;
+					"expr", loop f.f_expr
+				]]
+			| EBlock el ->
+				13, [enc_array (List.map loop el)]
+			| EFor (v,e,eloop) ->
+				14, [VString v;loop e;loop eloop]
+			| EIf (econd,e,eelse) ->
+				15, [loop econd;loop e;null loop eelse]
+			| EWhile (econd,e,flag) ->
+				16, [loop econd;loop e;VBool (match flag with NormalWhile -> true | DoWhile -> false)]
+			| ESwitch (e,cases,eopt) ->
+				17, [loop e;enc_array (List.map (fun (ecl,e) ->
+					enc_obj [
+						"values",enc_array (List.map loop ecl);
+						"expr",loop e
+					]
+				) cases);null loop eopt]
+			| ETry (e,catches) ->
+				18, [loop e;enc_array (List.map (fun (v,t,e) ->
+					enc_obj [
+						"name",VString v;
+						"type",encode_type t;
+						"expr",loop e
+					]
+				) catches)]
+			| EReturn eo ->
+				19, [null loop eo]
+			| EBreak ->
+				20, []
+			| EContinue ->
+				21, []
+			| EUntyped e ->
+				22, [loop e]
+			| EThrow e ->
+				23, [loop e]
+			| ECast (e,t) ->
+				24, [loop e; null encode_type t]
+			| ETernary (econd,e1,e2) ->
+				25, [loop econd;loop e1;loop e2]
+			| EDisplay _ | EDisplayNew _ ->
+				assert false
+		in
+		enc_obj [
+			"pos", encode_pos p;
+			"expr", enc_enum IExpr tag pl;
+		]
+	in
+	loop e
+

parser.ml

@@ -163,8 +163,8 @@ let rec	parse_file s =
 
 and parse_type_decl s =
 	match s with parser
-	| [< '(Kwd Import,p1); t = parse_type_path_normal; p2 = semicolon >] -> EImport t, punion p1 p2
-	| [< '(Kwd Using,p1); t = parse_type_path_normal; p2 = semicolon >] -> EUsing t, punion p1 p2
+	| [< '(Kwd Import,p1); t = parse_type_path; p2 = semicolon >] -> EImport t, punion p1 p2
+	| [< '(Kwd Using,p1); t = parse_type_path; p2 = semicolon >] -> EUsing t, punion p1 p2
 	| [< meta = parse_meta; c = parse_common_flags; s >] ->
 		match s with parser
 		| [< n , p1 = parse_enum_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] ->
@@ -189,7 +189,7 @@ and parse_type_decl s =
 				d_flags = List.map fst c @ n @ hl;
 				d_data = fl;
 			}, punion p1 p2)
-		| [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_constraint_params; '(Binop OpAssign,_); t = parse_type_path; s >] ->
+		| [< '(Kwd Typedef,p1); doc = get_doc; '(Const (Type name),p2); tl = parse_constraint_params; '(Binop OpAssign,_); t = parse_complex_type; s >] ->
 			(match s with parser
 			| [< '(Semicolon,_) >] -> ()
 			| [< >] -> ());
@@ -268,26 +268,26 @@ and parse_class_flags = parser
 	| [< '(Kwd Interface,p) >] -> [HInterface] , p
 
 and parse_type_opt = parser
-	| [< '(DblDot,_); t = parse_type_path >] -> Some t
+	| [< '(DblDot,_); t = parse_complex_type >] -> Some t
 	| [< >] -> None
 
-and parse_type_path = parser
-	| [< '(POpen,_); t = parse_type_path; '(PClose,_); s >] -> parse_type_path_next (TPParent t) s
+and parse_complex_type = parser
+	| [< '(POpen,_); t = parse_complex_type; '(PClose,_); s >] -> parse_complex_type_next (CTParent t) s
 	| [< '(BrOpen,_); s >] ->
 		let t = (match s with parser
-			| [< name = any_ident >] -> TPAnonymous (parse_type_anonymous_resume name s)
-			| [< '(Binop OpGt,_); t = parse_type_path_normal; '(Comma,_); s >] ->
+			| [< name = any_ident >] -> CTAnonymous (parse_type_anonymous_resume name s)
+			| [< '(Binop OpGt,_); t = parse_type_path; '(Comma,_); s >] ->
 				(match s with parser
-				| [< name = any_ident; l = parse_type_anonymous_resume name >] -> TPExtend (t,l)
-				| [< l = plist (parse_signature_field None); '(BrClose,_) >] -> TPExtend (t,l)
+				| [< name = any_ident; l = parse_type_anonymous_resume name >] -> CTExtend (t,l)
+				| [< l = plist (parse_signature_field None); '(BrClose,_) >] -> CTExtend (t,l)
 				| [< >] -> serror())
-			| [< l = plist (parse_signature_field None); '(BrClose,_) >] -> TPAnonymous l
+			| [< l = plist (parse_signature_field None); '(BrClose,_) >] -> CTAnonymous l
 			| [< >] -> serror()
 		) in
-		parse_type_path_next t s
-	| [< t = parse_type_path_normal; s >] -> parse_type_path_next (TPNormal t) s
+		parse_complex_type_next t s
+	| [< t = parse_type_path; s >] -> parse_complex_type_next (CTPath t) s
 
-and parse_type_path_normal s = parse_type_path1 [] s
+and parse_type_path s = parse_type_path1 [] s
 
 and parse_type_path1 pack = parser
 	| [< '(Const (Ident name),_); '(Dot,p); s >] ->
@@ -320,19 +320,19 @@ 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_type_path >] -> TPType t
+	| [< t = parse_complex_type >] -> TPType t
 
-and parse_type_path_next t = parser
-	| [< '(Arrow,_); t2 = parse_type_path >] ->
+and parse_complex_type_next t = parser
+	| [< '(Arrow,_); t2 = parse_complex_type >] ->
 		(match t2 with
-		| TPFunction (args,r) ->
-			TPFunction (t :: args,r)
+		| CTFunction (args,r) ->
+			CTFunction (t :: args,r)
 		| _ ->
-			TPFunction ([t] , t2))
+			CTFunction ([t] , t2))
 	| [< >] -> t
 
 and parse_type_anonymous_resume name = parser
-	| [< '(DblDot,p); t = parse_type_path; s >] ->
+	| [< '(DblDot,p); t = parse_complex_type; s >] ->
 		(name, None, AFVar t, p) ::
 		match s with parser
 		| [< '(BrClose,_) >] -> []
@@ -354,8 +354,8 @@ and parse_enum s =
 		| [< >] -> serror()
 
 and parse_enum_param = parser
-	| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,true,t)
-	| [< name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,false,t)
+	| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_complex_type >] -> (name,true,t)
+	| [< name = any_ident; '(DblDot,_); t = parse_complex_type >] -> (name,false,t)
 
 and parse_class_field s =
 	doc := None;
@@ -364,7 +364,7 @@ and parse_class_field s =
 		match s with parser
 		| [< '(Kwd Var,p1); name = any_ident; s >] ->
 			(match s with parser
-			| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); '(DblDot,_); t = parse_type_path; p2 = semicolon >] ->
+			| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); '(DblDot,_); t = parse_complex_type; p2 = semicolon >] ->
 				(FProp (name,doc,meta,l,i1,i2,t),punion p1 p2)
 			| [< t = parse_type_opt; s >] ->
 				let e , p2 = (match s with parser
@@ -391,10 +391,10 @@ and parse_class_field s =
 and parse_signature_field flag = parser
 	| [< '(Kwd Var,p1); name = any_ident; s >] ->
 		(match s with parser
-		| [< '(DblDot,_); t = parse_type_path; p2 = semicolon >] -> (name,flag,AFVar t,punion p1 p2)
-		| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); '(DblDot,_); t = parse_type_path; p2 = semicolon >] -> (name,flag,AFProp (t,i1,i2),punion p1 p2)
+		| [< '(DblDot,_); t = parse_complex_type; p2 = semicolon >] -> (name,flag,AFVar t,punion p1 p2)
+		| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_); '(DblDot,_); t = parse_complex_type; p2 = semicolon >] -> (name,flag,AFProp (t,i1,i2),punion p1 p2)
 		| [< >] -> serror())
-	| [< '(Kwd Function,p1); name = any_ident; '(POpen,_); al = psep Comma parse_fun_param_type; '(PClose,_); '(DblDot,_); t = parse_type_path; p2 = semicolon >] ->
+	| [< '(Kwd Function,p1); name = any_ident; '(POpen,_); al = psep Comma parse_fun_param_type; '(PClose,_); '(DblDot,_); t = parse_complex_type; p2 = semicolon >] ->
 		(name,flag,AFFun (al,t),punion p1 p2)
 	| [< '(Kwd Private,_) when flag = None; s >] -> parse_signature_field (Some false) s
 	| [< '(Kwd Public,_) when flag = None; s >] -> parse_signature_field (Some true) s
@@ -422,8 +422,8 @@ and parse_fun_param_value = parser
 	| [< >] -> None
 
 and parse_fun_param_type = parser
-	| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,true,t)
-	| [< name = any_ident; '(DblDot,_); t = parse_type_path >] -> (name,false,t)
+	| [< '(Question,_); name = any_ident; '(DblDot,_); t = parse_complex_type >] -> (name,true,t)
+	| [< name = any_ident; '(DblDot,_); t = parse_complex_type >] -> (name,false,t)
 
 and parse_constraint_params = parser
 	| [< '(Binop OpLt,_); l = psep Comma parse_constraint_param; '(Binop OpGt,_) >] -> l
@@ -434,14 +434,14 @@ and parse_constraint_param = parser
 		match s with parser
 		| [< '(DblDot,_); s >] ->
 			(match s with parser
-			| [< '(POpen,_); l = psep Comma parse_type_path_normal; '(PClose,_) >] -> (name,l)
-			| [< t = parse_type_path_normal >] -> (name,[t])
+			| [< '(POpen,_); l = psep Comma parse_type_path; '(PClose,_) >] -> (name,l)
+			| [< t = parse_type_path >] -> (name,[t])
 			| [< >] -> serror())
 		| [< >] -> (name,[])
 
 and parse_class_herit = parser
-	| [< '(Kwd Extends,_); t = parse_type_path_normal >] -> HExtends t
-	| [< '(Kwd Implements,_); t = parse_type_path_normal >] -> HImplements t
+	| [< '(Kwd Extends,_); t = parse_type_path >] -> HExtends t
+	| [< '(Kwd Implements,_); t = parse_type_path >] -> HImplements t
 
 and block1 = parser
 	| [< '(Const (Ident name),p); s >] -> block2 name true p s
@@ -514,13 +514,13 @@ and expr = parser
 		(match s with parser
 		| [< '(POpen,_); e = expr; s >] ->
 			(match s with parser
-			| [< '(Comma,_); t = parse_type_path; '(PClose,p2); s >] -> expr_next (ECast (e,Some t),punion p1 p2) s
+			| [< '(Comma,_); t = parse_complex_type; '(PClose,p2); s >] -> expr_next (ECast (e,Some t),punion p1 p2) s
 			| [< '(PClose,p2); s >] -> expr_next (ECast (e,None),punion p1 (pos e)) s
 			| [< >] -> serror())
 		| [< e = expr; s >] -> expr_next (ECast (e,None),punion p1 (pos e)) s
 		| [< >] -> serror())
 	| [< '(Kwd Throw,p); e = expr >] -> (EThrow e,p)
-	| [< '(Kwd New,p1); t = parse_type_path_normal; '(POpen,p); s >] ->
+	| [< '(Kwd New,p1); t = parse_type_path; '(POpen,p); s >] ->
 		if is_resuming p then display (EDisplayNew t,punion p1 p);
 		(match s with parser
 		| [< al = psep Comma expr; '(PClose,p2); s >] -> expr_next (ENew (t,al),punion p1 p2) s
@@ -646,7 +646,7 @@ and parse_switch_cases eswitch cases = parser
 and parse_catch etry = parser
 	| [< '(Kwd Catch,p); '(POpen,_); name = any_ident; s >] ->
 		match s with parser
-		| [< '(DblDot,_); t = parse_type_path; '(PClose,_); s >] ->
+		| [< '(DblDot,_); t = parse_complex_type; '(PClose,_); s >] ->
 			(try
 				match s with parser
 				| [< e = expr >] ->	(name,t,e)

std/haxe/macro/Expr.hx

@@ -0,0 +1,151 @@
+/*
+ * Copyright (c) 2005-2010, 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;
+
+extern enum Position {
+}
+
+enum Constant {
+	CInt( v : String );
+	CFloat( f : String );
+	CString( s : String );
+	CIdent( s : String );
+	CType( s : String );
+	CRegexp( r : String, opt : String );
+}
+
+enum Binop {
+	OpAdd;
+	OpMult;
+	OpDiv;
+	OpSub;
+	OpAssign;
+	OpEq;
+	OpNotEq;
+	OpGt;
+	OpGte;
+	OpLt;
+	OpLte;
+	OpAnd;
+	OpOr;
+	OpXor;
+	OpBoolAnd;
+	OpBoolOr;
+	OpShl;
+	OpShr;
+	OpUShr;
+	OpMod;
+	OpAssignOp( op : Binop );
+	OpInterval;
+}
+
+
+enum Unop {
+	OpIncrement;
+	OpIDecrement;
+	OpNot;
+	OpNeg;
+	OpNegBits;
+}
+
+typedef Expr = {
+	var expr : ExprDef;
+	var pos : Position;
+}
+
+enum ExprDef {
+	EConst( c : Constant );
+	EArray( e1 : Expr, e2 : Expr );
+	EBinop( op : Binop, e1 : Expr, e2 : Expr );
+	EField( e : Expr, field : String );
+	EType( e : Expr, field : String );
+	EParenthesis( e : Expr );
+	EObjectDecl( fields : Array<{ field : String, expr : Expr }> );
+	EArrayDecl( values : Array<Expr> );
+	ECall( e : Expr, params : Array<Expr> );
+	ENew( t : TypePath, params : Array<Expr> );
+	EUnop( op : Unop, postFix : Bool, e : Expr );
+	EVars( vars : Array<{ name : String, type : Null<ComplexType>, expr : Null<Expr> }> );
+	EFunction( f : Function );
+	EBlock( exprs : Array<Expr> );
+	EFor( v : String, it : Expr, expr : Expr );
+	EIf( econd : Expr, eif : Expr, eelse : Null<Expr> );
+	EWhile( econd : Expr, e : Expr, normalWhile : Bool );
+	ESwitch( e : Expr, cases : Array<{ values : Array<Expr>, expr : Expr }>, edef : Null<Expr> );
+	ETry( e : Expr, catches : Array<{ name : String, type : ComplexType, expr : Expr }> );
+	EReturn( e : Null<Expr> );
+	EBreak;
+	EContinue;
+	EUntyped( e : Expr );
+	EThrow( e : Expr );
+	ECast( e : Expr, t : Null<TypePath> );
+	ETernary( econd : Expr, eif : Expr, eelse : Expr );
+}
+
+enum ComplexType {
+	TPath( p : TypePath );
+	TFunction( args : Array<ComplexType>, ret : ComplexType );
+	TAnonymous( fields : Array<Field> );
+	TParent( t : ComplexType );
+}
+
+typedef TypePath = {
+	var pack : Array<String>;
+	var name : String;
+	var params : Array<TypeParam>;
+	var sub : Null<String>;
+}
+
+enum TypeParam {
+	TPType( t : ComplexType );
+	TPConst( c : Constant );
+}
+
+typedef Function = {
+	var args : Array<FunctionArg>;
+	var ret : Null<ComplexType>;
+	var expr : Expr;
+}
+
+typedef FunctionArg = {
+	var name : String;
+	var opt : Bool;
+	var type : Null<ComplexType>;
+	var value : Null<Expr>;
+}
+
+typedef Field = {
+	var name : String;
+	var isPublic : Null<Bool>;
+	var type : FieldType;
+	var pos : Position;
+}
+
+enum FieldType {
+	FVar( t : ComplexType );
+	FProp( t : ComplexType, get : String, set : String );
+	FFun( args : Array<{ name : String, opt : Bool, type : ComplexType }>, ret : ComplexType );
+}
+

typeload.ml

@@ -161,10 +161,10 @@ let rec load_instance ctx t p allow_no_params =
 *)
 and load_complex_type ctx p t =
 	match t with
-	| TPParent t -> load_complex_type ctx p t
-	| TPNormal t -> load_instance ctx t p false
-	| TPExtend (t,l) ->
-		(match load_complex_type ctx p (TPAnonymous l) with
+	| CTParent t -> load_complex_type ctx p t
+	| CTPath t -> load_instance ctx t p false
+	| CTExtend (t,l) ->
+		(match load_complex_type ctx p (CTAnonymous l) with
 		| TAnon a ->
 			let rec loop t =
 				match follow t with
@@ -194,7 +194,7 @@ and load_complex_type ctx p t =
 			in
 			loop (load_instance ctx t p false)
 		| _ -> assert false)
-	| TPAnonymous l ->
+	| CTAnonymous l ->
 		let rec loop acc (n,pub,f,p) =
 			if PMap.mem n acc then error ("Duplicate field declaration : " ^ n) p;
 			let t , access = (match f with
@@ -227,9 +227,9 @@ and load_complex_type ctx p t =
 			} acc
 		in
 		mk_anon (List.fold_left loop PMap.empty l)
-	| TPFunction (args,r) ->
+	| CTFunction (args,r) ->
 		match args with
-		| [TPNormal { tpackage = []; tparams = []; tname = "Void" }] ->
+		| [CTPath { tpackage = []; tparams = []; tname = "Void" }] ->
 			TFun ([],load_complex_type ctx p r)
 		| _ ->
 			TFun (List.map (fun t -> "",false,load_complex_type ctx p t) args,load_complex_type ctx p r)
@@ -746,7 +746,7 @@ let init_class ctx c p herits fields meta =
 			if constr && c.cl_interface then error "An interface cannot have a constructor" p;
 			if c.cl_interface && not stat && (match f.f_expr with EBlock [] , _ -> false | _ -> true) then error "An interface method cannot have a body" p;
 			if constr then (match f.f_type with
-				| None | Some (TPNormal { tpackage = []; tname = "Void" }) -> ()
+				| None | Some (CTPath { tpackage = []; tname = "Void" }) -> ()
 				| _ -> error "A class constructor can't have a return value" p
 			);
 			let cf = {
@@ -885,11 +885,11 @@ let init_class ctx c p herits fields meta =
 							if we have a package declaration, we are sure it's fully qualified
 						*)
 						let rec is_qualified = function
-							| TPNormal t -> is_qual_name t
-							| TPParent t -> is_qualified t
-							| TPFunction (tl,t) -> List.for_all is_qualified tl && is_qualified t
-							| TPAnonymous fl -> List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
-							| TPExtend (t,fl) -> is_qual_name t && List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
+							| CTPath t -> is_qual_name t
+							| CTParent t -> is_qualified t
+							| CTFunction (tl,t) -> List.for_all is_qualified tl && is_qualified t
+							| CTAnonymous fl -> List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
+							| CTExtend (t,fl) -> is_qual_name t && List.for_all (fun (_,_,f,_) -> is_qual_field f) fl
 						and is_qual_field = function
 							| AFVar t -> is_qualified t
 							| AFProp (t,_,_) -> is_qualified t
@@ -1165,12 +1165,12 @@ let parse_module ctx m p =
 					d_meta = [];
 					d_params = d.d_params;
 					d_flags = if priv then [EPrivate] else [];
-					d_data = TPNormal (if priv then { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } else
+					d_data = CTPath (if priv then { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } else
 						{
 							tpackage = !remap;
 							tname = d.d_name;
 							tparams = List.map (fun (s,_) ->
-								TPType (TPNormal { tpackage = []; tname = s; tparams = []; tsub = None; })
+								TPType (CTPath { tpackage = []; tname = s; tparams = []; tsub = None; })
 							) d.d_params;
 							tsub = None;
 						});