diff --git a/README.md b/README.md
index e220cd91f1d2e5f9372c0e6638958ba78f25e0ee..e1efc9044f6ee0037731b08510b0038b33d5cdd5 100644
--- a/README.md
+++ b/README.md
@@ -48,6 +48,10 @@ pour lancer fouine sur le fichier `basic.ml` :
```
dune exec ./main.exe < tests/basic.ml
```
+ou
+```
+dune exec ./main.exe tests/basic.ml
+```
pour lancer fouine sur tous les fichiers de tests/ :
```
@@ -55,7 +59,7 @@ for fichier in tests/*
do
echo "Contenu puis test du fichier $fichier :"
cat $fichier
- dune exec ./main.exe < $fichier
+ dune exec ./main.exe $fichier
done
```
diff --git a/affichage.ml b/affichage.ml
index 38567529a651c1d9d373404fcd2ac3b48dbe5528..68aef94c2c8471ccd334f7c543b88068af84ecbe 100644
--- a/affichage.ml
+++ b/affichage.ml
@@ -1,9 +1,5 @@
open Expr
let str_of_val = function
- | Vi(i) -> String.concat "" ["int : ";string_of_int i]
- | Vb(b) -> String.concat "" ["bool : ";string_of_bool b]
- | VFun(x, _, _) -> String.concat "" ["Function of ";x]
- | Vunit -> "unit"
- | Vref(i) -> String.concat "" ["ref : ";string_of_int i]
-
+ | Vi(i) -> string_of_int i
+ | _ -> raise (Type "Attempt to print non-int")
diff --git a/eval.ml b/eval.ml
index a87d2861cbdf22f8c18fae1812a3356ecb505eea..ce767eedf93d5f1fc0bb5ce300ff12599114841f 100644
--- a/eval.ml
+++ b/eval.ml
@@ -12,6 +12,7 @@ let rec pop_var name = function
| _::t -> pop_var name t
(* Add a function in its own environment under the name func_name *)
+(* TODO : comment in README *)
let recursify_fun fv func_name =
let varname, expr, env = f_of_v fv in
let rec recenv = (func_name, VFun(varname, expr, recenv))::env in
@@ -23,9 +24,9 @@ let rec eval env =
| IntConst k -> Vi(k)
| BoolConst b -> Vb(b)
| ArithmeticBinary(op, e1, e2) -> Vi(op (i_of_v (eval env e1)) (i_of_v (eval env e2)))
- | Ternary(b, e1, e2) -> Vi(if b_of_v (eval env b)
- then i_of_v (eval env e1)
- else i_of_v (eval env e2))
+ | Ternary(b, e1, e2) -> if b_of_v (eval env b)
+ then (eval env e1)
+ else (eval env e2)
| ArithmeticCompareBinary(op, e1, e2) -> Vb(op (i_of_v(eval env e1)) (i_of_v(eval env e2)))
| CompareBinary(op, e1, e2) -> Vb((cmp_fun op) (eval env e1) (eval env e2))
| BoolBinary(op, e1, e2) -> Vb(op (b_of_v(eval env e1)) (b_of_v(eval env e2)))
@@ -33,17 +34,18 @@ let rec eval env =
| Var s -> pop_var s env
| VarDecl (_, "_", ve, e) -> begin ignore (eval env ve); eval env e end
| VarDecl (isrec, v, ve, e) -> let varval = eval env ve in
- let v_rec = if isrec then recursify_fun varval v else varval in
+ let v_rec = if isrec then recursify_fun varval v else varval in
+ check_val_close v_rec;
eval ((v, v_rec)::env) e
| Neg b -> Vb(not (b_of_v (eval env b)))
| PrInt e -> let v = eval env e in print_string (str_of_val v); print_newline (); v
- | Fun (x, e) -> VFun(x, e, env)
+ | Fun (x, e) -> VFun(x, e, env)
| App (f, arg) -> let x, fexpr, fenv = f_of_v (eval env f) in eval ((x, eval env arg)::fenv) fexpr
- |Ref(e) -> if !i=Array.length tab then raise Plus_de_place_dans_le_tas
+ | Ref(e) -> if !i=Array.length tab then raise Plus_de_place_dans_le_tas
else tab.(!i) <- eval env e; i:=!i+1; Vref(!i-1)
- |Unit -> Vunit
- |Assign(e1, e2) -> tab.(ref_of_v (eval env e1)) <- eval env e2; Vunit
- |Dereference(e) -> tab.(ref_of_v (eval env e))
+ | Unit -> Vunit
+ | Assign(e1, e2) -> tab.(ref_of_v (eval env e1)) <- eval env e2; Vunit
+ | Dereference(e) -> tab.(ref_of_v (eval env e))
diff --git a/expr.ml b/expr.ml
index 707d8962af2a8fd89c3c467c9dad275054dea74e..3e56b3f85252cec758c1d0363a1facbe98457560 100644
--- a/expr.ml
+++ b/expr.ml
@@ -26,16 +26,46 @@ type expr =
| Assign of expr * expr
| Unit
| Ref of expr
+
+let rec remove_list elem = function
+ | [] -> []
+ | p::q when p = elem -> remove_list elem q
+ | p::q -> p::remove_list elem q
+
+let rec freevar = function
+ | IntConst _ | BoolConst _ -> []
+ | ArithmeticBinary (_, a, b) | ArithmeticCompareBinary (_, a, b) | CompareBinary (_, a, b) | BoolBinary (_, a, b) | Assign (a, b) -> freevar a @ freevar b
+ | Ternary (a, b, c) -> freevar a @ freevar b @ freevar c
+ | Var s -> [s]
+ | VarDecl (_, n, ve, e) -> freevar ve @ (remove_list n (freevar e))
+ | Ref e | Dereference e | Neg e | PrInt e -> freevar e
+ | Fun (x, e) -> remove_list x (freevar e)
+ | App (fe, ve) -> freevar fe @ freevar ve
+ | Unit -> []
type valeur =
| Vi of int
| Vb of bool
+ (* Arg name, expression, environment *)
| VFun of string*expr*((string*valeur) list)
| Vunit
| Vref of int
+let env_vars = List.map fst;;
+
exception Type of string
exception Undefined of string
+
+(* Check function value has no free variables *)
+let check_val_close = function
+ | VFun (varname, expr, env) -> let fv = ref (freevar expr) in
+ fv := remove_list varname !fv;
+ List.iter (fun x -> fv := remove_list x !fv) (env_vars env);
+ if !fv <> [] then
+ raise (Undefined (String.concat " " ("Undefined variables in definition of"::varname::":"::(!fv))))
+ else
+ ()
+ | _ -> ()
let b_of_v = function
| Vb b -> b
diff --git a/main.ml b/main.ml
index a202f9c3b929820354ce6c6d394dd3e5bbf23536..ea5cb16350d03de6278ee414e0883f135b974017 100644
--- a/main.ml
+++ b/main.ml
@@ -1,12 +1,13 @@
open Eval
-open Affichage
let interpret e = eval [] e
(* stdin désigne l'entrée standard (le clavier) *)
(* lexbuf est un canal ouvert sur stdin *)
-let lexbuf = Lexing.from_channel stdin
+let channel = if Array.length (Sys.argv) == 1 then stdin else open_in (Sys.argv.(1))
+
+let lexbuf = Lexing.from_channel channel
(* on enchaîne les tuyaux: lexbuf est passé à Lexer.token,
et le résultat est donné à Parser.main *)
@@ -16,8 +17,7 @@ let parse () = Parser.main Lexer.token lexbuf
(* la fonction que l'on lance ci-dessous *)
let calc () =
let result = parse () in
- print_string (str_of_val (interpret result));
- print_newline ();
+ ignore (interpret result);
flush stdout (* on ignore car sinon, on a un val et on ne sait pas quoi en faire pour le moment *)
let _ = calc()
diff --git a/parser.mly b/parser.mly
index c93f26dda34117f5765261a740000b8c651d37da..f66a70fde05c9a384f3f75ce5444748eb1a16694 100644
--- a/parser.mly
+++ b/parser.mly
@@ -31,12 +31,12 @@ open Expr (* rappel: dans expr.ml:
%left RIGHTARROW
+%left IN /* in le plus à gauche en premier */
+
%left SEMICOLON
%left ASSIGN
-%left IN /* in le plus à gauche en premier */
-
%left ELSE /* Else le plus à gauche en premier */
/* Faudra l'interpreter comme une fonction */
@@ -51,8 +51,6 @@ open Expr (* rappel: dans expr.ml:
PLUS et MINUS, car est sur une ligne située plus bas */
%left TIMES DIVIDE
-
-%nonassoc DEREF
%nonassoc UMINUS /* un "faux token", que l'on utilise pour le MINUS unaire */
/* cf. son usage plus bas : il sert à "marquer" une règle pour lui donner la
@@ -76,10 +74,17 @@ sexpr:
| FALSE { BoolConst(false) }
| v=VARNAME { Var(v) }
| LPAREN e=expression RPAREN { e }
+ | LPAREN RPAREN { Unit }
+ | d=deref { d }
+
+deref:
+ | DEREF v=VARNAME { Dereference(Var(v)) }
+ | DEREF LPAREN e=expression RPAREN { Dereference(e) }
applic:
| LPAREN e=expression RPAREN e1=sexpr { App(e, e1) }
| f=VARNAME e=sexpr { App(Var(f), e) }
+ | f=deref e=sexpr { App(f, e) }
| applic sexpr { App($1,$2) }
@@ -118,9 +123,7 @@ expression: /* règles de grammaire pour les expressions */
VarDecl(b, v, vexpr, e)
}
| e1=expression SEMICOLON e2=expression { VarDecl(false, "_", e1, e2) }
- | DEREF ref=expression { Dereference(ref) }
| e1=expression ASSIGN e2=expression { Assign(e1, e2) }
- | LPAREN RPAREN { Unit }
| REF e=expression { Ref(e) }
(* variable / function assignment part of a `let in` statement *)