commit 4645d05bbbd6b99d7dbd997eda2c784c6d36291d
parent a294d34c11911dd08db630bae25c795fe133f06c
Author: Georges Dupéron <jahvascriptmaniac+github@free.fr>
Date: Tue, 21 Dec 2010 15:29:42 +0100
Corrections sur les lambdas + squash-lisp-3-check.
Diffstat:
| M | lisp/squash-lisp.lisp | | | 96 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- |
1 file changed, 88 insertions(+), 8 deletions(-)
diff --git a/lisp/squash-lisp.lisp b/lisp/squash-lisp.lisp
@@ -553,18 +553,71 @@ On a donc une pile de cette forme (les vieilles données sont en haut) :
;; Beaucoup de code dupliqué entre les let[*] / lambda / flet / labels
;; TODO : gérer le &rest
((lambda :params ($$*) :body _)
- `(simple-lambda
- ,(length params)
- ,(squash-lisp-3
- `(let ,(loop
- for i upfrom 1
- for var in params
- collect `(,var (get-param ,i)))
- ,body))))
+ (let ((simple-lambda-captures (list nil)))
+ ;; Shift l'environnement courant en le remplaçant par un tout nouveau tout bô.
+ (setq env-var (cons nil env-var))
+ (push simple-lambda-captures captures)
+ ;; Création du simple-lambda
+ ;; TODO : insérer du code pour avoir les captures.
+ `(simple-lambda
+ ,(length params)
+ ,(squash-lisp-3
+ `(let ,(loop
+ for i upfrom 1
+ for var in params
+ collect `(,var (get-param ,i)))
+ ,body)))))
+ ;; (let ((simple-lambda-vars nil)
+ ;; (simple-lambda-backups nil)
+ ;; (simple-lambda-get-params nil)
+ ;; (simple-lambda-get-captured (list nil))
+ ;; (simple-lambda-body nil)
+ ;; (simple-lambda-restore nil)
+ ;; (set-expression)
+ ;; (unique-sym nil)
+ ;; (p-chan 0))
+ ;; ;; => Pour chaque paramètre
+ ;; (dolist (p params)
+ ;; ;; paramètre 0 = objet closure, donc on commence à partir du 1
+ ;; (incf p-chan)
+ ;; ;; => On crée un symbole unique pour représenter cette liaison
+ ;; (setq unique-sym (make-symbol (string p)))
+ ;; ;; => ajouter unique-sym dans le simple-lambda qu'on crée
+ ;; (push unique-sym simple-lambda-vars)
+
+ ;; (if (member p special-vars)
+ ;; ;; => Si c'est une variable spéciale,
+ ;; (progn
+ ;; ;; => On garde le nom d'origine comme nom de variable, et on utilise le nom unique comme symbole de sauvegarde.
+ ;; ;; => au tout début du body, avant les autres set, sauvegarder la variable
+ ;; (push `(setq ,unique-sym ,p) simple-lambda-backups)
+ ;; ;; => au début du body, set la variable avec (get-param <numéro>)
+ ;; (push `(setq ,p (get-param ,p-chan)) simple-lambda-get-params)
+ ;; ;; => à la fin du body (dans un unwind-protect), restaurer la variable
+ ;; (push `(setq ,p ,unique-sym) simple-lambda-restore))
+ ;; ;; => Sinon (variable "normale" ou futurement capturée),
+ ;; (progn
+ ;; ;; => au début du body, set la variable unique-sym avec (get-param <numéro>)
+ ;; (setq set-expression `(setq ,unique-sym (get-param p-chan)))
+ ;; (push set-expression simple-lambda-get-params)
+ ;; ;; => push (nom unique-sym nil <pas-de-get> <set-expression>) sur env-var
+ ;; (push `(,p ,unique-sym nil nil (,set-expression)) (car env-var)))))
+ ;; ;; => transforme le body dans env-var env-fun
+ ;; (setq simple-lambda-body (squash-lisp-3 body captures env-var env-fun))
+ ;; ;; => construit et renvoie le simple-lambda
+ ;; ;; TODO : closure ? make-closure ? ???
+ ;; `(simple-lambda ,simple-lambda-vars
+ ;; ,simple-lambda-backups
+ ;; ,simple-lambda-get-params
+ ;; ,simple-lambda-get-captured ;; Attention : encapsulé dans le car d'un cons.
+ ;; ,simple-lambda-body
+ ;; ,simple-lambda-restore))) ;; TODO : à la compilation, restore doit être unwind-protect du reste.
;; Appel de fonction
((funcall :fun _ :args _*)
(cons 'funcall (mapcar (lambda (x) (squash-lisp-3 x captures env-var env-fun)) (cons fun args))))
+
+ ;; TODO : apply ?
;; Référence à une fonction
((function :fun $$)
@@ -652,6 +705,33 @@ On a donc une pile de cette forme (les vieilles données sont en haut) :
(_
(error "squash-lisp-3: not implemented yet: ~a" expr)))) ;; end squash-lisp-3
+(defun squash-lisp-3-check (expr)
+ (cond-match
+ expr
+ ((simple-let :vars ($$*) :body _*)
+ (every #'squash-lisp-3-check body))
+ ((simple-lambda :nb-params (? numberp) :body _*)
+ ;; nb-params = sans compter le paramètre de closure.
+ (every #' squash-lisp-3-check body))
+ ((funcall :function _ :args _*)
+ (every #'squash-lisp-3-check (cons function args)))
+ ((progn :body _*)
+ (every #'squash-lisp-3-check body))
+ ((get-param (? numberp))
+ t)
+ ((setq :var $$ :val _)
+ (squash-lisp-3-check val))
+ ((get-var :var $$)
+ t)
+ ((setq-indirection :var $$ :val _)
+ (squash-lisp-3-check val))
+ ((get-var-indirection $$)
+ t)
+ ((quote :val _)
+ t)
+ (_
+ (error "squash-lisp-3-check: Assertion failed ! This should not be here : ~a" expr))))
+
#|
;; Formes pouvant créer des variables capturables :
