Soilihi BEN SOILIHI BOINA pushed to branch soilih at Stefan / Typer

Commits: 2910ba93 by Soilih BEN SOILIH at 2021-10-18T21:54:10-04:00 my symbol

- - - - - 00d0160e by Soilih BEN SOILIH at 2021-10-18T23:57:07-04:00 fixing on_req_symbol method

- - - - - 4e3f9651 by Soilih BEN SOILIH at 2021-10-19T00:02:06-04:00 -

- - - - -

1 changed file:

- src/typer_lsp_server.ml

Changes:

===================================== src/typer_lsp_server.ml ===================================== @@ -87,6 +87,15 @@ let lsp_pos_of_pos_end (p:Source.Location.t) : Lsp.Types.Position.t = let lsp_range_of_loc (l:Source.Location.t) : Lsp.Types.Range.t = Lsp.Types.Range.create ~start:(lsp_pos_of_pos_start l) ~end_:(lsp_pos_of_pos_end l)

+let lsp_pos_of_pos_start_for_symbol (p:Source.Location.t) : Lsp.Types.Position.t = + Lsp.Types.Position.create ~line:(p.start_line - 1) ~character:(p.start_column) + +let lsp_pos_of_pos_end_for_symbol (p:Source.Location.t) : Lsp.Types.Position.t = + Lsp.Types.Position.create ~line:(p.end_line - 1) ~character:(p.end_column) + +let lsp_range_of_loc_for_symbol (l:Source.Location.t) : Lsp.Types.Range.t = + Lsp.Types.Range.create ~start:(lsp_pos_of_pos_start_for_symbol l) ~end_:(lsp_pos_of_pos_end_for_symbol l) + let rec search_a_vname_with_a_given_position (vname_list: Util.vname list) (location : Source.Location.t): Util.vname = match vname_list with | [] -> let loc = Source.Location.dummy in @@ -819,16 +828,20 @@ let filter_the_list_list (list_list: list_in_list) : list_in_list = let take_all_list_el (list_list: list_in_list) = let rec foo (ll:list_in_list) ret_list = match list_list with - | [] -> [] - | hd::tl -> let hdl = List.nth hd 0 in - foo tl (hdl::ret_list) + | [] -> ret_list + | [n] -> List.append n ret_list + | [hd;tl] -> let apl = List.append hd tl in + List.append apl ret_list + | hd::ml::tl -> let apl = List.append hd ml in + foo tl (List.append apl ret_list) in foo list_list []

let create_symbols (list_list: list_in_list) : Lsp.Types.DocumentSymbol.t list = - let lst = take_all_list_el list_list in + let filtred_list = filter_the_list_list list_list in + let lst = take_all_list_el filtred_list in List.map ( fun x -> let ((l,s),_,_) = x in - let range = lsp_range_of_loc l in + let range = lsp_range_of_loc_for_symbol l in let nm = Option.get s in Lsp.Types.DocumentSymbol.create ~name:nm @@ -1055,6 +1068,36 @@ class lsp_server = Hashtbl.remove buffers d.uri; Linol_lwt.return ()

+ (*method! config_hover = Some (`Bool true)*) + + (*method! config_definition = Some (`Bool true)*) + + (*method! config_symbol = Some (`Bool true)*) + + method! config_modify_capabilities arg = + let completionProvider = + Lsp.Types.CompletionOptions.create ~triggerCharacters:[ "."; "#"; """; "'"; "/"; "@"; "<"] + ~resolveProvider:true () + in + + let documentSymbol = + Lsp.Types.DocumentSymbolOptions.create ~workDoneProgress:true () + in + + let hoverOption = + Lsp.Types.HoverOptions.create ~workDoneProgress:true () + in + + let definitionOption = + Lsp.Types.DefinitionOptions.create ~workDoneProgress:true () + in + + { arg with Lsp.Types.ServerCapabilities.completionProvider = Some completionProvider ; + Lsp.Types.ServerCapabilities.hoverProvider = Some (`HoverOptions hoverOption); + Lsp.Types.ServerCapabilities.definitionProvider = Some (`DefinitionOptions definitionOption); + Lsp.Types.ServerCapabilities.documentSymbolProvider = Some (`DocumentSymbolOptions documentSymbol) + } + method! on_req_definition ~notify_back ~id ~uri ~pos _st = match Hashtbl.find buffers uri with

@@ -1097,10 +1140,6 @@ class lsp_server = let e = Some r in let f = Linol_lwt.return e in f

- method! config_hover = Some (`Bool true) - - method! config_definition = Some (`Bool true) - (* provisional, to be done later *) method! on_req_execute_command ~notify_back ~id _c _args = match _c with @@ -1113,14 +1152,6 @@ class lsp_server = (Lsp.Types.Command.create ~title:_c ~command:_c () ) in let e = Linol_lwt.return h in e | _ -> assert false - - method! config_modify_capabilities arg = - let completionProvider = - (* TODO even if this re-enabled in general, it should stay disabled for - emacs. It makes completion too slow *) - Lsp.Types.CompletionOptions.create ~triggerCharacters:[ "."; "#"; """; "'"; "/"; "@"; "<"] - ~resolveProvider:true () in - { arg with Lsp.Types.ServerCapabilities.completionProvider = Some completionProvider}

(* provisional, to be done later *) @@ -1157,12 +1188,13 @@ class lsp_server = let f = Linol_lwt.return e in f

method! on_req_symbol ~notify_back ~id ~uri () = - let doc_ = self#find_doc uri in - let doc_state = Option.get doc_ in - let (_,(list_list, _)) = readstring doc_state.content in - let r = create_symbols list_list in - let e = Some (`DocumentSymbol r) in - let f = Linol_lwt.return e in f + + match Hashtbl.find buffers uri with + + | state_after_processing -> let (_,(list_list, _)) = state_after_processing in + let r = create_symbols list_list in + let e = Some (`DocumentSymbol r) in + let f = Linol_lwt.return e in f

end

@@ -1172,7 +1204,7 @@ end let comp (a:string) (b:string) : string = if (String.equal a b) then "/*******-----:-):-):-):-):-):-):-)__________SUCCESS_______:-):-):-):-):-):-):-)-----*******/\n\n\n" else "/*******-----:-(:-(:-(:-(:-(:-(:-(____FAILED___:-(:-(:-(:-(:-(:-(:-(-----*******/\n\n\n" - + let hoverTest (ctx:Debruijn.lexp_context) (name:string) (content:string) (position: int * int) (expected:string) = let (_, ast) = readstring content in let (list_list, _) = ast in @@ -1225,7 +1257,6 @@ let test () = hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,24) "##Int"; hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,24) "##Int"; hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,26) "##Int"; - sep name "FUNCTION(LAMBDA)"; hoverTest ctx name "multiply x y z = _*_ x y ;" (1,1) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; hoverTest ctx name "multiply x y z = _*_ x y ;" (1,10) "##Int"; @@ -1318,9 +1349,6 @@ let test () = hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (5,14) ""

- - - (*=======================================Test======================================*)

@@ -1330,7 +1358,7 @@ let test () = let run () = ignore (Arg.Set Log.lsp_enabled); Logs.set_level ~all:true (Some Logs.Debug); - test (); + (*test ();*) let s = new lsp_server in let server = Linol_lwt.Jsonrpc2.create_stdio s in let task = Linol_lwt.Jsonrpc2.run server in

View it on GitLab: https://gitlab.com/monnier/typer/-/compare/acf01ebf9a5626fcb22a39aa23ca2aa99...