aboutsummaryrefslogtreecommitdiff
path: root/lib/interpreter.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/interpreter.ml')
-rw-r--r--lib/interpreter.ml67
1 files changed, 0 insertions, 67 deletions
diff --git a/lib/interpreter.ml b/lib/interpreter.ml
deleted file mode 100644
index b719600..0000000
--- a/lib/interpreter.ml
+++ /dev/null
@@ -1,67 +0,0 @@
-(**
- This module provide a way to build the syntax parser with the menhir
- incremental engine. This feature allow to see the state of the parser, and
- get detailed error message but is not intended to be used directly.
-
- Refer to the menhir manual in order to see the values.
-
- The interresting function here is [of_lexbuf] which return the error code in
- case of invalid syntax.
- *)
-
-type error_code = UnrecoverableError | InvalidSyntax | MenhirCode of int
-
-module Interpreter (MI : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE) =
-struct
- type error = {
- code : error_code;
- start_pos : Lexing.position;
- end_pos : Lexing.position;
- }
-
- module E = MenhirLib.ErrorReports
- module L = MenhirLib.LexerUtil
-
- type step = MI.token * Lexing.position * Lexing.position
-
- let range_message (start_pos, end_pos) : error_code -> error =
- fun code -> { code; start_pos; end_pos }
-
- 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 = 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 :
- 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 () in
- let checkpoint = MI.offer checkpoint (token, startp, endp) in
- _parse buffer get_token checkpoint
- | MI.Shifting _ | MI.AboutToReduce _ ->
- let checkpoint = MI.resume checkpoint in
- _parse buffer get_token checkpoint
- | MI.HandlingError _env ->
- let err = get_parse_error buffer _env in
- Error err
- | MI.Accepted v -> Ok v
- | MI.Rejected ->
- 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 :
- (unit -> step) -> Lexbuf.t -> 'a MI.checkpoint -> ('a, error) result =
- fun lexer buffer init -> _parse buffer lexer init
-end