From 86bebfb6e7c4fbd13a7347bc9b8ab987c7df99a9 Mon Sep 17 00:00:00 2001
From: Guillaume Geoffroy <guillaume.geoffroy@irif.fr>
Date: Mon, 23 Oct 2023 16:00:15 +0200
Subject: [PATCH] TP : exemple de reduce/reduce

---
 .../functions-multiple-arguments/AST.ml       |  9 +++++
 .../functions-multiple-arguments/Makefile     | 11 ++++++
 .../functions-multiple-arguments/dune         | 11 ++++++
 .../functions-multiple-arguments/dune-project |  2 ++
 .../functions-multiple-arguments/fun.ml       | 32 +++++++++++++++++
 .../functions-multiple-arguments/id.ml        |  1 +
 .../functions-multiple-arguments/lexer.mll    | 21 +++++++++++
 .../functions-multiple-arguments/parser.mly   | 35 +++++++++++++++++++
 .../functions-multiple-arguments/printer.ml   | 18 ++++++++++
 9 files changed, 140 insertions(+)
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/Makefile
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/dune
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/dune-project
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/id.ml
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly
 create mode 100644 tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml

diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml b/tp/tp-reduce-reduce/functions-multiple-arguments/AST.ml
new file mode 100644
index 0000000..2e2b8a5
--- /dev/null
+++ b/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; }
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/Makefile b/tp/tp-reduce-reduce/functions-multiple-arguments/Makefile
new file mode 100644
index 0000000..0e58deb
--- /dev/null
+++ b/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
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/dune b/tp/tp-reduce-reduce/functions-multiple-arguments/dune
new file mode 100644
index 0000000..eb6e61b
--- /dev/null
+++ b/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)
+)
\ No newline at end of file
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/dune-project b/tp/tp-reduce-reduce/functions-multiple-arguments/dune-project
new file mode 100644
index 0000000..ca4766b
--- /dev/null
+++ b/tp/tp-reduce-reduce/functions-multiple-arguments/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.11)
+(using menhir 2.0)
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml b/tp/tp-reduce-reduce/functions-multiple-arguments/fun.ml
new file mode 100644
index 0000000..5133f58
--- /dev/null
+++ b/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 ()
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/id.ml b/tp/tp-reduce-reduce/functions-multiple-arguments/id.ml
new file mode 100644
index 0000000..c6a8e28
--- /dev/null
+++ b/tp/tp-reduce-reduce/functions-multiple-arguments/id.ml
@@ -0,0 +1 @@
+type t = string
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll b/tp/tp-reduce-reduce/functions-multiple-arguments/lexer.mll
new file mode 100644
index 0000000..28aef70
--- /dev/null
+++ b/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)
+}
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly b/tp/tp-reduce-reduce/functions-multiple-arguments/parser.mly
new file mode 100644
index 0000000..3243332
--- /dev/null
+++ b/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) }
diff --git a/tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml b/tp/tp-reduce-reduce/functions-multiple-arguments/printer.ml
new file mode 100644
index 0000000..81db7c7
--- /dev/null
+++ b/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