From ae51cc671ad7d277668a526be3c05466242fee88 Mon Sep 17 00:00:00 2001
From: Bertrand BRUN <bertrand.brun@me.com>
Date: Sat, 6 Nov 2010 13:22:28 +0100
Subject: [PATCH] Ajout de la gestion des call, if et progn dans meval

---
 meval.lisp | 65 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 43 insertions(+), 22 deletions(-)

diff --git a/meval.lisp b/meval.lisp
index 7d050ff..41b5801 100644
--- a/meval.lisp
+++ b/meval.lisp
@@ -9,6 +9,15 @@
            )))
   (get-env-num-t num env 0))
 
+(defun map-meval (list env)
+  (mapcar (lambda (x) (meval x env)) list))
+
+(defun meval-progn (list env)
+  (loop
+   for expr in list
+   do (meval expr env)
+  ))
+
 (defun meval (expr &optional env)
   "Interprète le langage intermédiaire passé en paramètre."
   (cond ((match :const (first expr))
@@ -17,27 +26,17 @@
          (let ((sub-env (get-env-num (second expr) env)))
            (if sub-env
                (aref sub-env (third expr))
-             (error "The variable ~S is unbound" (cdr expr)))))
+             (error "The variable ~S is unbound" expr))))
+        ((match :if (first expr))
+         (if (meval (second expr) env)
+             (meval (third expr) env)
+           (meval (fourth expr) env)))
+        ((match :call (first expr))
+         (apply (symbol-function (cadr expr)) (map-meval (cddr expr) env)))
+        ((match :progn (first expr))
+         (map-meval ())
         (T
-         (error "form special ~S not yet implemented" expr))))
-
-;;   (cond ((eq ':const (first expr))
-;;          (cdr expr))
-;;         ((eq ':var (first expr))
-;;          (let ((cell (get-binding env (cdr expr))))
-;;            (if cell
-;;                 (cdr cell)
-;;                (error "The variable ~S is unbound" (cdr expr)))))
-;;         ((eq ':if (car expr))
-;;          (if (meval (second expr) env)
-;;              (meval (third expr) env)
-;;            (meval (fourth expr) env)))
-;;         ((eq ':call (first expr))
-;;          (apply (second expr) (map-meval (cddr expr) env)))
-;;         ))
-
-(defun map-meval (list env)
-  (mapcar (lambda (x) (meval x env)) list))
+         (error "form special ~S not yet implemented" (car expr)))))
 
 ;; Test unitaire
 (load "test-unitaire")
@@ -69,8 +68,30 @@
 
 (deftest (meval :call)
   (meval '(:call + (:const . 3) (:cvar 0 1)) #(() 4 5 6))
-  8)
+  7)
+
+(deftest (meval :call)
+  (meval '(:call list (:const . 3) (:const . 2)))
+  '(3 2))
+
+(deftest (meval :if)
+  (meval '(:if (:const . T)
+               (:const . T)
+               (:const . nil)))
+  T)
+
+(deftest (meval :if)
+  (meval '(:if (:call eq (:const . 1)
+                      (:cvar 0 1))
+               (:const . T)
+               (:const . nil)) #(() 1 2 3))
+  T)
 
 (deftest (meval defun)
   (meval '(defun foo (x) x))
-  foo)
\ No newline at end of file
+  foo)
+
+(deftest (meval defun)
+  (meval '(defun foo (x y z) (list x y z)))
+  foo)
+