TP : exemple de reduce/reduce

tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml

@@ -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; }

tp/tp-reduce-reduce/functions-multiple-arguments/Makefile

@@ -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

tp/tp-reduce-reduce/functions-multiple-arguments/dune

@@ -0,0 +1,11 @@
+(ocamllex lexer)
+
+(menhir
+ (flags --explain --inspection --table)
+ (modules parser))
+
+(executable
+ (name fun)
+ (ocamlopt_flags :standard)
+ (libraries menhirLib)
+)

tp/tp-reduce-reduce/functions-multiple-arguments/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.11)
+(using menhir 2.0)

tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml

@@ -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 ()

tp/tp-reduce-reduce/functions-multiple-arguments/id.ml

@@ -0,0 +1 @@
+type t = string

tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll

@@ -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)
+}

tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly

@@ -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) }

tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml

@@ -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