Permalink
Browse files

types directly reference modules and not their path

ensure that cached modules don't get post processed twice
sort modules by file before generation heuristic (prevent different generation order depending of cache hits)

git-svn-id: http://haxe.googlecode.com/svn/trunk@4224 f16182fa-f095-11de-8f43-4547254af6c6
  • Loading branch information...
1 parent 26cb2c0 commit 7319923d5a4f800cc8bc9a1ff7d5753bfdbf6285 ncannasse committed Mar 8, 2012
Showing with 117 additions and 94 deletions.
  1. +22 −11 codegen.ml
  2. +2 −2 genswf9.ml
  3. +2 −2 genxml.ml
  4. +2 −2 interp.ml
  5. +16 −16 main.ml
  6. +27 −12 type.ml
  7. +29 −26 typeload.ml
  8. +17 −23 typer.ml
View
@@ -172,7 +172,7 @@ let extend_remoting ctx c t p async prot =
) decls in
let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
try
- List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.mtypes
+ List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
with Not_found ->
error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
) in
@@ -212,15 +212,18 @@ let rec build_generic ctx c p tl =
Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
with Error(Module_not_found path,_) when path = (pack,name) ->
let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
- let ctx = { ctx with local_types = m.mtypes @ ctx.local_types } in
- let cg = mk_class (pack,name) c.cl_pos in
+ let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
let mg = {
- mpath = cg.cl_path;
- mfile = m.mfile;
- mdeps = m.mdeps; (* share *)
- mtypes = [TClassDecl cg];
+ m_id = alloc_mid();
+ m_path = (pack,name);
+ m_file = m.m_file;
+ m_deps = m.m_deps; (* share *)
+ m_types = [];
+ m_processed = 0;
} in
- Hashtbl.add ctx.g.modules mg.mpath mg;
+ let cg = mk_class mg (pack,name) c.cl_pos in
+ mg.m_types <- [TClassDecl cg];
+ Hashtbl.add ctx.g.modules mg.m_path mg;
let rec loop l1 l2 =
match l1, l2 with
| [] , [] -> []
@@ -461,10 +464,11 @@ let rec has_rtti c =
) c.cl_implements || (match c.cl_super with None -> false | Some (c,_) -> has_rtti c)
let restore c =
- let meta = c.cl_meta and path = c.cl_path in
+ let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern in
let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
(fun() ->
c.cl_meta <- meta;
+ c.cl_extern <- ext;
c.cl_path <- path;
c.cl_fields <- fl;
c.cl_ordered_fields <- ofl;
@@ -476,7 +480,7 @@ let on_generate ctx t =
match t with
| TClassDecl c ->
if c.cl_private then begin
- let rpath = (fst c.cl_module,"_" ^ snd c.cl_module) in
+ let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
end;
c.cl_restore <- restore c;
@@ -939,8 +943,14 @@ let check_local_vars_init e =
(* -------------------------------------------------------------------------- *)
(* POST PROCESS *)
+let pp_counter = ref 1
+
let post_process types filters =
+ (* ensure that we don't process twice the same (cached) module *)
List.iter (fun t ->
+ let m = (t_infos t).mt_module in
+ if m.m_processed = 0 then m.m_processed <- !pp_counter;
+ if m.m_processed = !pp_counter then
match t with
| TClassDecl c ->
let process_field f =
@@ -960,7 +970,8 @@ let post_process types filters =
c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
| TEnumDecl _ -> ()
| TTypeDecl _ -> ()
- ) types
+ ) types;
+ incr pp_counter
(* -------------------------------------------------------------------------- *)
(* STACK MANAGEMENT EMULATION *)
View
@@ -2208,8 +2208,8 @@ let resource_path name =
(["_res"],"_" ^ String.concat "_" (ExtString.String.nsplit name "."))
let generate_resource ctx name =
- let c = mk_class (resource_path name) null_pos in
- c.cl_super <- Some (mk_class (["flash";"utils"],"ByteArray") null_pos,[]);
+ let c = mk_class null_module (resource_path name) null_pos in
+ c.cl_super <- Some (mk_class null_module (["flash";"utils"],"ByteArray") null_pos,[]);
let t = TClassDecl c in
match generate_type ctx t with
| Some (m,f) -> (t,m,f)
View
@@ -110,9 +110,9 @@ let gen_constr e =
) in
node e.ef_name args t
-let gen_type_params ipos priv path params pos mpath =
+let gen_type_params ipos priv path params pos m =
let mpriv = (if priv then [("private","1")] else []) in
- let mpath = (if mpath <> path then [("module",snd (gen_path mpath false))] else []) in
+ let mpath = (if m.m_path <> path then [("module",snd (gen_path m.m_path false))] else []) in
let file = (if ipos && pos <> null_pos then [("file",pos.pfile)] else []) in
gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: (file @ mpriv @ mpath)
View
@@ -1771,7 +1771,7 @@ let macro_lib =
| name :: l -> if is_ident name then (Ast.EField (loop l,name),p) else (Ast.EType (loop l,name),p)
in
let t = t_infos t in
- loop (List.rev (if t.mt_module = t.mt_path then fst t.mt_path @ [snd t.mt_path] else fst t.mt_module @ [snd t.mt_module;snd t.mt_path]))
+ loop (List.rev (if t.mt_module.m_path = t.mt_path then fst t.mt_path @ [snd t.mt_path] else fst t.mt_module.m_path @ [snd t.mt_module.m_path;snd t.mt_path]))
in
let rec loop = function
| VNull -> (Ast.EConst (Ast.Ident "null"),p)
@@ -3502,7 +3502,7 @@ let rec encode_mtype t fields =
"pack", enc_array (List.map enc_string (fst i.mt_path));
"name", enc_string (snd i.mt_path);
"pos", encode_pos i.mt_pos;
- "module", enc_string (s_type_path i.mt_module);
+ "module", enc_string (s_type_path i.mt_module.m_path);
"isPrivate", VBool i.mt_private;
"meta", encode_meta i.mt_meta (fun m -> i.mt_meta <- m);
] @ fields)
View
32 main.ml
@@ -393,12 +393,12 @@ and wait_loop boot_com host port =
data
);
let cache_module sign m =
- Hashtbl.replace cache.c_modules (m.Type.mpath,sign) (file_time m.Type.mfile,m);
+ Hashtbl.replace cache.c_modules (m.Type.m_path,sign) (file_time m.Type.m_file,m);
List.iter (fun t ->
match t with
| Type.TClassDecl c -> c.Type.cl_restore()
| _ -> ()
- ) m.Type.mtypes
+ ) m.Type.m_types
in
let modules_added = Hashtbl.create 0 in
Typeload.type_module_hook := (fun (ctx:Typecore.typer) mpath p ->
@@ -408,38 +408,38 @@ and wait_loop boot_com host port =
let dep = ref None in
let rec check m =
try
- Hashtbl.find modules_added m.Type.mpath
+ Hashtbl.find modules_added m.Type.m_path
with Not_found -> try
- !(Hashtbl.find modules_checked m.Type.mpath)
+ !(Hashtbl.find modules_checked m.Type.m_path)
with Not_found ->
let ok = ref true in
- Hashtbl.add modules_checked m.Type.mpath ok;
+ Hashtbl.add modules_checked m.Type.m_path ok;
try
- let time, m = Hashtbl.find cache.c_modules (m.Type.mpath,sign) in
- if m.Type.mfile <> Common.get_full_path (Typeload.resolve_module_file com2 m.Type.mpath (ref[]) p) then raise Not_found;
- if file_time m.Type.mfile <> time then raise Not_found;
- PMap.iter (fun m2 _ -> if not (check m2) then begin dep := Some m2; raise Not_found end) !(m.Type.mdeps);
+ let time, m = Hashtbl.find cache.c_modules (m.Type.m_path,sign) in
+ if m.Type.m_file <> Common.get_full_path (Typeload.resolve_module_file com2 m.Type.m_path (ref[]) p) then raise Not_found;
+ if file_time m.Type.m_file <> time then raise Not_found;
+ PMap.iter (fun m2 _ -> if not (check m2) then begin dep := Some m2; raise Not_found end) !(m.Type.m_deps);
true
with Not_found ->
- Hashtbl.add modules_added m.Type.mpath false;
+ Hashtbl.add modules_added m.Type.m_path false;
ok := false;
!ok
in
let rec add_modules m =
- if Hashtbl.mem modules_added m.Type.mpath then
+ if Hashtbl.mem modules_added m.Type.m_path then
()
else begin
- Hashtbl.add modules_added m.Type.mpath true;
- if verbose then print_endline ("Reusing cached module " ^ Ast.s_type_path m.Type.mpath);
+ Hashtbl.add modules_added m.Type.m_path true;
+ if verbose then print_endline ("Reusing cached module " ^ Ast.s_type_path m.Type.m_path);
Typeload.add_module ctx m p;
- PMap.iter (fun m2 _ -> add_modules m2) !(m.Type.mdeps);
+ PMap.iter (fun m2 _ -> add_modules m2) !(m.Type.m_deps);
end
in
try
let _, m = Hashtbl.find cache.c_modules (mpath,sign) in
if com2.dead_code_elimination then raise Not_found;
if not (check m) then begin
- if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.Type.mpath ^ ")"));
+ if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.Type.m_path ^ ")"));
raise Not_found;
end;
add_modules m;
@@ -942,7 +942,7 @@ with
try
let ctx = Typer.create com in
let m = Typeload.load_module ctx (p,c) Ast.null_pos in
- complete_fields (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_infos t).Type.mt_private) m.Type.mtypes))
+ complete_fields (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_infos t).Type.mt_private) m.Type.m_types))
with _ ->
error ctx ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos)
| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) ->
View
39 type.ml
@@ -151,7 +151,7 @@ and metadata = Ast.metadata
and tinfos = {
mt_path : path;
- mt_module : path;
+ mt_module : module_def;
mt_pos : Ast.pos;
mt_private : bool;
mt_doc : Ast.documentation;
@@ -160,7 +160,7 @@ and tinfos = {
and tclass = {
mutable cl_path : path;
- mutable cl_module : path;
+ mutable cl_module : module_def;
mutable cl_pos : Ast.pos;
mutable cl_private : bool;
mutable cl_doc : Ast.documentation;
@@ -196,7 +196,7 @@ and tenum_field = {
and tenum = {
mutable e_path : path;
- e_module : path;
+ e_module : module_def;
e_pos : Ast.pos;
e_private : bool;
e_doc : Ast.documentation;
@@ -210,7 +210,7 @@ and tenum = {
and tdef = {
t_path : path;
- t_module : path;
+ t_module : module_def;
t_pos : Ast.pos;
t_private : bool;
t_doc : Ast.documentation;
@@ -224,17 +224,23 @@ and module_type =
| TEnumDecl of tenum
| TTypeDecl of tdef
-type module_def = {
- mpath : path;
- mtypes : module_type list;
- mfile : string;
- mdeps : (module_def,unit) PMap.t ref;
+and module_def = {
+ m_id : int;
+ m_path : path;
+ m_file : string;
+ mutable m_types : module_type list;
+ mutable m_processed : int;
+ m_deps : (module_def,unit) PMap.t ref;
}
let alloc_var =
let uid = ref 0 in
(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false })
+let alloc_mid =
+ let mid = ref 0 in
+ (fun() -> incr mid; !mid)
+
let mk e t p = { eexpr = e; etype = t; epos = p }
let mk_block e =
@@ -252,10 +258,10 @@ let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
-let mk_class path pos =
+let mk_class m path pos =
{
cl_path = path;
- cl_module = path;
+ cl_module = m;
cl_pos = pos;
cl_doc = None;
cl_meta = [];
@@ -278,8 +284,17 @@ let mk_class path pos =
cl_restore = (fun() -> ());
}
+let null_module = {
+ m_id = alloc_mid();
+ m_path = [] , "";
+ m_types = [];
+ m_file = "";
+ m_processed = 0;
+ m_deps = ref PMap.empty;
+ }
+
let null_class =
- let c = mk_class ([],"") Ast.null_pos in
+ let c = mk_class null_module ([],"") Ast.null_pos in
c.cl_private <- true;
c
Oops, something went wrong.

0 comments on commit 7319923

Please sign in to comment.