commit 77c2905d53b48dc5e8dc1a6b4ef40797c592c457
parent c603beaebef0a4c73284b54f363e2ca36b97d71b
Author: Bertrand BRUN <bertrand.brun@me.com>
Date: Sat, 13 Nov 2010 03:02:57 +0100
Continuation du defmacro. On touche presque au but manque pas grand chose.
Diffstat:
2 files changed, 15 insertions(+), 19 deletions(-)
diff --git 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
@@ -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 _*)
