TP : exemple de reduce/reduce
This commit is contained in:
parent
ffbc3e72d3
commit
86bebfb6e7
9 changed files with 140 additions and 0 deletions
9
tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml
Normal file
9
tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
type expression =
|
||||||
|
Var of Id.t
|
||||||
|
| Int of int
|
||||||
|
| Add of expression * expression
|
||||||
|
| Fun of boundN
|
||||||
|
| App of expression * expression list
|
||||||
|
|
||||||
|
and boundN = { bound : Id.t list;
|
||||||
|
body : expression; }
|
11
tp/tp-reduce-reduce/functions-multiple-arguments/Makefile
Normal file
11
tp/tp-reduce-reduce/functions-multiple-arguments/Makefile
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
.PHONY: all clean
|
||||||
|
|
||||||
|
MAIN=fun
|
||||||
|
|
||||||
|
all:
|
||||||
|
dune build $(MAIN).exe
|
||||||
|
ln -sf _build/default/$(MAIN).exe $(MAIN)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
dune clean
|
||||||
|
rm -fr *~ l1
|
11
tp/tp-reduce-reduce/functions-multiple-arguments/dune
Normal file
11
tp/tp-reduce-reduce/functions-multiple-arguments/dune
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
(ocamllex lexer)
|
||||||
|
|
||||||
|
(menhir
|
||||||
|
(flags --explain --inspection --table)
|
||||||
|
(modules parser))
|
||||||
|
|
||||||
|
(executable
|
||||||
|
(name fun)
|
||||||
|
(ocamlopt_flags :standard)
|
||||||
|
(libraries menhirLib)
|
||||||
|
)
|
|
@ -0,0 +1,2 @@
|
||||||
|
(lang dune 1.11)
|
||||||
|
(using menhir 2.0)
|
32
tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml
Normal file
32
tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml
Normal file
|
@ -0,0 +1,32 @@
|
||||||
|
let rec interactive_loop () =
|
||||||
|
welcome_message ();
|
||||||
|
let rec loop () =
|
||||||
|
match read () |> eval |> print with
|
||||||
|
| () -> loop ()
|
||||||
|
| exception End_of_file -> print_newline ()
|
||||||
|
| exception exn ->
|
||||||
|
Printf.printf "Error: %s\n%!" (Printexc.to_string exn);
|
||||||
|
loop ()
|
||||||
|
in
|
||||||
|
loop ()
|
||||||
|
|
||||||
|
and welcome_message () =
|
||||||
|
Printf.printf ""
|
||||||
|
|
||||||
|
and read () =
|
||||||
|
prompt (); input_line stdin |> parse
|
||||||
|
|
||||||
|
and prompt () =
|
||||||
|
Printf.printf "> %!"
|
||||||
|
|
||||||
|
and parse input =
|
||||||
|
let lexbuf = Lexing.from_string input in
|
||||||
|
Parser.phrase Lexer.token lexbuf
|
||||||
|
|
||||||
|
and print e =
|
||||||
|
Printf.printf ":- %s\n%!" (Printer.string_of_exp e)
|
||||||
|
|
||||||
|
and eval e =
|
||||||
|
e
|
||||||
|
|
||||||
|
let main = interactive_loop ()
|
1
tp/tp-reduce-reduce/functions-multiple-arguments/id.ml
Normal file
1
tp/tp-reduce-reduce/functions-multiple-arguments/id.ml
Normal file
|
@ -0,0 +1 @@
|
||||||
|
type t = string
|
21
tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll
Normal file
21
tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
{ (* Emacs, open this file with -*- tuareg -*- *)
|
||||||
|
open Parser
|
||||||
|
}
|
||||||
|
|
||||||
|
let layout = ' ' | '\t' | '\n'
|
||||||
|
let number = ['0'-'9']+
|
||||||
|
let identifier = ['a'-'z']['A'-'Z' '0'-'9' 'a'-'z' '_']*
|
||||||
|
|
||||||
|
rule token = parse
|
||||||
|
| eof { EOF }
|
||||||
|
| layout { token lexbuf }
|
||||||
|
| number as i { INT (int_of_string i) }
|
||||||
|
| "fun" { FUN }
|
||||||
|
| identifier as s { ID s }
|
||||||
|
| "(" { LP }
|
||||||
|
| ")" { RP }
|
||||||
|
| "->" { RIGHT_ARROW }
|
||||||
|
| "+" { PLUS }
|
||||||
|
| _ as c {
|
||||||
|
failwith (Printf.sprintf "Invalid character: %c\n" c)
|
||||||
|
}
|
35
tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly
Normal file
35
tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly
Normal file
|
@ -0,0 +1,35 @@
|
||||||
|
%{ (* Emacs, open this with -*- tuareg -*- *)
|
||||||
|
open AST
|
||||||
|
%}
|
||||||
|
|
||||||
|
%token<int> INT
|
||||||
|
%token<string> ID
|
||||||
|
%token PLUS EOF FUN RIGHT_ARROW LP RP
|
||||||
|
|
||||||
|
%start<AST.expression> phrase
|
||||||
|
|
||||||
|
%nonassoc RIGHT_ARROW
|
||||||
|
%left PLUS
|
||||||
|
|
||||||
|
%nonassoc prec_application
|
||||||
|
|
||||||
|
%nonassoc LP INT ID FUN
|
||||||
|
|
||||||
|
%%
|
||||||
|
|
||||||
|
phrase:
|
||||||
|
e=expression EOF { e }
|
||||||
|
|
||||||
|
arguments:
|
||||||
|
| e=expression { [ e ] } %prec prec_application
|
||||||
|
| hd=expression tl=arguments { hd::tl }
|
||||||
|
|
||||||
|
expression:
|
||||||
|
| LP e=expression RP { e }
|
||||||
|
| n=INT { Int n }
|
||||||
|
| x=ID { Var x }
|
||||||
|
| e1=expression PLUS e2=expression { Add (e1, e2) }
|
||||||
|
| FUN vars=nonempty_list(ID) RIGHT_ARROW e=expression
|
||||||
|
{ Fun { bound=vars; body=e }}
|
||||||
|
| f=expression args=arguments
|
||||||
|
{ App (f, args) }
|
18
tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml
Normal file
18
tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
open AST
|
||||||
|
|
||||||
|
let string_of_exp e =
|
||||||
|
let rec aux = function
|
||||||
|
| Var x ->
|
||||||
|
x
|
||||||
|
| Int x ->
|
||||||
|
string_of_int x
|
||||||
|
| Add (e1, e2) ->
|
||||||
|
Printf.sprintf "(%s + %s)" (aux e1) (aux e2)
|
||||||
|
| Fun b ->
|
||||||
|
Printf.sprintf "(fun %s -> %s)"
|
||||||
|
(String.concat " " b.bound)
|
||||||
|
(aux b.body)
|
||||||
|
| App (f, a) ->
|
||||||
|
"(" ^ String.concat " " (List.map aux (f::a)) ^ ")"
|
||||||
|
in
|
||||||
|
aux e
|
Reference in a new issue