big speedup for compiler internal completion

doc/CHANGES.txt

@@ -43,6 +43,7 @@
 	all : removed String.cca (replaced by StringTools.fastCodeAt + StringTools.isEOF)
 	flash9 : fixed use of default values when null is passed for nullable basic types
 	all : fixed issues with inlining and class/function type parameters
+	all : big speedup for compiler internal completion
 
 2010-08-14: 2.06
 	neko : change serializer to be able to handle instances of basic classes from other modules

main.ml

@@ -86,6 +86,7 @@ let file_extension f =
 	| x :: _ -> x
 
 let make_path f =
+	let f = String.concat "/" (ExtString.String.nsplit f "\\") in
 	let cl = ExtString.String.nsplit f "." in
 	let cl = (match List.rev cl with
 		| ["hx";path] -> ExtString.String.nsplit path "/"
@@ -201,6 +202,20 @@ let parse_hxml file =
 			[l]
 	) lines)
 
+let lookup_classes com fpath =
+	let found = ref [] in
+	List.iter (fun cp ->
+		let c = Common.get_full_path cp in
+		let clen = String.length c in
+		if clen < String.length fpath && String.sub fpath 0 clen = c then begin
+			let path = String.sub fpath clen (String.length fpath - clen) in
+			found := make_path path :: !found;
+		end
+	) com.class_path;
+	match List.rev !found with
+	| [] -> []
+	| x :: _ -> [x]
+
 exception Hxml_found
 
 let rec process_params acc = function
@@ -407,7 +422,7 @@ try
 				Common.display := true;
 				Common.define com "display";
 				Parser.resume_display := {
-					Ast.pfile = String.lowercase (Common.get_full_path file);
+					Ast.pfile = Common.get_full_path file;
 					Ast.pmin = pos;
 					Ast.pmax = pos;
 				};
@@ -490,14 +505,15 @@ try
 		com.class_path <- lines @ com.class_path;
 	);
 	if !Common.display then begin
-		com.verbose <- false;
 		xml_out := None;
 		no_output := true;
 		com.warning <- store_message;
+		com.main_class <- None;
 		com.error <- (fun msg p ->
 			store_message msg p;
 			has_error := true;
 		);
+		classes := lookup_classes com (!Parser.resume_display).Ast.pfile;
 	end;
 	let add_std dir =
 		com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
@@ -619,6 +635,7 @@ with
 	| Common.Abort (m,p) -> report m p
 	| Lexer.Error (m,p) -> report (Lexer.error_msg m) p
 	| Parser.Error (m,p) -> report (Parser.error_msg m) p
+	| Typecore.Error (Typecore.Forbid_package _,_) when !Common.display -> () (* assume we have a --next *)
 	| Typecore.Error (m,p) -> report (Typecore.error_msg m) p
 	| Interp.Error (msg,p :: l) ->
 		store_message msg p;

parser.ml

@@ -60,7 +60,7 @@ let display e = raise (Display e)
 
 let is_resuming p =
 	let p2 = !resume_display in
-	p.pmax = p2.pmin && String.lowercase (Common.get_full_path p.pfile) = p2.pfile
+	p.pmax = p2.pmin && String.lowercase (Common.get_full_path p.pfile) = String.lowercase p2.pfile
 
 let priority = function
 	| OpAssign | OpAssignOp _ -> -4

typecore.ml

@@ -83,6 +83,7 @@ type error_msg =
 	| Protect of error_msg
 	| Unknown_ident of string
 	| Stack of error_msg * error_msg
+	| Forbid_package of string * path
 
 exception Error of error_msg * pos
 
@@ -127,6 +128,8 @@ let rec error_msg = function
 	| Custom s -> s
 	| Stack (m1,m2) -> error_msg m1 ^ "\n" ^ error_msg m2
 	| Protect m -> error_msg m
+	| Forbid_package (p,m) ->
+		"You can't access the " ^ p ^ " package with current compilation flags (for " ^ Ast.s_type_path m ^ ")"
 
 let display_error ctx msg p = ctx.com.error msg p
 

typeload.ml

@@ -637,7 +637,7 @@ let init_class ctx c p herits fields =
 		c.cl_extern <- true;
 		List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
 	end else fields, herits in
-	if core_api then delay ctx ((fun() -> init_core_api ctx c));
+	if core_api && not !Common.display then delay ctx ((fun() -> init_core_api ctx c));
 	let tthis = TInst (c,List.map snd c.cl_types) in
 	let rec extends_public c =
 		List.exists (fun (c,_) -> c.cl_path = (["haxe"],"Public") || extends_public c) c.cl_implements ||
@@ -680,6 +680,9 @@ let init_class ctx c p herits fields =
 		| Some (c,_) ->
 			PMap.exists f c.cl_fields || has_field f c.cl_super || List.exists (fun i -> has_field f (Some i)) c.cl_implements
 	in
+
+	(* ----------------------- DEAD CODE REMOVAL ----------------------------- *)
+
 	let is_main n = (match ctx.com.main_class with | Some cl when c.cl_path = cl -> true | _ -> false) && n = "main" in
 	let must_keep_types pf = match pf with
 		| Flash -> [["flash"], "Boot"]
@@ -715,6 +718,34 @@ let init_class ctx c p herits fields =
 			remove_field cf stat
 		end)
 	in
+	
+	(* ----------------------- COMPLETION ----------------------------- *)
+
+	let display_file = if !Common.display then String.lowercase (Common.get_full_path p.pfile) = String.lowercase (!Parser.resume_display).pfile else false in
+	let rec is_full_type t =
+		match t with
+		| TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args
+		| TMono r -> (match !r with None -> false | Some t -> is_full_type t)
+		| TInst _ | TEnum _ | TLazy _ | TDynamic _ | TAnon _ | TType _ -> true
+	in
+	let bind_type cf r p =
+		if !Common.display then begin
+			let cp = !Parser.resume_display in
+			if display_file && (cp.pmin = 0 || (p.pmin <= cp.pmin && p.pmax >= cp.pmax)) then begin
+				cf.cf_type <- TLazy r;
+				(fun() -> ignore((!r)()))
+			end else begin
+				if not (is_full_type cf.cf_type) then cf.cf_type <- TLazy r;
+				(fun() -> ())
+			end
+		end else begin
+			cf.cf_type <- TLazy r;
+			(fun () -> ignore(!r()))
+		end
+	in
+
+	(* ----------------------- FIELD INIT ----------------------------- *)
+
 	let loop_cf f =
 		let name = f.cff_name in
 		let p = f.cff_pos in
@@ -789,8 +820,7 @@ let init_class ctx c p herits fields =
 						cf.cf_expr <- Some (type_static_var ctx t e p);
 						t
 					) in
-					cf.cf_type <- TLazy r;
-					(fun () -> ignore(!r()))
+					bind_type cf r (snd e)
 			) in
 			f, false, cf, delay
 		| FFun (params,fd) ->
@@ -880,20 +910,18 @@ let init_class ctx c p herits fields =
 							ignore((!r)())
 					)
 				end
-			end else begin
-				if ((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__" then begin
-					(fun() -> ())
-				end else begin
-					cf.cf_type <- TLazy r;
-					(fun() -> ignore((!r)()))
-				end
-			end in
+			end else if ((c.cl_extern && not inline) || c.cl_interface) && cf.cf_name <> "__init__" then
+				(fun() -> ())
+			else
+				bind_type cf r (snd fd.f_expr)
+			in
 			f, constr, cf, delay
 		| FProp (get,set,t) ->
 			let ret = load_complex_type ctx p t in
 			let check_get = ref (fun() -> ()) in
 			let check_set = ref (fun() -> ()) in
 			let check_method m t () =
+				if !Common.display then () else
 				try
 					let t2 = (if stat then (PMap.find m c.cl_statics).cf_type else fst (class_field c m)) in
 					unify_raise ctx t2 t p;
@@ -1199,7 +1227,8 @@ let type_module ctx m tdecls loadp =
 				ctx.local_using<- ctx.local_using @ [resolve_typedef ctx t])
 		| EClass d ->
 			let c = get_class d.d_name in
-			delays := !delays @ check_overriding ctx c p :: check_interfaces ctx c p :: init_class ctx c p d.d_flags d.d_data
+			let checks = if not !Common.display then [check_overriding ctx c p; check_interfaces ctx c p] else [] in
+			delays := !delays @ (checks @ init_class ctx c p d.d_flags d.d_data)
 		| EEnum d ->
 			let e = get_enum d.d_name in
 			ctx.type_params <- e.e_types;
@@ -1279,7 +1308,7 @@ let parse_module ctx m p =
 		| x :: l , name ->
 			let x = (try
 				match PMap.find x ctx.com.package_rules with
-				| Forbidden -> error ("You can't access the " ^ x ^ " package with current compilation flags (for " ^ s_type_path m ^ ")") p;
+				| Forbidden -> raise (Error (Forbid_package (x,m),p));
 				| Directory d -> d
 				| Remap d -> remap := d :: l; d
 				with Not_found -> x