refactoring + allow @:build for enums

ast.ml

@@ -270,7 +270,7 @@ let punion p p2 =
 
 let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
 
-let s_parse_path s = 
+let parse_path s = 
 	match List.rev (ExtString.String.nsplit s ".") with
 	| [] -> failwith "Invalid empty path"
 	| x :: l -> List.rev l, x

codegen.ml

@@ -33,13 +33,13 @@ let fcall e name el ret p =
 	mk (TCall (field e name ft p,el)) ret p
 
 let string com str p =
-	mk (TConst (TString str)) com.type_api.tstring p
+	mk (TConst (TString str)) com.basic.tstring p
 
 let binop op a b t p =
 	mk (TBinop (op,a,b)) t p
 
 let index com e index t p =
-	mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) com.type_api.tint p)) t p
+	mk (TArray (e,mk (TConst (TInt (Int32.of_int index))) com.basic.tint p)) t p
 
 let concat e1 e2 =
 	let e = (match e1.eexpr, e2.eexpr with
@@ -174,7 +174,7 @@ let rec build_generic ctx c p tl =
 			match t with
 			| TInst ({ cl_kind = KGeneric } as c2,tl2) ->
 				(* maybe loop, or generate cascading generics *)
-				let _, _, f = ctx.api.build_instance (TClassDecl c2) p in
+				let _, _, f = ctx.g.do_build_instance ctx (TClassDecl c2) p in
 				f (List.map build_type tl2)
 			| _ ->
 				try List.assq t subst with Not_found -> Type.map build_type t
@@ -262,7 +262,7 @@ let extend_xml_proxy ctx c t file p =
 (* BUILD META DATA OBJECT *)
 
 let build_metadata com t =
-	let api = com.type_api in
+	let api = com.basic in
 	let p, meta, fields, statics = (match t with
 		| TClassDecl c ->
 			let fields = List.map (fun f -> f.cf_name,f.cf_meta()) (c.cl_ordered_fields @ (match c.cl_constructor with None -> [] | Some f -> [{ f with cf_name = "_" }])) in
@@ -357,11 +357,11 @@ let on_generate ctx t =
 			| ":native",[{ eexpr = TConst (TString name) } as e] ->				
 				meta := (":real",[{ e with eexpr = TConst (TString (s_type_path c.cl_path)) }]) :: !meta;
 				c.cl_meta <- (fun() -> !meta);
-				c.cl_path <- s_parse_path name;
+				c.cl_path <- parse_path name;
 			| _ -> ()
 		) (!meta);
 		if has_rtti c && not (PMap.mem "__rtti" c.cl_statics) then begin
-			let f = mk_field "__rtti" ctx.api.tstring in
+			let f = mk_field "__rtti" ctx.t.tstring in
 			let str = Genxml.gen_type_string ctx.com t in
 			f.cf_expr <- Some (mk (TConst (TString str)) f.cf_type c.cl_pos);
 			c.cl_ordered_statics <- f :: c.cl_ordered_statics;
@@ -464,15 +464,15 @@ let rec local_usage f e =
 	This way, each value is captured independantly.
 *)
 
-let block_vars ctx e =
+let block_vars com e =
 
 	let uid = ref 0 in
 	let gen_unique() =
 		incr uid;
 		"$t" ^ string_of_int !uid;
 	in
 
-	let t = ctx.type_api in
+	let t = com.basic in
 
 	let rec mk_init v vt vtmp pos =
 		let at = t.tarray vt in
@@ -556,7 +556,7 @@ let block_vars ctx e =
 					v, o, vt
 			) f.tf_args in
 			let e = { e with eexpr = TFunction { f with tf_args = fargs; tf_expr = !fexpr } } in
-			(match ctx.platform with
+			(match com.platform with
 			| Cpp -> e
 			| _ ->
 				let args = List.map (fun (v,t) -> v, None, t) vars in
@@ -634,7 +634,7 @@ let block_vars ctx e =
 	local_usage collect_vars e;
 	if PMap.is_empty !used then e else wrap !used e
 	in
-	match ctx.platform with
+	match com.platform with
 	| Neko | Php | Cross -> e
 	| Cpp -> all_vars e
 	| _ -> out_loop e
@@ -806,7 +806,7 @@ type stack_context = {
 }
 
 let stack_context_init com stack_var exc_var pos_var tmp_var use_add p =
-	let t = com.type_api in
+	let t = com.basic in
 	let st = t.tarray t.tstring in
 	let stack_e = mk (TLocal stack_var) st p in
 	let exc_e = mk (TLocal exc_var) st p in
@@ -1015,7 +1015,7 @@ let rec is_volatile t =
 
 let set_default ctx a c t p =
 	let ve = mk (TLocal a) t p in
-	mk (TIf (mk (TBinop (OpEq,ve,mk (TConst TNull) t p)) ctx.type_api.tbool p, mk (TBinop (OpAssign,ve,mk (TConst c) t p)) t p,None)) ctx.type_api.tvoid p
+	mk (TIf (mk (TBinop (OpEq,ve,mk (TConst TNull) t p)) ctx.basic.tbool p, mk (TBinop (OpAssign,ve,mk (TConst c) t p)) t p,None)) ctx.basic.tvoid p
 
 let bytes_serialize data =
 	let b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789%:" in
@@ -1103,7 +1103,7 @@ let dump_types com =
 	{ var $t = <e>; if( Std.is($t,<t>) ) $t else throw "Class cast error"; }
 *)
 let default_cast ?(vtmp="$t") com e texpr t p =
-	let api = com.type_api in
+	let api = com.basic in
 	let mk_texpr = function
 		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
 		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
@@ -1112,8 +1112,7 @@ let default_cast ?(vtmp="$t") com e texpr t p =
 	let var = mk (TVars [(vtmp,e.etype,Some e)]) api.tvoid p in
 	let vexpr = mk (TLocal vtmp) e.etype p in
 	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in
-	let std = (match (api.load_module ([],"Std") p).mtypes with [std] -> std | _ -> assert false) in
-	(*Typeload.load_type_def ctx p { tpackage = []; tname = "Std"; tparams = []; tsub = None } in *)
+	let std = (try List.find (fun t -> t_path t = ([],"Std")) com.types with Not_found -> assert false) in
 	let std = mk (TTypeExpr std) (mk_texpr std) p in
 	let is = mk (TField (std,"is")) (tfun [t_dynamic;t_dynamic] api.tbool) p in
 	let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in

common.ml

@@ -34,22 +34,14 @@ type platform =
 
 type pos = Ast.pos
 
-type context_type_api = {
-	(* basic types *)
+type basic_types = {
 	mutable tvoid : t;
 	mutable tint : t;
 	mutable tfloat : t;
 	mutable tbool : t;
 	mutable tnull : t -> t;
 	mutable tstring : t;
 	mutable tarray : t -> t;
-	(* api *)
-	mutable load_module : path -> pos -> module_def;
-	mutable build_instance : module_type -> pos -> ((string * t) list * path * (t list -> t));
-	mutable on_generate : module_type -> unit;
-	mutable get_type_module : module_type -> module_def;
-	mutable optimize : texpr -> texpr;
-	mutable load_extern_type : (path -> pos -> Ast.package) list;
 }
 
 type context = {
@@ -67,15 +59,17 @@ type context = {
 	mutable error : string -> pos -> unit;
 	mutable warning : string -> pos -> unit;
 	mutable js_namespace : string option;
+	mutable load_extern_type : (path -> pos -> Ast.package option) list; (* allow finding types which are not in sources *)
 	(* output *)
 	mutable file : string;
 	mutable flash_version : int;
+	mutable modules : Type.module_def list;
 	mutable types : Type.module_type list;
 	mutable resources : (string,string) Hashtbl.t;
 	mutable php_front : string option;
 	mutable swf_libs : (string * (unit -> Swf.swf) * (unit -> ((string list * string),As3hl.hl_class) Hashtbl.t)) list;
 	(* typing *)
-	mutable type_api : context_type_api;
+	mutable basic : basic_types;
 	mutable lines : Lexer.line_index;
 }
 
@@ -98,34 +92,30 @@ let create v =
 		package_rules = PMap.empty;
 		file = "";
 		types = [];
+		modules = [];
 		flash_version = 8;
 		resources = Hashtbl.create 0;
 		php_front = None;
 		swf_libs = [];
 		js_namespace = None;
+		load_extern_type = [];
 		warning = (fun _ _ -> assert false);
 		error = (fun _ _ -> assert false);
-		type_api = {
+		basic = {
 			tvoid = m;
 			tint = m;
 			tfloat = m;
 			tbool = m;
 			tnull = (fun _ -> assert false);
 			tstring = m;
 			tarray = (fun _ -> assert false);
-			load_module = (fun _ _ -> assert false);
-			build_instance = (fun _ _ -> assert false);
-			on_generate = (fun _ -> ());
-			get_type_module = (fun _ -> assert false);
-			optimize = (fun _ -> assert false);
-			load_extern_type = [];
 		};
 		lines = Lexer.build_line_index();
 	}
 
 let clone com =
-	let t = com.type_api in
-	{ com with type_api = { t with tvoid = t.tvoid } }
+	let t = com.basic in
+	{ com with basic = { t with tvoid = t.tvoid } }
 
 let platforms = [
 	Flash;

genas3.ml

@@ -451,7 +451,7 @@ and gen_expr ctx e =
 	| TEnumField (en,s) ->
 		print ctx "%s.%s" (s_path ctx true en.e_path e.epos) (s_ident s)
 	| TArray ({ eexpr = TLocal "__global__" },{ eexpr = TConst (TString s) }) ->
-		let path = Ast.s_parse_path s in
+		let path = Ast.parse_path s in
 		spr ctx (s_path ctx false path e.epos)
 	| TArray (e1,e2) ->
 		gen_value ctx e1;

genswf.ml

@@ -750,7 +750,7 @@ let merge com file priority (h1,tags1) (h2,tags2) =
 		| TSetBgColor _ -> priority
 		| TExport el when !nframe = 0 && com.flash_version >= 9 ->
 			let el = List.filter (fun e ->
-				let path = s_parse_path e.exp_name in
+				let path = parse_path e.exp_name in
 				List.exists (fun t -> t_path t = path) com.types
 			) el in
 			classes := !classes @ List.map (fun e -> { f9_cid = Some e.exp_id; f9_classname = e.exp_name }) el;

genswf9.ml

@@ -686,7 +686,7 @@ let begin_fun ctx args tret el stat p =
 	)
 
 let empty_method ctx p =
-	let f = begin_fun ctx [] ctx.com.type_api.tvoid [] true p in
+	let f = begin_fun ctx [] ctx.com.basic.tvoid [] true p in
 	write ctx HRetVoid;
 	f()
 
@@ -777,7 +777,7 @@ let gen_access ctx e (forset : 'a) : 'a access =
 				VCast (id,classify ctx e.etype)
 		)
 	| TArray ({ eexpr = TLocal "__global__" },{ eexpr = TConst (TString s) }) ->
-		let path = s_parse_path s in
+		let path = parse_path s in
 		let id = type_path ctx path in
 		if is_set forset then write ctx HGetGlobalScope;
 		VGlobal id
@@ -1782,10 +1782,10 @@ let generate_class ctx c =
 			else
 				generate_construct ctx {
 					tf_args = [];
-					tf_type = ctx.com.type_api.tvoid;
+					tf_type = ctx.com.basic.tvoid;
 					tf_expr = {
 						eexpr = TBlock [];
-						etype = ctx.com.type_api.tvoid;
+						etype = ctx.com.basic.tvoid;
 						epos = null_pos;
 					}
 				} c
@@ -1872,7 +1872,7 @@ let generate_class ctx c =
 
 let generate_enum ctx e meta =
 	let name_id = type_path ctx e.e_path in
-	let api = ctx.com.type_api in
+	let api = ctx.com.basic in
 	let f = begin_fun ctx [("tag",None,api.tstring);("index",None,api.tint);("params",None,mk_mono())] api.tvoid [ethis] false e.e_pos in
 	let tag_id = ident "tag" in
 	let index_id = ident "index" in
@@ -1981,7 +1981,7 @@ let generate_inits ctx =
 	(* define flash.Boot.init method *)
 	write ctx HGetGlobalScope;
 	write ctx (HGetProp (type_path ctx (["flash"],"Boot")));
-	let finit = begin_fun ctx [] ctx.com.type_api.tvoid [] true null_pos in
+	let finit = begin_fun ctx [] ctx.com.basic.tvoid [] true null_pos in
 	List.iter (fun t ->
 		match t with
 		| TClassDecl c ->
@@ -2007,7 +2007,7 @@ let generate_type ctx t =
 			None
 		else
 			let hlc = generate_class ctx c in
-			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false c.cl_pos in
+			let init = begin_fun ctx [] ctx.com.basic.tvoid [ethis] false c.cl_pos in
 			generate_class_init ctx c hlc;
 			if c.cl_path = (["flash"],"Boot") then generate_inits ctx;
 			write ctx HRetVoid;
@@ -2023,7 +2023,7 @@ let generate_type ctx t =
 		else
 			let meta = Codegen.build_metadata ctx.com t in
 			let hlc = generate_enum ctx e meta in
-			let init = begin_fun ctx [] ctx.com.type_api.tvoid [ethis] false e.e_pos in
+			let init = begin_fun ctx [] ctx.com.basic.tvoid [ethis] false e.e_pos in
 			generate_enum_init ctx e hlc meta;
 			write ctx HRetVoid;
 			Some (init(), {

genxml.ml

@@ -52,7 +52,7 @@ let gen_arg_name (name,opt,_) =
 let cpath c =
 	let rec loop = function
 		| [] -> c.cl_path
-		| (":real",[{ eexpr = TConst (TString s) }]) :: _ -> s_parse_path s
+		| (":real",[{ eexpr = TConst (TString s) }]) :: _ -> parse_path s
 		| _ :: l -> loop l
 	in
 	loop (c.cl_meta())
@@ -125,7 +125,7 @@ let rec exists f c =
 			| Some (csup,_) -> exists f csup
 
 let gen_type_decl com t =
-	let m = com.type_api.get_type_module t in
+	let m = (try List.find (fun m -> List.memq t m.mtypes) com.modules with Not_found -> { mpath = t_path t; mtypes = [t] }) in
 	match t with
 	| TClassDecl c ->
 		let stats = List.map (gen_field ["static","1"]) c.cl_ordered_statics in

main.ml

@@ -339,8 +339,12 @@ try
 		("-swf-lib",Arg.String (fun file ->
 			let getSWF = Genswf.parse_swf com file in
 			let extract = Genswf.extract_data getSWF in
-			let build cl p = Genswf.build_class com (Hashtbl.find (extract()) cl) file in
-			com.type_api.load_extern_type <- com.type_api.load_extern_type @ [build];
+			let build cl p = 
+				match (try Some (Hashtbl.find (extract()) cl) with Not_found -> None) with
+				| None -> None
+				| Some c -> Some (Genswf.build_class com c file)
+			in
+			com.load_extern_type <- com.load_extern_type @ [build];
 			com.swf_libs <- (file,getSWF,extract) :: com.swf_libs
 		),"<file> : add the SWF library to the compiled SWF");
 		("-x", Arg.String (fun file ->
@@ -378,7 +382,7 @@ try
 			close_in ch;
 			excludes := (List.map (fun l ->
 				let l = ExtString.String.strip l in
-				if l = "" then ([],"") else Ast.s_parse_path l
+				if l = "" then ([],"") else Ast.parse_path l
 			) lines) @ !excludes;
 		),"<filename> : don't generate code for classes listed in this file");
 		("-prompt", Arg.Unit (fun() -> prompt := true),": prompt on error");
@@ -518,14 +522,15 @@ try
 		if com.verbose then print_endline ("Classpath : " ^ (String.concat ";" com.class_path));
 		let t = Common.timer "typing" in
 		Typecore.type_expr_ref := (fun ctx e need_val -> Typer.type_expr ~need_val ctx e);
-		Typecore.build_inheritance := Codegen.on_inherit;
 		let ctx = Typer.create com in
-		List.iter (fun cpath -> ignore(com.type_api.load_module cpath Ast.null_pos)) (List.rev !classes);
+		List.iter (fun cpath -> ignore(ctx.Typecore.g.Typecore.do_load_module ctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize ctx;
 		t();
 		if !has_error then do_exit();
 		if !no_output then com.platform <- Cross;
-		com.types <- Typer.types ctx com.main_class (!excludes);
+		let types, modules = Typer.generate ctx com.main_class (!excludes) in
+		com.types <- types;
+		com.modules <- modules;
 		com.lines <- Lexer.build_line_index();
 		let filters = [
 			Codegen.check_local_vars_init;