Kaynağa Gözat

separate DisplayType and DisplaySignatures, add position information to DisplayType

 * the position is used by IDE's to highlight the full expression that this type is for.

 * not sure that all positions are correct, but time will tell, i guess
Dan Korostelev 9 yıl önce
ebeveyn
işleme
3c031134a9
4 değiştirilmiş dosya ile 43 ekleme ve 26 silme
  1. 8 7
      src/display/display.ml
  2. 14 1
      src/main.ml
  3. 10 10
      src/typing/typeload.ml
  4. 11 8
      src/typing/typer.ml

+ 8 - 7
src/display/display.ml

@@ -19,7 +19,8 @@ type identifier_type =
 	| ITPackage of string
 	| ITPackage of string
 
 
 exception DocumentSymbols of string
 exception DocumentSymbols of string
-exception DisplayTypes of t list
+exception DisplaySignatures of t list
+exception DisplayType of t * pos
 exception DisplayPosition of Ast.pos list
 exception DisplayPosition of Ast.pos list
 exception DisplaySubExpression of Ast.expr
 exception DisplaySubExpression of Ast.expr
 exception DisplayFields of (string * t * display_field_kind option * documentation) list
 exception DisplayFields of (string * t * display_field_kind option * documentation) list
@@ -96,7 +97,7 @@ let find_before_pos com e =
 	in
 	in
 	map e
 	map e
 
 
-let display_type dm t =
+let display_type dm t p =
 	try
 	try
 		let mt = module_type_of_type t in
 		let mt = module_type_of_type t in
 		begin match dm with
 		begin match dm with
@@ -104,7 +105,7 @@ let display_type dm t =
 			| DMUsage ->
 			| DMUsage ->
 				let ti = t_infos mt in
 				let ti = t_infos mt in
 				ti.mt_meta <- (Meta.Usage,[],ti.mt_pos) :: ti.mt_meta
 				ti.mt_meta <- (Meta.Usage,[],ti.mt_pos) :: ti.mt_meta
-			| DMType -> raise (DisplayTypes [t])
+			| DMType -> raise (DisplayType (t,p))
 			| _ -> ()
 			| _ -> ()
 		end
 		end
 	with Exit ->
 	with Exit ->
@@ -113,16 +114,16 @@ let display_type dm t =
 let display_module_type dm mt =
 let display_module_type dm mt =
 	display_type dm (type_of_module_type mt)
 	display_type dm (type_of_module_type mt)
 
 
-let display_variable dm v = match dm with
+let display_variable dm v p = match dm with
 	| DMPosition -> raise (DisplayPosition [v.v_pos])
 	| DMPosition -> raise (DisplayPosition [v.v_pos])
 	| DMUsage -> v.v_meta <- (Meta.Usage,[],v.v_pos) :: v.v_meta;
 	| DMUsage -> v.v_meta <- (Meta.Usage,[],v.v_pos) :: v.v_meta;
-	| DMType -> raise (DisplayTypes [v.v_type])
+	| DMType -> raise (DisplayType (v.v_type,p))
 	| _ -> ()
 	| _ -> ()
 
 
-let display_field dm cf = match dm with
+let display_field dm cf p = match dm with
 	| DMPosition -> raise (DisplayPosition [cf.cf_pos]);
 	| DMPosition -> raise (DisplayPosition [cf.cf_pos]);
 	| DMUsage -> cf.cf_meta <- (Meta.Usage,[],cf.cf_pos) :: cf.cf_meta;
 	| DMUsage -> cf.cf_meta <- (Meta.Usage,[],cf.cf_pos) :: cf.cf_meta;
-	| DMType -> raise (DisplayTypes [cf.cf_type])
+	| DMType -> raise (DisplayType (cf.cf_type,p))
 	| _ -> ()
 	| _ -> ()
 
 
 module SymbolKind = struct
 module SymbolKind = struct

+ 14 - 1
src/main.ml

@@ -1715,7 +1715,20 @@ with
 			fields
 			fields
 		in
 		in
 		complete_fields com fields
 		complete_fields com fields
-	| Display.DisplayTypes tl ->
+	| Display.DisplayType (t,p) ->
+		let ctx = print_context() in
+		let b = Buffer.create 0 in
+		if p = null_pos then
+			Buffer.add_string b "<type>\n"
+		else begin
+			let error_printer file line = sprintf "%s:%d:" (Common.unique_full_path file) line in
+			let epos = Lexer.get_error_pos error_printer p in
+			Buffer.add_string b ("<type p=\"" ^ (htmlescape epos) ^ "\">\n")
+		end;
+		Buffer.add_string b (htmlescape (s_type ctx t));
+		Buffer.add_string b "\n</type>\n";
+		raise (Completion (Buffer.contents b))
+	| Display.DisplaySignatures tl ->
 		let ctx = print_context() in
 		let ctx = print_context() in
 		let b = Buffer.create 0 in
 		let b = Buffer.create 0 in
 		List.iter (fun t ->
 		List.iter (fun t ->

+ 10 - 10
src/typing/typeload.ml

@@ -472,7 +472,7 @@ let rec load_instance ?(allow_display=false) ctx (t,p) allow_no_params =
 		end
 		end
 	in
 	in
 	if allow_display && ctx.com.display <> DMNone && Display.is_display_position p then
 	if allow_display && ctx.com.display <> DMNone && Display.is_display_position p then
-		Display.display_type ctx.com.display t;
+		Display.display_type ctx.com.display t p;
 	t
 	t
 
 
 (*
 (*
@@ -1507,7 +1507,7 @@ let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp =
 	c.cl_meta <- tp.Ast.tp_meta;
 	c.cl_meta <- tp.Ast.tp_meta;
 	if enum_constructor then c.cl_meta <- (Meta.EnumConstructorParam,[],c.cl_pos) :: c.cl_meta;
 	if enum_constructor then c.cl_meta <- (Meta.EnumConstructorParam,[],c.cl_pos) :: c.cl_meta;
 	let t = TInst (c,List.map snd c.cl_params) in
 	let t = TInst (c,List.map snd c.cl_params) in
-	if Display.is_display_position (pos tp.tp_name) then Display.display_type ctx.com.display t;
+	if Display.is_display_position (pos tp.tp_name) then Display.display_type ctx.com.display t (pos tp.tp_name);
 	match tp.tp_constraints with
 	match tp.tp_constraints with
 	| [] ->
 	| [] ->
 		n, t
 		n, t
@@ -1553,7 +1553,7 @@ let type_function ctx args ret fmode f do_display p =
 		let v,c = add_local ctx n t pn, c in
 		let v,c = add_local ctx n t pn, c in
 		v.v_meta <- m;
 		v.v_meta <- m;
 		if do_display && Display.encloses_position !Parser.resume_display pn then
 		if do_display && Display.encloses_position !Parser.resume_display pn then
-			Display.display_variable ctx.com.display v;
+			Display.display_variable ctx.com.display v pn;
 		if n = "this" then v.v_meta <- (Meta.This,[],p) :: v.v_meta;
 		if n = "this" then v.v_meta <- (Meta.This,[],p) :: v.v_meta;
 		v,c
 		v,c
 	) args f.f_args in
 	) args f.f_args in
@@ -1578,7 +1578,7 @@ let type_function ctx args ret fmode f do_display p =
 		with
 		with
 		| Parser.TypePath (_,None,_) | Exit ->
 		| Parser.TypePath (_,None,_) | Exit ->
 			type_expr ctx e NoValue
 			type_expr ctx e NoValue
-		| Display.DisplayTypes [t] when (match follow t with TMono _ -> true | _ -> false) ->
+		| Display.DisplayType (t,_) | Display.DisplaySignatures [t] when (match follow t with TMono _ -> true | _ -> false) ->
 			type_expr ctx (if ctx.com.display = DMToplevel then Display.find_enclosing ctx.com e else e) NoValue
 			type_expr ctx (if ctx.com.display = DMToplevel then Display.find_enclosing ctx.com e else e) NoValue
 	end in
 	end in
 	let e = match e.eexpr with
 	let e = match e.eexpr with
@@ -2225,7 +2225,7 @@ module ClassInitializer = struct
 
 
 	let check_field_display com p cf =
 	let check_field_display com p cf =
  		if Display.encloses_position !Parser.resume_display p then
  		if Display.encloses_position !Parser.resume_display p then
-			Display.display_field com.display cf
+			Display.display_field com.display cf p
 
 
 	let create_variable (ctx,cctx,fctx) c f t eo p =
 	let create_variable (ctx,cctx,fctx) c f t eo p =
 		if not fctx.is_static && cctx.abstract <> None then error (fst f.cff_name ^ ": Cannot declare member variable in abstract") p;
 		if not fctx.is_static && cctx.abstract <> None then error (fst f.cff_name ^ ": Cannot declare member variable in abstract") p;
@@ -2989,7 +2989,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 		context_init := (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) :: !context_init
 		context_init := (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) :: !context_init
 	| EClass d ->
 	| EClass d ->
 		let c = (match get_type (fst d.d_name) with TClassDecl c -> c | _ -> assert false) in
 		let c = (match get_type (fst d.d_name) with TClassDecl c -> c | _ -> assert false) in
-		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TClassDecl c);
+		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TClassDecl c) (pos d.d_name);
 		check_global_metadata ctx (fun m -> c.cl_meta <- m :: c.cl_meta) c.cl_module.m_path c.cl_path None;
 		check_global_metadata ctx (fun m -> c.cl_meta <- m :: c.cl_meta) c.cl_module.m_path c.cl_path None;
 		let herits = d.d_flags in
 		let herits = d.d_flags in
 		if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
 		if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
@@ -3049,7 +3049,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 			);
 			);
 	| EEnum d ->
 	| EEnum d ->
 		let e = (match get_type (fst d.d_name) with TEnumDecl e -> e | _ -> assert false) in
 		let e = (match get_type (fst d.d_name) with TEnumDecl e -> e | _ -> assert false) in
-		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TEnumDecl e);
+		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TEnumDecl e) (pos d.d_name);
 		let ctx = { ctx with type_params = e.e_params } in
 		let ctx = { ctx with type_params = e.e_params } in
 		let h = (try Some (Hashtbl.find ctx.g.type_patches e.e_path) with Not_found -> None) in
 		let h = (try Some (Hashtbl.find ctx.g.type_patches e.e_path) with Not_found -> None) in
 		check_global_metadata ctx (fun m -> e.e_meta <- m :: e.e_meta) e.e_module.m_path e.e_path None;
 		check_global_metadata ctx (fun m -> e.e_meta <- m :: e.e_meta) e.e_module.m_path e.e_path None;
@@ -3161,7 +3161,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 			if is_display_file && Display.encloses_position !Parser.resume_display p then begin match ctx.com.display with
 			if is_display_file && Display.encloses_position !Parser.resume_display p then begin match ctx.com.display with
 				| DMPosition -> raise (Display.DisplayPosition [p]);
 				| DMPosition -> raise (Display.DisplayPosition [p]);
 				| DMUsage -> f.ef_meta <- (Meta.Usage,[],p) :: f.ef_meta;
 				| DMUsage -> f.ef_meta <- (Meta.Usage,[],p) :: f.ef_meta;
-				| DMType -> raise (Display.DisplayTypes [f.ef_type])
+				| DMType -> raise (Display.DisplayType (f.ef_type,p))
 				| _ -> ()
 				| _ -> ()
 			end;
 			end;
 			e.e_constrs <- PMap.add f.ef_name f e.e_constrs;
 			e.e_constrs <- PMap.add f.ef_name f e.e_constrs;
@@ -3189,7 +3189,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 			);
 			);
 	| ETypedef d ->
 	| ETypedef d ->
 		let t = (match get_type (fst d.d_name) with TTypeDecl t -> t | _ -> assert false) in
 		let t = (match get_type (fst d.d_name) with TTypeDecl t -> t | _ -> assert false) in
-		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TTypeDecl t);
+		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TTypeDecl t) (pos d.d_name);
 		check_global_metadata ctx (fun m -> t.t_meta <- m :: t.t_meta) t.t_module.m_path t.t_path None;
 		check_global_metadata ctx (fun m -> t.t_meta <- m :: t.t_meta) t.t_module.m_path t.t_path None;
 		let ctx = { ctx with type_params = t.t_params } in
 		let ctx = { ctx with type_params = t.t_params } in
 		let tt = load_complex_type ctx true d.d_data in
 		let tt = load_complex_type ctx true d.d_data in
@@ -3219,7 +3219,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 			);
 			);
 	| EAbstract d ->
 	| EAbstract d ->
 		let a = (match get_type (fst d.d_name) with TAbstractDecl a -> a | _ -> assert false) in
 		let a = (match get_type (fst d.d_name) with TAbstractDecl a -> a | _ -> assert false) in
-		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TAbstractDecl a);
+		if Display.is_display_position (pos d.d_name) then Display.display_module_type ctx.com.display (TAbstractDecl a) (pos d.d_name);
 		check_global_metadata ctx (fun m -> a.a_meta <- m :: a.a_meta) a.a_module.m_path a.a_path None;
 		check_global_metadata ctx (fun m -> a.a_meta <- m :: a.a_meta) a.a_module.m_path a.a_path None;
 		let ctx = { ctx with type_params = a.a_params } in
 		let ctx = { ctx with type_params = a.a_params } in
 		let is_type = ref false in
 		let is_type = ref false in

+ 11 - 8
src/typing/typer.ml

@@ -2821,7 +2821,7 @@ and type_vars ctx vl p =
 			if v.[0] = '$' && ctx.com.display = DMNone then error "Variables names starting with a dollar are not allowed" p;
 			if v.[0] = '$' && ctx.com.display = DMNone then error "Variables names starting with a dollar are not allowed" p;
 			let v,e = add_local ctx v t pv, e in
 			let v,e = add_local ctx v t pv, e in
 			if Display.is_display_position pv then
 			if Display.is_display_position pv then
-				Display.display_variable ctx.com.display v;
+				Display.display_variable ctx.com.display v pv;
 			v,e
 			v,e
 		with
 		with
 			Error (e,p) ->
 			Error (e,p) ->
@@ -3124,7 +3124,7 @@ and type_new ctx path el with_type p =
 		| mt ->
 		| mt ->
 			error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
 			error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
 	in
 	in
-	if Display.is_display_position (pos path) then Display.display_type ctx.com.display t;
+	if Display.is_display_position (pos path) then Display.display_type ctx.com.display t (pos path);
 	let build_constructor_call c tl =
 	let build_constructor_call c tl =
 		let ct, f = get_constructor ctx c tl p in
 		let ct, f = get_constructor ctx c tl p in
 		if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (s_type_path c.cl_path ^ " does not have a constructor") p;
 		if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (s_type_path c.cl_path ^ " does not have a constructor") p;
@@ -3219,7 +3219,7 @@ and type_try ctx e1 catches with_type p =
 		let locals = save_locals ctx in
 		let locals = save_locals ctx in
 		let v = add_local ctx v t pv in
 		let v = add_local ctx v t pv in
 		if Display.is_display_position pv then
 		if Display.is_display_position pv then
-			Display.display_variable ctx.com.display v;
+			Display.display_variable ctx.com.display v pv;
 		let e = type_expr ctx e with_type in
 		let e = type_expr ctx e with_type in
 		v.v_type <- t2;
 		v.v_type <- t2;
 		locals();
 		locals();
@@ -3692,7 +3692,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		(match follow t with
 		(match follow t with
 		| TInst (c,params) | TAbstract({a_impl = Some c},params) ->
 		| TInst (c,params) | TAbstract({a_impl = Some c},params) ->
 			let ct, f = get_constructor ctx c params p in
 			let ct, f = get_constructor ctx c params p in
-			raise (Display.DisplayTypes (ct :: List.map (fun f -> f.cf_type) f.cf_overloads))
+			raise (Display.DisplaySignatures (ct :: List.map (fun f -> f.cf_type) f.cf_overloads))
 		| _ ->
 		| _ ->
 			error "Not a class" p)
 			error "Not a class" p)
 	| ECheckType (e,t) ->
 	| ECheckType (e,t) ->
@@ -3760,7 +3760,7 @@ and handle_display ctx e_ast iscall with_type p =
 	with Error (Unknown_ident n,_) when not iscall ->
 	with Error (Unknown_ident n,_) when not iscall ->
 		raise (Parser.TypePath ([n],None,false))
 		raise (Parser.TypePath ([n],None,false))
 	| Error (Unknown_ident "trace",_) ->
 	| Error (Unknown_ident "trace",_) ->
-		raise (Display.DisplayTypes [tfun [t_dynamic] ctx.com.basic.tvoid])
+		raise (Display.DisplaySignatures [tfun [t_dynamic] ctx.com.basic.tvoid])
 	| Error (Type_not_found (path,_),_) as err ->
 	| Error (Type_not_found (path,_),_) as err ->
 		begin try
 		begin try
 			raise (Display.DisplayFields (get_submodule_fields path))
 			raise (Display.DisplayFields (get_submodule_fields path))
@@ -3783,7 +3783,7 @@ and handle_display ctx e_ast iscall with_type p =
 	| DMResolve _ ->
 	| DMResolve _ ->
 		assert false
 		assert false
 	| DMType ->
 	| DMType ->
-		raise (Display.DisplayTypes [match e.eexpr with TVar(v,_) -> v.v_type | _ -> e.etype])
+		raise (Display.DisplayType ((match e.eexpr with TVar(v,_) -> v.v_type | _ -> e.etype),p))
 	| DMUsage ->
 	| DMUsage ->
 		let rec loop e = match e.eexpr with
 		let rec loop e = match e.eexpr with
 		| TField(_,FEnum(_,ef)) ->
 		| TField(_,FEnum(_,ef)) ->
@@ -4020,7 +4020,7 @@ and handle_display ctx e_ast iscall with_type p =
 		in
 		in
 		(match follow t with
 		(match follow t with
 		| TMono _ | TDynamic _ when ctx.in_macro -> mk (TConst TNull) t p
 		| TMono _ | TDynamic _ when ctx.in_macro -> mk (TConst TNull) t p
-		| _ -> raise (Display.DisplayTypes (t :: tl_overloads)))
+		| _ -> raise (Display.DisplaySignatures (t :: tl_overloads)))
 
 
 and maybe_type_against_enum ctx f with_type p =
 and maybe_type_against_enum ctx f with_type p =
 	try
 	try
@@ -4620,9 +4620,12 @@ let make_macro_api ctx p =
 			with Display.DisplayFields fields ->
 			with Display.DisplayFields fields ->
 				let pctx = print_context() in
 				let pctx = print_context() in
 				String.concat "," (List.map (fun (f,t,_,_) -> f ^ ":" ^ s_type pctx t) fields)
 				String.concat "," (List.map (fun (f,t,_,_) -> f ^ ":" ^ s_type pctx t) fields)
-			| Display.DisplayTypes tl ->
+			| Display.DisplaySignatures tl ->
 				let pctx = print_context() in
 				let pctx = print_context() in
 				String.concat "," (List.map (s_type pctx) tl)
 				String.concat "," (List.map (s_type pctx) tl)
+			| Display.DisplayType (t,_) ->
+				let pctx = print_context() in
+				s_type pctx t
 			| Parser.TypePath (p,sub,_) ->
 			| Parser.TypePath (p,sub,_) ->
 				(match sub with
 				(match sub with
 				| None ->
 				| None ->