Commit 370743e6 authored by POTTIER Francois's avatar POTTIER Francois

Hooked the random expression generator with the parser.

parent 8bf77e5b
(* A generator of well-formed arithmetic expressions, for use as test input
for the parser. *)
(* -------------------------------------------------------------------------- *)
(* A tiny library of finite or infinite streams. *)
type 'a stream =
unit -> 'a answer
and 'a answer =
| Done
| More of 'a * 'a stream
let empty () =
Done
let cons x ys () =
More (x, ys)
let singleton x =
cons x empty
let rec (++) xs ys () =
match xs() with
| More (x, xs) ->
More (x, xs ++ ys)
| Done ->
ys()
(* -------------------------------------------------------------------------- *)
(* A random generator of well-formed arithmetic expressions. *)
(* A random generator of well-formed arithmetic expressions, for use as test
input for the parser. *)
open Stream
open Parser
(* [split n] produces two numbers [n1] and [n2] comprised between [0] and [n]
......@@ -47,11 +17,17 @@ let split n =
and is concatenated with the stream [k] -- this allows an efficient
formulation that does not use the stream concatenation operator. *)
(* We do not produce divisions because they are of no grammatical
interest (we already have multiplication) and they can cause
early termination of the parser due to a division by zero (the
parser performs evaluation on the fly!). *)
let rec produce n (k : token stream) : token stream =
if n = 0 then
cons (INT 0) k
let i = Random.int 10 in
cons (INT i) k
else
match Random.int 6 with
match Random.int 5 with
| 0 ->
(* Parentheses. *)
cons LPAREN (produce (n - 1) (cons RPAREN k))
......@@ -68,12 +44,13 @@ let rec produce n (k : token stream) : token stream =
let n1, n2 = split (n - 1) in
produce n1 (cons TIMES (produce n2 k))
| 4 ->
(* Div. *)
let n1, n2 = split (n - 1) in
produce n1 (cons DIV (produce n2 k))
| 5 ->
(* Unary minus. *)
cons MINUS (produce (n - 1) k)
| _ ->
assert false
(* We finish with an EOL. *)
let produce n : token stream =
produce n (singleton EOL)
.PHONY: all clean
OCAMLBUILD := ocamlbuild -use-ocamlfind
all:
$(OCAMLBUILD) gene.native
clean:
$(OCAMLBUILD) -clean
(* A tiny library of finite or infinite streams. *)
type 'a stream =
unit -> 'a answer
and 'a answer =
| Done
| More of 'a * 'a stream
let empty () =
Done
let cons x ys () =
More (x, ys)
let singleton x =
cons x empty
let rec (++) xs ys () =
match xs() with
| More (x, xs) ->
More (x, xs ++ ys)
| Done ->
ys()
let rec fold_left accu f xs =
match xs() with
| Done ->
accu
| More (x, xs) ->
let accu = f accu x in
fold_left accu f xs
let iter f xs =
fold_left () (fun () x -> f x) xs
let rec map f xs () =
match xs() with
| Done ->
Done
| More (x, xs) ->
More (f x, map f xs)
(* An infinite, imperative stream. *)
type 'a infinite_imperative_stream =
unit -> 'a
let fresh (xs : 'a stream) : 'a infinite_imperative_stream =
let r = ref xs in
fun () ->
match !r() with
| Done ->
raise End_of_file
| More (x, xs) ->
r := xs;
x
true: use_menhir, package(menhirLib)
open Printf
open Parser
open Stream
open Generator
(* A token printer, for debugging. *)
let print_token = function
| INT i ->
printf "%d" i
| PLUS ->
printf " + "
| MINUS ->
printf " - "
| TIMES ->
printf " * "
| DIV ->
printf " / "
| LPAREN ->
printf "("
| RPAREN ->
printf ")"
| EOL ->
printf "\n"
let print_token_stream =
iter print_token
(* Hooking the stream to the parser. *)
let parse xs =
MenhirLib.Convert.Simplified.traditional2revised Parser.main
(fresh (map (fun token -> (token, Lexing.dummy_pos, Lexing.dummy_pos)) xs))
let () =
let i : int = parse (produce 10000000) in
printf "%d\n%!" i
%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