package merlin-lib
Merlin's libraries
Install
Dune Dependency
Authors
Maintainers
Sources
merlin-5.5-503.tbz
sha256=67da3b34f2fea07678267309f61da4a2c6f08298de0dc59655b8d30fd8269af1
sha512=1fb3b5180d36aa82b82a319e15b743b802b6888f0dc67645baafdb4e18dfc23a7b90064ec9bc42f7424061cf8cde7f8839178d8a8537bf4596759f3ff4891873
doc/src/merlin-lib.kernel/mreader_recover.ml.html
Source file mreader_recover.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
open Std let { Logger.log } = Logger.for_section "Mreader_recover" module Make (Parser : MenhirLib.IncrementalEngine.EVERYTHING) (Recovery : sig val default_value : Location.t -> 'a Parser.symbol -> 'a type action = | Abort | R of int | S : 'a Parser.symbol -> action | Sub of action list type decision = | Nothing | One of action list | Select of (int -> action list) val depth : int array val recover : int -> decision val guide : 'a Parser.symbol -> bool val token_of_terminal : 'a Parser.terminal -> 'a -> Parser.token val nullable : 'a Parser.nonterminal -> bool end) (Dump : sig val symbol : unit -> Parser.xsymbol -> string end) = struct type 'a candidate = { line : int; min_col : int; max_col : int; env : 'a Parser.env } type 'a candidates = { popped : Parser.xsymbol list; shifted : Parser.xsymbol option; final : 'a option; candidates : 'a candidate list } module T = struct (* FIXME: this is a bit ugly. We should ask for the type to be exported publicly by MenhirLib. *) [@@@ocaml.warning "-37"] type 'a checkpoint = | InputNeeded of 'a Parser.env | Shifting of 'a Parser.env * 'a Parser.env * bool | AboutToReduce of 'a Parser.env * Parser.production | HandlingError of 'a Parser.env | Accepted of 'a | Rejected external inj : 'a checkpoint -> 'a Parser.checkpoint = "%identity" end (*let env_state env = match Parser.top env with | None -> -1 | Some (Parser.Element (state, _, _, _)) -> Parser.number state*) let feed_token ~allow_reduction token env = let rec aux allow_reduction = function | Parser.HandlingError _ | Parser.Rejected -> `Fail | Parser.AboutToReduce _ when not allow_reduction -> `Fail | Parser.Accepted v -> `Accept v | (Parser.Shifting _ | Parser.AboutToReduce _) as checkpoint -> aux true (Parser.resume checkpoint) | Parser.InputNeeded env as checkpoint -> `Recovered (checkpoint, env) in aux allow_reduction (Parser.offer (T.inj (T.InputNeeded env)) token) let rec follow_guide col env = match Parser.top env with | None -> col | Some (Parser.Element (state, _, pos, _)) -> if Recovery.guide (Parser.incoming_symbol state) then match Parser.pop env with | None -> col | Some env -> follow_guide (snd (Lexing.split_pos pos)) env else col let candidate env = let line, min_col, max_col = match Parser.top env with | None -> (1, 0, 0) | Some (Parser.Element (state, _, pos, _)) -> let depth = Recovery.depth.(Parser.number state) in let line, col = Lexing.split_pos pos in if depth = 0 then (line, col, col) else let col' = match Parser.pop_many depth env with | None -> max_int | Some env -> ( match Parser.top env with | None -> max_int | Some (Parser.Element (_, _, pos, _)) -> follow_guide (snd (Lexing.split_pos pos)) env) in (line, min col col', max col col') in { line; min_col; max_col; env } let attempt r token = let _, startp, _ = token in let line, col = Lexing.split_pos startp in let more_indented candidate = line <> candidate.line && candidate.min_col > col in let recoveries = List.drop_while ~f:more_indented r.candidates in let same_indented candidate = line = candidate.line || (candidate.min_col <= col && col <= candidate.max_col) in let recoveries = List.take_while ~f:same_indented recoveries in let rec aux = function | [] -> `Fail | x :: xs -> ( match feed_token ~allow_reduction:true token x.env with | `Fail -> (*if not (is_closed k) then printf k "Couldn't resume %d with %S.\n" (env_state x.env) (let (t,_,_) = token in Dump.token t);*) aux xs | `Recovered (checkpoint, _) -> `Ok (checkpoint, x.env) | `Accept v -> begin match aux xs with | `Fail -> `Accept v | x -> x end) in aux recoveries let decide env = let rec nth_state env n = if n = 0 then match Parser.top env with | None -> -1 (*allow giving up recovery on empty files*) | Some (Parser.Element (state, _, _, _)) -> Parser.number state else match Parser.pop env with | None -> assert (n = 1); -1 | Some env -> nth_state env (n - 1) in let st = nth_state env 0 in match Recovery.recover st with | Recovery.Nothing -> [] | Recovery.One actions -> actions | Recovery.Select f -> f (nth_state env Recovery.depth.(st)) let generate (type a) (env : a Parser.env) = let module E = struct exception Result of a end in let shifted = ref None in let rec aux acc env = match Parser.top env with | None -> (None, acc) | Some (Parser.Element (state, _, _startp, endp)) -> ( (*Dump.element k elt;*) log ~title:"decide state" "%d" (Parser.number state); let actions = decide env in let candidate0 = candidate env in let rec eval (env : a Parser.env) : Recovery.action -> a Parser.env = function | Recovery.Abort -> log ~title:"eval Abort" ""; raise Not_found | Recovery.R prod -> log ~title:"eval Reduce" ""; let prod = Parser.find_production prod in Parser.force_reduction prod env | Recovery.S (Parser.N n as sym) -> let xsym = Parser.X sym in if !shifted = None && not (Recovery.nullable n) then shifted := Some xsym; log ~title:"eval Shift N" "%a" Dump.symbol xsym; (* FIXME: if this is correct remove the fixme, otherwise use [startp] *) let loc = { Location.loc_start = endp; loc_end = endp; loc_ghost = true } in let v = Recovery.default_value loc sym in Parser.feed sym endp v endp env | Recovery.S (Parser.T t as sym) -> let xsym = Parser.X sym in if !shifted = None then shifted := Some xsym; log ~title:"eval Shift T" "%a" Dump.symbol xsym; let loc = { Location.loc_start = endp; loc_end = endp; loc_ghost = true } in let v = Recovery.default_value loc sym in let token = (Recovery.token_of_terminal t v, endp, endp) in begin match feed_token ~allow_reduction:true token env with | `Fail -> assert false | `Accept v -> raise (E.Result v) | `Recovered (_, env) -> env end | Recovery.Sub actions -> log ~title:"enter Sub" ""; let env = List.fold_left ~f:eval ~init:env actions in log ~title:"leave Sub" ""; env in match List.rev_scan_left [] ~f:eval ~init:env actions |> List.map ~f:(fun env -> { candidate0 with env }) with | exception Not_found -> (None, acc) | exception E.Result v -> (Some v, acc) | [] -> (None, acc) | candidate :: _ as candidates -> aux (candidates @ acc) candidate.env) in let popped = ref [] in (*let should_pop stack = let Parser.Element (state, _, _, _) = Parser.stack_element stack in match Parser.incoming_symbol state with | (Parser.T term) as t1 when Recovery.can_pop term -> log "Pop" "pop %s" (Dump.symbol (Parser.X t1)); begin match Parser.stack_next stack with | None -> false | Some stack' -> let rec check_next = function | Recovery.S (Parser.T term' as t2) :: _ when Parser.X t1 = Parser.X t2 -> false | Recovery.S sym :: _ -> log "Pop" "then push %s" (Dump.symbol (Parser.X sym)); popped := Parser.X t1 :: !popped; true | Recovery.Sub xs :: _ -> check_next xs | _ -> popped := Parser.X t1 :: !popped; true in check_next (decide stack') end | _ -> false in*) let final, candidates = aux [] env in (List.rev !popped, !shifted, final, candidates) let generate env = let popped, shifted, final, candidates = generate env in let candidates = List.rev_filter candidates ~f:(fun t -> not (Parser.env_has_default_reduction t.env)) in { popped; shifted; final; candidates = candidate env :: candidates } (*let dump {Nav. nav; body; _} ~wrong:(t,s,_ as token) ~rest:tokens env = if not (is_closed body) then ( let l, c = Lexing.split_pos s in printf body "Unexpected %S at %d:%d, " (Dump.token t) l c; link body "see recoveries" (fun _ -> Nav.push nav "Recoveries" @@ fun {Nav. body; _} -> let r = generate body env in let rec aux = function | [] -> () | token :: tokens -> match attempt body r token with | `Fail -> aux tokens | `Accept _ -> text body "\nCouldn't resume, generated final AST.\n" | `Ok (_, recovered_from) -> printf body "\nResumed with %S from:\n" (let (t,_,_) = token in Dump.token t); Dump.env body recovered_from in aux (token :: tokens) ); text body ".\n"; Dump.env body env; text body "\n" )*) end
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>