moved genHX from genswf9 to genas3

genas3.ml

@@ -932,3 +932,232 @@ let generate dir types =
 		ctx.inits <- List.rev !inits;
 		generate_class ctx c;
 		close ctx
+
+(* ----------------------------------------------------------------------------------------
+
+	HX generation
+
+   ---------------------------------------------------------------------------------------- *)
+open As3
+
+let s_type_path = Ast.s_type_path
+
+let ident ctx p =
+	As3code.iget ctx.as3_idents p
+
+let package ctx idx =
+	match As3code.iget ctx.as3_namespaces idx with
+	| A3NPrivate (Some id)
+	| A3NPublic (Some id)
+	| A3NInternal (Some id)
+	| A3NProtected id
+	| A3NExplicit id
+	| A3NStaticProtected (Some id) ->
+		let pack = ident ctx id in
+		ExtString.String.nsplit pack "."
+	| A3NNamespace id ->
+		["/* namespace " ^ ident ctx id ^ "*/"]
+	| A3NPrivate None | A3NPublic None | A3NInternal None | A3NStaticProtected None ->
+		[]
+
+let rec real_type_path ctx p =
+	let rec loop = function
+		| A3MName (id,pack) ->
+			let name = ident ctx id in
+			let pack = package ctx pack in
+			pack , name
+		| A3MMultiName (Some id,pack) ->
+			let name = ident ctx id in
+			let pack = package ctx (List.hd (As3code.iget ctx.as3_nsets pack)) in
+			pack , name
+		| A3MMultiName (None,_) ->
+			[] , "$MultiName"
+		| A3MMultiNameLate _ ->
+			[] , "$MultiNameLate"
+		| A3MRuntimeName _ ->
+			[] , "$RuntimeName"
+		| A3MRuntimeNameLate ->
+			[] , "$RuntimeNameLate"
+		| A3MAttrib n ->
+			let path, name = loop n in
+			"$Attrib" :: path, name
+	in
+	loop (As3code.iget ctx.as3_names p)
+
+let type_path ctx p =
+	match real_type_path ctx p with
+	| [] , "Object" -> [] , "Dynamic"
+	| [] , "Boolean" -> [] , "Bool"
+	| [] , "int" -> [] , "Int"
+	| [] , "uint" -> [] , "UInt"
+	| [] , "Number" -> [] , "Float"
+	| [] , "Array" -> [] , "Array<Dynamic>"
+	| [] , "void" -> [] , "Void"
+	| [] , "Function" -> [] , "Dynamic"
+	| [] , "Class" -> [] , "Class<Dynamic>"
+	| path -> path
+
+let ident_rights ctx id =
+	match As3code.iget ctx.as3_names id with
+	| A3MName (id,r) ->
+		let name = ident ctx id in
+		(match As3code.iget ctx.as3_namespaces r with
+		| A3NNamespace i when As3code.iget ctx.as3_idents i = "http://www.adobe.com/2006/flex/mx/internal" -> false, "$" ^ name
+		| A3NPublic _ | A3NNamespace _ -> false , name
+		| _ -> true , name)
+	| _ -> false, "???"
+
+let rec create_dir acc = function
+	| [] -> ()
+	| d :: l ->
+		let path = acc ^ "/" ^ d in
+		(try Unix.mkdir path 0o777 with _ -> ());
+		create_dir path l
+
+let value_type = function
+	| A3VNone
+	| A3VNull -> "Dynamic"
+	| A3VBool _ -> "Bool"
+	| A3VString _ -> "String"
+	| A3VInt _ -> "Int"
+	| A3VUInt _ -> "UInt"
+	| A3VFloat _ -> "Float"
+	| A3VNamespace _ -> "$Namespace"
+
+let type_val ctx t v =
+	match t with
+	| None ->
+		(match v with
+		| None -> "Dynamic"
+		| Some v -> value_type v)
+	| Some t ->
+		s_type_path (type_path ctx t)
+
+let has_getset ml f m =
+	List.exists (fun f2 ->
+		match f2.f3_kind with
+		| A3FMethod m2 when f.f3_name = f2.f3_name ->
+			(match m.m3_kind , m2.m3_kind with
+			| MK3Getter , MK3Setter | MK3Setter , MK3Getter -> true
+			| _ -> false)
+		| _ -> false
+	) ml
+
+let gen_method ctx ch name mt =
+	let m = As3code.iget ctx.as3_method_types (As3parse.no_nz mt) in
+	let ret = (match m.mt3_ret with
+		| None -> "Void"
+		| Some t -> s_type_path (type_path ctx t)
+	) in
+	let p = ref 0 in
+	let params = List.map (fun a ->
+		let name = (match m.mt3_pnames with
+			| None -> "p" ^ string_of_int !p
+			| Some l -> ident ctx (List.nth l (!p))
+		) in
+		let opt_val = (match m.mt3_dparams with
+			| None -> None
+			| Some l ->
+				try
+					Some (List.nth l (!p - List.length m.mt3_args + List.length l))
+				with
+					_ -> None
+		) in
+		let t = type_val ctx a opt_val in
+		incr p;
+		(if opt_val <> None then "?" else "") ^ name ^ " : " ^ t
+	) m.mt3_args in
+	let vargs = if m.mt3_var_args then " /* ...arguments */" else "" in
+	IO.printf ch "function %s(%s%s) : %s;\n" name (String.concat ", " params) vargs ret
+
+let gen_fields ctx ch fields stat =
+	let fields = List.sort (fun f1 f2 -> compare (ident_rights ctx f1.f3_name) (ident_rights ctx f2.f3_name)) (Array.to_list fields) in
+	List.iter (fun f ->
+		let priv , name = ident_rights ctx f.f3_name in
+		if name.[0] = '$' then
+			()
+		else match f.f3_kind with
+		| A3FMethod m ->
+			if m.m3_override then
+				()
+			else
+			(match m.m3_kind with
+			| MK3Normal ->
+				IO.printf ch "\t";
+				if priv then IO.printf ch "private ";
+				if stat then IO.printf ch "static ";
+				gen_method ctx ch name m.m3_type
+			| MK3Getter ->
+				let set = has_getset fields f m in
+				let set_str = if set then "" else "(default,null)" in
+				let m = As3code.iget ctx.as3_method_types (As3parse.no_nz m.m3_type) in
+				let t = (match m.mt3_ret with None -> "Dynamic" | Some t -> s_type_path (type_path ctx t)) in
+				IO.printf ch "\t%s%svar %s%s : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name set_str t
+			| MK3Setter ->
+				let get = has_getset fields f m in
+				if not get then begin
+					let m = As3code.iget ctx.as3_method_types (As3parse.no_nz m.m3_type) in
+					let t = (match m.mt3_ret with None -> "Dynamic" | Some t -> s_type_path (type_path ctx t)) in
+					IO.printf ch "\t%s%svar %s(null,default) : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name t
+				end;
+			)
+		| A3FVar v ->
+			let t = type_val ctx v.v3_type (Some v.v3_value) in
+			IO.printf ch "\t%s%svar %s : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name t
+		| A3FFunction _ ->
+			assert false
+		| A3FClass _ ->
+			IO.printf ch "\t// ????\n"
+	) fields
+
+let genhx_class ctx c s =
+	let base_path = "hxclasses" in
+	let pack , name = real_type_path ctx c.cl3_name in
+	let skip = (match pack with
+		| [_;x] when String.length x > 3 && String.sub x 0 3 = "as$" -> true
+		| _ when name.[0] = '_' -> true
+		| _ -> false
+	) in
+	if skip then
+		prerr_endline ("// skip " ^ s_type_path (pack,name))
+	else
+	let () = prerr_string ("import " ^ s_type_path (pack,name)) in
+	create_dir "." (base_path :: pack);
+	let f = open_out (base_path ^ "/" ^ (match pack with [] -> "" | l -> String.concat "/" l ^ "/") ^ name ^ ".hx") in
+	let ch = IO.output_channel f in
+	if pack <> [] then IO.printf ch "package %s;\n\n" (String.concat "." pack);
+	IO.printf ch "extern %s %s" (if c.cl3_interface then "interface" else "class") name;
+	let prev = ref (match c.cl3_super with
+	| None -> false
+	| Some p ->
+		match type_path ctx p with
+		| [] , "Dynamic" -> false
+		| path ->
+			IO.printf ch " extends %s" (s_type_path path);
+			true
+	) in
+	Array.iter (fun i ->
+		if !prev then IO.printf ch ",";
+		prev := true;
+		IO.printf ch " implements %s" (s_type_path (type_path ctx i));
+	) c.cl3_implements;
+	IO.printf ch " {\n";
+	IO.printf ch "\t"; gen_method ctx ch "new" c.cl3_construct;
+	gen_fields ctx ch c.cl3_fields false;
+	gen_fields ctx ch s.st3_fields true;
+	IO.printf ch "}\n";
+	prerr_endline ";";
+	IO.close_out ch
+
+let genhx file =
+	let file = (try Plugin.find_file file with Not_found -> failwith ("File not found : " ^ file)) in
+	let ch = IO.input_channel (open_in_bin file) in
+	SwfParser.full_parsing := true;
+	let _, swf = Swf.parse ch in
+	SwfParser.full_parsing := false;
+	IO.close_in ch;
+	List.iter (fun t ->
+		match t.Swf.tdata with
+		| Swf.TActionScript3 (_,t) -> Array.iteri (fun i c -> genhx_class t c t.as3_statics.(i)) t.as3_classes
+		| _ -> ()
+	) swf

genswf9.ml

@@ -1596,232 +1596,5 @@ let generate types hres =
 	} in
 	[Swf.TActionScript3 (Some (0,""),a)], ctx.boot
 
-
-(* ----------------------------------------------------------------------------------------
-
-	HX generation
-
-   ---------------------------------------------------------------------------------------- *)
-
-let ident ctx p =
-	As3code.iget ctx.as3_idents p
-
-let package ctx idx =
-	match As3code.iget ctx.as3_namespaces idx with
-	| A3NPrivate (Some id)
-	| A3NPublic (Some id)
-	| A3NInternal (Some id)
-	| A3NProtected id
-	| A3NExplicit id
-	| A3NStaticProtected (Some id) ->
-		let pack = ident ctx id in
-		ExtString.String.nsplit pack "."
-	| A3NNamespace id ->
-		["/* namespace " ^ ident ctx id ^ "*/"]
-	| A3NPrivate None | A3NPublic None | A3NInternal None | A3NStaticProtected None ->
-		[]
-
-let rec real_type_path ctx p =
-	let rec loop = function
-		| A3MName (id,pack) ->
-			let name = ident ctx id in
-			let pack = package ctx pack in
-			pack , name
-		| A3MMultiName (Some id,pack) ->
-			let name = ident ctx id in
-			let pack = package ctx (List.hd (As3code.iget ctx.as3_nsets pack)) in
-			pack , name
-		| A3MMultiName (None,_) ->
-			[] , "$MultiName"
-		| A3MMultiNameLate _ ->
-			[] , "$MultiNameLate"
-		| A3MRuntimeName _ ->
-			[] , "$RuntimeName"
-		| A3MRuntimeNameLate ->
-			[] , "$RuntimeNameLate"
-		| A3MAttrib n ->
-			let path, name = loop n in
-			"$Attrib" :: path, name
-	in
-	loop (As3code.iget ctx.as3_names p)
-
-let type_path ctx p =
-	match real_type_path ctx p with
-	| [] , "Object" -> [] , "Dynamic"
-	| [] , "Boolean" -> [] , "Bool"
-	| [] , "int" -> [] , "Int"
-	| [] , "uint" -> [] , "UInt"
-	| [] , "Number" -> [] , "Float"
-	| [] , "Array" -> [] , "Array<Dynamic>"
-	| [] , "void" -> [] , "Void"
-	| [] , "Function" -> [] , "Dynamic"
-	| [] , "Class" -> [] , "Class<Dynamic>"
-	| path -> path
-
-let ident_rights ctx id =
-	match As3code.iget ctx.as3_names id with
-	| A3MName (id,r) ->
-		let name = ident ctx id in
-		(match As3code.iget ctx.as3_namespaces r with
-		| A3NNamespace i when As3code.iget ctx.as3_idents i = "http://www.adobe.com/2006/flex/mx/internal" -> false, "$" ^ name
-		| A3NPublic _ | A3NNamespace _ -> false , name
-		| _ -> true , name)
-	| _ -> false, "???"
-
-let rec create_dir acc = function
-	| [] -> ()
-	| d :: l ->
-		let path = acc ^ "/" ^ d in
-		(try Unix.mkdir path 0o777 with _ -> ());
-		create_dir path l
-
-let value_type = function
-	| A3VNone
-	| A3VNull -> "Dynamic"
-	| A3VBool _ -> "Bool"
-	| A3VString _ -> "String"
-	| A3VInt _ -> "Int"
-	| A3VUInt _ -> "UInt"
-	| A3VFloat _ -> "Float"
-	| A3VNamespace _ -> "$Namespace"
-
-let type_val ctx t v =
-	match t with
-	| None ->
-		(match v with
-		| None -> "Dynamic"
-		| Some v -> value_type v)
-	| Some t ->
-		s_type_path (type_path ctx t)
-
-let has_getset ml f m =
-	List.exists (fun f2 ->
-		match f2.f3_kind with
-		| A3FMethod m2 when f.f3_name = f2.f3_name ->
-			(match m.m3_kind , m2.m3_kind with
-			| MK3Getter , MK3Setter | MK3Setter , MK3Getter -> true
-			| _ -> false)
-		| _ -> false
-	) ml
-
-let gen_method ctx ch name mt =
-	let m = As3code.iget ctx.as3_method_types (As3parse.no_nz mt) in
-	let ret = (match m.mt3_ret with
-		| None -> "Void"
-		| Some t -> s_type_path (type_path ctx t)
-	) in
-	let p = ref 0 in
-	let params = List.map (fun a ->
-		let name = (match m.mt3_pnames with
-			| None -> "p" ^ string_of_int !p
-			| Some l -> ident ctx (List.nth l (!p))
-		) in
-		let opt_val = (match m.mt3_dparams with
-			| None -> None
-			| Some l ->
-				try
-					Some (List.nth l (!p - List.length m.mt3_args + List.length l))
-				with
-					_ -> None
-		) in
-		let t = type_val ctx a opt_val in
-		incr p;
-		(if opt_val <> None then "?" else "") ^ name ^ " : " ^ t
-	) m.mt3_args in
-	let vargs = if m.mt3_var_args then " /* ...arguments */" else "" in
-	IO.printf ch "function %s(%s%s) : %s;\n" name (String.concat ", " params) vargs ret
-
-let gen_fields ctx ch fields stat =
-	let fields = List.sort (fun f1 f2 -> compare (ident_rights ctx f1.f3_name) (ident_rights ctx f2.f3_name)) (Array.to_list fields) in
-	List.iter (fun f ->
-		let priv , name = ident_rights ctx f.f3_name in
-		if name.[0] = '$' then
-			()
-		else match f.f3_kind with
-		| A3FMethod m ->
-			if m.m3_override then
-				()
-			else
-			(match m.m3_kind with
-			| MK3Normal ->
-				IO.printf ch "\t";
-				if priv then IO.printf ch "private ";
-				if stat then IO.printf ch "static ";
-				gen_method ctx ch name m.m3_type
-			| MK3Getter ->
-				let set = has_getset fields f m in
-				let set_str = if set then "" else "(default,null)" in
-				let m = As3code.iget ctx.as3_method_types (As3parse.no_nz m.m3_type) in
-				let t = (match m.mt3_ret with None -> "Dynamic" | Some t -> s_type_path (type_path ctx t)) in
-				IO.printf ch "\t%s%svar %s%s : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name set_str t
-			| MK3Setter ->
-				let get = has_getset fields f m in
-				if not get then begin
-					let m = As3code.iget ctx.as3_method_types (As3parse.no_nz m.m3_type) in
-					let t = (match m.mt3_ret with None -> "Dynamic" | Some t -> s_type_path (type_path ctx t)) in
-					IO.printf ch "\t%s%svar %s(null,default) : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name t
-				end;
-			)
-		| A3FVar v ->
-			let t = type_val ctx v.v3_type (Some v.v3_value) in
-			IO.printf ch "\t%s%svar %s : %s;\n" (if priv then "private " else "") (if stat then "static " else "") name t
-		| A3FFunction _ ->
-			assert false
-		| A3FClass _ ->
-			IO.printf ch "\t// ????\n"
-	) fields
-
-let genhx_class ctx c s =
-	let base_path = "hxclasses" in
-	let pack , name = real_type_path ctx c.cl3_name in
-	let skip = (match pack with
-		| [_;x] when String.length x > 3 && String.sub x 0 3 = "as$" -> true
-		| _ when name.[0] = '_' -> true
-		| _ -> false
-	) in
-	if skip then
-		prerr_endline ("// skip " ^ s_type_path (pack,name))
-	else
-	let () = prerr_string ("import " ^ s_type_path (pack,name)) in
-	create_dir "." (base_path :: pack);
-	let f = open_out (base_path ^ "/" ^ (match pack with [] -> "" | l -> String.concat "/" l ^ "/") ^ name ^ ".hx") in
-	let ch = IO.output_channel f in
-	if pack <> [] then IO.printf ch "package %s;\n\n" (String.concat "." pack);
-	IO.printf ch "extern %s %s" (if c.cl3_interface then "interface" else "class") name;
-	let prev = ref (match c.cl3_super with
-	| None -> false
-	| Some p ->
-		match type_path ctx p with
-		| [] , "Dynamic" -> false
-		| path ->
-			IO.printf ch " extends %s" (s_type_path path);
-			true
-	) in
-	Array.iter (fun i ->
-		if !prev then IO.printf ch ",";
-		prev := true;
-		IO.printf ch " implements %s" (s_type_path (type_path ctx i));
-	) c.cl3_implements;
-	IO.printf ch " {\n";
-	IO.printf ch "\t"; gen_method ctx ch "new" c.cl3_construct;
-	gen_fields ctx ch c.cl3_fields false;
-	gen_fields ctx ch s.st3_fields true;
-	IO.printf ch "}\n";
-	prerr_endline ";";
-	IO.close_out ch
-
-let genhx file =
-	let file = (try Plugin.find_file file with Not_found -> failwith ("File not found : " ^ file)) in
-	let ch = IO.input_channel (open_in_bin file) in
-	SwfParser.full_parsing := true;
-	let _, swf = Swf.parse ch in
-	SwfParser.full_parsing := false;
-	IO.close_in ch;
-	List.iter (fun t ->
-		match t.Swf.tdata with
-		| Swf.TActionScript3 (_,t) -> Array.iteri (fun i c -> genhx_class t c t.as3_statics.(i)) t.as3_classes
-		| _ -> ()
-	) swf
-
 ;;
 gen_expr_ref := gen_expr

main.ml

@@ -310,7 +310,7 @@ try
 		("--neko-source", define "neko_source", ": keep generated neko source");
 		("--gen-hx-classes", Arg.String (fun file ->
 			gen_hx := true;
-			Genswf9.genhx file
+			Genas3.genhx file
 		),"<file> : generate hx headers from SWF9 file");
 		("--next", Arg.Unit (fun() -> assert false), ": separate several haxe compilations");
 		("--altfmt", Arg.Unit (fun() -> alt_format := true),": use alternative error output format");