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