Début de l'implémentation de squash-lisp (il manque : la famille des let (labels …), lambda, et les appels de fonction)
This commit is contained in:
Georges Dupéron
parent
10ef5de892
commit
c729c7d2a9
|
|
@ -9,7 +9,7 @@
|
|||
|
||||
(defmacro etat-special (etat)
|
||||
;; Variables spéciales et constantes. (ou devrait-on mettre les constantes dans etat-global ?)
|
||||
;; Note sur les constantes : On ne protège pas contre la modification de parties d'une constante non atomiqe (mais clisp non plus, donc ça va).
|
||||
;; Note sur les constantes : On ne protège pas contre la modification de parties d'une constante non atomique (mais clisp non plus, donc ça va).
|
||||
`(caddr ,etat))
|
||||
|
||||
(defun assoc-etat (var type etat)
|
||||
|
|
@ -184,28 +184,17 @@
|
|||
(when (endp fixed) (go end-fixed))
|
||||
(when (endp params) (error "mini-meval-params : not enough parameters !"))
|
||||
(setq new-etat (push-local-or-special new-etat (car fixed) 'variable (car params) nil))
|
||||
;; (setq association (assoc-special (car fixed) 'variable etat))
|
||||
;; (if association
|
||||
;; (push (list association (mini-meval (car params) etat) (cdr association)) restore-special-fixed)
|
||||
;; (setq new-etat (push-local new-etat (car fixed) 'variable (car params))))
|
||||
(setq params (cdr params))
|
||||
(setq fixed (cdr fixed))
|
||||
(go fixed)
|
||||
end-fixed
|
||||
(affect-future-specials new-etat etat)
|
||||
;; (dolist (x restore-special-fixed) (setf (cdar x) (cadr x)))
|
||||
optional
|
||||
(when (endp optional) (go rest))
|
||||
(if (endp params)
|
||||
(setq value (mini-meval (cadar optional) new-etat)) ;; default value
|
||||
(setq value (car params)))
|
||||
(setq new-etat (push-local-or-special new-etat (caar optional) 'variable value t))
|
||||
;; (setq association (assoc-special (car optional) 'variable etat))
|
||||
;; (when association
|
||||
;; (push (cons association (cdr association)) restore-special-optional)
|
||||
;; (setf (cdr association) value))
|
||||
;; (unless association
|
||||
;; (setq new-etat (push-local new-etat (car optional) 'variable value)))
|
||||
(setq svar (caddar optional))
|
||||
(when svar
|
||||
(setq new-etat (push-local-or-special new-etat svar 'variable (endp params) t)))
|
||||
|
|
@ -235,12 +224,6 @@
|
|||
(go assoc-key-loop)
|
||||
end-assoc-key-loop
|
||||
(setq new-etat (push-local-or-special new-etat (second current-key) 'variable (second params) t))
|
||||
;; (setq association (assoc-special (second current-key) 'variable etat))
|
||||
;; (when association
|
||||
;; (push (cons association (cdr association)) restore-special-optional)
|
||||
;; (setf (cdr association) (cadr params)))
|
||||
;; (unless association
|
||||
;; (setq new-etat (push-local new-etat (car current-key) 'variable (cadr params))))
|
||||
(setq svar (fourth current-key))
|
||||
(when svar
|
||||
(setq new-etat (push-local-or-special new-etat svar 'variable t t)))
|
||||
|
|
@ -264,41 +247,6 @@
|
|||
fin)
|
||||
new-etat))
|
||||
|
||||
;; (if fixed
|
||||
;; (if (endp params)
|
||||
;; (error "mini-meval-params : not enough parameters !")
|
||||
;; (mini-meval-params (cdr params) (push-local etat (car fixed) 'variable (car params)) (cdr fixed) optional rest key other aux))
|
||||
;; (if optional
|
||||
;; (let* ((var (caar optional))
|
||||
;; (value (if (endp params)
|
||||
;; (mini-meval (cadar optional) etat)
|
||||
;; (car params)))
|
||||
;; (svar (caddar optional))
|
||||
;; (new-etat (push-local etat var 'variable value)))
|
||||
;; (when svar (setq new-etat (push-local new-etat svar 'variable (endp params))))
|
||||
;; (mini-meval-params (cdr params) new-etat nil (cdr optional) rest key other aux))
|
||||
;; (if rest
|
||||
;; (mini-meval-params params (push-local etat (car rest) 'variable params) nil nil nil key other aux)
|
||||
;; ;; TODO : finir d'implémenter &key &allow-other-keys &aux &rest (et relire CLTL).
|
||||
;; etat))))
|
||||
; (if key
|
||||
; (let* ((keyword (first (car key)))
|
||||
; (var (second (car key)))
|
||||
; (maybe-val (member keyword params))
|
||||
; (maybe-val-2 (if maybe-val
|
||||
; (if (n-consp 2 maybe-val)
|
||||
; maybe-val
|
||||
; (error "mini-meval-params : Nombre de paramètres impair alors qu'il y a &key."))))
|
||||
; (svar (fourth (car key)))
|
||||
; (new-local (acons `(,var . variable) (if maybe-val-2
|
||||
; (cadr maybe-val-2)
|
||||
; (mini-meval (third (car key)) global local))
|
||||
; local))
|
||||
; (new-local-2 (if svar
|
||||
; (acons `(,svar . variable) (not (not (maybe-val-2))) new-local)
|
||||
; new-local)))
|
||||
; (mini-meval-params params global new-local-2 nil nil nil (cdr key) other aux)
|
||||
|
||||
(defun mini-meval-get-params-from-real (etat lambda-list effective-parameters)
|
||||
"Lambda-list doit être déjà sliced."
|
||||
(mini-meval-params effective-parameters etat
|
||||
|
|
@ -355,13 +303,12 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
|
|||
((:name $$ :params _*)
|
||||
(let ((definition (assoc-etat name 'macro etat)))
|
||||
(if definition
|
||||
#| - Si on a une fonction de ce nom dans l'état-local ou dans l'etat-global, on l'exécute. |#
|
||||
(mini-meval (apply (cdr definition) params) etat)
|
||||
(else))))
|
||||
#| 1) Cas des formes spéciales |#
|
||||
((eval-when :situations ($*) :body _*)
|
||||
(if (member :execute situations)
|
||||
(mini-meval body etat)
|
||||
(mini-meval `(progn ,@body) etat)
|
||||
nil))
|
||||
((flet ((:name $ :lambda-list @ :fbody _*)*) :body _*)
|
||||
(mini-meval `(progn ,@body)
|
||||
|
|
@ -385,58 +332,37 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
|
|||
(res nil))
|
||||
(dolist* ((name name) (value value))
|
||||
(setq new-etat (push-local-or-special new-etat name 'variable (mini-meval value etat) nil)))
|
||||
;; (new-etat (reduce-on-local
|
||||
;; etat
|
||||
;; (lambda (ignore name value) ignore
|
||||
;; (when (assoc-etat name 'constant etat) (error "mini-meval : Can't bind ~w : it is a constant." name))
|
||||
;; (setq association (assoc-special name 'variable etat))
|
||||
;; (when association
|
||||
;; (push (list association (mini-meval value etat) (cdr association)) restore-special))
|
||||
;; (unless association
|
||||
;; (list name 'variable (mini-meval value etat))))
|
||||
;; name value)))
|
||||
(affect-future-specials new-etat etat)
|
||||
;; (dolist (x restore-special) (setf (cdar x) (cadr x)))
|
||||
(setq res (mini-meval `(progn ,@body) new-etat))
|
||||
(pop-special-backups new-etat etat)
|
||||
res))
|
||||
;; (dolist (x restore-special) (setf (cdar x) (caddr x)))))
|
||||
(((? (eq x 'let*)) ((:name $ :value _)*) :body _*)
|
||||
(let ((new-etat etat)
|
||||
(res nil))
|
||||
;; pour chaque variable
|
||||
(dolist* ((name name) (value value))
|
||||
(setq new-etat (push-local-or-special new-etat name 'variable (mini-meval value new-etat) t)))
|
||||
;; (new-etat (reduce-on-local
|
||||
;; etat
|
||||
;; (lambda (new-etat-local name value)
|
||||
;; (when (assoc-etat name 'constant etat) (error "mini-meval : Can't bind ~w : it is a constant." name))
|
||||
;; (setq association (assoc-special name 'variable etat))
|
||||
;; (when association
|
||||
;; (push (cons association (cdr association)) restore-special)
|
||||
;; (setf (cdr association) (mini-meval value (replace-local etat new-etat-local))))
|
||||
;; (unless association
|
||||
;; (list name 'variable (mini-meval value (replace-local etat new-etat-local)))))
|
||||
;; name value)))
|
||||
(setq res (mini-meval `(progn ,@body) new-etat))
|
||||
(pop-special-backups new-etat etat)
|
||||
res))
|
||||
;; (dolist (x restore-special) (setf (cdar x) (cdr x)))))
|
||||
((macrolet ((:name $ :lambda-list @ :mbody _*)*) :body _*)
|
||||
(mini-meval `(progn ,@body)
|
||||
(let ((etat-sans-local (replace-local etat nil)))
|
||||
(reduce-on-local
|
||||
etat
|
||||
(lambda (ignore name lambda-list mbody) ignore
|
||||
;; comme le flet sauf nil au lieu de new-etat-local
|
||||
;; CLTL 7.5 :
|
||||
;; The precise rule is that the macro-expansion functions defined
|
||||
;; by macrolet are defined in the global environment; lexically
|
||||
;; scoped entities that would ordinarily be lexically apparent
|
||||
;; are not visible within the expansion functions.
|
||||
(list name 'macro
|
||||
(mini-meval `(lambda ,lambda-list ,@mbody) etat-sans-local)))
|
||||
name lambda-list mbody))))
|
||||
(let ((new-etat
|
||||
(reduce-on-local
|
||||
etat
|
||||
(lambda (ignore name lambda-list mbody) ignore
|
||||
;; comme le flet sauf nil au lieu de new-etat-local
|
||||
;; CLTL 7.5 :
|
||||
;; The precise rule is that the macro-expansion functions defined
|
||||
;; by macrolet are defined in the global environment; lexically
|
||||
;; scoped entities that would ordinarily be lexically apparent
|
||||
;; are not visible within the expansion functions.
|
||||
(list name 'macro
|
||||
(mini-meval `(lambda ,lambda-list ,@mbody) (replace-local etat nil))))
|
||||
name lambda-list mbody))
|
||||
(get-etat (assoc-etat 'trapdoor 'squash-trapdoor etat)))
|
||||
(if (and get-etat (eq (car body) (cdr get-etat)))
|
||||
new-etat ;; Trapdoor pour récupérer l'etat avec les définitions du macrolet.
|
||||
(mini-meval `(progn ,@body) new-etat))))
|
||||
((progn :body _*)
|
||||
(let ((res nil))
|
||||
(dolist (expr body res)
|
||||
|
|
@ -455,6 +381,9 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
|
|||
(res (mini-meval `(progn ,@body) new-etat)))
|
||||
(pop-special-backups new-etat etat)
|
||||
res))))
|
||||
;; Lorsqu'une fonction "littérale" est présente dans le code, on la renvoie telle qu'elle.
|
||||
((:fun . (? functionp))
|
||||
fun)
|
||||
((defun :name $ :lambda-list @ :body _*)
|
||||
(push-global! etat name 'function
|
||||
(mini-meval `(lambda ,lambda-list ,@body) etat))
|
||||
|
|
@ -551,10 +480,9 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
|
|||
#| - Si on a une fonction de ce nom dans l'état-local ou dans l'etat-global, on l'exécute. |#
|
||||
(apply (cdr definition) (mapcar (lambda (x) (mini-meval x etat)) params))
|
||||
(mini-meval-error expr etat "Undefined function : ~w." name))))
|
||||
((:num . (? numberp))
|
||||
num)
|
||||
((:str . (? stringp))
|
||||
str)
|
||||
((? or numberp stringp)
|
||||
expr)
|
||||
;; TODO : nil et t devraient être des defconst
|
||||
(nil
|
||||
nil)
|
||||
((:name . $$)
|
||||
|
|
|
|||
|
|
@ -1,15 +1,150 @@
|
|||
(require 'mini-meval "implementation/mini-meval")
|
||||
|
||||
;; lisp2li simpliste pour le compilateur. On fusionnera les deux plus tard.
|
||||
|
||||
(defmatch squash-lisp)
|
||||
(defun simple-splice-up-tagbody (body)
|
||||
"Découpe le body d'un tagbody en une liste associative ordonnée toute simple :
|
||||
(tagbody a b (foo bar) c (baz) (quux) d) => '((a) (b (foo bar)) (c (baz) (quux)) (d))"
|
||||
(let ((all-res nil) (res (list (make-symbol "START"))))
|
||||
(tagbody
|
||||
start
|
||||
(when (endp body)
|
||||
(push (reverse res) all-res)
|
||||
(go end))
|
||||
(when (and (car body) (symbolp (car body)))
|
||||
(push (reverse res) all-res)
|
||||
(setq res (list (car body)))
|
||||
(setq body (cdr body))
|
||||
(go start))
|
||||
(push (car body) res)
|
||||
(setq body (cdr body))
|
||||
(go start)
|
||||
end)
|
||||
(reverse all-res)))
|
||||
|
||||
(defmatch squash-lisp (:num . (? numberp)) `(:const . ,num))
|
||||
(defmatch squash-lisp (:str . (? stringp)) `(:const . ,str))
|
||||
(defmatch squash-lisp (quote :val _) `(:const . ,val))
|
||||
(defmatch squash-lisp () `(:const . nil))
|
||||
(defmatch squash-lisp (let ((:name $ :value _)*) :body _*)
|
||||
`(:let ,name ,value ,body))
|
||||
(defmatch squash-lisp (:name _ :params _*) `(:call ,name ,@(mapcar #'squash-lisp params)))
|
||||
(defmatch squash-lisp (:x . _) (error "Squash-Lisp ne sait pas gérer : ~w" x))
|
||||
;; (defmatch squash-lisp)
|
||||
|
||||
;; (defmatch squash-lisp (:num . (? numberp)) `(:const . ,num))
|
||||
;; (defmatch squash-lisp (:str . (? stringp)) `(:const . ,str))
|
||||
;; (defmatch squash-lisp (quote :val _) `(:const . ,val))
|
||||
;; (defmatch squash-lisp () `(:const . nil))
|
||||
;; (defmatch squash-lisp (let ((:name $ :value _)*) :body _*)
|
||||
;; `(:let ,name ,value ,body))
|
||||
;; (defmatch squash-lisp (:name _ :params _*) `(:call ,name ,@(mapcar #'squash-lisp params)))
|
||||
;; (defmatch squash-lisp (:x . _) (error "Squash-Lisp ne sait pas gérer : ~w" x))
|
||||
|
||||
(defun squash-lisp (expr &optional (at-toplevel t) (etat (list nil nil nil)))
|
||||
(cond-match
|
||||
expr
|
||||
;; - Si on rencontre une macro définie dans l'environnement de compiler-meval,
|
||||
;; 1) On demande à compiler-meval d'expanser la macro sur un niveau.
|
||||
;; 2) On re-lance la transformation (eval-when / defmacro / appel de macro / ...) sur le résultat s'il y a a eu expansion.
|
||||
((:name $$ :params _*)
|
||||
(print etat)
|
||||
(print name)
|
||||
(let ((definition (assoc-etat name 'macro etat)))
|
||||
(print definition)
|
||||
(if definition
|
||||
(squash-lisp (apply (cdr definition) params) at-toplevel etat)
|
||||
(else))))
|
||||
|
||||
;; - Si on rencontre EVAL-WHEN,
|
||||
;; - Au top-level,
|
||||
;; - Pour chaque form du body,
|
||||
;; - Si la situation contient :compile-toplevel, le form est évalué dans compiler-meval.
|
||||
;; - Si la situation contient :load-toplevel, le form est compilé (après évaluation dans compiler-meval s'il y a lieu).
|
||||
;; - Lorsqu'un eval-when au top-level contient des eval-when directement sous lui, ils sont traités comme s'ils étaient directement au top-level.
|
||||
;; - Ailleurs
|
||||
;; - Si la situation contient :load-toplevel, le form est compilé
|
||||
((eval-when :situations ($*) :body _*)
|
||||
(when (and at-toplevel (member :compile-toplevel situations))
|
||||
(mini-meval `(progn ,@body) etat))
|
||||
(when (member :load-toplevel situations)
|
||||
(squash-lisp body at-toplevel etat)))
|
||||
|
||||
;; - Si on rencontre un defmacro (au toplevel ou ailleurs).
|
||||
;; - On demande à compiler-meval de l'exécuter.
|
||||
((defmacro :name $ :lambda-list @ :body _*)
|
||||
(mini-meval expr etat))
|
||||
|
||||
;; - Si on rencontre un macrolet
|
||||
;; - On fait une copie de l'état de compiler-meval
|
||||
;; - On lui demande d'exécuter les définitions
|
||||
;; - On évalue le body avec ce nouvel état
|
||||
;; - On continue avec l'ancien état
|
||||
((macrolet :definitions ((:name $ :lambda-list @ :mbody _*)*) :body _*)
|
||||
(let ((get-etat (make-symbol "GET-ETAT")))
|
||||
(squash-lisp
|
||||
`(progn ,@body)
|
||||
at-toplevel
|
||||
(mini-meval `(macrolet ,definitions ,get-etat) (push-local etat 'trapdoor 'squash-trapdoor get-etat)))))
|
||||
|
||||
;; - Si on gère le symbol-macrolet
|
||||
;; - Le fonctionnement est le même que pour le macrolet
|
||||
;; - Lorsqu'on rencontre un symbole, on regarde s'il a une définition de type symbol-macrolet
|
||||
((symbol-macrolet . _)
|
||||
(error "squash-lisp Symbol-macrolet n'est pas implémenté."))
|
||||
|
||||
;; TODO : squash le progn
|
||||
((progn :body _*)
|
||||
(cons 'progn (mapcar (lambda (form) (squash-lisp form at-toplevel etat)) body)))
|
||||
|
||||
;; Lorsqu'on rentre dans un block, on met sur la pile un marqueur spécial avec un pointeur vers un objet créé à l'exécution.
|
||||
((block :block-name $$ :body _*)
|
||||
(let ((retval-sym (make-symbol "RETVAL"))
|
||||
(end-sym (make-symbol "END-BLOCK")))
|
||||
(squash-lisp
|
||||
`(let ((,retval-sym nil))
|
||||
(tagbody
|
||||
(progn ,@body)
|
||||
,end-sym)
|
||||
,retval-sym)
|
||||
(push-local etat block-name 'squash-block-catch (cons end-sym retval-sym)))))
|
||||
|
||||
;; Les return-from <nom> qui sont accessibles lexicalement sont remplacés par un (unwind <l'objet>)
|
||||
;; Unwind remonte la pile jusqu'à trouver le marqueur spécial, tout en exécutant les unwind-protect éventuels.
|
||||
;; Si unwind ne trouve pas le marqueur et arrive en haut de la pile, il signale une erreur et termine le programme.
|
||||
;; Sinon, l'exécution reprend après le block.
|
||||
((return-from :block-name $$ :value _)
|
||||
(let ((association (assoc-etat block-name 'squash-block-catch etat)))
|
||||
(unless association (error "Squash-Lisp : Can't return from block ~w, it is inexistant or not lexically apparent." block-name))
|
||||
(squash-lisp `(progn (setq ,(cddr association) value) (go ,(cadr association))))))
|
||||
|
||||
|
||||
;; Le traitement de tagbody/go est similaire pour sortir d'un tag, puis on jmp directement sur le tag de destination (vu qu'il est au même niveau).
|
||||
((tagbody :body _*)
|
||||
(let ((spliced-body (simple-splice-up-tagbody body)))
|
||||
(let ((res nil)
|
||||
(the-body nil)
|
||||
(unwind-catch-marker-sym (make-symbol "UNWIND-CATCH-MARKER-SYM"))
|
||||
(new-etat etat)
|
||||
(unique-label-sym nil)
|
||||
(dolist (zone spliced-body)
|
||||
(setq unique-label-sym (make-symbol (format nil "~a" (car zone))))
|
||||
(setq new-etat (push-local new-etat (car zone) 'squash-tagbody-catch (cons unwind-catch-marker-sym unique-label-sym)))
|
||||
(setf (car zone) unique-label-sym))
|
||||
;; Définition de (unwind-catch name &rest body) :
|
||||
;; `(let ((,name (make-unwind-marker))) ,body)
|
||||
`(unwind-catch ,unwind-catch-marker-sym
|
||||
,@(progn (dolist (zone spliced-body)
|
||||
(setq the-body ,@)
|
||||
(push `(tagbody-label (car zone)) res)
|
||||
(push (squash-lisp `(progn (cdr zone)) new-etat) res))
|
||||
`(simple-tagbody ,@(cdr (reverse res)))))))) ;; cdr pour zapper le tout premier (tagbody-label)
|
||||
|
||||
((go :target $$)
|
||||
(let ((association (assoc-etat target 'squash-tagbody-catch etat)))
|
||||
(unless association (error "Squash-Lisp : Can't go to label ~w, it is inexistant or not lexically apparent." target))
|
||||
`(progn (unwind ,(cadr association)) (simple-go ,(cddr association)))))
|
||||
|
||||
;; Le traitement de catch/throw est similaire, sauf que le pointeur est simplement un pointeur vers l'objet utilisé pour le catch / throw.
|
||||
|
||||
;; Les constantes sont renvoyées telles qu'elles
|
||||
((? or numberp stringp)
|
||||
expr)
|
||||
;; TODO : nil et t devraient être des defconst
|
||||
(nil
|
||||
nil)))
|
||||
|
||||
#|
|
||||
|
||||
|
|
@ -76,7 +211,8 @@ Exemple :
|
|||
Le comportement des fonctions et des macros expliqué ci-dessous permet de prouver que la capture s'effectue sur toutes les variables et non pas seulement celles qui paraissent être accessibles :
|
||||
(defmacro introspect-closure (get-variable closure)
|
||||
`(progn (defmacro introspect () '(print ,get-variable))
|
||||
(funcall ,closure)))
|
||||
(funcall ,closure)
|
||||
(defun introspect () nil)))
|
||||
(introspect-closure a (cdr cl1))
|
||||
=> 1 ;; (print a)
|
||||
=> 3
|
||||
|
|
@ -97,7 +233,8 @@ Pourtant ces listes d'un million d'éléments semblent inaccessibles, sauf par n
|
|||
;; Comportement des fonctions et des macros
|
||||
Si une macro est rencontrée, elle est expansée
|
||||
Si un appel de fonction est rencontré, la fonction est appellée telle qu'elle
|
||||
Si une fonction est redéfinie en tant que macro, tous les appels de fonction qui lui correspondent sont transformés en appels de macro (expansion à la volée). On peut alors redéfinir la macro en macro ou en fonction, au choix, plusieurs fois, les appels suivent "intuitivement". (Ça existe encore ça l'intuition ?)
|
||||
Si une fonction est redéfinie en tant que macro, tous les appels de fonction qui lui correspondent sont transformés en appels de macro (expansion à la volée).
|
||||
On peut alors redéfinir la macro en macro ou en fonction, au choix, plusieurs fois, les appels suivent "intuitivement". (Ça existe encore ça l'intuition ?)
|
||||
Si une macro "rencontrée initialement" est redéfinie en tant que fonction, les appels qui ont déjà été "expansés initialement" ne sont pas redéfinis.
|
||||
Dans la structure suivante, la règle du "rencontrée initialement" est bien appliquée, la macro n'est pas ré-expansée :
|
||||
(defmacro mcr (x) `(list ',x 'y))
|
||||
|
|
@ -230,29 +367,29 @@ compiler-meval transforme le eval-when en progn si sa situation contient :execut
|
|||
|
||||
NOTE : lorsqu'on rencontre la macro declaim au top-level, la proclamation est prise en compte.
|
||||
|
||||
- Si on rencontre EVAL-WHEN,
|
||||
- Au top-level,
|
||||
- Pour chaque form du body,
|
||||
- Si la situation contient :compile-toplevel, le form est évalué dans compiler-meval.
|
||||
- Si la situation contient :load-toplevel, le form est compilé (après évaluation dans compiler-meval s'il y a lieu).
|
||||
- Lorsqu'un eval-when au top-level contient des eval-when directement sous lui, ils sont traités comme s'ils étaient directement au top-level.
|
||||
- Ailleurs
|
||||
- Si la situation contient :load-toplevel, le eval-when est remplacé par son body (TODO : À VÉRIVFIER !).
|
||||
- Si on rencontre un defmacro
|
||||
- On demande à compiler-meval de l'exécuter. TODO : doit-on le faire uniquement au top-level ?.
|
||||
- Si on rencontre un macrolet
|
||||
- On fait une copie de l'état de compiler-meval
|
||||
- On lui demande d'exécuter les définitions
|
||||
- On évalue le body avec ce nouvel état
|
||||
- On continue avec l'ancien état
|
||||
- Si on gère le symbol-macrolet
|
||||
- Le fonctionnement est le même que pour le macrolet
|
||||
- Lorsqu'on rencontre un symbole, on regarde s'il a une définition de type symbol-macrolet
|
||||
- Si on rencontre une macro définie dans l'environnement de compiler-meval,
|
||||
1) On demande à compiler-meval d'expanser la macro sur un niveau.
|
||||
2) On re-lance la transformation (eval-when / defmacro / appel de macro / ...) sur le résultat s'il y a a eu expansion.
|
||||
- S'occuper du cas du lambda et des autres mot-clés bizarres (ne pas faire de macro-expansion dessus).
|
||||
- Dans les autres cas, on transforme récursivement l'expression.
|
||||
| - Si on rencontre un defmacro (au toplevel ou ailleurs).
|
||||
| - On demande à compiler-meval de l'exécuter.
|
||||
| - Si on rencontre EVAL-WHEN,
|
||||
| - Au top-level,
|
||||
| - Pour chaque form du body,
|
||||
| - Si la situation contient :compile-toplevel, le form est évalué dans compiler-meval.
|
||||
| - Si la situation contient :load-toplevel, le form est compilé (après évaluation dans compiler-meval s'il y a lieu).
|
||||
| - Lorsqu'un eval-when au top-level contient des eval-when directement sous lui, ils sont traités comme s'ils étaient directement au top-level.
|
||||
| - Ailleurs
|
||||
| - Si la situation contient :load-toplevel, le eval-when est remplacé par son body (TODO : À VÉRIVFIER !).
|
||||
| - Si on rencontre un macrolet
|
||||
| - On fait une copie de l'état de compiler-meval
|
||||
| - On lui demande d'exécuter les définitions
|
||||
| - On évalue le body avec ce nouvel état
|
||||
| - On continue avec l'ancien état
|
||||
| - Si on gère le symbol-macrolet
|
||||
| - Le fonctionnement est le même que pour le macrolet
|
||||
| - Lorsqu'on rencontre un symbole, on regarde s'il a une définition de type symbol-macrolet
|
||||
| - Si on rencontre une macro définie dans l'environnement de compiler-meval,
|
||||
| 1) On demande à compiler-meval d'expanser la macro sur un niveau.
|
||||
| 2) On re-lance la transformation (eval-when / defmacro / appel de macro / ...) sur le résultat s'il y a a eu expansion.
|
||||
| - S'occuper du cas du lambda et des autres mot-clés bizarres (ne pas faire de macro-expansion dessus).
|
||||
| - Dans les autres cas, on transforme récursivement l'expression.
|
||||
|
||||
;; Comportement des variables globales et spéciales
|
||||
Lorsqu'une variable est utilisée mais ne correspond à aucune liaison (établie par let, …), cette utilisation fait référence
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user