From 77c2905d53b48dc5e8dc1a6b4ef40797c592c457 Mon Sep 17 00:00:00 2001
From: Bertrand BRUN <bertrand.brun@me.com>
Date: Sat, 13 Nov 2010 03:02:57 +0100
Subject: [PATCH] Continuation du defmacro. On touche presque au but manque pas
 grand chose.

---
 lisp2li.lisp | 18 +++++++++++-------
 meval.lisp   | 16 ++++------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/lisp2li.lisp b/lisp2li.lisp
index 00013dd..559219d 100644
--- a/lisp2li.lisp
+++ b/lisp2li.lisp
@@ -164,7 +164,7 @@ par le compilateur et par l’interpréteur"
    ;; macro meta-definie
    ((get (car expr) :defmacro)
     `(:mcall ,(car expr)
-             ,@(mapcar (lambda (x) (lisp2li x env)) (cdr expr))))
+             ,@(mapcar (lambda (x) `(:const . ,x)) (cdr expr))))
    ;; fonction inconnue
    ((and (not (fboundp (car expr)))
          (not (get (car expr) :defun))
@@ -218,11 +218,16 @@ par le compilateur et par l’interpréteur"
     `(:sapply ,(second expr) ,@(cddr expr)))
    ;; setf
    ((eq 'setf (car expr))
-    (if (symbolp (cadr expr))
-        (let ((cell (assoc (cadr expr) env)))
-          `(:set-var (,(second cell) ,(third cell))
-                     ,(lisp2li (third expr) env)))
-      `(:set-fun ,(caadr expr) ,@(last expr) ,@(cdadr expr))))
+    (cond ((symbolp (cadr expr))
+           (let ((cell (assoc (cadr expr) env)))
+             `(:set-var (,(second cell) ,(third cell))
+                        ,(lisp2li (third expr) env))))
+          ((symbolp (cdadr expr))
+           (let ((cell (assoc (cdadr expr) env)))
+             `(:set-var (,(second cell) ,(third cell))
+                        ,(third expr))))
+          (T
+           `(:set-fun ,(caadr expr) ,@(last expr) ,@(cdadr expr)))))
    ;; setq
    ((eq 'setq (car expr))
     (lisp2li `(setf ,@(cdr expr)) env))
@@ -234,7 +239,6 @@ par le compilateur et par l’interpréteur"
     (cons :const nil))
    ;; macros
    ((macro-function (car expr))
-    (print "macro-function")
     (lisp2li (macroexpand-1 expr) env))
    ;; foctions normales
    ((not (special-operator-p (car expr)))
diff --git a/meval.lisp b/meval.lisp
index e3d2160..5411c15 100644
--- a/meval.lisp
+++ b/meval.lisp
@@ -110,12 +110,6 @@ d’arguments dans un certain environnement."
         (setf (aref sub-env (second place))
               (meval val env)))))
 
-(defun make-closure (lmbd env)
-  `(,lmbd . ,env))
-
-(defun meval-closure (clos args)
-  (meval-lambda (cadr clos) args (cddr clos)))
-
 (defun make-empty-list (size)
   (if (= size 0)
       nil
@@ -148,16 +142,14 @@ d’arguments dans un certain environnement."
                (let ((values (meval-args params env)))
                  (meval-lambda (car (get func-name :defun))
                                values
-                               (make-env (length values)
-                                       values
-                                       env))))
+                               (make-env (length values) values env))))
               ((:nil :mcall :macro-name (? (get x :defmacro)) :params _*)
                (let ((values (meval-args params env)))
                  (meval (lisp2li (meval-lambda (car (get macro-name :defmacro))
                                params
-                               (make-env (length values)
-                                         values
-                                         env)) env) env)))
+                               (make-env (length values) values env))
+                                 env)
+                        env)))
               ((:nil :mcall :lambda (:nil :lclosure (? integerp) (? integerp)? _*) :args _*)
                (meval-lambda lambda (meval-args args env) env))
               ((:nil :call :func-name _ :body _*)