Soilihi BEN SOILIHI BOINA pushed to branch minimal-server at Stefan / Typer

Commits: 8f23b347 by Soilih at 2022-05-24T14:42:30-04:00 fixing variable searching

- - - - -

3 changed files:

- src/lexp.ml - + src/lsp_server_test.ml - src/typer_lsp_server.ml

Changes:

===================================== src/lexp.ml ===================================== @@ -1068,7 +1068,7 @@ and lexp_str ctx (exp : lexp) : string =

let print_arg str (arg_type, lxp) = match arg_type with - | Aerasable when pp_erasable ctx -> str ^ " " ^ (lexp_str' lxp) + | Aerasable when pp_erasable ctx -> "" | Aimplicit when pp_implicit ctx -> str ^ " " ^ (lexp_str' lxp) | Anormal -> str ^ " " ^ (lexp_str' lxp) | _ -> str in (

===================================== src/lsp_server_test.ml ===================================== @@ -0,0 +1,216 @@ +(* +* +* +* HOVER +* +* +**) + +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,_) = Typer_lsp_server.compile_string content in +let (list_list, _) = Option.get ast in +let (l,c) = position in +let pos = Typer_lsp_server.pos_of_tuple position in + +let (lctx,vx) = Typer_lsp_server.lexp_search ctx list_list pos in +let ((lvn,_),lexp,ltyp) = vx in +let (l_ctx_r,_,_,_,_,_) as ret = Typer_lsp_server.browse_lexp lctx lexp pos [] in +let ret' = (l_ctx_r, None, ltyp, None, lvn,[]) in +let (_,_,l_type,_,_,_) = Typer_lsp_server.browse_list_lexp [ret;ret'] pos in + +let excpect = "excpected : " ^ expected ^ "\n" in +let output = "output : " ^ (Lexp.lexp_string_for_lsp l_type) ^ "\n\n" in +let input = "input : " ^ content ^ "\n" in +let res = "result : " ^ (comp expected (Lexp.lexp_string_for_lsp l_type)) in +let pos = "position : line " ^ (string_of_int l) ^ " character " ^ (string_of_int c) ^ "\n" in +let sep = "################################################\n" in +let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in +output_string oc (sep ^ input ^ pos ^ excpect ^ output ^ res ^ sep ); +close_out oc + +let sep name s = +let content = "\n\n\n/*-----------------------------" ^ s ^ "-----------------------------------*/\n\n\n" in +let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in +output_string oc content; +close_out oc + + +let test_hover () = +let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in +let name = "/home/soilih/Bureau/test/test.txt" in +sep name "INT"; +hoverTest ctx name "e = 12 ;" (1,1) "##Int"; +hoverTest ctx name "e = 12 ;" (1,5) "##Int"; +sep name "STRING"; +hoverTest ctx name "s = "hejej" ;" (1,1) "##String"; +hoverTest ctx name "s = "hejej" ;" (1,8) "##String"; +sep name "FLOAT"; +hoverTest ctx name "f = 12.3 ;" (1,1) "##Float"; +hoverTest ctx name "f = 12.3 ;" (1,6) "##Float"; +sep name "LAMBDA"; +hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,1) "(x : ##Int) -> Int"; +hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,8) "##Int"; +hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,13) "##Int"; +hoverTest ctx name "l = (lambda x y -> _+_ x y) ;" (1,23) ""; +hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,19) "(Int -> (Int -> Int))"; +hoverTest ctx name "l = (lambda x -> _+_ x 2) ;" (1,21) "##Int"; +hoverTest ctx name "l = (lambda x y -> x + y) ;" (1,20) "##Int"; +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"; +hoverTest ctx name "multiply x y z = _*_ x y ;" (1,12) "##Int"; +hoverTest ctx name "multiply x y z = _*_ x y ;" (1,14) "τ"; +hoverTest ctx name "multiply x y z = _*_ x y ;" (1,18) "(Int -> (Int -> Int))"; +hoverTest ctx name "multiply x y z = _*_ x y ;" (1,21) "##Int"; +hoverTest ctx name "multiply x y z = _*_ x y ;" (1,23) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,1) "(x : ##Int) -> (y : ##Int) -> (z : ##Int) -> Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,10) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,12) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,14) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,18) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,20) "(Int -> (Int -> Int))"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,22) "##Int"; +hoverTest ctx name "multiply x y z = x + y + z ;" (1,26) "##Int"; +sep name "CALL"; +hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,1) "##Int"; +hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,7) "(ℓ : ##TypeLevel) ≡> (τ : (##Type_ ℓ)) ≡> (x : ##Int) -> (y : ##Int) -> (z : τ) -> Int"; +hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,13) "##Int"; +hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,15) "##Int"; +hoverTest ctx name "multiply x y z = _*_ x y ; \n\n\ne = multiply 2 3 "h" ;" (4,19) "##String"; +sep name "BUILTIN"; +hoverTest ctx name "foo = ##Int ;" (1,1) "##Type"; +hoverTest ctx name "foo = ##Int ;" (1,9) "##Type"; +sep name "SUSP"; +hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; +hoverTest ctx name "foo = ##Int ; \n\n\nv = foo ;" (4,6) "(##Type_ ##TypeLevel.z)"; +hoverTest ctx name "foo = ##String ; \n\n\nv = foo ;" (4,1) "(##Type_ (##TypeLevel.succ ##TypeLevel.z))"; +hoverTest ctx name "foo = ##Type ; \n\n\nv = foo ;" (4,1) "(##Type_ ##TypeLevel.z)"; +sep name "LIST"; +hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,1) "(List ##TypeLevel.z ##Int)"; +hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,8) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (a -> ((List ℓ a) -> (List ℓ a)))"; +hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,12) "##Int"; +hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ;" (1,27) "(ℓ : TypeLevel) ≡> (a : (##Type_ ℓ)) ≡> (List ℓ a)"; +sep name "TUPLE"; +hoverTest ctx name "lst = cons 2 ( (cons 1 ) nil ) ; \n\n\ntup = (1,2,"str",lst) ;" (4,1) "typecons (Tuple) (cons ##Int ##Int ##String (List ##TypeLevel.z ##Int))"; +hoverTest ctx name "tup = (1,2,"str",false) ;" (1,8) "##Int"; +hoverTest ctx name "tup = (1,2,"str",false) ;" (1,10) "##Int"; +hoverTest ctx name "tup = (1,2,"str",false) ;" (1,15) "##String"; +hoverTest ctx name "tup = (1,2,"str",false) ;" (1,21) "Bool"; +sep name "ARROW"; +hoverTest ctx name "type Floo = bar Int Int ;" (1,1) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,17) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,29) ""; +hoverTest ctx name "v = Int -> Int ;" (1,1) ""; +sep name "INDUCTIVE"; +hoverTest ctx name "type Floo = bar Int Int ;" (1,7) ""; +hoverTest ctx name "type Floo = bar Int Int ;" (1,18) ""; +hoverTest ctx name "type Floo = bar Int Int ;" (1,22) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,1) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,19) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (1,26) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,1) ""; +hoverTest ctx name "floo = typecons (floo) (bar Int Int) ;\n\n\nbar = datacons floo bar ;" (4,10) ""; +hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,1) ""; +hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,10) ""; +hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,18) ""; +hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,24) ""; +hoverTest ctx name "Bool = typecons (Bool) (true) (false);" (1,32) ""; +sep name "METAVAR"; +hoverTest ctx name "x : ?t = 3 ;" (1,1) ""; +hoverTest ctx name "x : ?t = 3 ;" (1,6) ""; +hoverTest ctx name "f x = _+_ ?y x ;" (1,1) ""; +hoverTest ctx name "f x = _+_ ?y x ;" (1,3) ""; +hoverTest ctx name "f x = _+_ ?y x ;" (1,12) ""; +hoverTest ctx name "f x = _+_ ?y x ;" (1,14) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,1) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,6) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (1,10) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,1) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,11) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,15) ""; +hoverTest ctx name "x : ?t ; x = 3 ;\n\n\nfoo = let x : ?t = 3 in x;" (4,24) ""; +sep name "LET"; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,1) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,10) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,18) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,26) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,35) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,37) ""; +hoverTest ctx name "bar = let x = 1 ; y = 2 ; z = 6 in x + y + z ;" (1,41) ""; +sep name "CASE"; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,1) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,5) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (1,14) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (3,4) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (3,13) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (5,4) ""; +hoverTest ctx name "foo x = case x\n\n| true => "true"\n\n| false => "false" ;" (5,14) "" + + +(* +* +* +* AFFICHER LA LISTE DE LISTE +* +* +**) + +let afficher_lst code filename = + let ch = open_in code in + let content = really_input_string ch (in_channel_length ch) in + close_in ch; + let (_,ast,_) = Typer_lsp_server.compile_string content in + let (list_list, _) = Option.get ast in + List.iteri (fun i x -> + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 filename in + output_string oc ("\n\n---------------liste: " ^ (string_of_int i) ^ " --------------\n\n"); + close_out oc; + List.iteri (fun _j (y : Util.vname * Lexp.lexp * Lexp.ltype)-> + let (vn,_,_) = y in + let (l,ss) = vn in + let s = try Option.get ss + with _ -> failwith "The Var doesn't have a string!" + in + let output = "Var: " ^ s ^ "\nline: " ^ (string_of_int l.start_line) ^ " - " ^ + (string_of_int l.end_line) ^ "\ncolumn: " ^ (string_of_int l.start_column) ^ " - " + ^ (string_of_int l.end_column) ^ "\n\n" + in + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 filename in + output_string oc output; + close_out oc; + ) x + ) list_list + +(* +* +* +* BREADCRUMBS +* +* +**) +let testerBread cursor str = + let (_,ast,_) = Typer_lsp_server.compile_string str in + let (list_list, _) = Option.get ast in + let typer_loc = Typer_lsp_server.pos_of_tuple cursor in + let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in + let lexp = Typer_lsp_server.trans_list_in_list_to_let list_list in + let (_,_,_,_,_,lst) = Typer_lsp_server.browse_lexp ctx lexp typer_loc [] in + let str = List.fold_left ( + fun str x -> + let (_,st) = x in + (Option.get st) ^ " > " ^ str + ) "" lst in + let name = "/home/soilih/Bureau/test/symbol.txt" in + let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in + output_string oc ("bread: " ^ str ^ "\n") + +let bread_test = + afficher_lst "/home/soilih/Bureau/exemple.typer" "/home/soilih/Bureau/test/highlight.txt"; + testerBread (2,2) "multiply _x = \nlet lst = cons 2 nil in\nlst" \ No newline at end of file

===================================== src/typer_lsp_server.ml ===================================== @@ -729,15 +729,15 @@ let rec str_order (substr:string) (str:string) : bool =

(* Filter completions list by a string *) let complete_oth (str:string) (liste: Lsp.Types.CompletionItem.t list) = -match liste with -| [] -> liste -| _ -> let lst = List.filter (fun (x:Lsp.Types.CompletionItem.t) -> - string_contain str x.label - ) liste - in - List.filter (fun (x:Lsp.Types.CompletionItem.t) -> - str_order str x.label - ) lst + match liste with + | [] -> liste + | _ -> let lst = List.filter (fun (x:Lsp.Types.CompletionItem.t) -> + string_contain str x.label + ) liste + in + List.filter (fun (x:Lsp.Types.CompletionItem.t) -> + str_order str x.label + ) lst

@@ -746,21 +746,21 @@ let sep_list = [';';',';'(';')';' ';'{';'}']

let split_string_line (content:string) (line:int) = -let str_list = String.split_on_char '\n' content in -List.nth str_list (line - 1) + let str_list = String.split_on_char '\n' content in + List.nth str_list (line - 1)

(* Find the word in which the cursor is *) let rec search_word_in_cursor (str:string) (char_list:char list) (pos:int) (ret:string) : string = -if (String.equal str "") then "" -else if (Int.equal pos 0) then String.make 1 str.[pos] ^ ret -else if (List.exists (fun x -> Char.equal x str.[pos]) char_list) then ret -else search_word_in_cursor str char_list (pos - 1) ((String.make 1 str.[pos]) ^ ret) + if (String.equal str "") then "" + else if (Int.equal pos 0) then String.make 1 str.[pos] ^ ret + else if (List.exists (fun x -> Char.equal x str.[pos]) char_list) then ret + else search_word_in_cursor str char_list (pos - 1) ((String.make 1 str.[pos]) ^ ret)

let use_search_word (str:string) (char_list:char list) (pos:int) (ret:string) : string = -match pos with -| 0 -> search_word_in_cursor str char_list pos ret -| _ -> search_word_in_cursor str char_list (pos - 1) ret + match pos with + | 0 -> search_word_in_cursor str char_list pos ret + | _ -> search_word_in_cursor str char_list (pos - 1) ret

@@ -920,7 +920,7 @@ let browse_list_defs (tab : Source.Location.t list) (cursor:Source.Location.t) = | Var _ -> None | Susp (e, s) -> browse_defs (Lexp.push_susp e s) cursor | Let (_, defs, el) - -> let idx = (List.length defs) - 1 in + -> (let idx = (List.length defs) - 1 in let rec foo (ctx_list: (vname * Lexp.lexp * Lexp.lexp) list) cursor comp = match ctx_list with | [] -> failwith "No Variable on the cursor" @@ -929,8 +929,29 @@ let browse_list_defs (tab : Source.Location.t list) (cursor:Source.Location.t) = else foo tl cursor (comp + 1) | _::tl -> foo tl cursor (comp + 1) in - foo defs cursor 0 - + let rec foo'' (ctx_list: (vname * Lexp.lexp * Lexp.lexp) list) cursor comp = + match ctx_list with + | [] -> failwith "No variable found on the cursor!" + | (_, _, ltp)::tl + -> if (not ((browse_defs lxp cursor) = None)) then + browse_defs ltp cursor + else foo'' tl cursor (comp + 1) + in + let rec foo' (ctx_list: (vname * Lexp.lexp * Lexp.lexp) list) cursor comp = + match ctx_list with + | [] -> foo'' ctx_list cursor comp + | (_, lxp, _)::tl + -> if (not ((browse_defs lxp cursor) = None)) then + browse_defs lxp cursor + else foo' tl cursor (comp + 1) + in + try foo defs cursor 0 + with _ + -> if (not ((browse_defs el cursor) = None)) then + browse_defs el cursor + else foo' defs cursor 0 + ) + | Arrow (_, v, t1, _, t2) -> if (vn_on_the_cursor v cursor) then Some (t2, v, 0) @@ -941,7 +962,10 @@ let browse_list_defs (tab : Source.Location.t list) (cursor:Source.Location.t) =

| Lambda (_, v, t, e) -> (*let ctx' = Debruijn.lctx_extend ctx v Variable t in*) if (vn_on_the_cursor v cursor) then Some (e, v, 0) - else browse_defs t cursor + else (if not ((browse_defs e cursor) = None) then + browse_defs e cursor + else browse_defs t cursor + )

| Call (f, args) -> if not ((browse_defs f cursor) = None) then browse_defs f cursor @@ -1361,56 +1385,11 @@ class lsp_server =

end

- -let afficher_lst code filename = - let ch = open_in code in - let content = really_input_string ch (in_channel_length ch) in - close_in ch; - let (_,ast,_) = compile_string content in - let (list_list, _) = Option.get ast in - List.iteri (fun i x -> - let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 filename in - output_string oc ("\n\n---------------liste: " ^ (string_of_int i) ^ " --------------\n\n"); - close_out oc; - List.iteri (fun _j (y : vname * Lexp.lexp * Lexp.ltype)-> - let (vn,_,_) = y in - let (l,ss) = vn in - let s = try Option.get ss - with _ -> failwith "The Var doesn't have a string!" - in - let output = "Var: " ^ s ^ "\nline: " ^ (string_of_int l.start_line) ^ " - " ^ - (string_of_int l.end_line) ^ "\ncolumn: " ^ (string_of_int l.start_column) ^ " - " - ^ (string_of_int l.end_column) ^ "\n\n" - in - let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 filename in - output_string oc output; - close_out oc; - ) x - ) list_list - -let testerBread cursor str = - let (_,ast,_) = compile_string str in - let (list_list, _) = Option.get ast in - let typer_loc = pos_of_tuple cursor in - let ctx = Debruijn.ectx_to_lctx (Elab.default_ectx) in - let lexp = trans_list_in_list_to_let list_list in - let (_,_,_,_,_,lst) = browse_lexp ctx lexp typer_loc [] in - let str = List.fold_left ( - fun str x -> - let (_,st) = x in - (Option.get st) ^ " > " ^ str - ) "" lst in - let name = "/home/soilih/Bureau/test/symbol.txt" in - let oc = open_out_gen [Open_creat; Open_text; Open_append] 0o640 name in - output_string oc ("bread: " ^ str ^ "\n") - (* Main code This is the code that creates an instance of the lsp server class and runs it as a task. *) let run () = ignore (Arg.Set Log.lsp_enabled); - afficher_lst "/home/soilih/Bureau/exemple.typer" "/home/soilih/Bureau/test/highlight.txt"; - testerBread (2,2) "multiply _x = \nlet lst = cons 2 nil in\nlst"; 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/-/commit/8f23b3470dcd115470055142bcb399b8ed...