diff options
Diffstat (limited to 'lib/interpreter.ml')
| -rw-r--r-- | lib/interpreter.ml | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/lib/interpreter.ml b/lib/interpreter.ml index b41d74e..21c1430 100644 --- a/lib/interpreter.ml +++ b/lib/interpreter.ml @@ -22,26 +22,27 @@ struct module E = MenhirLib.ErrorReports module L = MenhirLib.LexerUtil - let range_message start_pos end_pos code = { code; start_pos; end_pos } + type step = MI.token * Lexing.position * Lexing.position - let get_parse_error default_position env : error = + let range_message (start_pos, end_pos) code = { code; start_pos; end_pos } + + let get_parse_error lexbuf env : error = match MI.stack env with | (lazy Nil) -> - range_message default_position.Lexing.lex_start_p - default_position.Lexing.lex_curr_p InvalidSyntax + let positions = Sedlexing.lexing_positions lexbuf in + range_message positions InvalidSyntax | (lazy (Cons (MI.Element (state, _, start_pos, end_pos), _))) -> - range_message start_pos end_pos (MenhirCode (MI.number state)) + range_message (start_pos, end_pos) (MenhirCode (MI.number state)) let rec _parse : - (Lexing.lexbuf -> MI.token) -> - Lexing.lexbuf -> + (Sedlexing.lexbuf -> unit -> step) -> + Sedlexing.lexbuf -> 'a MI.checkpoint -> ('a, error) Result.t = - fun get_token (lexbuf : Lexing.lexbuf) (checkpoint : 'a MI.checkpoint) -> + fun get_token (lexbuf : Sedlexing.lexbuf) (checkpoint : 'a MI.checkpoint) -> match checkpoint with | MI.InputNeeded _env -> - let token = get_token lexbuf in - let startp = lexbuf.Lexing.lex_start_p and endp = lexbuf.lex_curr_p in + let token, startp, endp = get_token lexbuf () in let checkpoint = MI.offer checkpoint (token, startp, endp) in _parse get_token lexbuf checkpoint | MI.Shifting _ | MI.AboutToReduce _ -> @@ -52,19 +53,18 @@ struct Error err | MI.Accepted v -> Ok v | MI.Rejected -> - let err = - range_message lexbuf.lex_start_p lexbuf.lex_curr_p InvalidSyntax - in + let positions = Sedlexing.lexing_positions lexbuf in + let err = range_message positions InvalidSyntax in Error err type 'a builder = Lexing.position -> 'a MI.checkpoint let of_lexbuf : - Lexing.lexbuf -> - (Lexing.lexbuf -> MI.token) -> + Sedlexing.lexbuf -> + (Sedlexing.lexbuf -> unit -> step) -> 'a builder -> ('a, error) result = fun lexbuf lexer f -> - let init = f lexbuf.lex_curr_p in + let init = f (fst (Sedlexing.lexing_positions lexbuf)) in _parse lexer lexbuf init end |