diff options
Diffstat (limited to 'lib/interpreter.ml')
-rw-r--r-- | lib/interpreter.ml | 32 |
1 files changed, 13 insertions, 19 deletions
diff --git a/lib/interpreter.ml b/lib/interpreter.ml index d3b24c9..b719600 100644 --- a/lib/interpreter.ml +++ b/lib/interpreter.ml @@ -27,47 +27,41 @@ struct let range_message (start_pos, end_pos) : error_code -> error = fun code -> { code; start_pos; end_pos } - let get_parse_error lexbuf env : error = + let get_parse_error : Lexbuf.t -> 'a MI.env -> error = + fun buffer env -> match MI.stack env with | (lazy Nil) -> (* The parser is in its initial state. We should not get an error here *) - let positions = Sedlexing.lexing_positions lexbuf in + let positions = Lexbuf.positions buffer in + range_message positions UnrecoverableError | (lazy (Cons (MI.Element (state, _, start_pos, end_pos), _))) -> range_message (start_pos, end_pos) (MenhirCode (MI.number state)) let rec _parse : - (Sedlexing.lexbuf -> unit -> step) -> - Sedlexing.lexbuf -> - 'a MI.checkpoint -> - ('a, error) Result.t = - fun get_token (lexbuf : Sedlexing.lexbuf) (checkpoint : 'a MI.checkpoint) -> + Lexbuf.t -> (unit -> step) -> 'a MI.checkpoint -> ('a, error) Result.t = + fun buffer get_token (checkpoint : 'a MI.checkpoint) -> match checkpoint with | MI.InputNeeded _env -> - let token, startp, endp = get_token lexbuf () in + let token, startp, endp = get_token () in let checkpoint = MI.offer checkpoint (token, startp, endp) in - _parse get_token lexbuf checkpoint + _parse buffer get_token checkpoint | MI.Shifting _ | MI.AboutToReduce _ -> let checkpoint = MI.resume checkpoint in - _parse get_token lexbuf checkpoint + _parse buffer get_token checkpoint | MI.HandlingError _env -> - let err = get_parse_error lexbuf _env in + let err = get_parse_error buffer _env in Error err | MI.Accepted v -> Ok v | MI.Rejected -> - let positions = Sedlexing.lexing_positions lexbuf in + let positions = Lexbuf.positions buffer in let err = range_message positions InvalidSyntax in Error err type 'a builder = Lexing.position -> 'a MI.checkpoint let of_lexbuf : - Sedlexing.lexbuf -> - (Sedlexing.lexbuf -> unit -> step) -> - 'a builder -> - ('a, error) result = - fun lexbuf lexer f -> - let init = f (fst (Sedlexing.lexing_positions lexbuf)) in - _parse lexer lexbuf init + (unit -> step) -> Lexbuf.t -> 'a MI.checkpoint -> ('a, error) result = + fun lexer buffer init -> _parse buffer lexer init end |