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

Ajout du cas du defmacro (pas encore fini)

Browse Source
This commit is contained in:
Bertrand BRUN 2010-11-12 23:38:36 +01:00
parent cb07628ee8
commit 5416bb34d8
2 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lisp2li.lisp
View File

@ -160,7 +160,11 @@ par le compilateur et par l’interpréteur"
;; fonction meta-definie
((get (car expr) :defun)
`(:mcall ,(car expr)
,@(mapcar (lambda (x) (lisp2li x env)) (cdr expr))))
,@(mapcar (lambda (x) (lisp2li x env)) (cdr expr))))
;; macro meta-definie
((get (car expr) :defmacro)
`(:mcall ,(car expr)
,@(mapcar (lambda (x) (lisp2li x env)) (cdr expr))))
;; fonction inconnue
((and (not (fboundp (car expr)))
(not (get (car expr) :defun)))
@ -204,6 +208,10 @@ par le compilateur et par l’interpréteur"
((eq 'defun (car expr))
`(:mcall set-defun (:const . ,(second expr))
,(lisp2li `(lambda ,(third expr) ,@(cdddr expr)) env)))
;; defmacro
((eq 'defmacro (car expr))
`(:mcall set-defmacro (:const . ,(second expr))
,(lisp2li `(lambda ,(third expr) ,@(cdddr expr)) env)))
;; apply
((eq 'apply (car expr))
`(:sapply ,(second expr) ,@(cddr expr)))

17
meval.lisp
View File

@ -85,9 +85,6 @@ retourne la liste de leurs valeurs"
(defun meval-lambda (lclosure args env)
"Applique une λ-fonction quelconque à des valeurs
d’arguments dans un certain environnement."
(print "meval-lambda")
(print env)
(print args)
(match (:nil :lclosure :size (? integerp) :rest (? integerp)? :body _*) lclosure
(meval lclosure
(make-env size args env rest))))
@ -111,7 +108,6 @@ d’arguments dans un certain environnement."
(defun meval (expr &optional (env #()))
"Interprète le langage intermédiaire passé en paramètre."
(print expr)
(cond-match expr
((:nil :const :val . _) expr val)
((:nil :cvar :num-env (? integerp) :index (? integerp))
@ -129,13 +125,24 @@ d’arguments dans un certain environnement."
(let ((name (meval func-name env)))
(setf (get name :defun) closure)
name))
((:nil :mcall :func-name $ :params _*)
((:nil :mcall set-defmacro :macro-name @. :closure _*)
(let ((name (meval macro-name env)))
(setf (get name :defmacro) closure)
name))
((:nil :mcall :func-name (? (get x :defun)) :params _*)
(let ((values (meval-args params env)))
(meval-lambda (car (get func-name :defun))
values
(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)))
((:nil :mcall :lambda (:nil :lclosure (? integerp) (? integerp)? _*) :args _*)
(meval-lambda lambda (meval-args args env) env))
((:nil :call :func-name _ :body _*)