www

commit 25e891e6fcafb89518fb9388fd504e623e8f693a
parent 2905eaf456d6dfd16cd23635cdc3c8878ce5918b
Author: Bertrand BRUN <bertrand.brun@me.com>
Date:   Mon,  8 Nov 2010 19:51:09 +0100

Ajout du cas du let dans meval

Diffstat:
M
lisp2li.lisp
 | 
32
++++++++++++++++++++++++++++++++
M
meval.lisp
 | 
13
++-----------
M
test-unitaire.lisp
 | 
2
+-

3 files changed, 35 insertions(+), 12 deletions(-)
diff --git a/lisp2li.lisp b/lisp2li.lisp
@@ -329,3 +329,34 @@ par le compilateur et par l’interpréteur"
                (:call eq (:call car (:const 1 2)) (:const . 1)))
         (:const . nil)
         (:const . T)))
+
+(deftest (lisp2li let)
+  (lisp2li '(let ((x 1) (y 2))
+              (cons x y)) ())
+  '(:let 2 (:set-var (0 1) (:const . 1))
+         (:set-var (0 2) (:const . 2))
+         (:call cons (:cvar 0 1) (:cvar 0 2))))
+
+(deftest (lisp2li let)
+  (lisp2li '(let ((x 1) (y 2))
+              (cons x y)
+              (list x y)) ())
+  '(:let 2 (:set-var (0 1) (:const . 1))
+         (:set-var (0 2) (:const . 2))
+         (:progn
+          (:call cons (:cvar 0 1) (:cvar 0 2))
+          (:call list (:cvar 0 1) (:cvar 0 2)))))
+
+(deftest (lisp2li let)
+  (lisp2li '(let ((x z) (y 2))
+              (cons x y)) '((z 0 1)))
+  '(:let 2 (:set-var (1 1) (:cvar 0 1))
+         (:set-var (1 2) (:const . 2))
+         (:call cons (:cvar 1 1) (:cvar 1 2))))
+
+(deftest (lisp2li let)
+  (lisp2li '(let ((x 2))
+              (cons x z)) '((z 0 1)))
+  '(:let 1 (:set-var (1 1) (:const . 2))
+         (:call cons (:cvar 1 1) (:cvar 0 1))))
+         
+\ No newline at end of file
diff --git a/meval.lisp b/meval.lisp
@@ -61,17 +61,6 @@ du &rest dans une cellule de l'env sous forme d'une liste"
 (defun map-meval (list env)
   (mapcar (lambda (x) (meval x env)) list))
 
-(defun meval-progn (list env)
-  "Mevalue toutes les sous expressions et renvoie
-la valeur de la dernier"
-  (if (endp list)
-      nil
-    (if (endp (cdr list))
-        (meval (car list) env)
-      (progn
-        (meval (car list) env)
-        (meval-progn (cdr list) env)))))
-
 (defun meval-body (list-expr env)
   "Évalue en séquence la liste des expressions et
 retourne la valeur retournée par la dernière"
@@ -135,6 +124,8 @@ d’arguments dans un certain environnement."
                (meval-body `(,body) env))
               ((:nil :set-var :place @. :value _)
                (msetf place value env))
+              ((:nil :let :size (? integerp) :affectations (:nil :set-var :places @ :values _)* :body _*)
+               (meval-body body (make-env size (meval-args values env) env)))
               (_*
                (error "form special ~S not yet implemented" expr))))
 
diff --git a/test-unitaire.lisp b/test-unitaire.lisp
@@ -132,7 +132,7 @@
 
 (erase-tests test-unitaire)
 (deftest (test-unitaire copy-all)
-    (let* ((foo #(a b (1 #(2 4 6) 3) c))
+  (let* ((foo #(a b (1 #(2 4 6) 3) c))
            (copy-of-foo (copy-all foo)))
       copy-of-foo
       (setf (aref (cadr (aref copy-of-foo 2)) 1) (cons 'MODIFIED (random 42)))