Selaa lähdekoodia

[display] merge internal Toplevel/Completion exceptions too

Simon Krajewski 7 vuotta sitten
vanhempi
commit
ed81df3225

+ 5 - 3
src/compiler/displayOutput.ml

@@ -60,7 +60,9 @@ let print_fields fields =
 		| ITModule s -> "type",s,"",None
 		| ITMetadata(s,doc) -> "metadata",s,"",doc
 		| ITTimer(name,value) -> "timer",name,"",Some value
-		| ITGlobal _ | ITLiteral _ | ITLocal _ -> assert false
+		| ITGlobal(_,s,t) -> "global",s,s_type (print_context()) t,None
+		| ITLiteral(s,t) -> "literal",s,s_type (print_context()) t,None
+		| ITLocal v -> "local",v.v_name,s_type (print_context()) v.v_type,None
 	in
 	let fields = List.sort (fun k1 k2 -> compare (legacy_sort k1) (legacy_sort k2)) fields in
 	let fields = List.map convert fields in
@@ -837,9 +839,9 @@ let print_type com t p doc = match com.json_out with
 		"type",generate_type (create_context ()) t;
 	])
 
-let print_fields com fields = match com.json_out with
+let print_fields com fields is_toplevel = match com.json_out with
 	| None ->
-		print_fields fields
+		if is_toplevel then print_toplevel fields else print_fields fields
 	| Some(f,_) ->
 		let j = List.map (CompletionKind.to_json (Genjson.create_context ())) fields in
 		f (jarray j)

+ 3 - 12
src/compiler/main.ml

@@ -902,7 +902,7 @@ with
 		message ctx (CMInfo(msg,null_pos))
 	| Display.DisplayPackage pack ->
 		raise (DisplayOutput.Completion (DisplayOutput.print_package ctx.com pack))
-	| Display.DisplayFields fields ->
+	| Display.DisplayFields(fields,is_toplevel) ->
 		let fields =
 			if !measure_times then begin
 				Timer.close_times();
@@ -912,7 +912,7 @@ with
 			end else
 				fields
 		in
-		raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields))
+		raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields is_toplevel))
 	| Display.DisplayType (t,p,doc) ->
 		let doc = match doc with Some _ -> doc | None -> DisplayOutput.find_doc t in
 		raise (DisplayOutput.Completion (DisplayOutput.print_type ctx.com t p doc))
@@ -923,15 +923,6 @@ with
 			raise (DisplayOutput.Completion (DisplayOutput.print_signatures signatures))
 	| Display.DisplayPosition pl ->
 		raise (DisplayOutput.Completion (DisplayOutput.print_positions ctx.com pl))
-	| Display.DisplayToplevel il ->
-		let il =
-			if !measure_times then begin
-				Timer.close_times();
-				(List.map (fun (name,value) -> DisplayTypes.CompletionKind.ITTimer ("@TIME " ^ name,value)) (DisplayOutput.get_timer_fields !start_time)) @ il
-			end else
-				il
-		in
-		raise (DisplayOutput.Completion (DisplayOutput.print_toplevel il))
 	| Parser.TypePath (p,c,is_import) ->
 		let fields =
 			try begin match c with
@@ -943,7 +934,7 @@ with
 				error ctx msg p;
 				None
 		in
-		Option.may (fun fields -> raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields))) fields
+		Option.may (fun fields -> raise (DisplayOutput.Completion (DisplayOutput.print_fields ctx.com fields false))) fields
 	| Display.ModuleSymbols s | Display.Diagnostics s | Display.Statistics s | Display.Metadata s ->
 		raise (DisplayOutput.Completion s)
 	| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->

+ 2 - 3
src/context/display.ml

@@ -15,8 +15,7 @@ exception Metadata of string
 exception DisplaySignatures of (tsignature * documentation) list * int
 exception DisplayType of t * pos * string option
 exception DisplayPosition of pos list
-exception DisplayFields of DisplayTypes.CompletionKind.t list
-exception DisplayToplevel of DisplayTypes.CompletionKind.t list
+exception DisplayFields of DisplayTypes.CompletionKind.t list * bool (* toplevel? *)
 exception DisplayPackage of string list
 
 let is_display_file file =
@@ -196,7 +195,7 @@ module DisplayEmitter = struct
 			let all = List.map (fun (s,doc) ->
 				ITMetadata(s,Some doc)
 			) all in
-			raise (DisplayFields all)
+			raise (DisplayFields(all,false))
 		| _ ->
 			()
 

+ 1 - 1
src/typing/typeload.ml

@@ -39,7 +39,7 @@ let type_function_params_rec = ref (fun _ _ _ _ -> assert false)
 let rec load_type_def ctx p t =
 	let no_pack = t.tpackage = [] in
 	let tname = (match t.tsub with None -> t.tname | Some n -> n) in
-	if tname = "" then raise (Display.DisplayToplevel (DisplayToplevel.collect ctx true NoValue));
+	if tname = "" then raise (Display.DisplayFields (DisplayToplevel.collect ctx true NoValue,true));
 	try
 		if t.tsub <> None then raise Not_found;
 		let path_matches t2 =

+ 2 - 2
src/typing/typeloadModule.ml

@@ -360,7 +360,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 				ctx.m.wildcard_packages <- (List.map fst pack,p) :: ctx.m.wildcard_packages
 			| _ ->
 				(match List.rev path with
-				| [] -> raise (Display.DisplayToplevel (DisplayToplevel.collect ctx true NoValue));
+				| [] -> raise (Display.DisplayFields (DisplayToplevel.collect ctx true NoValue,true));
 				| (_,p) :: _ -> error "Module name must start with an uppercase letter" p))
 		| (tname,p2) :: rest ->
 			let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
@@ -469,7 +469,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 			| (s1,_) :: sl ->
 				{ tpackage = List.rev (List.map fst sl); tname = s1; tsub = None; tparams = [] }
 			| [] ->
-				raise (Display.DisplayToplevel (DisplayToplevel.collect ctx true NoValue));
+				raise (Display.DisplayFields (DisplayToplevel.collect ctx true NoValue,true));
 		in
 		(* do the import first *)
 		let types = (match t.tsub with

+ 4 - 4
src/typing/typerDisplay.ml

@@ -42,7 +42,7 @@ let rec handle_display ctx e_ast dk with_type =
 		raise (Parser.TypePath ([n],None,false))
 	| Error (Type_not_found (path,_),_) as err ->
 		begin try
-			raise (Display.DisplayFields (DisplayFields.get_submodule_fields ctx path))
+			raise (Display.DisplayFields (DisplayFields.get_submodule_fields ctx path,false))
 		with Not_found ->
 			raise err
 		end
@@ -226,10 +226,10 @@ and display_expr ctx e_ast e dk with_type p =
 		let pl = loop e in
 		raise (Display.DisplayPosition pl);
 	| DMDefault when not (!Parser.had_resume)->
-		raise (Display.DisplayToplevel (DisplayToplevel.collect ctx false with_type))
+		raise (Display.DisplayFields (DisplayToplevel.collect ctx false with_type,true))
 	| DMDefault | DMNone | DMModuleSymbols _ | DMDiagnostics _ | DMStatistics ->
 		let fields = DisplayFields.collect ctx e_ast e dk with_type p in
-		raise (Display.DisplayFields fields)
+		raise (Display.DisplayFields(fields,false))
 
 let handle_structure_display ctx e with_type =
 	let p = pos e in
@@ -249,7 +249,7 @@ let handle_structure_display ctx e with_type =
 			end
 		| _ -> fail()
 		in
-		raise (Display.DisplayFields fields)
+		raise (Display.DisplayFields(fields,false))
 	| _ ->
 		error "Expected object expression" p