suzanne.soy/2010-m1s1-compilation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Continuation du defmacro. On touche presque au but manque pas grand chose.

Browse Source
This commit is contained in:
Bertrand BRUN 2010-11-13 03:02:57 +01:00
parent c603beaebe
commit 77c2905d53
2 changed files with 15 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lisp2li.lisp
View File

@ -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)))

16
meval.lisp
View File

@ -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 _*)