www

commit 846d140d3fa40627243f00e1d11282067ca95c74
parent 00fa7660de179edc17bcccffe4fc96e0ee8b8467
Author: Bertrand BRUN <bertrand.brun@me.com>
Date:   Mon,  8 Nov 2010 19:13:01 +0100

Ajout du cas du let dans lisp2li

Diffstat:
M
lisp2li.lisp
 | 
12
++++++++++++
M
meval.lisp
 | 
21
++++++++++-----------

2 files changed, 22 insertions(+), 11 deletions(-)
diff --git a/lisp2li.lisp b/lisp2li.lisp
@@ -130,6 +130,18 @@ par le compilateur et par l’interpréteur"
    ;; #'fn (FUNCTION fn)
    ((eq 'function (car expr))
     `(:sclosure ,(cadr expr)))
+   ;; let
+   ((eq 'let (car expr))
+    (match (let :bindings ((:names $ :values _)*) :body _*) expr
+           (let ((new-env (make-stat-env names env)))
+             `(:let ,(length bindings)
+                    ,@(mapcar
+                       (lambda (name value)
+                         (let ((cell (assoc name new-env)))
+                           `(:set-var (,(second cell) ,(third cell))
+                                      ,(lisp2li value env))))
+                       names values)
+                    ,(lisp2li (implicit-progn body) new-env)))))
    ;; defun
    ((eq 'defun (car expr))
     `(:mcall set-defun (:const . ,(second expr))
diff --git a/meval.lisp b/meval.lisp
@@ -117,28 +117,27 @@ d’arguments dans un certain environnement."
   (cond-match expr
               ((:nil :const :val . _) expr val)
               ((:nil :cvar :num-env (? integerp) :index (? integerp))
-                (let ((sub-env (get-env-num num-env env)))
-                (if sub-env
-                    (aref sub-env index)
-                  (error "The variable unbound" expr))))
+               (let ((sub-env (get-env-num num-env env)))
+                 (if sub-env
+                     (aref sub-env index)
+                   (error "The variable unbound" expr))))
               ((:nil :if :predicat @. :expr1 @. :expr2 @.)
-                (if (meval predicat env)
-                    (meval expr1 env)
-                  (meval expr2 env)))
+               (if (meval predicat env)
+                   (meval expr1 env)
+                 (meval expr2 env)))
               ((:nil :call :func-name _ :body _*)
                (apply (symbol-function func-name) (map-meval body env)))
               ((:nil :mcall :lambda (:nil :lclosure (? integerp) (? integerp)? _*) :args _*)
                (meval-lambda lambda (meval-args args env) env))
-              (match (:nil :progn :body @.+)
-                     (meval-body body env))
+              ((:nil :progn :body @.+)
+               (meval-body body env))
               ((:nil :lclosure (? integerp) (? integerp)? :body _*)
-                (meval-body `(,body) env))
+               (meval-body `(,body) env))
               ((:nil :set-var :place @. :value _)
                (msetf place value env))
               (_*
                (error "form special ~S not yet implemented" expr))))
 
-        
 ;; Test unitaire
 (load "test-unitaire")
 (load "lisp2li")