Browse Source

SWC support is now working

Nicolas Cannasse 16 years ago
parent
commit
eb5736a3b8
3 changed files with 152 additions and 54 deletions
  1. 105 7
      genswf.ml
  2. 46 42
      genswf9.ml
  3. 1 5
      std/Std.hx

+ 105 - 7
genswf.ml

@@ -286,6 +286,92 @@ let add_as3_code ctx data types =
 let add_as3_clips ctx cl =
 let add_as3_clips ctx cl =
 	ctx.f9clips <- List.filter (fun c -> c.f9_cid <> None) cl @ ctx.f9clips
 	ctx.f9clips <- List.filter (fun c -> c.f9_cid <> None) cl @ ctx.f9clips
 
 
+type dependency_kind =
+	| DKInherit
+	| DKExpr
+	| DKType
+
+let build_dependencies t = 
+	let h = ref PMap.empty in	
+	let add_path p k =
+		h := PMap.add (p,k) () !h;
+	in
+	let rec add_type t =
+		match follow t with
+		| TEnum (e,pl) ->
+			add_path e.e_path DKType;
+			List.iter add_type pl;
+		| TInst (c,pl) ->
+			add_path c.cl_path DKType;
+			List.iter add_type pl;
+		| TFun (pl,t) ->
+			List.iter (fun (_,_,t) -> add_type t) pl;
+			add_type t;
+		| TAnon a ->
+			PMap.iter (fun _ f -> add_type f.cf_type) a.a_fields
+		| TDynamic t2 ->
+			if t2 != t then add_type t2;
+		| _ ->
+			()
+	and add_expr e =
+		match e.eexpr with
+		| TTypeExpr t -> add_path (Type.t_path t) DKExpr
+		| TEnumField (e,_) -> add_path e.e_path DKExpr
+		| TNew (c,pl,el) ->
+			add_path c.cl_path DKExpr;
+			List.iter add_type pl;
+			List.iter add_expr el;
+		| TFunction f ->
+			List.iter (fun (_,_,t) -> add_type t) f.tf_args;
+			add_type f.tf_type;
+			add_expr f.tf_expr;
+		| TFor (_,t,e1,e2) ->
+			add_type t;
+			add_expr e1;
+			add_expr e2;
+		| TVars vl ->
+			List.iter (fun (_,t,e) ->
+				add_type t;
+				match e with
+				| None -> ()
+				| Some e -> add_expr e
+			) vl
+		| _ ->
+			Type.iter add_expr e
+	and add_field f =
+		add_type f.cf_type;
+		match f.cf_expr with
+		| None -> ()
+		| Some e -> add_expr e
+	in
+	let add_inherit (c,pl) =
+		add_path c.cl_path DKInherit;
+		List.iter add_type pl;
+	in
+	(match t with
+	| TClassDecl c when not c.cl_extern ->
+		List.iter add_field c.cl_ordered_fields;
+		List.iter add_field c.cl_ordered_statics;
+		(match c.cl_constructor with
+		| None -> ()
+		| Some f -> 
+			add_field f;
+			if c.cl_path <> (["flash"],"Boot") then add_path (["flash"],"Boot") DKExpr;
+		);
+		(match c.cl_init with
+		| None -> ()
+		| Some e -> add_expr e);
+		(match c.cl_super with
+		| None -> add_path ([],"Object") DKInherit;
+		| Some x -> add_inherit x);
+		List.iter add_inherit c.cl_implements;
+	| TEnumDecl e when not e.e_extern ->
+		PMap.iter (fun _ f -> add_type f.ef_type) e.e_constrs;
+	| _ -> ());
+	h := PMap.remove (([],"Int"),DKType) (!h);
+	h := PMap.remove (([],"Int"),DKExpr) (!h);
+	PMap.foldi (fun (c,k) () acc -> (c,k) :: acc) (!h) []
+
 let build_swc_catalog com types =
 let build_swc_catalog com types =
 	let node x att l =
 	let node x att l =
 		Xml.Element (x,att,l)
 		Xml.Element (x,att,l)
@@ -294,12 +380,24 @@ let build_swc_catalog com types =
 		let path, name = t_path t in
 		let path, name = t_path t in
 		String.concat sep (path @ [name])
 		String.concat sep (path @ [name])
 	in
 	in
+	let make_id path =
+		match Genswf9.real_path path with
+		| [],n -> n
+		| l,n -> (String.concat "." l) ^ ":" ^ n
+	in
 	let build_script t =
 	let build_script t =
-		node "script" [("name",make_path t "/");("mod","0")] [
-			node "def" ["id",make_path t ":"] [];
-			node "def" [("id","AS3");("type","n")] [];
-			node "def" [("id","Object");("type","i")] [];
-		]
+		let deps = build_dependencies t in
+		node "script" [("name",make_path t "/");("mod","0")] ([
+			node "def" ["id",make_id (t_path t)] [];
+			node "dep" [("id","AS3");("type","n")] [];
+		] @ List.map (fun (p,k) ->
+			let t = (match k with
+				| DKInherit -> "i"
+				| DKExpr -> (match p with "flash" :: _ :: _ , _ -> "i" | _ -> "e")
+				| DKType -> "s"
+			) in
+			node "dep" [("id",make_id p);("type",t)] []
+		) deps)
 	in
 	in
 	let x = node "swc" ["xmlns","http://www.adobe.com/flash/swccatalog/9"] [
 	let x = node "swc" ["xmlns","http://www.adobe.com/flash/swccatalog/9"] [
 		node "versions" [] [
 		node "versions" [] [
@@ -331,8 +429,8 @@ let generate com swf_header swf_lib =
 		swc_catalog = "";
 		swc_catalog = "";
 	} in
 	} in
 	if isf9 then begin
 	if isf9 then begin
-		let code, boot, m = Genswf9.generate com in
-		ctx.f9clips <- [{ f9_cid = None; f9_classname = boot }];
+		let code, m = Genswf9.generate com in
+		ctx.f9clips <- [{ f9_cid = None; f9_classname = "flash.Boot" }];
 		ctx.hx9code <- code;
 		ctx.hx9code <- code;
 		ctx.genmethod <- m;
 		ctx.genmethod <- m;
 	end else begin
 	end else begin

+ 46 - 42
genswf9.ml

@@ -77,9 +77,9 @@ type context = {
 	(* globals *)
 	(* globals *)
 	com : Common.context;
 	com : Common.context;
 	debugger : bool;
 	debugger : bool;
+	swc : bool;
 	mutable last_line : int;
 	mutable last_line : int;
 	mutable last_file : string;
 	mutable last_file : string;
-	boot : string;
 	(* per-function *)
 	(* per-function *)
 	mutable locals : (string,local) PMap.t;
 	mutable locals : (string,local) PMap.t;
 	mutable code : hl_opcode DynArray.t;
 	mutable code : hl_opcode DynArray.t;
@@ -151,23 +151,23 @@ let jump_back ctx =
 		write ctx (HJump (cond,delta))
 		write ctx (HJump (cond,delta))
 	)
 	)
 
 
+let real_path = function
+	| [] , "Int" -> [] , "int"
+	| [] , "UInt" -> [] , "uint"
+	| [] , "Float" -> [] , "Number"
+	| [] , "Bool" -> [] , "Boolean"
+	| [] , "Enum" -> [] , "Class"
+	| ["flash";"xml"], "XML" -> [], "XML"
+	| ["flash";"xml"], "XMLList" -> [], "XMLList"
+	| ["flash";"utils"], "QName" -> [] , "QName"
+	| ["flash";"utils"], "Namespace" -> [] , "Namespace"
+	| ["flash"] , "FlashXml__" -> [] , "Xml"
+	| ["flash"] , "Error" -> [], "Error"
+	| ["flash"] , "Vector" -> ["__AS3__";"vec"], "Vector"
+	| path -> path
+	
 let type_path ctx path =
 let type_path ctx path =
-	let pack, name = (match path with
-		| [] , "Int" -> [] , "int"
-		| [] , "UInt" -> [] , "uint"
-		| [] , "Float" -> [] , "Number"
-		| [] , "Bool" -> [] , "Boolean"
-		| [] , "Enum" -> [] , "Class"
-		| ["flash";"xml"], "XML" -> [], "XML"
-		| ["flash";"xml"], "XMLList" -> [], "XMLList"
-		| ["flash";"utils"], "QName" -> [] , "QName"
-		| ["flash";"utils"], "Namespace" -> [] , "Namespace"
-		| ["flash"] , "FlashXml__" -> [] , "Xml"
-		| ["flash"] , "Boot" -> [] , ctx.boot
-		| ["flash"] , "Error" -> [], "Error"
-		| ["flash"] , "Vector" -> ["__AS3__";"vec"], "Vector"
-		| _ -> path
-	) in
+	let pack, name = real_path path in
 	HMPath (pack,name)
 	HMPath (pack,name)
 
 
 let rec follow_basic t =
 let rec follow_basic t =
@@ -260,7 +260,11 @@ let classify ctx t =
 	| TLazy _ ->
 	| TLazy _ ->
 		assert false
 		assert false
 
 
-let ident i = HMPath ([],i)
+let ident i =
+	(* some field identifiers might cause issues with SWC *)
+	match i with
+	| "int" -> HMPath ([],"_" ^ i)
+	| _ -> HMPath ([],i)
 
 
 let as3 p =
 let as3 p =
 	HMName (p,HNNamespace "http://adobe.com/AS3/2006/builtin")
 	HMName (p,HNNamespace "http://adobe.com/AS3/2006/builtin")
@@ -826,7 +830,7 @@ let rec gen_expr_content ctx retval e =
 		gen_constant ctx c e.etype e.epos
 		gen_constant ctx c e.etype e.epos
 	| TThrow e ->
 	| TThrow e ->
 		ctx.infos.icond <- true;
 		ctx.infos.icond <- true;
-		getvar ctx (VGlobal (type_path ctx ([],ctx.boot)));
+		getvar ctx (VGlobal (type_path ctx (["flash"],"Boot")));
 		let id = type_path ctx (["flash"],"Error") in
 		let id = type_path ctx (["flash"],"Error") in
 		write ctx (HFindPropStrict id);
 		write ctx (HFindPropStrict id);
 		write ctx (HConstructProperty (id,0));
 		write ctx (HConstructProperty (id,0));
@@ -990,7 +994,7 @@ let rec gen_expr_content ctx retval e =
 					getvar ctx (gen_local_access ctx ename e.epos Read);
 					getvar ctx (gen_local_access ctx ename e.epos Read);
 					write ctx (HAsType (type_path ctx (["flash"],"Error")));
 					write ctx (HAsType (type_path ctx (["flash"],"Error")));
 					let j = jump ctx J3False in
 					let j = jump ctx J3False in
-					getvar ctx (VGlobal (type_path ctx ([],ctx.boot)));
+					getvar ctx (VGlobal (type_path ctx (["flash"],"Boot")));
 					getvar ctx (gen_local_access ctx ename e.epos Read);
 					getvar ctx (gen_local_access ctx ename e.epos Read);
 					setvar ctx (VId (ident "lastError")) false;
 					setvar ctx (VId (ident "lastError")) false;
 					j();
 					j();
@@ -1239,7 +1243,7 @@ and gen_call ctx retval e el r =
 		gen_expr ctx true f;
 		gen_expr ctx true f;
 		write ctx (HDeleteProp dynamic_prop);
 		write ctx (HDeleteProp dynamic_prop);
 	| TLocal "__unprotect__" , [e] ->
 	| TLocal "__unprotect__" , [e] ->
-		write ctx (HGetLex (type_path ctx ([],ctx.boot)));
+		write ctx (HGetLex (type_path ctx (["flash"],"Boot")));
 		gen_expr ctx true e;
 		gen_expr ctx true e;
 		write ctx (HCallProperty (ident "__unprotect__",1));
 		write ctx (HCallProperty (ident "__unprotect__",1));
 	| TLocal "__typeof__", [e] ->
 	| TLocal "__typeof__", [e] ->
@@ -1556,7 +1560,7 @@ let generate_construct ctx fdata c =
 	| KGenericInstance _ -> ()
 	| KGenericInstance _ -> ()
 	| _ ->
 	| _ ->
 		let id = ident "skip_constructor" in
 		let id = ident "skip_constructor" in
-		getvar ctx (VGlobal (type_path ctx ([],ctx.boot)));
+		getvar ctx (VGlobal (type_path ctx (["flash"],"Boot")));
 		getvar ctx (VId id);
 		getvar ctx (VId id);
 		let j = jump ctx J3False in
 		let j = jump ctx J3False in
 		write ctx HRetVoid;
 		write ctx HRetVoid;
@@ -1576,6 +1580,17 @@ let generate_construct ctx fdata c =
 	write ctx HRetVoid;
 	write ctx HRetVoid;
 	f() , List.length fdata.tf_args
 	f() , List.length fdata.tf_args
 
 
+let generate_class_statics ctx c =
+	List.iter (fun f ->
+		match f.cf_expr with
+		| None -> ()
+		| Some { eexpr = TFunction _ } -> ()
+		| Some e ->
+			write ctx (HGetLex (type_path ctx c.cl_path));
+			gen_expr ctx true e;
+			write ctx (HInitProp (ident f.cf_name));
+	) c.cl_ordered_statics
+
 let generate_class_init ctx c hc =
 let generate_class_init ctx c hc =
 	write ctx HGetGlobalScope;
 	write ctx HGetGlobalScope;
 	if c.cl_interface then
 	if c.cl_interface then
@@ -1596,18 +1611,8 @@ let generate_class_init ctx c hc =
 		| _ -> ()
 		| _ -> ()
 	) c.cl_ordered_statics;
 	) c.cl_ordered_statics;
 	if not c.cl_interface then write ctx HPopScope;
 	if not c.cl_interface then write ctx HPopScope;
-	write ctx (HInitProp (type_path ctx c.cl_path))
-
-let generate_class_statics ctx c =
-	List.iter (fun f ->
-		match f.cf_expr with
-		| None -> ()
-		| Some { eexpr = TFunction _ } -> ()
-		| Some e ->
-			write ctx (HGetLex (type_path ctx c.cl_path));
-			gen_expr ctx true e;
-			write ctx (HInitProp (ident f.cf_name));
-	) c.cl_ordered_statics
+	write ctx (HInitProp (type_path ctx c.cl_path));
+	if ctx.swc then generate_class_statics ctx c
 
 
 let generate_enum_init ctx e hc =
 let generate_enum_init ctx e hc =
 	let path = ([],"Object") in
 	let path = ([],"Object") in
@@ -1734,7 +1739,8 @@ let generate_class ctx c =
 		hlc_namespace = None;
 		hlc_namespace = None;
 		hlc_implements = Array.of_list (List.map (fun (c,_) ->
 		hlc_implements = Array.of_list (List.map (fun (c,_) ->
 			if not c.cl_interface then error "Can't implement class in Flash9" c.cl_pos;
 			if not c.cl_interface then error "Can't implement class in Flash9" c.cl_pos;
-			type_path ctx c.cl_path
+			let pack, name = real_path c.cl_path in
+			HMMultiName (Some name,[HNPublic (Some (String.concat "." pack))])
 		) c.cl_implements);
 		) c.cl_implements);
 		hlc_construct = cid;
 		hlc_construct = cid;
 		hlc_fields = fields;
 		hlc_fields = fields;
@@ -1770,7 +1776,7 @@ let generate_enum ctx e =
 	write ctx HRetVoid;
 	write ctx HRetVoid;
 	let construct = f() in
 	let construct = f() in
 	let f = begin_fun ctx [] t_string [] true e.e_pos in
 	let f = begin_fun ctx [] t_string [] true e.e_pos in
-	write ctx (HGetLex (type_path ctx ([],ctx.boot)));
+	write ctx (HGetLex (type_path ctx (["flash"],"Boot")));
 	write ctx HThis;
 	write ctx HThis;
 	write ctx (HCallProperty (ident "enum_to_string",1));
 	write ctx (HCallProperty (ident "enum_to_string",1));
 	write ctx HRet;
 	write ctx HRet;
@@ -1850,7 +1856,7 @@ let generate_enum ctx e =
 let generate_inits ctx =
 let generate_inits ctx =
 	(* define flash.Boot.init method *)
 	(* define flash.Boot.init method *)
 	write ctx HGetGlobalScope;
 	write ctx HGetGlobalScope;
-	write ctx (HGetProp (type_path ctx ([],ctx.boot)));
+	write ctx (HGetProp (type_path ctx (["flash"],"Boot")));
 	let finit = begin_fun ctx [] t_void [] true null_pos in
 	let finit = begin_fun ctx [] t_void [] true null_pos in
 	List.iter (fun t ->
 	List.iter (fun t ->
 		match t with
 		match t with
@@ -1860,7 +1866,7 @@ let generate_inits ctx =
 			| Some e -> gen_expr ctx false e);
 			| Some e -> gen_expr ctx false e);
 		| _ -> ()
 		| _ -> ()
 	) ctx.com.types;
 	) ctx.com.types;
-	List.iter (fun t ->
+	if not ctx.swc then List.iter (fun t ->
 		match t with
 		match t with
 		| TClassDecl { cl_extern = true; cl_path = "flash" :: _ , _ } -> ()
 		| TClassDecl { cl_extern = true; cl_path = "flash" :: _ , _ } -> ()
 		| TClassDecl c -> generate_class_statics ctx c
 		| TClassDecl c -> generate_class_statics ctx c
@@ -1905,12 +1911,10 @@ let generate_type ctx t =
 		None
 		None
 
 
 let generate com =
 let generate com =
-	let file_path = (try Common.get_full_path com.file with _ -> com.file) in
-	let uid = String.sub (Digest.to_hex (Digest.string file_path)) 0 6 in
 	let ctx = {
 	let ctx = {
 		com = com;
 		com = com;
 		debugger = Common.defined com "fdb";
 		debugger = Common.defined com "fdb";
-		boot = "Boot_" ^ uid;
+		swc = Common.defined com "swc";
 		code = DynArray.create();
 		code = DynArray.create();
 		locals = PMap.empty;
 		locals = PMap.empty;
 		infos = default_infos();
 		infos = default_infos();
@@ -1930,7 +1934,7 @@ let generate com =
 		| None -> acc
 		| None -> acc
 		| Some (m,f) -> (t,m,f) :: acc
 		| Some (m,f) -> (t,m,f) :: acc
 	) [] com.types in
 	) [] com.types in
-	List.rev classes, ctx.boot, (fun () -> empty_method ctx null_pos)
+	List.rev classes, (fun () -> empty_method ctx null_pos)
 
 
 ;;
 ;;
 Random.self_init();
 Random.self_init();

+ 1 - 5
std/Std.hx

@@ -173,12 +173,8 @@ class Std {
 			Class = { __name__ : ["Class"] };
 			Class = { __name__ : ["Class"] };
 			Enum = {};
 			Enum = {};
 			Void = { __ename__ : ["Void"] };
 			Void = { __ename__ : ["Void"] };
-		#elseif as3
-			null;
 		#elseif flash9
 		#elseif flash9
-			Bool = __global__["Boolean"];
-			Int = __global__["int"];
-			Float = __global__["Number"];
+			null;
 		#elseif flash
 		#elseif flash
 			var g : Dynamic = _global;
 			var g : Dynamic = _global;
 			g["Int"] = { __name__ : ["Int"] };
 			g["Int"] = { __name__ : ["Int"] };