Commit 847850c0 authored by POTTIER Francois's avatar POTTIER Francois

New demo calc-incremental-dune.

parent c3f00d4e
......@@ -6,6 +6,7 @@
# The following demos require dune (a.k.a. jbuilder)
# and assume that Menhir is already installed:
# calc-dune
# calc-incremental-dune
DEMOS := \
calc \
......@@ -27,3 +28,4 @@ clean::
realclean: clean
make -C calc-dune clean
make -C calc-incremental-dune clean
.PHONY: all clean test
DUNE := jbuilder
EXECUTABLE := calc.exe
all:
$(DUNE) build $(EXECUTABLE)
clean:
$(DUNE) clean
rm -f *~ .*~
test: all
@echo "The following command should print 42:"
echo "(1 + 2 * 10) * 2" | ./_build/default/$(EXECUTABLE)
This demo is identical to the "calc-incremental" demo,
but uses dune (a.k.a. jbuilder)
instead of ocamlbuild.
open Lexing
(* A short name for the incremental parser API. *)
module I =
Parser.MenhirInterpreter
(* -------------------------------------------------------------------------- *)
(* The loop which drives the parser. At each iteration, we analyze a
checkpoint produced by the parser, and act in an appropriate manner.
[lexbuf] is the lexing buffer. [checkpoint] is the last checkpoint produced
by the parser. *)
let rec loop lexbuf (checkpoint : int I.checkpoint) =
match checkpoint with
| I.InputNeeded env ->
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
checkpoint. Then, repeat. *)
let token = Lexer.token lexbuf in
let startp = lexbuf.lex_start_p
and endp = lexbuf.lex_curr_p in
let checkpoint = I.offer checkpoint (token, startp, endp) in
loop lexbuf checkpoint
| I.Shifting _
| I.AboutToReduce _ ->
let checkpoint = I.resume checkpoint in
loop lexbuf checkpoint
| I.HandlingError env ->
(* The parser has suspended itself because of a syntax error. Stop. *)
Printf.fprintf stderr
"At offset %d: syntax error.\n%!"
(lexeme_start lexbuf)
| I.Accepted v ->
(* The parser has succeeded and produced a semantic value. Print it. *)
Printf.printf "%d\n%!" v
| I.Rejected ->
(* The parser rejects this input. This cannot happen, here, because
we stop as soon as the parser reports [HandlingError]. *)
assert false
(* -------------------------------------------------------------------------- *)
(* The above loop is shown for explanatory purposes, but can in fact be
replaced with the following code, which exploits the functions
[lexer_lexbuf_to_supplier] and [loop_handle] offered by Menhir. *)
let succeed (v : int) =
(* The parser has succeeded and produced a semantic value. Print it. *)
Printf.printf "%d\n%!" v
let fail lexbuf (_ : int I.checkpoint) =
(* The parser has suspended itself because of a syntax error. Stop. *)
Printf.fprintf stderr
"At offset %d: syntax error.\n%!"
(lexeme_start lexbuf)
let loop lexbuf result =
let supplier = I.lexer_lexbuf_to_supplier Lexer.token lexbuf in
I.loop_handle succeed (fail lexbuf) supplier result
(* -------------------------------------------------------------------------- *)
(* Initialize the lexer, and catch any exception raised by the lexer. *)
let process (line : string) =
let lexbuf = from_string line in
try
loop lexbuf (Parser.Incremental.main lexbuf.lex_curr_p)
with
| Lexer.Error msg ->
Printf.fprintf stderr "%s%!" msg
(* -------------------------------------------------------------------------- *)
(* The rest of the code is as in the [calc] demo. *)
let process (optional_line : string option) =
match optional_line with
| None ->
()
| Some line ->
process line
let rec repeat channel =
(* Attempt to read one line. *)
let optional_line, continue = Lexer.line channel in
process optional_line;
if continue then
repeat channel
let () =
repeat (from_channel stdin)
(jbuild_version 1)
(ocamllex (lexer))
(menhir (
(modules (parser))
(flags ("--table"))
))
(executable (
(name calc)
(libraries (menhirLib))
))
{
open Parser
exception Error of string
}
(* This rule looks for a single line, terminated with '\n' or eof.
It returns a pair of an optional string (the line that was found)
and a Boolean flag (false if eof was reached). *)
rule line = parse
| ([^'\n']* '\n') as line
(* Normal case: one line, no eof. *)
{ Some line, true }
| eof
(* Normal case: no data, eof. *)
{ None, false }
| ([^'\n']+ as line) eof
(* Special case: some data but missing '\n', then eof.
Consider this as the last line, and add the missing '\n'. *)
{ Some (line ^ "\n"), false }
(* This rule analyzes a single line and turns it into a stream of
tokens. *)
and token = parse
| [' ' '\t']
{ token lexbuf }
| '\n'
{ EOL }
| ['0'-'9']+ as i
{ INT (int_of_string i) }
| '+'
{ PLUS }
| '-'
{ MINUS }
| '*'
{ TIMES }
| '/'
{ DIV }
| '('
{ LPAREN }
| ')'
{ RPAREN }
| _
{ raise (Error (Printf.sprintf "At offset %d: unexpected character.\n" (Lexing.lexeme_start lexbuf))) }
%token <int> INT
%token PLUS MINUS TIMES DIV
%token LPAREN RPAREN
%token EOL
%left PLUS MINUS /* lowest precedence */
%left TIMES DIV /* medium precedence */
%nonassoc UMINUS /* highest precedence */
%start <int> main
%%
main:
| e = expr EOL
{ e }
expr:
| i = INT
{ i }
| LPAREN e = expr RPAREN
{ e }
| e1 = expr PLUS e2 = expr
{ e1 + e2 }
| e1 = expr MINUS e2 = expr
{ e1 - e2 }
| e1 = expr TIMES e2 = expr
{ e1 * e2 }
| e1 = expr DIV e2 = expr
{ e1 / e2 }
| MINUS e = expr %prec UMINUS
{ - e }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment