[display] store signatures directly in DisplaySignatures, instead of TFun - less run-time checks, more type safety \o/

src/display/display.ml

@@ -27,7 +27,7 @@ exception Diagnostics of string
 exception Statistics of string
 exception ModuleSymbols of string
 exception Metadata of string
-exception DisplaySignatures of (t * documentation) list * int
+exception DisplaySignatures of (tsignature * documentation) list * int
 exception DisplayType of t * pos * string option
 exception DisplayPosition of pos list
 exception DisplayFields of (string * display_field_kind * documentation) list

src/display/displayOutput.ml

@@ -103,11 +103,11 @@ let print_type t p doc =
 
 let print_signatures tl =
 	let b = Buffer.create 0 in
-	List.iter (fun (t,doc) ->
+	List.iter (fun ((args,ret),doc) ->
 		Buffer.add_string b "<type";
 		Option.may (fun s -> Buffer.add_string b (Printf.sprintf " d=\"%s\"" (htmlescape s))) doc;
 		Buffer.add_string b ">\n";
-		Buffer.add_string b (htmlescape (s_type (print_context()) (follow t)));
+		Buffer.add_string b (htmlescape (s_type (print_context()) (TFun(args,ret))));
 		Buffer.add_string b "\n</type>\n";
 	) tl;
 	Buffer.contents b
@@ -409,17 +409,15 @@ let print_signature tl display_arg =
 	let st = s_type (print_context()) in
 	let s_arg (n,o,t) = Printf.sprintf "%s%s:%s" (if o then "?" else "") n (st t) in
 	let s_fun args ret = Printf.sprintf "(%s):%s" (String.concat ", " (List.map s_arg args)) (st ret) in
-	let siginf = List.map (fun (t,doc) ->
-		let label = match follow t with TFun(args,ret) -> s_fun args ret | _ -> st t in
-		let parameters = match follow t with
-			| TFun(args,_) ->
-				List.map (fun arg ->
+	let siginf = List.map (fun ((args,ret),doc) ->
+		let label = s_fun args ret in
+		let parameters =
+			List.map (fun arg ->
 					let label = s_arg arg in
 					JObject [
 						"label",JString label
 					]
-				) args
-			| _ -> []
+			) args
 		in
 		let js = [
 			"label",JString label;

src/main.ml

@@ -905,11 +905,11 @@ with
 	| Display.DisplayType (t,p,doc) ->
 		let doc = match doc with Some _ -> doc | None -> DisplayOutput.find_doc t in
 		raise (DisplayOutput.Completion (DisplayOutput.print_type t p doc))
-	| Display.DisplaySignatures(tl,display_arg) ->
+	| Display.DisplaySignatures(signatures,display_arg) ->
 		if ctx.com.display.dms_kind = DMSignature then
-			raise (DisplayOutput.Completion (DisplayOutput.print_signature tl display_arg))
+			raise (DisplayOutput.Completion (DisplayOutput.print_signature signatures display_arg))
 		else
-			raise (DisplayOutput.Completion (DisplayOutput.print_signatures tl))
+			raise (DisplayOutput.Completion (DisplayOutput.print_signatures signatures))
 	| Display.DisplayPosition pl ->
 		raise (DisplayOutput.Completion (DisplayOutput.print_positions pl))
 	| Display.DisplayToplevel il ->

src/typing/type.ml

@@ -57,12 +57,14 @@ type t =
 	| TEnum of tenum * tparams
 	| TInst of tclass * tparams
 	| TType of tdef * tparams
-	| TFun of (string * bool * t) list * t
+	| TFun of tsignature
 	| TAnon of tanon
 	| TDynamic of t
 	| TLazy of (unit -> t) ref
 	| TAbstract of tabstract * tparams
 
+and tsignature = (string * bool * t) list * t
+
 and tparams = t list
 
 and type_params = (string * t) list

src/typing/typeload.ml

@@ -1584,7 +1584,7 @@ let type_function ctx args ret fmode f do_display p =
 		with
 		| Parser.TypePath (_,None,_) | Exit ->
 			type_expr ctx e NoValue
-		| Display.DisplayType (t,_,_) | Display.DisplaySignatures ([(t,_)],_) when (match follow t with TMono _ -> true | _ -> false) ->
+		| Display.DisplayType (t,_,_) when (match follow t with TMono _ -> true | _ -> false) ->
 			type_expr ctx (if ctx.com.display.dms_kind = DMToplevel then Display.ExprPreprocessing.find_enclosing ctx.com e else e) NoValue
 	end in
 	let e = match e.eexpr with

src/typing/typer.ml

@@ -3655,9 +3655,9 @@ and handle_display ctx e_ast with_type =
 	let e = match e_ast,with_type with
 	| (EConst (Ident "$type"),_),_ ->
 		let mono = mk_mono() in
-		raise (Display.DisplaySignatures ([(TFun(["expression",false,mono],mono),Some "Outputs type of argument as a warning and uses argument as value")],0))
+		raise (Display.DisplaySignatures ([((["expression",false,mono],mono),Some "Outputs type of argument as a warning and uses argument as value")],0))
 	| (EConst (Ident "trace"),_),_ ->
-		raise (Display.DisplaySignatures ([(tfun [t_dynamic] ctx.com.basic.tvoid,Some "Print given arguments")],0))
+		raise (Display.DisplaySignatures ([((["value",false,t_dynamic],ctx.com.basic.tvoid),Some "Print given arguments")],0))
 	| (EConst (Ident "_"),p),WithType t ->
 		mk (TConst TNull) t p (* This is "probably" a bind skip, let's just use the expected type *)
 	| _ -> try
@@ -3717,7 +3717,7 @@ and handle_signature_display ctx e_ast with_type =
 	in
 	let rec follow_with_callable (t,doc) = match follow t with
 		| TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta -> follow_with_callable (Abstract.get_underlying_type a tl,doc)
-		| TFun(_,_) as t -> (t,doc)
+		| TFun(args,ret) -> ((args,ret),doc)
 		| _ -> error ("Not a callable type: " ^ (s_type (print_context()) t)) p
 	in
 	let tl = List.map follow_with_callable tl in
@@ -3733,16 +3733,14 @@ and handle_signature_display ctx e_ast with_type =
 	let el = if display_arg >= List.length el then el @ [EConst (Ident "null"),null_pos] else el in
 	let rec loop acc tl = match tl with
 		| (t,doc) :: tl ->
-			let keep t = match t with
-				| TFun (args,r) ->
-					begin try
-						let _ = unify_call_args' ctx el args r p false false in
-						true
-					with
-					| Error(Call_error (Not_enough_arguments _),_) -> true
-					| _ -> false
-					end
+			let keep (args,r) =
+				begin try
+					let _ = unify_call_args' ctx el args r p false false in
+					true
+				with
+				| Error(Call_error (Not_enough_arguments _),_) -> true
 				| _ -> false
+				end
 			in
 			loop (if keep t then (t,doc) :: acc else acc) tl
 		| [] ->