ソースを参照

added empty genneko
types are now generated in good order

Nicolas Cannasse 20 年 前
コミット
8bdc706c99
5 ファイル変更132 行追加13 行削除
  1. 23 0
      genneko.ml
  2. 4 8
      genswf8.ml
  3. 3 0
      haxe.vcproj
  4. 22 3
      main.ml
  5. 80 2
      typer.ml

+ 23 - 0
genneko.ml

@@ -0,0 +1,23 @@
+(*
+ *  Haxe Compiler
+ *  Copyright (c)2005 Nicolas Cannasse
+ *
+ *  This program is free software; you can redistribute it and/or modify
+ *  it under the terms of the GNU General Public License as published by
+ *  the Free Software Foundation; either version 2 of the License, or
+ *  (at your option) any later version.
+ *
+ *  This program is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU General Public License for more details.
+ *
+ *  You should have received a copy of the GNU General Public License
+ *  along with this program; if not, write to the Free Software
+ *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+open Ast
+open Type
+
+let generate file types =
+	()

+ 4 - 8
genswf8.ml

@@ -1126,7 +1126,7 @@ let gen_type_def ctx t tdef =
 		setvar ctx VarStr;
 		PMap.iter (fun _ f -> gen_enum_field ctx f) e.e_constrs
 
-let gen_boot ctx m =
+let gen_boot ctx =
 	let id = gen_type ctx ([],"Boot") false in
 	(* r0 = Boot *)
 	push ctx [VStr id];
@@ -1208,7 +1208,7 @@ let to_utf8 str =
 			String.iter (fun c -> UTF8.Buf.add_char b (UChar.of_char c)) str;
 			UTF8.Buf.contents b
 
-let generate file ver modules =
+let generate file ver types =
 	let ctx = {
 		opcodes = DynArray.create();
 		code_pos = 0;
@@ -1228,13 +1228,9 @@ let generate file ver modules =
 		statics = [];
 	} in
 	write ctx (AStringPool []);
-	let boot = ref None in
-	List.iter (fun m ->
-		if m.mpath = ([],"Boot") then boot := Some m;
-		List.iter (fun (p,t) -> gen_type_def ctx p t) m.mtypes
-	) modules;
+	List.iter (fun (p,t) -> gen_type_def ctx p t) types;
 	gen_type_map ctx;
-	gen_boot ctx (match !boot with None -> assert false | Some m -> m);
+	gen_boot ctx;
 	List.iter (gen_class_static_init ctx) (List.rev ctx.statics);
 	let idents = ctx.idents in
 	let idents = Hashtbl.fold (fun ident pos acc -> (ident,pos) :: acc) idents [] in

+ 3 - 0
haxe.vcproj

@@ -41,6 +41,9 @@
 		<File
 			RelativePath=".\ast.ml">
 		</File>
+		<File
+			RelativePath=".\genneko.ml">
+		</File>
 		<File
 			RelativePath=".\genswf.ml">
 		</File>

+ 22 - 3
main.ml

@@ -63,20 +63,28 @@ try
 	let base_path = normalize_path (try Extc.executable_path() with _ -> "./") in
 	let classes = ref ["Std"] in
 	let swf_out = ref None in
+	let neko_out = ref None in
 	let swf_version = ref 8 in
 	let time = Sys.time() in
 	Plugin.class_path := [base_path ^ "std/";"";"/"];
+	let check_targets() =
+		if !swf_out <> None || !neko_out <> None then raise (Arg.Bad "Multiple targets");
+	in
 	let args_spec = [
 		("-cp",Arg.String (fun path ->
 			Plugin.class_path := normalize_path path :: !Plugin.class_path
 		),"<path> : add a directory to find source files");
 		("-swf",Arg.String (fun file ->
-			Plugin.class_path := (base_path ^ "flash/") :: !Plugin.class_path;
+			check_targets();
 			swf_out := Some file
 		),"<file> : compile code to SWF file");
 		("-fplayer",Arg.Int (fun v ->
 			swf_version := v;
 		),"<version> : flash player version (8 by default)");
+		("-neko",Arg.String (fun file ->
+			check_targets();
+			neko_out := Some file
+		),"<file> : compile code to Neko Binary");
 		("-D",Arg.String (fun def ->
 			Hashtbl.add Parser.defines def ();
 		),"<var> : define the macro variable");
@@ -87,7 +95,13 @@ try
 	| None -> ()
 	| Some _ ->
 		Hashtbl.add Parser.defines "flash" ();
+		Plugin.class_path := (base_path ^ "flash/") :: !Plugin.class_path;
 		Hashtbl.add Parser.defines ("flash" ^ string_of_int !swf_version) ());
+	(match !neko_out with
+	| None -> ()
+	| Some _ ->
+		Hashtbl.add Parser.defines "neko" ();
+		Plugin.class_path := (base_path ^ "neko/") :: !Plugin.class_path);
 	if !classes = [] then begin
 		Arg.usage args_spec usage
 	end else begin
@@ -95,13 +109,18 @@ try
 		let ctx = Typer.context warn in
 		List.iter (compile ctx) (List.rev !classes);
 		Typer.finalize ctx;
-		let modules = Typer.modules ctx in
+		let types = Typer.types ctx in
 		(match !swf_out with
 		| None -> ()
 		| Some file ->
 			if !Plugin.verbose then print_endline ("Generating swf : " ^ file);
-			Genswf.generate file (!swf_version) modules
+			Genswf.generate file (!swf_version) types
 		);
+		(match !neko_out with
+		| None -> ()
+		| Some file ->
+			if !Plugin.verbose then print_endline ("Generating neko : " ^ file);
+			Genneko.generate file types);
 		if !Plugin.verbose then print_endline ("Time spent : " ^ string_of_float (Sys.time() -. time));
 	end;
 with

+ 80 - 2
typer.ml

@@ -1161,8 +1161,86 @@ let rec finalize ctx =
 		List.iter (fun f -> f()) l;
 		finalize ctx
 
-let modules ctx =
-	Hashtbl.fold (fun _ m acc -> m :: acc) ctx.modules []
+type state =
+	| Generating
+	| Done
+	| NotYet
+
+let types ctx =
+	let types = ref [] in
+	let states = Hashtbl.create 0 in
+	let state p = try Hashtbl.find states p with Not_found -> NotYet in
+	let rec loop (p,t) =
+		match state p with
+		| Done -> ()
+		| Generating ->
+			prerr_endline ("Warning : maybe loop in static generation of " ^ s_type_path p);
+		| NotYet ->
+			Hashtbl.add states p Generating;
+			(match t with
+			| TClassDecl c -> walk_class p c
+			| TEnumDecl e -> ());				
+			Hashtbl.replace states p Done;
+			types := (p,t) :: !types
+
+    and loop_class p c =
+		if c.cl_path <> p then loop (c.cl_path,TClassDecl c)
+
+	and loop_enum p e =
+		if e.e_path <> p then loop (e.e_path,TEnumDecl e)
+
+	and walk_static_call p c name =
+		try
+			let f = PMap.find name c.cl_statics in
+			match f.cf_expr with
+			| None -> ()
+			| Some e -> walk_expr p e
+		with
+			Not_found -> ()
+
+	and walk_expr p e =
+		match e.eexpr with
+		| TType t ->
+			(match t with
+			| TClassDecl c -> loop_class p c
+			| TEnumDecl e -> loop_enum p e)
+		| TEnumField (e,_) ->
+			loop_enum p e
+		| TNew (c,_,_) ->
+			loop_class p c
+		| TMatch (e,_,_) ->
+			loop_enum p e
+		| TCall (f,_) ->
+			iter (walk_expr p) e;
+			(* static call for initializing a variable *)
+			let rec loop f =
+				match f.eexpr with
+				| TField ({ eexpr = TType t },name) ->
+					(match t with
+					| TEnumDecl _ -> ()
+					| TClassDecl c -> walk_static_call p c name)
+				| TField (f,_) -> loop f
+				| _ -> ()
+			in
+			loop f
+		| _ -> 
+			iter (walk_expr p) e
+
+    and walk_class p c =
+		(match c.cl_super with None -> () | Some (c,_) -> loop_class p c);
+		List.iter (fun (c,_) -> loop_class p c) c.cl_implements;
+		PMap.iter (fun _ f ->
+			match f.cf_expr with
+			| None -> ()
+			| Some e -> 
+				match e.eexpr with
+				| TFunction _ -> ()
+				| _ -> walk_expr p e
+		) c.cl_statics
+
+	in
+	Hashtbl.iter (fun _ m -> List.iter loop m.mtypes) ctx.modules;
+	List.rev !types
 
 ;;
 load_ref := load