--display for completion.

ast.ml

@@ -193,6 +193,7 @@ and expr_def =
 	| EUntyped of expr
 	| EThrow of expr
 	| ECast of expr * type_path option
+	| EDisplay of expr
 
 and expr = expr_def * pos
 

genxml.ml

@@ -112,7 +112,7 @@ let rec exists f c =
 			| None -> true
 			| Some (csup,_) -> exists f csup
 
-let gen_type ctx t =
+let gen_type_decl ctx t =
 	let m = Typer.module_of_type ctx t in
 	match t with
 	| TClassDecl c ->
@@ -168,13 +168,13 @@ let rec write_xml ch tabs x =
 		IO.printf ch "<![CDATA[%s]]>" s
 
 let generate file ctx types =
-	let x = node "haxe" [] (List.map (gen_type ctx) types) in
+	let x = node "haxe" [] (List.map (gen_type_decl ctx) types) in
 	let ch = IO.output_channel (open_out file) in
 	write_xml ch "" x;
 	IO.close_out ch
 
 let gen_type_string ctx t =
-	let x = gen_type ctx t in
+	let x = gen_type_decl ctx t in
 	let ch = IO.output_string() in
 	write_xml ch "" x;
 	IO.close_out ch

main.ml

@@ -18,8 +18,8 @@
  *)
 open Printf
 
-type target = 
-	| No 
+type target =
+	| No
 	| Js of string
 	| Swf of string
 	| Neko of string
@@ -28,12 +28,13 @@ let prompt = ref false
 let alt_format = ref false
 let has_error = ref false
 let auto_xml = ref false
+let display = ref false
 
 let normalize_path p =
 	let l = String.length p in
 	if l = 0 then
 		"./"
-	else match p.[l-1] with 
+	else match p.[l-1] with
 		| '\\' | '/' -> p
 		| _ -> p ^ "/"
 
@@ -41,7 +42,7 @@ let warn msg p =
 	if p = Ast.null_pos then
 		prerr_endline msg
 	else begin
-		let error_printer file line = 
+		let error_printer file line =
 			if !alt_format then
 				sprintf "%s(%d):" file line
 			else
@@ -63,6 +64,18 @@ let report msg p =
 	warn msg p;
 	do_exit()
 
+let report_list l =
+	let htmlescape s =
+		let s = String.concat "&lt;" (ExtString.String.nsplit s "<") in
+		let s = String.concat "&gt;" (ExtString.String.nsplit s ">") in
+		s
+	in
+	prerr_endline "<list>";
+	List.iter (fun (n,t,d) ->
+		prerr_endline (Printf.sprintf "<i n=\"%s\"><t>%s</t><d>%s</d></i>" n (htmlescape t) (htmlescape d));
+	) l;
+	prerr_endline "</list>"
+
 let type_error e p =
 	warn (Typer.error_msg e) p;
 	has_error := true
@@ -72,7 +85,7 @@ let parse_error e p =
 	warn (Parser.error_msg e) p;
 	has_error := true
 
-let file_extension f = 
+let file_extension f =
 	let cl = ExtString.String.nsplit f "." in
 	match List.rev cl with
 	| [] -> ""
@@ -103,6 +116,22 @@ let make_path f =
 	in
 	loop cl
 
+let read_type_path p cp =
+	let classes = ref [] in
+	let packages = ref [] in
+	List.iter (fun path ->
+		let dir = path ^ String.concat "/" p in
+		let r = Sys.readdir dir in
+		Array.iter (fun f ->
+			if (Unix.stat (dir ^ "/" ^ f)).Unix.st_kind = Unix.S_DIR then begin
+				if f.[0] > 'a' && f.[0] < 'z' then packages := f :: !packages
+			end else if file_extension f = "hx" then begin
+				let c = Filename.chop_extension f in
+				if String.length c < 2 || String.sub c (String.length c - 2) 2 <> "__" then classes := c :: !classes;
+			end;
+		) r;
+	) cp;
+	List.sort compare (!packages), List.sort compare (!classes)
 
 let delete_file f = try Sys.remove f with _ -> ()
 
@@ -111,7 +140,7 @@ let base_defines = !Plugin.defines
 exception Hxml_found
 
 let rec process_params acc = function
-	| [] ->	
+	| [] ->
 		init (List.rev acc)
 	| "--next" :: l ->
 		init (List.rev acc);
@@ -120,7 +149,7 @@ let rec process_params acc = function
 		process_params (x :: acc) l
 
 and init params =
-try	
+try
 	let version = 111 in
 	let version_str = Printf.sprintf "%d.%.2d" (version / 100) (version mod 100) in
 	let usage = "Haxe Compiler " ^ version_str ^ " - (c)2005-2007 Motion-Twin\n Usage : haxe.exe [options] <class names...>\n Options :" in
@@ -134,7 +163,7 @@ try
 	let hres = Hashtbl.create 0 in
 	let cmds = ref [] in
 	let excludes = ref [] in
-	let libs = ref [] in	
+	let libs = ref [] in
 	let gen_hx = ref false in
 	Plugin.defines := base_defines;
 	Plugin.define ("haxe_" ^ string_of_int version);
@@ -145,7 +174,7 @@ try
 	(try
 		let p = Sys.getenv "HAXE_LIBRARY_PATH" in
 		let rec loop = function
-			| drive :: path :: l ->	
+			| drive :: path :: l ->
 				if String.length drive = 1 && ((drive.[0] >= 'a' && drive.[0] <= 'z') || (drive.[0] >= 'A' && drive.[0] <= 'Z')) then
 					(drive ^ ":" ^ path) :: loop l
 				else
@@ -179,7 +208,7 @@ try
 			Typer.forbidden_packages := ["js"; "neko"];
 			target := Swf file
 		),"<file> : compile code to Flash SWF file");
-		("-swf-version",Arg.Int (fun v -> 
+		("-swf-version",Arg.Int (fun v ->
 			swf_version := v;
 		),"<version> : change the SWF version (6,7,8,9)");
 		("-swf-header",Arg.String (fun h ->
@@ -241,7 +270,7 @@ try
 			let ch = open_in file in
 			let lines = Std.input_list ch in
 			close_in ch;
-			excludes := (List.map (fun l -> 
+			excludes := (List.map (fun l ->
 				let len = String.length l in
 				let l = (if len > 0 && l.[len-1] = '\r' then String.sub l 0 (len - 1) else l) in
 				match List.rev (ExtString.String.nsplit l ".") with
@@ -256,7 +285,7 @@ try
 			cmds := cmd :: !cmds
 		),": run the specified command after successful compilation");
 		("--flash-strict", define "flash_strict", ": more type strict flash API");
-		("--override", Arg.Unit (fun() -> 
+		("--override", Arg.Unit (fun() ->
 			Typer.check_override := true
 		),": ensure that overriden methods are declared with 'override'");
 		("--no-traces", define "no_traces", ": don't compile trace calls in the program");
@@ -269,6 +298,10 @@ try
 		("--next", Arg.Unit (fun() -> assert false), ": separate several haxe compilations");
 		("--altfmt", Arg.Unit (fun() -> alt_format := true),": use alternative error output format");
 		("--auto-xml", Arg.Unit (fun() -> auto_xml := true),": automatically create an XML for each target");
+		("--display", Arg.Unit (fun () ->
+			display := true;
+			Parser.resume_display := true;
+		),": display code tips");
 	] in
 	let current = ref 0 in
 	let args = Array.of_list ("" :: params) in
@@ -277,7 +310,7 @@ try
 		| x :: _ when String.lowercase x = "hxml" ->
 			let ch = (try open_in cl with _ -> failwith ("File not found " ^ cl)) in
 			let lines = Std.input_list ch in
-			let hxml_args = List.concat (List.map (fun l -> 
+			let hxml_args = List.concat (List.map (fun l ->
 				let len = String.length l in
 				let l = (if len != 0 && l.[len - 1] = '\r' then String.sub l 0 (len-1) else l) in
 				if l = "" || l.[0] = '#' then
@@ -308,7 +341,7 @@ try
 		let p = Unix.open_process_in cmd in
 		let lines = Std.input_list p in
 		let ret = Unix.close_process_in p in
-		let lines = List.fold_left (fun acc l ->			
+		let lines = List.fold_left (fun acc l ->
 			let p = String.length l - 1 in
 			let l = (if l.[p] = '\r' then String.sub l 0 p else l) in
 			if p > 3 && String.sub l 0 3 = "-L " then begin
@@ -326,7 +359,7 @@ try
 	| Swf file ->
 		(* check file extension. In case of wrong commandline, we don't want
 		   to accidentaly delete a source file. *)
-		if file_extension file = "swf" then delete_file file;	
+		if file_extension file = "swf" then delete_file file;
 		Plugin.define "flash";
 		Plugin.define ("flash"  ^ string_of_int !swf_version);
 	| Neko file ->
@@ -344,6 +377,10 @@ try
 		List.iter (fun cpath -> ignore(Typer.load ctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize ctx;
 		if !has_error then do_exit();
+		if !display then begin
+			target := No;
+			auto_xml := false;
+		end;
 		let do_auto_xml file = if !auto_xml then xml_out := Some (file ^ ".xml") in
 		let types = Typer.types ctx (!main_class) (!excludes) in
 		(match !target with
@@ -374,13 +411,28 @@ try
 		else
 			if Sys.command cmd <> 0 then failwith "Command failed"
 	) (List.rev !cmds)
-with	
+with
 	| Lexer.Error (m,p) -> report (Lexer.error_msg m) p
 	| Parser.Error (m,p) -> report (Parser.error_msg m) p
 	| Typer.Error (m,p) -> report (Typer.error_msg m) p
 	| Failure msg | Arg.Bad msg -> report ("Error : " ^ msg) Ast.null_pos
 	| Arg.Help msg -> print_string msg
 	| Hxml_found -> ()
+	| Typer.Display t ->
+		let ctx = Type.print_context() in
+		(match Type.follow t with
+		| Type.TAnon a ->
+			report_list (PMap.fold (fun f acc ->
+				(f.Type.cf_name,Type.s_type ctx f.Type.cf_type,match f.Type.cf_doc with None -> "" | Some d -> d) :: acc
+			) a.Type.a_fields []);
+		| _ ->
+			prerr_string (Type.s_type ctx t));
+		exit 0;
+	| Parser.TypePath p ->
+		let packs, classes = read_type_path p (!Plugin.class_path) in
+		if packs = [] && classes = [] then report ("No classes found in " ^ String.concat "." p) Ast.null_pos;
+		report_list (List.map (fun f -> f,"","") (packs @ classes));
+		exit 0;
 	| e -> report (Printexc.to_string e) Ast.null_pos
 
 ;;

parser.ml

@@ -27,6 +27,7 @@ type error_msg =
 	| Missing_type
 
 exception Error of error_msg * pos
+exception TypePath of string list
 
 let error_msg = function
 	| Unexpected t -> "Unexpected "^(s_token t)
@@ -42,6 +43,7 @@ let display_error : (error_msg -> pos -> unit) ref = ref (fun _ _ -> assert fals
 let cache = ref (DynArray.create())
 let doc = ref None
 let use_doc = ref false
+let resume_display = ref false
 
 let last_token s =
 	let n = Stream.count s in
@@ -136,7 +138,9 @@ let semicolon s =
 	else
 		match s with parser
 		| [< '(Semicolon,p) >] -> p
-		| [< s >] -> error Missing_semicolon (snd (last_token s))
+		| [< s >] ->
+			let pos = snd (last_token s) in
+			if !resume_display then pos else error Missing_semicolon pos
 
 let rec	parse_file s =
 	doc := None;
@@ -146,7 +150,7 @@ let rec	parse_file s =
 
 and parse_type_decl s =
 	match s with parser
-	| [< '(Kwd Import,p1); p, t, s = parse_import; p2 = semicolon >] -> EImport (p,t,s) , punion p1 p2
+	| [< '(Kwd Import,p1); p, t, s = parse_import []; p2 = semicolon >] -> EImport (p,t,s) , punion p1 p2
 	| [< c = parse_common_flags; s >] ->
 		match s with parser
 		| [< n , p1 = parse_enum_flags; doc = get_doc; '(Const (Type name),_); tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] ->
@@ -176,12 +180,18 @@ and parse_type_decl s =
 
 and parse_package s = psep Dot ident s
 
-and parse_import = parser
-	| [< '(Const (Ident k),_); '(Dot,_); p, t, s = parse_import >] -> (k :: p), t, s
+and parse_import acc = parser
+	| [< '(Const (Ident k),_); '(Dot,_); s >] ->
+		parse_import (k :: acc) s
 	| [< '(Const (Type t),_); s >] ->
-		[] , t , match s with parser
+		(List.rev acc , t , match s with parser
 			| [< '(Dot,_); '(Const (Type s),_) >] -> Some s
-			| [< >] -> None
+			| [< >] -> None)
+	| [< >] ->
+		if !resume_display then
+			raise  (TypePath (List.rev acc))
+		else
+			serror()
 
 and parse_common_flags = parser
 	| [< '(Kwd Private,_); l = parse_common_flags >] -> (HPrivate, EPrivate) :: l
@@ -229,6 +239,11 @@ and parse_type_path1 pack = parser
 			tname = name;
 			tparams = params
 		}
+	| [< >] ->
+		if !resume_display then
+			raise  (TypePath (List.rev pack))
+		else
+			serror()
 
 and parse_type_path_variance = parser
 	| [< '(Binop OpAdd,_); t = parse_type_path_or_const VCo >] -> t
@@ -418,7 +433,7 @@ and parse_var_decl = parser
 		| [< >] -> (name,t,None)
 
 and expr = parser
-	| [< '(BrOpen,p1); b = block1; '(BrClose,p2); s >] -> 
+	| [< '(BrOpen,p1); b = block1; '(BrClose,p2); s >] ->
 		let e = (b,punion p1 p2) in
 		(match b with
 		| EObjectDecl _ -> expr_next e s
@@ -476,13 +491,15 @@ and expr = parser
 	| [< '(Kwd Untyped,p1); e = expr >] -> (EUntyped e,punion p1 (pos e))
 
 and expr_next e1 = parser
-	| [< '(Dot,_); s >] ->
+	| [< '(Dot,p); s >] ->
 		(match s with parser
 		| [< '(Const (Ident f),p); s >] -> expr_next (EField (e1,f) , punion (pos e1) p) s
 		| [< '(Const (Type t),p); s >] -> expr_next (EType (e1,t) , punion (pos e1) p) s
-		| [< >] -> serror())
-	| [< '(POpen,p1); params = psep Comma expr; '(PClose,p2); s >] ->
-		expr_next (ECall (e1,params) , punion (pos e1) p2) s
+		| [< >] -> if !resume_display then (EDisplay e1, p) else serror())
+	| [< '(POpen,p1); params = psep Comma expr; s >] ->
+		(match s with parser
+		| [< '(PClose,p2); s >] -> expr_next (ECall (e1,params) , punion (pos e1) p2) s
+		| [< >] -> if !resume_display then (EDisplay e1,p1) else serror())
 	| [< '(BkOpen,_); e2 = expr; '(BkClose,p2); s >] ->
 		expr_next (EArray (e1,e2), punion (pos e1) p2) s
 	| [< '(Binop OpGt,_); s >] ->

typer.ml

@@ -16,7 +16,6 @@
  *  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
 
@@ -52,6 +51,7 @@ type context = {
 	mutable in_constructor : bool;
 	mutable in_static : bool;
 	mutable in_loop : bool;
+	mutable in_display : bool;
 	mutable ret : t;
 	mutable locals : (string, t) PMap.t;
 	mutable locals_map : (string, string) PMap.t;
@@ -74,6 +74,7 @@ type switch_mode =
 	| CExpr of texpr
 
 exception Error of error_msg * pos
+exception Display of t
 
 let access_str = function
 	| NormalAccess -> "default"
@@ -140,6 +141,7 @@ let context err warn =
 		untyped = false;
 		isproxy = false;
 		super_call = false;
+		in_display = false;
 		ret = mk_mono();
 		warn = warn;
 		error = err;
@@ -1543,7 +1545,9 @@ and type_access ctx e p get =
 									) (List.rev acc) in
 									raise (Error (Module_not_found (List.rev !path,name),p))
 								with
-									Not_found -> raise e)
+									Not_found ->
+										if ctx.in_display then raise (Parser.TypePath (List.map (fun (n,_,_) -> n) (List.rev acc)));
+										raise e)
 				| (_,false,_) as x :: path ->
 					loop (x :: acc) path
 				| (name,true,p) as x :: path ->
@@ -1988,6 +1992,27 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			(EIf (cond,etmp,Some (EThrow (EConst (String "Class cast error"),p),p)),p);
 		],p) in
 		{ e with etype = t }
+	| EDisplay e ->
+		let old = ctx.in_display in
+		ctx.in_display <- true;
+		let e = (try type_expr ctx e with Error (Unknown_ident n,_) -> raise (Parser.TypePath [n])) in
+		ctx.in_display <- old;
+		let t = (match follow e.etype with
+			| TInst (c,params) ->
+				let priv = is_parent c ctx.curclass in
+				let rec loop c params =
+					let m = (match c.cl_super with
+						| None -> PMap.empty
+						| Some (csup,cparams) -> loop csup cparams
+					) in
+					let m = PMap.fold (fun f m -> if priv || f.cf_public then PMap.add f.cf_name f m else m) c.cl_fields m in
+					PMap.map (fun f -> { f with cf_type = apply_params c.cl_types params f.cf_type }) m
+				in
+				let fields = loop c params in
+				TAnon { a_fields = fields; a_status = ref Closed; }
+			| t -> t
+		) in
+		raise (Display t)
 
 and type_function ctx t static constr f p =
 	let locals = save_locals ctx in
@@ -2419,6 +2444,7 @@ let type_module ctx m tdecls loadp =
 		super_call = false;
 		in_constructor = false;
 		in_static = false;
+		in_display = false;
 		in_loop = false;
 		untyped = false;
 		opened = [];