add display.ml and document-symbol mode

Makefile

@@ -24,7 +24,7 @@ OCAMLC?=ocamlc
 LFLAGS=
 
 CFLAGS= -g -I libs/extlib -I libs/extc -I libs/neko -I libs/javalib -I libs/ziplib -I libs/swflib -I libs/xml-light -I libs/ttflib -I libs/ilib -I libs/objsize \
-	-I src -I src/generators -I src/macro -I src/optimization -I src/syntax -I src/typing
+	-I src -I src/generators -I src/macro -I src/optimization -I src/syntax -I src/typing -I src/display
 
 LIBS=unix str libs/extlib/extLib libs/xml-light/xml-light libs/swflib/swflib \
 	libs/extc/extc libs/neko/neko libs/javalib/java libs/ziplib/zip \
@@ -52,6 +52,7 @@ CC_PARSER_CMD = $(COMPILER) -pp camlp4o $(CFLAGS) -c src/syntax/parser.ml
 RELDIR=../../..
 
 MODULES=json syntax/ast typing/type syntax/lexer typing/common generators/genxml syntax/parser typing/typecore \
+	display/display \
 	optimization/optimizer typing/typeload generators/codegen generators/gencommon generators/genas3 \
 	generators/gencpp generators/genjs generators/genneko generators/genphp generators/genswf9 \
 	generators/genswf generators/genjava generators/gencs generators/genpy macro/interp generators/genhl \
@@ -130,6 +131,10 @@ uninstall:
 
 # Modules
 
+# display
+
+src/display/display.$(MODULE_EXT): src/syntax/ast.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT)
+
 # generators
 
 src/generators/codegen.$(MODULE_EXT): src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/generators/genxml.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT)
@@ -199,18 +204,18 @@ src/typing/common.$(MODULE_EXT): src/typing/type.$(MODULE_EXT) src/syntax/ast.$(
 
 src/typing/matcher.$(MODULE_EXT): src/optimization/optimizer.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/typing/typer.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT)
 
-src/typing/type.$(MODULE_EXT): src/syntax/ast.$(MODULE_EXT)
+src/typing/type.$(MODULE_EXT): src/syntax/ast.$(MODULE_EXT) src/json.$(MODULE_EXT)
 
 src/typing/typecore.$(MODULE_EXT): src/typing/type.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT)
 
-src/typing/typeload.$(MODULE_EXT): src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT)
+src/typing/typeload.$(MODULE_EXT): src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/json.$(MODULE_EXT) src/display/display.$(MODULE_EXT)
 
 src/typing/typer.$(MODULE_EXT): src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/optimization/filters.$(MODULE_EXT) src/generators/gencommon.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT)
 
 
 # main
 
-src/main.$(MODULE_EXT): src/optimization/filters.$(MODULE_EXT) src/typing/matcher.$(MODULE_EXT) src/typing/typer.$(MODULE_EXT) src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/generators/genxml.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genphp.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT) src/generators/gencpp.$(MODULE_EXT) src/generators/genas3.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/gencommon.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/generators/genpy.$(MODULE_EXT) src/generators/genhl.$(MODULE_EXT) src/version.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
+src/main.$(MODULE_EXT): src/optimization/filters.$(MODULE_EXT) src/typing/matcher.$(MODULE_EXT) src/typing/typer.$(MODULE_EXT) src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/generators/genxml.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genphp.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT) src/generators/gencpp.$(MODULE_EXT) src/generators/genas3.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/gencommon.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/generators/genpy.$(MODULE_EXT) src/generators/genhl.$(MODULE_EXT) src/version.$(MODULE_EXT) src/display/display.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
 
 src/version.$(MODULE_EXT):
 	$(MAKE) -f Makefile.version_extra -s --no-print-directory ADD_REVISION=$(ADD_REVISION) BRANCH=$(BRANCH) COMMIT_SHA=$(COMMIT_SHA) COMMIT_DATE=$(COMMIT_DATE) > src/version.ml

src/display/display.ml

@@ -0,0 +1,232 @@
+open Ast
+
+exception DocumentSymbols of string
+
+let is_display_file p =
+	Common.unique_full_path p.pfile = (!Parser.resume_display).pfile
+
+let encloses_position p_target p =
+	p.pmin <= p_target.pmin && p.pmax >= p_target.pmax
+
+let find_enclosing com e =
+	let display_pos = ref (!Parser.resume_display) in
+	let mk_null p = (EDisplay(((EConst(Ident "null")),p),false),p) in
+	let encloses_display_pos p =
+		if encloses_position !display_pos p then begin
+			let p = !display_pos in
+			display_pos := { pfile = ""; pmin = -2; pmax = -2 };
+			Some p
+		end else
+			None
+	in
+	let rec loop e = match fst e with
+		| EBlock el ->
+			let p = pos e in
+			(* We want to find the innermost block which contains the display position. *)
+			let el = List.map loop el in
+			let el = match encloses_display_pos p with
+				| None ->
+					el
+				| Some p2 ->
+					let b,el = List.fold_left (fun (b,el) e ->
+						let p = pos e in
+						if b || p.pmax <= p2.pmin then begin
+							(b,e :: el)
+						end else begin
+							let e_d = (EDisplay(mk_null p,false)),p in
+							(true,e :: e_d :: el)
+						end
+					) (false,[]) el in
+					let el = if b then
+						el
+					else begin
+						mk_null p :: el
+					end in
+					List.rev el
+			in
+			(EBlock el),(pos e)
+		| _ ->
+			Ast.map_expr loop e
+	in
+	loop e
+
+let find_before_pos com e =
+	let display_pos = ref (!Parser.resume_display) in
+	let is_annotated p =
+		if p.pmin <= !display_pos.pmin && p.pmax >= !display_pos.pmax then begin
+			display_pos := { pfile = ""; pmin = -2; pmax = -2 };
+			true
+		end else
+			false
+	in
+	let rec loop e =
+		if is_annotated (pos e) then
+			(EDisplay(e,false),(pos e))
+		else
+			e
+	in
+	let rec map e =
+		loop (Ast.map_expr map e)
+	in
+	map e
+
+module SymbolKind = struct
+	type t =
+		| File
+		| Module
+		| Namespace
+		| Package
+		| Class
+		| Method
+		| Property
+		| Field
+		| Constructor
+		| Enum
+		| Interface
+		| Function
+		| Variable
+		| Constant
+		| String
+		| Number
+		| Boolean
+		| Array
+
+	let to_int = function
+		| File -> 1
+		| Module -> 2
+		| Namespace -> 3
+		| Package -> 4
+		| Class -> 5
+		| Method -> 6
+		| Property -> 7
+		| Field -> 8
+		| Constructor -> 9
+		| Enum -> 10
+		| Interface -> 11
+		| Function -> 12
+		| Variable -> 13
+		| Constant -> 14
+		| String -> 15
+		| Number -> 16
+		| Boolean -> 17
+		| Array -> 18
+end
+
+module SymbolInformation = struct
+	type t = {
+		name : string;
+		kind : SymbolKind.t;
+		location : pos;
+		containerName : string option;
+	}
+
+	let make name kind location containerName = {
+		name = name;
+		kind = kind;
+		location = location;
+		containerName = containerName;
+	}
+end
+
+open Json
+open SymbolKind
+open SymbolInformation
+
+let print_document_symbols (pack,decls) =
+	let l = DynArray.create() in
+	let add name kind location parent =
+		let si = SymbolInformation.make name kind location (match parent with None -> None | Some si -> Some si.name) in
+		DynArray.add l si;
+		si
+	in
+(* 		let si_pack = match pack with
+		| [] -> None
+		| _ -> Some (add (String.concat "." pack) Package null_pos None) (* TODO: we don't have the position *)
+	in *)
+	let si_pack = None in (* TODO: no position, no point *)
+	let rec expr si (e,p) =
+		let add name kind location = add name kind location si in
+		let add_ignore name kind location = ignore(add name kind location) in
+		begin match e with
+			(* TODO: disabled for now because it's too spammy *)
+(* 			| EConst ct ->
+			begin match ct with
+				| Int i | Float i -> add_ignore i Number p
+				| Ast.String s -> add_ignore s String p
+				| Ident ("true" | "false" as s) -> add_ignore s Boolean p
+				| Ident _ -> (* Hmm... *) ()
+				| _ -> ()
+			end *)
+		| EVars vl ->
+			List.iter (fun (s,_,eo) ->
+				add_ignore s Variable p; (* TODO: Don't have a good pos here... *)
+				expr_opt si eo
+			) vl
+		| ETry(e1,catches) ->
+			expr si e1;
+			List.iter (fun (s,_,e) ->
+				add_ignore s Variable (pos e); (* TODO: No good pos as usual... *)
+				expr si e
+			) catches;
+		| EFunction(Some s,f) ->
+			let si_function = add s Function p in
+			func si_function f
+		| EIn((EConst(Ident s),p),e2) ->
+			add_ignore s Variable p;
+			expr si e2;
+		| _ ->
+			iter_expr (expr si) (e,p)
+		end
+	and expr_opt si eo = match eo with
+		| None -> ()
+		| Some e -> expr si e
+	and func si f =
+		List.iter (fun (s,_,_,eo) ->
+			let si_arg = add s Variable si.location (* TODO: don't have *) (Some si) in
+			expr_opt (Some si_arg) eo
+		) f.f_args;
+		expr_opt (Some si) f.f_expr
+	in
+	let field si_type cff = match cff.cff_kind with
+		| FVar(_,eo) ->
+			let si_field = add cff.cff_name Field cff.cff_pos (Some si_type) in
+			expr_opt (Some si_field) eo
+		| FFun f ->
+			let si_method = add cff.cff_name (if cff.cff_name = "new" then Constructor else Method) cff.cff_pos (Some si_type) in
+			func si_method f
+		| FProp(_,_,_,eo) ->
+			let si_property = add cff.cff_name Property cff.cff_pos (Some si_type) in
+			expr_opt (Some si_property) eo
+	in
+	List.iter (fun (td,p) -> match td with
+		| EImport _ | EUsing _ ->
+			() (* TODO: Can we do anything with these? *)
+		| EClass d ->
+			let si_type = add d.d_name (if List.mem HInterface d.d_flags then Interface else Class) p si_pack in
+			List.iter (field si_type) d.d_data
+		| EEnum d ->
+			let si_type = add d.d_name Enum p si_pack in
+			List.iter (fun ef ->
+				ignore (add ef.ec_name Method ef.ec_pos (Some si_type))
+			) d.d_data
+		| ETypedef d ->
+			(* TODO: hmm... *)
+			()
+		| EAbstract d ->
+			let si_type = add d.d_name Class p si_pack in
+			List.iter (field si_type) d.d_data
+	) decls;
+	let error_printer file line = Printf.sprintf "%s:%d:" (Common.unique_full_path file) line in
+	let jl = List.map (fun si ->
+		let l =
+			("name",JString si.name) ::
+			("kind",JInt (to_int si.kind)) ::
+			("location",JString (Lexer.get_error_pos error_printer si.location)) ::
+			(match si.containerName with None -> [] | Some s -> ["containerName",JString s])
+		in
+		JObject l
+	) (DynArray.to_list l) in
+	let js = JArray jl in
+	let b = Buffer.create 0 in
+	write_json (Buffer.add_string b) js;
+	Buffer.contents b

src/main.ml

@@ -1276,6 +1276,9 @@ try
 					| "toplevel" ->
 						activate_special_display_mode();
 						DMToplevel
+					| "document-symbols" ->
+						Common.define com Define.NoCOpt;
+						DMDocumentSymbols;
 					| "" ->
 						Parser.use_parser_resume := true;
 						DMDefault
@@ -1803,6 +1806,8 @@ with
 				raise (Completion c)
 			| _ ->
 				error ctx ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos)
+	| Display.DocumentSymbols s ->
+		raise (Completion s)
 	| Interp.Sys_exit i ->
 		ctx.flush();
 		exit i

src/typing/common.ml

@@ -98,6 +98,7 @@ type display_mode =
 	| DMToplevel
 	| DMResolve of string
 	| DMType
+	| DMDocumentSymbols
 
 type compiler_callback = {
 	mutable after_typing : (module_type list -> unit) list;
@@ -207,8 +208,8 @@ module Define = struct
 		| JsUnflatten
 		| KeepOldOutput
 		| LoopUnrollMaxCost
-	        | LuaVer
-	        | LuaJit
+		| LuaVer
+		| LuaJit
 		| Macro
 		| MacroTimes
 		| NekoSource
@@ -968,9 +969,9 @@ let rec mkdir_recursive base dir_list =
 	| [] -> ()
 	| dir :: remaining ->
 		let path = match base with
-		           | "" ->  dir
-		           | "/" -> "/" ^ dir
-		           | _ -> base ^ "/" ^ dir
+				   | "" ->  dir
+				   | "/" -> "/" ^ dir
+				   | _ -> base ^ "/" ^ dir
 		in
 		if not ( (path = "") || ( ((String.length path) = 2) && ((String.sub path 1 1) = ":") ) ) then
 			if not (Sys.file_exists path) then
@@ -1043,8 +1044,8 @@ Ast.Meta.to_string_ref := fun m -> fst (MetaInfo.to_string m)
 
 (*  Taken from OCaml source typing/oprint.ml
 
-    This is a better version of string_of_float which prints without loss of precision
-    so that float_of_string (float_repres x) = x for all floats x
+	This is a better version of string_of_float which prints without loss of precision
+	so that float_of_string (float_repres x) = x for all floats x
 *)
 let valid_float_lexeme s =
 	let l = String.length s in

src/typing/typeload.ml

@@ -226,6 +226,8 @@ let parse_file_from_lexbuf com file p lexbuf =
 	Lexer.init file true;
 	incr stats.s_files_parsed;
 	let data = (try Parser.parse com lexbuf with e -> t(); raise e) in
+	if com.display = DMDocumentSymbols && Common.unique_full_path file = (!Parser.resume_display).pfile then
+		raise (Display.DocumentSymbols(Display.print_document_symbols data));
 	t();
 	Common.log com ("Parsed " ^ file);
 	data
@@ -1528,83 +1530,6 @@ let type_function_params ctx fd fname p =
 	params := type_type_params ctx ([],fname) (fun() -> !params) p fd.f_params;
 	!params
 
-module Display = struct
-	let is_display_file ctx p = match ctx.com.display with
-			| DMNone -> false
-			| DMResolve s ->
-				let mt = load_type_def ctx p {tname = s; tpackage = []; tsub = None; tparams = []} in
-				let p = (t_infos mt).mt_pos in
-				raise (DisplayPosition [p]);
-			| _ ->
-				Common.unique_full_path p.pfile = (!Parser.resume_display).pfile
-
-	let encloses_position p_target p =
-		p.pmin <= p_target.pmin && p.pmax >= p_target.pmax
-
-	let find_enclosing com e =
-		let display_pos = ref (!Parser.resume_display) in
-		let mk_null p = (EDisplay(((EConst(Ident "null")),p),false),p) in
-		let encloses_display_pos p =
-			if encloses_position !display_pos p then begin
-				let p = !display_pos in
-				display_pos := { pfile = ""; pmin = -2; pmax = -2 };
-				Some p
-			end else
-				None
-		in
-		let rec loop e = match fst e with
-			| EBlock el ->
-				let p = pos e in
-				(* We want to find the innermost block which contains the display position. *)
-				let el = List.map loop el in
-				let el = match encloses_display_pos p with
-					| None ->
-						el
-					| Some p2 ->
-						let b,el = List.fold_left (fun (b,el) e ->
-							let p = pos e in
-							if b || p.pmax <= p2.pmin then begin
-								(b,e :: el)
-							end else begin
-								let e_d = (EDisplay(mk_null p,false)),p in
-								(true,e :: e_d :: el)
-							end
-						) (false,[]) el in
-						let el = if b then
-							el
-						else begin
-							mk_null p :: el
-						end in
-						List.rev el
-				in
-				(EBlock el),(pos e)
-			| _ ->
-				Ast.map_expr loop e
-		in
-		loop e
-
-	let find_before_pos com e =
-		let display_pos = ref (!Parser.resume_display) in
-		let is_annotated p =
-			if p.pmin <= !display_pos.pmin && p.pmax >= !display_pos.pmax then begin
-				display_pos := { pfile = ""; pmin = -2; pmax = -2 };
-				true
-			end else
-				false
-		in
-		let rec loop e =
-			if is_annotated (pos e) then
-				(EDisplay(e,false),(pos e))
-			else
-				e
-		in
-		let rec map e =
-			loop (Ast.map_expr map e)
-		in
-		map e
-
-end
-
 let type_function ctx args ret fmode f do_display p =
 	let locals = save_locals ctx in
 	let fargs = List.map (fun (n,c,t) ->
@@ -1929,6 +1854,15 @@ let build_module_def ctx mt meta fvars context_init fbuild =
 	List.iter (fun f -> f()) (List.rev f_build);
 	(match f_enum with None -> () | Some f -> f())
 
+let is_display_file ctx p = match ctx.com.display with
+	| DMNone -> false
+	| DMResolve s ->
+		let mt = load_type_def ctx p {tname = s; tpackage = []; tsub = None; tparams = []} in
+		let p = (t_infos mt).mt_pos in
+		raise (DisplayPosition [p]);
+	| _ ->
+		Display.is_display_file p
+
 module ClassInitializer = struct
 	type class_init_ctx = {
 		tclass : tclass; (* I don't trust ctx.curclass because it's mutable. *)
@@ -1998,7 +1932,7 @@ module ClassInitializer = struct
 			| None -> false
 			| Some (c,_) -> extends_public c
 		in
-		let is_display_file = Display.is_display_file ctx p in
+		let is_display_file = is_display_file ctx p in
 		let cctx = {
 			tclass = c;
 			is_lib = is_lib;
@@ -3152,7 +3086,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 		let index = ref 0 in
 		let is_flat = ref true in
 		let fields = ref PMap.empty in
-		let is_display_file = Display.is_display_file ctx p in
+		let is_display_file = is_display_file ctx p in
 		List.iter (fun c ->
 			let p = c.ec_pos in
 			let params = ref [] in

src/typing/typer.ml

@@ -3819,7 +3819,7 @@ and handle_display ctx e_ast iscall with_type p =
 		raise (DisplayPosition pl);
 	| DMToplevel ->
 		collect_toplevel_identifiers ctx;
-	| DMDefault | DMNone ->
+	| DMDefault | DMNone | DMDocumentSymbols ->
 		let opt_args args ret = TFun(List.map(fun (n,o,t) -> n,true,t) args,ret) in
 		let e = match e.eexpr with
 			| TField (e1,fa) ->