Soilihi BEN SOILIHI BOINA pushed to branch diagnostics_and_hover at Stefan / Typer
Commits: f50b55d1 by Soilih at 2022-02-09T21:51:20-05:00 fixing the warnings
- - - - -
2 changed files:
- src/opslexp.ml - src/typer_lsp_server.ml
Changes:
===================================== src/opslexp.ml ===================================== @@ -966,7 +966,7 @@ and fv (e : lexp) : (DB.set * mv_set) = | Sort (_, (StypeOmega | StypeLevel)) -> fv_empty | Builtin _ -> fv_empty | Var (_, i) -> (DB.set_singleton i, mv_set_empty) - | Proj (l,lxp,lbl) -> fv lxp + | Proj (_, lxp, _) -> fv lxp | Susp (e, s) -> fv (push_susp e s) | Let (_, defs, e) -> let len = List.length defs in
===================================== src/typer_lsp_server.ml ===================================== @@ -192,7 +192,7 @@ let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list let log_tab = log_entry_to_list log in List.map (fun x -> let (loc, lev, msg) = x in - let ( file ,start_line,start_column,end_line,end_column) = loc in + let ( _, start_line, start_column, end_line, end_column) = loc in let severity = log_level_to_severity lev in let start_pos = Lsp.Types.Position.create ~line:start_line ~character:start_column in let end_pos = Lsp.Types.Position.create ~line:end_line ~character:end_column in @@ -281,10 +281,10 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D ( (lctx_tl,lxp') ) - | hd::ml::tl -> let (lctx_hd,hdl) = hd in - let (lctx_ml,mll) = ml in - let (_,x,_) as lxp = nearest_lexp_of_the_list hdl cursor in - let (_,y,_) as lxp' = nearest_lexp_of_the_list mll cursor in + | hd::ml::tl -> let (_, hdl) = hd in + let (_, mll) = ml in + let (_, x, _) = nearest_lexp_of_the_list hdl cursor in + let (_, y, _) = nearest_lexp_of_the_list mll cursor in if (dist (Lexp.lexp_location x) cursor < dist (Lexp.lexp_location y) cursor ) then (foo (hd::tl) cursor) else foo (ml::tl) cursor @@ -311,7 +311,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D (* Find the lexp the cursor on or the nearest one *) let lexp_search (ctx: Debruijn.lexp_context) (lst:list_in_list) (cursor:Source.Location.t) = try pos_in_lexp_interval ctx lst cursor - with exn -> find_the_nearest_lexp ctx lst cursor + with _ -> find_the_nearest_lexp ctx lst cursor
(* If lexp_search didn't find something, give the last context and a dummy lexp *) @@ -320,7 +320,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D let lstr_rev = List.rev lstr in let (last_ctx,_) = List.hd lstr_rev in try lexp_search ctx lst cursor - with exn -> (last_ctx,((Source.Location.dummy,None),Lexp.impossible, Lexp.impossible)) + with _ -> (last_ctx,((Source.Location.dummy,None),Lexp.impossible, Lexp.impossible))
(* search the type of a lexp browsing a lexp *) let rec browse_lexp (ctx:Debruijn.lexp_context) (e:Lexp.lexp) (cursor:Source.Location.t) : Debruijn.lexp_context * (((Source.Location.t * string option) * int) option) * Lexp.lexp * Source.Location.t = @@ -333,26 +333,26 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D | Imm (String (_, _)) -> (ctx, None, Debruijn.type_string, location) | Imm (Block (_, _) | Symbol _ | Node (_, _)) -> (ctx, None, Debruijn.type_string, location) | SortLevel SLz -> (ctx, None, Debruijn.type_level, location) - | SortLevel (SLsucc e) + | SortLevel (SLsucc _) -> (ctx, None, Debruijn.type_level, location) - | SortLevel (SLlub (e1, e2)) + | SortLevel (SLlub (_, _)) -> (ctx, None, Debruijn.type_level, location) | Sort (l, Stype e) -> (ctx, None, Lexp.mkSort (l, Stype (Lexp.mkSortLevel (SLsucc e))), location) | Sort (_, StypeLevel) -> (ctx, None, Debruijn.sort_omega, location) | Sort (_, StypeOmega) -> (ctx, None, Debruijn.sort_omega, location) | Builtin (_, t)-> (ctx, None, t, location) - | Var (((l, name), idx) as v) -> + | Var (((_, _), _) as v) -> (ctx, Some v, Debruijn.lctx_lookup_type ctx v, location) | Susp (e, s) -> browse_lexp ctx (Lexp.push_susp e s) cursor - | Let (l, defs, e) + | Let (_, defs, e) -> let ctx' = List.fold_left (fun ctx (v, _e, t) -> (Debruijn.lctx_extend ctx v ForwardRef t)) ctx defs in
let tab = List.map - (fun (vn,lxp,ltp) -> + (fun (_, lxp, _) -> browse_lexp ctx' lxp cursor ) defs @@ -378,7 +378,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D -> (nctx, None, Lexp.mkSort (l, StypeOmega), location) )
- | Lambda (ak, ((l,_) as v), t, e) -> let ctx' = Debruijn.lctx_extend ctx v Variable t in + | Lambda (_, ((l,_) as v), t, e) -> let ctx' = Debruijn.lctx_extend ctx v Variable t in let a = browse_lexp ctx' e cursor in let b = browse_lexp ctx t cursor in (*let etp = Opslexp.get_type ctx' e in @@ -407,7 +407,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D | [] -> let (level, tab) = SMap.fold - (fun _ case (level,tab) -> + (fun _ case (level, _) -> let ((level, _, _), tab) = List.fold_left ( @@ -435,7 +435,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D (Lexp.mkSortLevel SLz, []) in browse_list_lexp ((ctx, None,level,l)::tab) cursor
- | (ak, v, t)::args + | (_, v, t)::args -> let ctx' = Debruijn.lctx_extend ctx v Variable t in browse_list_lexp ( @@ -476,10 +476,10 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D let a = Lexp.mkSusp ftype s in candidats := (browse_lexp ctx a cursor):: !candidats; else (Log.log_error ~loc:l "Can't Proj an erasalbe field: %s" label) - | (ak, vdef, ftype)::fieldtypes + | (_, vdef, _)::fieldtypes -> let fvdef vdef e loc lbl = match vdef with - |(l, Some n) -> Lexp.mkProj (loc, e, lbl) + |(_, Some _) -> Lexp.mkProj (loc, e, lbl) |_ -> Lexp.impossible in let fieldref = fvdef vdef e l (loc, label) in getfieldtype (Subst.cons fieldref s) fieldtypes in @@ -489,7 +489,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D | _,_ -> ()); browse_list_lexp !candidats cursor
- | Case (l, e, ret, branches, default) + | Case (l, e, _, branches, default) -> let candidats = ref [] in
@@ -555,10 +555,10 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D let hctor = Lexp.mkCall (Lexp.mkCons (it, (l, name)), List.map (fun (_, a) -> (Pexp.Aerasable, a)) aargs) in - let (nerased, nctx, hlxp) = + let (_, nctx, hlxp) = mkctx erased ctx s hctor vdefs fieldtypes in let subst = Subst.shift (List.length vdefs) in - let (nerased, nctx) = ctx_extend_with_eq nctx subst hlxp in + let (_, nctx) = ctx_extend_with_eq nctx subst hlxp in candidats := (browse_lexp nctx branch cursor) :: !candidats; ) brch @@ -584,7 +584,7 @@ let update_the_context (ctx: Debruijn.lexp_context) (liste : list_in_list ) : (D browse_list_lexp !candidats cursor | Cons (t, (_l, name)) -> (match Opslexp.lexp'_whnf t ctx with - | Inductive (l, _, fargs, constructors) + | Inductive (_, _, fargs, constructors) -> (try let fieldtypes = Util.SMap.find name constructors in let rec indtype fargs start_index = @@ -626,7 +626,7 @@ let search_name_in_ctx (lctx: Debruijn.lexp_context) (lxp: Lexp.lexp) = let rec foo lst comp rlst = match lst with | [] -> rlst - | ((vn, Lexp.LetDef (idx, lxpv), _) as hd)::tl + | ((_, Lexp.LetDef (_, lxpv), _) as hd)::tl -> if String.equal (Lexp.lexp_string lxp) (Lexp.lexp_string lxpv) then foo tl (comp + 1) ((hd,comp)::rlst) else foo tl (comp + 1) rlst @@ -638,7 +638,7 @@ let use_search_name_in_ctx lctx lxp = let rlst = search_name_in_ctx lctx lxp in match rlst with | [] -> failwith "no name found !!!" - | hd::_ -> let (((l,s) as vn,vrbd,ltp),i) = hd in + | hd::_ -> let (((_, s) as vn, _, _),i) = hd in match s with | None -> failwith "no name found !!!" | Some _-> let lx = Lexp.mkVar (vn,i) in @@ -656,7 +656,7 @@ let use_search_name_in_ctx lctx lxp = *) class lsp_server = object(self) - inherit Linol_lwt.Jsonrpc2.server as super + inherit Linol_lwt.Jsonrpc2.server
(* one env per document *) val buffers: (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t @@ -767,7 +767,7 @@ class lsp_server = f
*) - method! on_req_hover ~notify_back ~id ~uri ~pos doc_state = + method! on_req_hover ~notify_back:_ ~id:_ ~uri ~pos _ = match Hashtbl.find buffers uri with | state_after_processing -> let (_,ast,_) = state_after_processing in let (list_list, _) = Option.get ast in @@ -786,7 +786,7 @@ class lsp_server = in let range = lsp_range_of_loc location' in let s = try use_search_name_in_ctx l_ctx l_type - with exe -> Lexp.lexp_string_for_lsp l_type + with _ -> Lexp.lexp_string_for_lsp l_type in let r = Lsp.Types.Hover.create ~contents:(`MarkedString {Lsp.Types.MarkedString.value=s; language=(Some "Typer")})
View it on GitLab: https://gitlab.com/monnier/typer/-/commit/f50b55d1b5f3c05490f1d9aaf4cef32f93...