display.ml 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326
  1. open Ast
  2. open Common
  3. open DisplayTypes
  4. open DisplayMode
  5. open CompletionItem
  6. open Type
  7. open Typecore
  8. open Globals
  9. open DisplayPosition
  10. open ImportStatus
  11. let merge_core_doc ctx mtype =
  12. display_position#run_outside (fun () -> Typecore.merge_core_doc ctx mtype)
  13. let parse_module' com m p =
  14. display_position#run_outside (fun () -> TypeloadParse.parse_module' com m p)
  15. let parse_module ctx m p =
  16. display_position#run_outside (fun () -> TypeloadParse.parse_module ctx m p)
  17. module ReferencePosition = struct
  18. let reference_position = ref ("",null_pos,SKOther)
  19. let set (s,p,k) =
  20. let p =
  21. if p = null_pos then p
  22. else {p with pfile = Path.get_full_path p.pfile}
  23. in
  24. reference_position := (s,p,k)
  25. let get () = !reference_position
  26. let reset () = reference_position := ("",null_pos,SKOther)
  27. end
  28. module ExprPreprocessing = struct
  29. let find_before_pos dm e =
  30. let display_pos = ref (DisplayPosition.display_position#get) in
  31. let was_annotated = ref false in
  32. let is_annotated,is_completion = match dm with
  33. | DMDefault -> (fun p -> not !was_annotated && encloses_position !display_pos p),true
  34. | DMHover -> (fun p -> not !was_annotated && encloses_position_gt !display_pos p),false
  35. | _ -> (fun p -> not !was_annotated && encloses_position !display_pos p),false
  36. in
  37. let annotate e dk =
  38. was_annotated := true;
  39. (EDisplay(e,dk),pos e)
  40. in
  41. let annotate_marked e = annotate e DKMarked in
  42. let mk_null p = annotate_marked ((EConst(Ident "null")),p) in
  43. let loop_el el =
  44. let pr = DisplayPosition.display_position#with_pos (pos e) in
  45. let rec loop el = match el with
  46. | [] -> [mk_null pr]
  47. | e :: el ->
  48. if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el
  49. else e :: loop el
  50. in
  51. (* print_endline (Printf.sprintf "%i-%i: PR" pr.pmin pr.pmax);
  52. List.iter (fun e ->
  53. print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e));
  54. ) el; *)
  55. match el with
  56. | [] -> [mk_null pr]
  57. | e :: el ->
  58. if (pos e).pmin >= pr.pmax then (mk_null pr) :: e :: el
  59. else loop (e :: el)
  60. in
  61. let in_pattern = ref false in
  62. let loop e =
  63. (* print_endline (Printf.sprintf "%i-%i: %s" (pos e).pmin (pos e).pmax (Ast.s_expr e)); *)
  64. match fst e with
  65. | EFunction(FKNamed((_,p),_),_) when is_annotated p && is_completion ->
  66. raise Exit
  67. | EVars vl when is_annotated (pos e) && is_completion ->
  68. let rec loop2 acc mark vl = match vl with
  69. | v :: vl ->
  70. if mark then
  71. loop2 (v :: acc) mark vl
  72. else if is_annotated (snd v.ev_name) then
  73. (* If the name is the display position, mark the expression *)
  74. loop2 (v :: acc) true vl
  75. else begin match v.ev_expr with
  76. | None ->
  77. (* If there is no expression, we don't have to do anything.
  78. Should the display position be on the type-hint, it will
  79. be picked up while loading the type. *)
  80. loop2 (v :: acc) mark vl
  81. | Some e ->
  82. (* Determine the area between the `|` in `var x| = | e`. This is not really
  83. correct because we don't want completion on the left side of the `=`, but
  84. we cannot determine that correctly without knowing its position.
  85. Note: We know `e` itself isn't the display position because this entire
  86. algorithm is bottom-up and it would be marked already if it was. *)
  87. let p0 = match v.ev_type with
  88. | Some (_,pt) -> pt
  89. | None -> snd v.ev_name
  90. in
  91. let p = {p0 with pmax = (pos e).pmin} in
  92. let e = if is_annotated p then annotate_marked e else e in
  93. loop2 ({ v with ev_expr = Some e } :: acc) mark vl
  94. end
  95. | [] ->
  96. List.rev acc,mark
  97. in
  98. let vl,mark = loop2 [] false vl in
  99. let e = EVars (List.rev vl),pos e in
  100. if !was_annotated then e else raise Exit
  101. | EBinop((OpAssign | OpAssignOp _) as op,e1,e2) when is_annotated (pos e) && is_completion ->
  102. (* Special case for assign ops: If the expression is marked, but none of its operands are,
  103. we are "probably" interested in the rhs. Like with EVars, this isn't accurate because we
  104. could be on the left side of the `=`. I don't think there's a reason for requesting
  105. completion there though. *)
  106. (EBinop(op,e1,annotate_marked e2)),(pos e)
  107. | EBinop(OpOr,e1,(EIf(_,(EConst(Ident "null"),_),None),p1)) when is_annotated (pos e) && is_completion && !in_pattern ->
  108. (* This HAS TO come from an attempted `case pattern | guard:` completion (issue #7068). *)
  109. let p = { p1 with pmin = (pos e1).pmax; pmax = p1.pmin } in
  110. EBinop(OpOr,e1,mk_null p),(pos e)
  111. | EIf(_,(EConst(Ident "null"),_),None) when is_completion && !in_pattern ->
  112. (* This is fine. *)
  113. mk_null (pos e)
  114. | EBlock [] when is_annotated (pos e) ->
  115. annotate e DKStructure
  116. | EBlock [EDisplay((EConst(Ident s),pn),DKMarked),_] when is_completion ->
  117. let e = EObjectDecl [(s,pn,NoQuotes),(EConst (Ident "null"),null_pos)],(pos e) in
  118. annotate e DKStructure
  119. | EBlock el when is_annotated (pos e) && is_completion ->
  120. let el = loop_el el in
  121. EBlock el,(pos e)
  122. | ECall(e1,el) when is_annotated (pos e) && is_completion ->
  123. let el = loop_el el in
  124. ECall(e1,el),(pos e)
  125. | ENew((tp,pp),el) when is_annotated (pos e) && is_completion ->
  126. if is_annotated pp || pp.pmax >= (DisplayPosition.display_position#get).pmax then
  127. annotate_marked e
  128. else begin
  129. let el = loop_el el in
  130. ENew((tp,pp),el),(pos e)
  131. end
  132. | EArrayDecl el when is_annotated (pos e) && is_completion ->
  133. let el = loop_el el in
  134. EArrayDecl el,(pos e)
  135. | EObjectDecl fl when is_annotated (pos e) && is_completion ->
  136. annotate e DKStructure
  137. | ESwitch(e1,cases,def) when is_annotated (pos e) ->
  138. (* We must be "between" two cases, or at the end of the last case.
  139. Let's find the last case which has a position that is < the display
  140. position and mark it. *)
  141. let did_mark = ref false in
  142. let mark_case ec p =
  143. did_mark := true;
  144. let ep = mk_null p in
  145. match ec with
  146. | Some ec ->
  147. let ec = match fst ec with
  148. | EBlock el -> (EBlock (el @ [ep]),p)
  149. | _ -> (EBlock [ec;ep],p)
  150. in
  151. Some ec
  152. | None ->
  153. Some (mk_null p)
  154. in
  155. let rec loop cases = match cases with
  156. | [el,eg,ec,p1] ->
  157. let ec = match def with
  158. | None when (pos e).pmax > !display_pos.pmin -> (* this is so we don't trigger if we're on the } *)
  159. mark_case ec p1 (* no default, must be the last case *)
  160. | Some (_,p2) when p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax ->
  161. mark_case ec p1 (* default is beyond display position, mark *)
  162. | _ ->
  163. ec (* default contains display position, don't mark *)
  164. in
  165. [el,eg,ec,p1]
  166. | (el1,eg1,ec1,p1) :: (el2,eg2,ec2,p2) :: cases ->
  167. if p1.pmax <= !display_pos.pmin && p2.pmin >= !display_pos.pmax then
  168. (el1,eg1,mark_case ec1 p1,p1) :: (el2,eg2,ec2,p2) :: cases
  169. else
  170. (el1,eg1,ec1,p1) :: loop ((el2,eg2,ec2,p2) :: cases)
  171. | [] ->
  172. []
  173. in
  174. let cases = loop cases in
  175. let def = if !did_mark then
  176. def
  177. else match def with
  178. | Some(eo,p) when (pos e).pmax > !display_pos.pmin -> Some (mark_case eo p,p)
  179. | _ -> def
  180. in
  181. ESwitch(e1,cases,def),pos e
  182. | EDisplay _ ->
  183. raise Exit
  184. | EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
  185. annotate_marked e
  186. | EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion ->
  187. (* TODO: check if this makes any sense *)
  188. raise Exit
  189. | EConst(Regexp _) when is_annotated (pos e) && is_completion ->
  190. raise Exit
  191. | EVars vl when is_annotated (pos e) ->
  192. (* We only want to mark EVars if we're on a var name. *)
  193. if List.exists (fun v -> is_annotated (snd v.ev_name)) vl then
  194. annotate_marked e
  195. else
  196. raise Exit
  197. | _ ->
  198. if is_annotated (pos e) then
  199. annotate_marked e
  200. else
  201. e
  202. in
  203. let opt f o =
  204. match o with None -> None | Some v -> Some (f v)
  205. in
  206. let rec map e = match fst e with
  207. | ESwitch(e1,cases,def) when is_annotated (pos e) ->
  208. let e1 = map e1 in
  209. let cases = List.map (fun (el,eg,e,p) ->
  210. let old = !in_pattern in
  211. in_pattern := true;
  212. let el = List.map map el in
  213. in_pattern := old;
  214. let eg = opt map eg in
  215. let e = opt map e in
  216. el,eg,e,p
  217. ) cases in
  218. let def = opt (fun (eo,p) -> opt map eo,p) def in
  219. loop (ESwitch (e1, cases, def),(pos e))
  220. | _ ->
  221. loop (Ast.map_expr map e)
  222. in
  223. try map e with Exit -> e
  224. let find_display_call e =
  225. let found = ref false in
  226. let handle_el e el =
  227. let call_arg_is_marked () =
  228. el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el
  229. in
  230. if not !Parser.was_auto_triggered || call_arg_is_marked () then begin
  231. found := true;
  232. Parser.mk_display_expr e DKCall
  233. end else
  234. e
  235. in
  236. let loop e = match fst e with
  237. | ECall(_,el) | ENew(_,el) when not !found && display_position#enclosed_in (pos e) ->
  238. handle_el e el
  239. | EArray(e1,e2) when not !found && display_position#enclosed_in (pos e2) ->
  240. handle_el e [e2]
  241. | EDisplay(_,DKCall) ->
  242. raise Exit
  243. | _ -> e
  244. in
  245. let rec map e = loop (Ast.map_expr map e) in
  246. try map e with Exit -> e
  247. let process_expr com e = match com.display.dms_kind with
  248. | DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> find_before_pos com.display.dms_kind e
  249. | DMSignature -> find_display_call e
  250. | _ -> e
  251. end
  252. let get_expected_name with_type = match with_type with
  253. | WithType.Value (Some src) | WithType.WithType(_,Some src) ->
  254. (match src with
  255. | WithType.FunctionArgument si -> Some si.si_name
  256. | WithType.StructureField si -> Some si .si_name
  257. | WithType.ImplicitReturn -> None
  258. )
  259. | _ -> None
  260. let sort_fields l with_type tk =
  261. let p = match tk with
  262. | TKExpr p | TKField p -> Some p
  263. | _ -> None
  264. in
  265. let expected_name = get_expected_name with_type in
  266. let l = List.map (fun ci ->
  267. let i = get_sort_index tk ci (Option.default Globals.null_pos p) expected_name in
  268. ci,i
  269. ) l in
  270. let sort l =
  271. List.map fst (List.sort (fun (_,i1) (_,i2) -> compare i1 i2) l)
  272. in
  273. (* This isn't technically accurate, but I don't think it matters. *)
  274. let rec dynamify_type_params t = match follow t with
  275. | TInst({cl_kind = KTypeParameter _},_) -> mk_mono()
  276. | _ -> Type.map dynamify_type_params t
  277. in
  278. let l = match with_type with
  279. | WithType.WithType(t,_) when (match follow t with TMono _ -> false | _ -> true) ->
  280. let comp item = match item.ci_type with
  281. | None -> 9
  282. | Some (t',_) ->
  283. (* For enum constructors, we consider the return type of the constructor function
  284. so it has the same priority as argument-less constructors. *)
  285. let t' = match item.ci_kind,follow t' with
  286. | ITEnumField _,TFun(_,r) -> r
  287. | _ -> t'
  288. in
  289. let t' = dynamify_type_params t' in
  290. if type_iseq t' t then 0 (* equal types - perfect *)
  291. else if t' == t_dynamic then 5 (* dynamic isn't good, but better than incompatible *)
  292. else try Type.unify t' t; 1 (* assignable - great *)
  293. with Unify_error _ -> match follow t' with
  294. | TFun(_,tr) ->
  295. if type_iseq tr t then 2 (* function returns our exact type - alright *)
  296. else (try Type.unify tr t; 3 (* function returns compatible type - okay *)
  297. with Unify_error _ -> 7) (* incompatible function - useless *)
  298. | _ ->
  299. 6 (* incompatible type - probably useless *)
  300. in
  301. let l = List.map (fun (item,i1) ->
  302. let i2 = comp item in
  303. item,(i2,i1)
  304. ) l in
  305. sort l
  306. | _ ->
  307. sort l
  308. in
  309. l
  310. let get_import_status ctx path =
  311. try
  312. let mt' = ctx.g.do_load_type_def ctx null_pos (mk_type_path ([],snd path)) in
  313. if path <> (t_infos mt').mt_path then Shadowed else Imported
  314. with _ ->
  315. Unimported