Browse Source

allow direct access and completion with classes defined in swf libs

Nicolas Cannasse 15 years ago
parent
commit
9c4d953b15
5 changed files with 269 additions and 46 deletions
  1. 5 1
      common.ml
  2. 1 0
      doc/CHANGES.txt
  3. 214 18
      genswf.ml
  4. 24 10
      main.ml
  5. 25 17
      typeload.ml

+ 5 - 1
common.ml

@@ -49,6 +49,7 @@ type context_type_api = {
 	mutable on_generate : module_type -> unit;
 	mutable on_generate : module_type -> unit;
 	mutable get_type_module : module_type -> module_def;
 	mutable get_type_module : module_type -> module_def;
 	mutable optimize : texpr -> texpr;
 	mutable optimize : texpr -> texpr;
+	mutable load_extern_type : (path -> pos -> Ast.package) list;
 }
 }
 
 
 type context = {
 type context = {
@@ -59,7 +60,7 @@ type context = {
 	mutable foptimize : bool;
 	mutable foptimize : bool;
 	mutable platform : platform;
 	mutable platform : platform;
 	mutable class_path : string list;
 	mutable class_path : string list;
-	mutable main_class : Type.path option; 
+	mutable main_class : Type.path option;
 	mutable defines : (string,unit) PMap.t;
 	mutable defines : (string,unit) PMap.t;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable error : string -> pos -> unit;
 	mutable error : string -> pos -> unit;
@@ -71,6 +72,7 @@ type context = {
 	mutable types : Type.module_type list;
 	mutable types : Type.module_type list;
 	mutable resources : (string,string) Hashtbl.t;
 	mutable resources : (string,string) Hashtbl.t;
 	mutable php_front : string option;
 	mutable php_front : string option;
+	mutable swf_libs : ((unit -> Swf.swf) * (unit -> ((string list * string),As3hl.hl_class) Hashtbl.t)) list;
 	(* typing *)
 	(* typing *)
 	mutable type_api : context_type_api;
 	mutable type_api : context_type_api;
 	mutable lines : Lexer.line_index;
 	mutable lines : Lexer.line_index;
@@ -95,6 +97,7 @@ let create v =
 		flash_version = 8;
 		flash_version = 8;
 		resources = Hashtbl.create 0;
 		resources = Hashtbl.create 0;
 		php_front = None;
 		php_front = None;
+		swf_libs = [];
 		js_namespace = None;
 		js_namespace = None;
 		warning = (fun _ _ -> assert false);
 		warning = (fun _ _ -> assert false);
 		error = (fun _ _ -> assert false);
 		error = (fun _ _ -> assert false);
@@ -111,6 +114,7 @@ let create v =
 			on_generate = (fun _ -> ());
 			on_generate = (fun _ -> ());
 			get_type_module = (fun _ -> assert false);
 			get_type_module = (fun _ -> assert false);
 			optimize = (fun _ -> assert false);
 			optimize = (fun _ -> assert false);
+			load_extern_type = [];
 		};
 		};
 		lines = Lexer.build_line_index();
 		lines = Lexer.build_line_index();
 	}
 	}

+ 1 - 0
doc/CHANGES.txt

@@ -19,6 +19,7 @@
 	flash : allow several -swf-lib
 	flash : allow several -swf-lib
 		no longer support automatic creation of classes for f8 swfs in f9 mode
 		no longer support automatic creation of classes for f8 swfs in f9 mode
 		classes defined in f9 swf are not redefinable in haXe code (use extern)
 		classes defined in f9 swf are not redefinable in haXe code (use extern)
+	flash9 : allow direct access and completion with classes defined in -swf-lib's
 
 
 2010-01-09: 2.05
 2010-01-09: 2.05
 	js : added js.Scroll
 	js : added js.Scroll

+ 214 - 18
genswf.ml

@@ -22,6 +22,7 @@ open As3hl
 open Genswf9
 open Genswf9
 open Type
 open Type
 open Common
 open Common
+open Ast
 
 
 (* --- MINI ZIP IMPLEMENTATION --- *)
 (* --- MINI ZIP IMPLEMENTATION --- *)
 
 
@@ -141,6 +142,201 @@ let zip_write_cdr z =
 
 
 (* ------------------------------- *)
 (* ------------------------------- *)
 
 
+let rec make_tpath = function
+	| HMPath (pack,name) ->
+		let pdyn = ref false in
+		let pack, name = match pack, name with
+			| [], "void" -> [], "Void"
+			| [], "int" -> [], "Int"
+			| [], "uint" -> [], "UInt"
+			| [], "Number" -> [], "Float"
+			| [], "Boolean" -> [], "Bool"
+			| [], "Object" | [], "Function" -> [], "Dynamic"
+			| [],"Class" | [],"Array" -> pdyn := true; pack, name
+			| _ -> pack, name
+		in
+		{
+			tpackage = pack;
+			tname = name;
+			tparams = if !pdyn then [TPType (TPNormal { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; })] else[];
+			tsub = None;
+		}
+	| HMName (id,_) ->
+		{
+			tpackage = [];
+			tname = id;
+			tparams = [];
+			tsub = None;
+		}
+	| HMMultiName (Some id,[HNPublic (Some ns)]) ->
+		{
+			tpackage = ExtString.String.nsplit ns ".";
+			tname = id;
+			tparams = [];
+			tsub = None;
+		}
+	| HMMultiName _ ->
+		assert false
+	| HMRuntimeName _ ->
+		assert false
+	| HMRuntimeNameLate ->
+		assert false
+	| HMMultiNameLate _ ->
+		assert false
+	| HMAttrib _ ->
+		assert false
+	| HMParams (t,params) ->
+		let params = List.map (fun t -> TPType (TPNormal (make_tpath t))) params in
+		{ (make_tpath t) with tparams = params }
+
+let make_topt = function
+	| None -> { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None }
+	| Some t -> make_tpath t
+
+let build_class com c file =
+	let path = make_tpath c.hlc_name in
+  (* make flags *)
+	let flags = [HExtern] in
+	let flags = if c.hlc_interface then HInterface :: flags else flags in
+	let flags = (match c.hlc_super with
+		| None | Some (HMPath ([],"Object")) -> flags
+		| Some s -> HExtends (make_tpath s) :: flags
+	) in
+	let flags = List.map (fun i -> HImplements (make_tpath i)) (Array.to_list c.hlc_implements) @ flags in
+	let flags = if c.hlc_sealed || Common.defined com "flash_strict" then flags else HImplements (make_tpath (HMPath ([],"Dynamic"))) :: flags in
+  (* make fields *)
+	let pos = { pfile = file ^ "@" ^ s_type_path (path.tpackage,path.tname); pmin = 0; pmax = 0 } in
+	let getters = Hashtbl.create 0 in
+	let setters = Hashtbl.create 0 in
+	let make_field stat acc f =
+		let flags = (match f.hlf_name with
+			| HMPath _ -> [APublic]
+			| HMName (_,ns) ->
+				(match ns with
+				| HNPrivate _ -> []
+				| HNExplicit _ | HNNamespace _ | HNInternal _ | HNPublic _ -> [APublic]
+				| HNStaticProtected _ | HNProtected _ -> [APrivate])
+			| _ -> []
+		) in
+		if flags = [] then acc else
+		let flags = if stat then AStatic :: flags else flags in
+		let name = (make_tpath f.hlf_name).tname in
+		match f.hlf_kind with
+		| HFVar v ->
+			let v = if v.hlv_const then
+				FProp (name,None,[],flags,"default","never",TPNormal (make_topt v.hlv_type))
+			else
+				FVar (name,None,[],flags,Some (TPNormal (make_topt v.hlv_type)),None)
+			in
+			v :: acc
+		| HFMethod m when not m.hlm_override ->
+			(match m.hlm_kind with
+			| MK3Normal ->
+				let t = m.hlm_type in
+				let p = ref 0 in
+				let args = List.map (fun at ->
+					let name = (match t.hlmt_pnames with
+						| None -> "p" ^ string_of_int !p
+						| Some l ->
+							match List.nth l !p with
+							| None -> "p" ^ string_of_int !p
+							| Some i -> i
+					) in
+					let opt_val = (match t.hlmt_dparams with
+						| None -> None
+						| Some l ->
+							try
+								Some (List.nth l (!p - List.length t.hlmt_args + List.length l))
+							with
+								_ -> None
+					) in
+					incr p;
+					(name,opt_val <> None,Some (TPNormal (make_topt at)),None)
+				) t.hlmt_args in
+				let f = {
+					f_args = args;
+					f_type = Some (TPNormal (make_topt t.hlmt_ret));
+					f_expr = (EBlock [],pos)
+				} in
+				FFun (name,None,[],flags,[],f) :: acc
+			| MK3Getter ->
+				Hashtbl.add getters (name,stat) m.hlm_type.hlmt_ret;
+				acc
+			| MK3Setter ->
+				Hashtbl.add setters (name,stat) (match m.hlm_type.hlmt_args with [t] -> t | _ -> assert false);
+				acc
+			)
+		| _ -> acc
+	in
+	let fields = if c.hlc_interface then [] else make_field false [] {
+		hlf_name = HMPath ([],"new");
+		hlf_slot = 0;
+		hlf_metas = None;
+		hlf_kind = HFMethod {
+			hlm_type = { c.hlc_construct with hlmt_ret = Some (HMPath ([],"void")) };
+			hlm_final = false;
+			hlm_override = false;
+			hlm_kind = MK3Normal
+		}
+	} in
+	let fields = Array.fold_left (make_field false) fields c.hlc_fields in
+	let fields = Array.fold_left (make_field true) fields c.hlc_static_fields in
+	let make_get_set name stat tget tset =
+		let get, set, t = (match tget, tset with
+			| None, None -> assert false
+			| Some t, None -> true, false, t
+			| None, Some t -> false, true, t
+			| Some t1, Some t2 -> if t1 <> t2 then assert false; true, true, t1
+		) in
+		let flags = [APublic] in
+		let flags = if stat then AStatic :: flags else flags in
+		FProp (name,None,[],flags,(if get then "default" else "never"),(if set then "default" else "never"),TPNormal (make_topt t))
+	in
+	let fields = Hashtbl.fold (fun (name,stat) t acc ->
+		make_get_set name stat (Some t) (try Some (Hashtbl.find setters (name,stat)) with Not_found -> None) :: acc
+	) getters fields in
+	let fields = Hashtbl.fold (fun (name,stat) t acc ->
+		if Hashtbl.mem getters (name,stat) then
+			acc
+		else
+			make_get_set name stat None (Some t) :: acc
+	) setters fields in
+	let class_data = {
+		d_name = path.tname;
+		d_doc = None;
+		d_params = [];
+		d_meta = [];
+		d_flags = flags;
+		d_data = List.map (fun f -> f, pos) fields;
+	} in
+	(path.tpackage, [(EClass class_data,pos)])
+
+let extract_data swf =
+	let cache = ref None in
+	(fun() ->
+		match !cache with
+		| Some h -> h
+		| None ->
+			let _, tags = swf() in
+			let h = Hashtbl.create 0 in
+			let rec loop_field f =
+				match f.hlf_kind with
+				| HFClass c ->
+					let path = make_tpath f.hlf_name in
+					Hashtbl.add h (path.tpackage,path.tname) c
+				| _ -> ()
+			in
+			List.iter (fun t ->
+				match t.tdata with
+				| TActionScript3 (_,as3) ->
+					List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
+				| _ -> ()
+			) tags;
+			cache := Some h;
+			h)
+
+(* ------------------------------- *)
+
 let tag ?(ext=false) d = {
 let tag ?(ext=false) d = {
 	tid = 0;
 	tid = 0;
 	textended = ext;
 	textended = ext;
@@ -171,13 +367,13 @@ type dependency_kind =
 	| DKExpr
 	| DKExpr
 	| DKType
 	| DKType
 
 
-let build_dependencies t = 
-	let h = ref PMap.empty in	
+let build_dependencies t =
+	let h = ref PMap.empty in
 	let add_path p k =
 	let add_path p k =
 		h := PMap.add (p,k) () !h;
 		h := PMap.add (p,k) () !h;
 	in
 	in
 	let rec add_type_rec l t =
 	let rec add_type_rec l t =
-		if List.memq t l then () else		
+		if List.memq t l then () else
 		match t with
 		match t with
 		| TEnum (e,pl) ->
 		| TEnum (e,pl) ->
 			add_path e.e_path DKType;
 			add_path e.e_path DKType;
@@ -201,7 +397,7 @@ let build_dependencies t =
 		| TType (tt,pl) ->
 		| TType (tt,pl) ->
 			add_type_rec (t::l) tt.t_type;
 			add_type_rec (t::l) tt.t_type;
 			List.iter (add_type_rec (t::l)) pl
 			List.iter (add_type_rec (t::l)) pl
-	and add_type t = 
+	and add_type t =
 		add_type_rec [] t
 		add_type_rec [] t
 	and add_expr e =
 	and add_expr e =
 		match e.eexpr with
 		match e.eexpr with
@@ -244,7 +440,7 @@ let build_dependencies t =
 		List.iter add_field c.cl_ordered_statics;
 		List.iter add_field c.cl_ordered_statics;
 		(match c.cl_constructor with
 		(match c.cl_constructor with
 		| None -> ()
 		| None -> ()
-		| Some f -> 
+		| Some f ->
 			add_field f;
 			add_field f;
 			if c.cl_path <> (["flash"],"Boot") then add_path (["flash"],"Boot") DKExpr;
 			if c.cl_path <> (["flash"],"Boot") then add_path (["flash"],"Boot") DKExpr;
 		);
 		);
@@ -313,15 +509,13 @@ let build_swc_catalog com types =
 
 
 let make_as3_public data =
 let make_as3_public data =
 	(* set all protected+private fields to public - this will enable overriding/reflection in haXe classes *)
 	(* set all protected+private fields to public - this will enable overriding/reflection in haXe classes *)
-	let ipublic = ref (-1) in
 	let ns = Array.mapi (fun i ns ->
 	let ns = Array.mapi (fun i ns ->
 		match ns with
 		match ns with
 		| A3NPrivate _
 		| A3NPrivate _
 		| A3NInternal _
 		| A3NInternal _
-		| A3NProtected _ 
+		| A3NProtected _
 		| A3NPublic None
 		| A3NPublic None
 			->
 			->
-			ipublic := i;
 			A3NPublic None
 			A3NPublic None
 		| A3NPublic _
 		| A3NPublic _
 		| A3NNamespace _
 		| A3NNamespace _
@@ -362,7 +556,7 @@ let build_swf8 com codeclip exports =
 
 
 let build_swf9 com swc =
 let build_swf9 com swc =
 	let code, genmethod = Genswf9.generate com in
 	let code, genmethod = Genswf9.generate com in
-	let code = (match swc with 
+	let code = (match swc with
 	| Some cat ->
 	| Some cat ->
 		cat := build_swc_catalog com (List.map (fun (t,_,_) -> t) code);
 		cat := build_swc_catalog com (List.map (fun (t,_,_) -> t) code);
 		List.map (fun (t,m,f) ->
 		List.map (fun (t,m,f) ->
@@ -403,6 +597,8 @@ let merge com priority (h1,tags1) (h2,tags2) =
 		| TRemoveObject2 _
 		| TRemoveObject2 _
 		| TRemoveObject _ -> use_stage
 		| TRemoveObject _ -> use_stage
 		| TShowFrame -> incr nframe; use_stage
 		| TShowFrame -> incr nframe; use_stage
+		(* patch : this class has a public method which redefines a private one ! *)
+		| TActionScript3 (Some (_,"org/papervision3d/render/QuadrantRenderEngine"),_) -> false
 		| TFilesAttributes _ | TEnableDebugger2 _ | TF9Scene _ -> false
 		| TFilesAttributes _ | TEnableDebugger2 _ | TF9Scene _ -> false
 		| TSetBgColor _ -> priority
 		| TSetBgColor _ -> priority
 		| TF9Classes el ->
 		| TF9Classes el ->
@@ -432,15 +628,15 @@ let merge com priority (h1,tags1) (h2,tags2) =
   (* merge timelines *)
   (* merge timelines *)
 	let rec loop l1 l2 =
 	let rec loop l1 l2 =
 		match l1, l2 with
 		match l1, l2 with
-		| ({ tdata = TSetBgColor _ } as t) :: l1, _ 
-		| ({ tdata = TEnableDebugger2 _ } as t) :: l1, _ 
+		| ({ tdata = TSetBgColor _ } as t) :: l1, _
+		| ({ tdata = TEnableDebugger2 _ } as t) :: l1, _
 		| ({ tdata = TFilesAttributes _ } as t) :: l1, _ ->
 		| ({ tdata = TFilesAttributes _ } as t) :: l1, _ ->
 			t :: loop l1 l2
 			t :: loop l1 l2
 		| _, ({ tdata = TSetBgColor _ } as t) :: l2 ->
 		| _, ({ tdata = TSetBgColor _ } as t) :: l2 ->
 			t :: loop l1 l2
 			t :: loop l1 l2
 		| { tdata = TShowFrame } :: l1, { tdata = TShowFrame } :: l2 ->
 		| { tdata = TShowFrame } :: l1, { tdata = TShowFrame } :: l2 ->
 			tag TShowFrame :: loop l1 l2
 			tag TShowFrame :: loop l1 l2
-		| { tdata = TShowFrame } :: _, x :: l2 -> 
+		| { tdata = TShowFrame } :: _, x :: l2 ->
 			(* wait until we finish frame on other swf *)
 			(* wait until we finish frame on other swf *)
 			x :: loop l1 l2
 			x :: loop l1 l2
 		| { tdata = TF9Classes el } :: l1, _ ->
 		| { tdata = TF9Classes el } :: l1, _ ->
@@ -448,7 +644,7 @@ let merge com priority (h1,tags1) (h2,tags2) =
 			tag (TF9Classes (classes @ el)) :: loop l1 l2
 			tag (TF9Classes (classes @ el)) :: loop l1 l2
 		| _ , x :: l2 ->
 		| _ , x :: l2 ->
 			x :: loop l1 l2
 			x :: loop l1 l2
-		| x :: l1, [] -> 
+		| x :: l1, [] ->
 			x :: loop l1 l2
 			x :: loop l1 l2
 		| [], [] ->
 		| [], [] ->
 			[]
 			[]
@@ -456,7 +652,7 @@ let merge com priority (h1,tags1) (h2,tags2) =
 	let tags = loop tags1 tags2 in
 	let tags = loop tags1 tags2 in
 	header, tags
 	header, tags
 
 
-let generate com swf_header swf_libs =
+let generate com swf_header =
 	let t = Common.timer "generate swf" in
 	let t = Common.timer "generate swf" in
 	let isf9 = com.flash_version >= 9 in
 	let isf9 = com.flash_version >= 9 in
 	let swc = if Common.defined com "swc" then Some (ref "") else None in
 	let swc = if Common.defined com "swc" then Some (ref "") else None in
@@ -464,14 +660,14 @@ let generate com swf_header swf_libs =
 	let file , codeclip = (try let f , c = ExtString.String.split com.file "@" in f, Some c with _ -> com.file , None) in
 	let file , codeclip = (try let f , c = ExtString.String.split com.file "@" in f, Some c with _ -> com.file , None) in
   (* list exports *)
   (* list exports *)
 	let exports = Hashtbl.create 0 in
 	let exports = Hashtbl.create 0 in
-	List.iter (fun lib ->
+	List.iter (fun (lib,_) ->
 		let _, tags = lib() in
 		let _, tags = lib() in
 		List.iter (fun t ->
 		List.iter (fun t ->
 			match t.tdata with
 			match t.tdata with
 			| TExport l -> List.iter (fun e -> Hashtbl.add exports e.exp_name ()) l
 			| TExport l -> List.iter (fun e -> Hashtbl.add exports e.exp_name ()) l
 			| _ -> ()
 			| _ -> ()
 		) tags;
 		) tags;
-	) swf_libs;
+	) com.swf_libs;
   (* build haxe swf *)
   (* build haxe swf *)
 	let tags = if isf9 then build_swf9 com swc else build_swf8 com codeclip exports in
 	let tags = if isf9 then build_swf9 com swc else build_swf8 com codeclip exports in
 	let header, bg = (match swf_header with None -> default_header com | Some h -> convert_header com h) in
 	let header, bg = (match swf_header with None -> default_header com | Some h -> convert_header com h) in
@@ -489,11 +685,11 @@ let generate com swf_header swf_libs =
 	let swf = header, fattr @ bg :: debug @ tags @ [tag TShowFrame] in
 	let swf = header, fattr @ bg :: debug @ tags @ [tag TShowFrame] in
   (* merge swf libraries *)
   (* merge swf libraries *)
 	let priority = ref (swf_header = None) in
 	let priority = ref (swf_header = None) in
-	let swf = List.fold_left (fun swf lib ->
+	let swf = List.fold_left (fun swf (lib,_) ->
 		let swf = merge com !priority swf (lib()) in
 		let swf = merge com !priority swf (lib()) in
 		priority := false;
 		priority := false;
 		swf
 		swf
-	) swf swf_libs in
+	) swf com.swf_libs in
 	t();
 	t();
   (* write swf/swc *)
   (* write swf/swc *)
 	let t = Common.timer "write swf" in
 	let t = Common.timer "write swf" in

+ 24 - 10
main.ml

@@ -140,6 +140,18 @@ let rec read_type_path com p =
 			end;
 			end;
 		) r;
 		) r;
 	) com.class_path;
 	) com.class_path;
+	List.iter (fun (_,extract) ->
+		Hashtbl.iter (fun (path,name) _ ->
+			if path = p then classes := name :: !classes else
+			let rec loop p1 p2 =
+				match p1, p2 with
+				| [], _ -> ()
+				| x :: _, [] -> packages := x :: !packages
+				| a :: p1, b :: p2 -> if a = b then loop p1 p2
+			in
+			loop path p
+		) (extract());
+	) com.swf_libs;
 	let rec unique = function
 	let rec unique = function
 		| [] -> []
 		| [] -> []
 		| x1 :: x2 :: l when x1 = x2 -> unique (x2 :: l)
 		| x1 :: x2 :: l when x1 = x2 -> unique (x2 :: l)
@@ -197,7 +209,6 @@ and init params =
 try
 try
 	let xml_out = ref None in
 	let xml_out = ref None in
 	let swf_header = ref None in
 	let swf_header = ref None in
-	let swf_libs = ref [] in
 	let cmds = ref [] in
 	let cmds = ref [] in
 	let excludes = ref [] in
 	let excludes = ref [] in
 	let libs = ref [] in
 	let libs = ref [] in
@@ -327,7 +338,7 @@ try
 			let getSWF() =
 			let getSWF() =
 				match !data with
 				match !data with
 				| Some swf -> swf
 				| Some swf -> swf
-				| None -> 
+				| None ->
 					let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
 					let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
 					let ch = IO.input_channel (open_in_bin file) in
 					let ch = IO.input_channel (open_in_bin file) in
 					let swf = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
 					let swf = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
@@ -335,7 +346,10 @@ try
 					data := Some swf;
 					data := Some swf;
 					swf
 					swf
 			in
 			in
-			swf_libs := getSWF :: !swf_libs
+			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];
+			com.swf_libs <- (getSWF,extract) :: com.swf_libs
 		),"<file> : add the SWF library to the compiled SWF");
 		),"<file> : add the SWF library to the compiled SWF");
 		("-x", Arg.String (fun file ->
 		("-x", Arg.String (fun file ->
 			let neko_file = file ^ ".n" in
 			let neko_file = file ^ ".n" in
@@ -354,11 +368,11 @@ try
 				| _ -> raise (Arg.Bad "Invalid Resource format : should be file@name")
 				| _ -> raise (Arg.Bad "Invalid Resource format : should be file@name")
 			) in
 			) in
 			let file = (try Common.find_file com file with Not_found -> file) in
 			let file = (try Common.find_file com file with Not_found -> file) in
-			let data = (try 
+			let data = (try
 				let s = Std.input_file ~bin:true file in
 				let s = Std.input_file ~bin:true file in
 				if String.length s > 12000000 then raise Exit;
 				if String.length s > 12000000 then raise Exit;
 				s;
 				s;
-			with 
+			with
 				| Sys_error _ -> failwith ("Resource file not found : " ^ file)
 				| Sys_error _ -> failwith ("Resource file not found : " ^ file)
 				| _ -> failwith ("Resource '" ^ file ^ "' excess the maximum size of 12MB")
 				| _ -> failwith ("Resource '" ^ file ^ "' excess the maximum size of 12MB")
 			) in
 			) in
@@ -413,7 +427,7 @@ try
 		("--no-output", Arg.Unit (fun() -> no_output := true),": compiles but does not generate any file");
 		("--no-output", Arg.Unit (fun() -> no_output := true),": compiles but does not generate any file");
 		("--times", Arg.Unit (fun() -> measure_times := true),": measure compilation times");
 		("--times", Arg.Unit (fun() -> measure_times := true),": measure compilation times");
 		("--no-inline", define "no_inline", ": disable inlining");
 		("--no-inline", define "no_inline", ": disable inlining");
-		("--no-opt", Arg.Unit (fun() -> 
+		("--no-opt", Arg.Unit (fun() ->
 			com.foptimize <- false;
 			com.foptimize <- false;
 			Common.define com "no_opt";
 			Common.define com "no_opt";
 		), ": disable code optimizations");
 		), ": disable code optimizations");
@@ -524,7 +538,7 @@ try
 			Genas3.generate com;
 			Genas3.generate com;
 		| Flash | Flash9 ->
 		| Flash | Flash9 ->
 			if com.verbose then print_endline ("Generating swf : " ^ com.file);
 			if com.verbose then print_endline ("Generating swf : " ^ com.file);
-			Genswf.generate com !swf_header (List.rev !swf_libs);
+			Genswf.generate com !swf_header;
 		| Neko ->
 		| Neko ->
 			if com.verbose then print_endline ("Generating neko : " ^ com.file);
 			if com.verbose then print_endline ("Generating neko : " ^ com.file);
 			Genneko.generate com !libs;
 			Genneko.generate com !libs;
@@ -582,16 +596,16 @@ with
 		exit 0;
 		exit 0;
 	| Parser.TypePath (p,c) ->
 	| Parser.TypePath (p,c) ->
 		(match c with
 		(match c with
-		| None -> 
+		| None ->
 			let packs, classes = read_type_path com p in
 			let packs, classes = read_type_path com p in
 			if packs = [] && classes = [] then report ("No classes found in " ^ String.concat "." p) Ast.null_pos;
 			if packs = [] && classes = [] then report ("No classes found in " ^ String.concat "." p) Ast.null_pos;
 			report_list (List.map (fun f -> f,"","") (packs @ classes))
 			report_list (List.map (fun f -> f,"","") (packs @ classes))
 		| Some c ->
 		| Some c ->
-			try 
+			try
 				let ctx = Typer.create com in
 				let ctx = Typer.create com in
 				let m = Typeload.load_module ctx (p,c) Ast.null_pos in
 				let m = Typeload.load_module ctx (p,c) Ast.null_pos in
 				report_list (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_private t)) m.Type.mtypes))
 				report_list (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_private t)) m.Type.mtypes))
-			with _ -> 
+			with _ ->
 				report ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos
 				report ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos
 		);
 		);
 		exit 0;
 		exit 0;

+ 25 - 17
typeload.ml

@@ -55,7 +55,7 @@ let type_static_var ctx t e p =
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
 
 
 (*
 (*
-	load a type or a subtype definition 
+	load a type or a subtype definition
 *)
 *)
 let rec load_type_def ctx p t =
 let rec load_type_def ctx p t =
 	let no_pack = t.tpackage = [] in
 	let no_pack = t.tpackage = [] in
@@ -87,7 +87,7 @@ let rec load_type_def ctx p t =
 						(match PMap.find x ctx.com.package_rules with
 						(match PMap.find x ctx.com.package_rules with
 						| Forbidden -> raise Exit
 						| Forbidden -> raise Exit
 						| _ -> ())
 						| _ -> ())
-					with Not_found -> ());				
+					with Not_found -> ());
 				load_type_def ctx p { t with tpackage = fst ctx.current.mpath }
 				load_type_def ctx p { t with tpackage = fst ctx.current.mpath }
 			with
 			with
 				| Error (Module_not_found _,p2)
 				| Error (Module_not_found _,p2)
@@ -349,7 +349,7 @@ let rec check_interface ctx c p intf params =
 			else if not (unify_access f2.cf_get f.cf_get) then
 			else if not (unify_access f2.cf_get f.cf_get) then
 				display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_access f2.cf_get ^ " should be " ^ s_access f.cf_get ^ ")") p
 				display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_access f2.cf_get ^ " should be " ^ s_access f.cf_get ^ ")") p
 			else if not (unify_access f2.cf_set f.cf_set) then
 			else if not (unify_access f2.cf_set f.cf_set) then
-				display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_access f2.cf_set ^ " should be " ^ s_access f.cf_set ^ ")") p			
+				display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_access f2.cf_set ^ " should be " ^ s_access f.cf_set ^ ")") p
 			else try
 			else try
 				valid_redefinition ctx f2 t2 f (apply_params intf.cl_types params f.cf_type)
 				valid_redefinition ctx f2 t2 f (apply_params intf.cl_types params f.cf_type)
 			with
 			with
@@ -476,10 +476,10 @@ let type_type_params ctx path p (n,flags) =
 
 
 let type_function ctx args ret static constr f p =
 let type_function ctx args ret static constr f p =
 	let locals = save_locals ctx in
 	let locals = save_locals ctx in
-	let fargs = List.map (fun (n,c,t) -> 
-		let c = (match c with 
+	let fargs = List.map (fun (n,c,t) ->
+		let c = (match c with
 			| None -> None
 			| None -> None
-			| Some e -> 
+			| Some e ->
 				let p = pos e in
 				let p = pos e in
 				let e = ctx.api.optimize (type_expr ctx e true) in
 				let e = ctx.api.optimize (type_expr ctx e true) in
 				unify ctx e.etype t p;
 				unify ctx e.etype t p;
@@ -532,7 +532,7 @@ let type_function ctx args ret static constr f p =
 
 
 let type_meta ctx meta =
 let type_meta ctx meta =
 	let notconst p = error "Metadata should be constant" p in
 	let notconst p = error "Metadata should be constant" p in
-	let rec mk_const (e,p) = 
+	let rec mk_const (e,p) =
 		match e with
 		match e with
 		| EConst c ->
 		| EConst c ->
 			(match c with
 			(match c with
@@ -695,7 +695,7 @@ let init_class ctx c p herits fields =
 					tf_type = ret;
 					tf_type = ret;
 					tf_expr = e;
 					tf_expr = e;
 				} in
 				} in
-				if stat && name = "__init__" then 
+				if stat && name = "__init__" then
 					(match e.eexpr with
 					(match e.eexpr with
 					| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
 					| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
 					| _ -> c.cl_init <- Some e);
 					| _ -> c.cl_init <- Some e);
@@ -803,10 +803,10 @@ let init_class ctx c p herits fields =
 					let esuper = (ECall ((EConst (Ident "super"),p),List.map (fun (n,_,_,_) -> (EConst (Ident n),p)) f.f_args),p) in
 					let esuper = (ECall ((EConst (Ident "super"),p),List.map (fun (n,_,_,_) -> (EConst (Ident n),p)) f.f_args),p) in
 					let acc = (if csuper.cl_extern && acc = [] then [APublic] else acc) in
 					let acc = (if csuper.cl_extern && acc = [] then [APublic] else acc) in
 					let fnew = { f with f_expr = esuper; f_args = List.map (fun (a,opt,t,def) ->
 					let fnew = { f with f_expr = esuper; f_args = List.map (fun (a,opt,t,def) ->
-						(* 
+						(*
 							we are removing the type and letting the type inference
 							we are removing the type and letting the type inference
 							work because the current package is not the same as the superclass one
 							work because the current package is not the same as the superclass one
-							or there might be private and/or imported types 
+							or there might be private and/or imported types
 
 
 							if we are an extern class then we need a type
 							if we are an extern class then we need a type
 							if the type is Dynamic also because it would not propagate
 							if the type is Dynamic also because it would not propagate
@@ -871,7 +871,7 @@ let type_module ctx m tdecls loadp =
 			Not_found ->
 			Not_found ->
 				Hashtbl.add ctx.types_module tpath m;
 				Hashtbl.add ctx.types_module tpath m;
 				tpath
 				tpath
-	in	
+	in
 	List.iter (fun (d,p) ->
 	List.iter (fun (d,p) ->
 		match d with
 		match d with
 		| EImport _ | EUsing _ -> ()
 		| EImport _ | EUsing _ -> ()
@@ -1017,7 +1017,7 @@ let type_module ctx m tdecls loadp =
 					| [] -> et
 					| [] -> et
 					| l ->
 					| l ->
 						let pnames = ref PMap.empty in
 						let pnames = ref PMap.empty in
-						TFun (List.map (fun (s,opt,t) -> 
+						TFun (List.map (fun (s,opt,t) ->
 							if PMap.mem s (!pnames) then error ("Duplicate parameter '" ^ s ^ "' in enum constructor " ^ c) p;
 							if PMap.mem s (!pnames) then error ("Duplicate parameter '" ^ s ^ "' in enum constructor " ^ c) p;
 							pnames := PMap.add s () (!pnames);
 							pnames := PMap.add s () (!pnames);
 							s, opt, load_type_opt ~opt ctx p (Some t)
 							s, opt, load_type_opt ~opt ctx p (Some t)
@@ -1049,7 +1049,7 @@ let type_module ctx m tdecls loadp =
 			| _ -> assert false);
 			| _ -> assert false);
 	) tdecls;
 	) tdecls;
 	(* PASS 3 : type checking, delayed until all modules and types are built *)
 	(* PASS 3 : type checking, delayed until all modules and types are built *)
-	ctx.delays := !delays :: !(ctx.delays);	
+	ctx.delays := !delays :: !(ctx.delays);
 	m
 	m
 
 
 let parse_module ctx m p =
 let parse_module ctx m p =
@@ -1066,7 +1066,7 @@ let parse_module ctx m p =
 			) in
 			) in
 			String.concat "/" (x :: l) ^ "/" ^ name
 			String.concat "/" (x :: l) ^ "/" ^ name
 	) ^ ".hx" in
 	) ^ ".hx" in
-	let file = (try Common.find_file ctx.com file with Not_found -> raise (Error (Module_not_found m,p))) in
+	let file = Common.find_file ctx.com file in
 	let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
 	let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
 	let t = Common.timer "parsing" in
 	let t = Common.timer "parsing" in
 	let pack , decls = (try Parser.parse ctx.com (Lexing.from_channel ch) file with e -> close_in ch; t(); raise e) in
 	let pack , decls = (try Parser.parse ctx.com (Lexing.from_channel ch) file with e -> close_in ch; t(); raise e) in
@@ -1085,13 +1085,13 @@ let parse_module ctx m p =
 		List.rev (List.fold_left (fun acc (t,p) ->
 		List.rev (List.fold_left (fun acc (t,p) ->
 			let build f d =
 			let build f d =
 				let priv = List.mem f d.d_flags in
 				let priv = List.mem f d.d_flags in
-				(ETypedef { 
+				(ETypedef {
 					d_name = d.d_name;
 					d_name = d.d_name;
 					d_doc = None;
 					d_doc = None;
 					d_meta = [];
 					d_meta = [];
 					d_params = d.d_params;
 					d_params = d.d_params;
 					d_flags = if priv then [EPrivate] else [];
 					d_flags = if priv then [EPrivate] else [];
-					d_data = TPNormal (if priv then { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } else 
+					d_data = TPNormal (if priv then { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } else
 						{
 						{
 							tpackage = !remap;
 							tpackage = !remap;
 							tname = d.d_name;
 							tname = d.d_name;
@@ -1116,5 +1116,13 @@ let load_module ctx m p =
 		Hashtbl.find ctx.modules m
 		Hashtbl.find ctx.modules m
 	with
 	with
 		Not_found ->
 		Not_found ->
-			let decls = parse_module ctx m p in
+			let decls = (try
+				parse_module ctx m p
+			with Not_found ->
+				let rec loop = function
+					| [] -> raise (Error (Module_not_found m,p))
+					| load :: l -> try snd (load m p) with Not_found -> loop l
+				in
+				loop ctx.api.load_extern_type
+			) in
 			type_module ctx m decls p
 			type_module ctx m decls p