squash-lisp-1 : 100% + tests d'équivalence du code + tous les tests passent.

This commit is contained in:
Georges Dupéron 2011-01-09 18:28:06 +01:00
parent 2140eeca89
commit 85196b56f6
5 changed files with 201 additions and 191 deletions

View File

@ -1,225 +1,213 @@
(require 'squash-lisp "squash-lisp")
(require 'mini-meval "mini-meval")
(require 'test-unitaire "test-unitaire")
(defun expr-equiv-p (expr &optional (expected nil expected-p))
(let ((res-eval (eval expr))
(temp nil))
(setq temp (mini-meval expr))
(unless (equalp res-eval temp)
(return-from expr-equiv-p (format nil "mini-meval differs from eval : ~a vs ~a" res-eval temp)))
(when expected-p
(unless (equalp expected temp)
(return-from expr-equiv-p "mini-meval differs from expected value")))
(setq temp (squash-lisp-1 expr))
(unless (squash-lisp-1-check temp)
(return-from expr-equiv-p "squash-lisp-1-check failed"))
(unless (equalp res-eval (eval (squash-lisp-1-wrap temp)))
(return-from expr-equiv-p "squash-lisp-1 differs from eval"))
;; (setq temp (squash-lisp-2 (squash-lisp-1 expr)))
;; (unless (squash-lisp-2-check temp)
;; (return-from expr-equiv-p "squash-lisp-2-check failed"))
;; (unless (equalp res-eval (eval (squash-lisp-2-wrap temp)))
;; (return-from expr-equiv-p "squash-lisp-2 differs from eval"))
t))
(defmacro deftest-equiv (module test expected)
`(progn
(deftest ,(append '(equiv expected/eval) module) (eval ,test) ,expected)
(deftest ,(append '(equiv expected/mini-meval) module) (mini-meval ,test etat) ,expected)
(deftest ,(append '(equiv squash-lisp-1-check) module) (squash-lisp-1-check (squash-lisp-1 ,test t etat)) t) ;; etat -> pour les macros
(deftest ,(append '(equiv expected/squash-lisp-1) module) (eval (squash-lisp-1-wrap (squash-lisp-1 ,test t etat))) ,expected) ;; etat -> pour les macros
;; (deftest ,(append '(equiv squash-lisp-2-check) module) (squash-lisp-2-check (squash-lisp-2 ,test)) t)
;; (deftest ,(append '(equiv expected/squash-lisp-2) module) (eval (squash-lisp-2-wrap (squash-lisp-2 ,test))) ,expected)
))
(defmacro deftest-equiv (module test &optional (expected nil expected-p))
`(deftest ,module (expr-equiv-p ,test . ,(if expected-p (list expected) nil))
t))
(erase-tests equiv)
(deftestvar (equiv) etat (push-local (make-etat list + - cons car cdr < > <= >= =) '*test-equiv-var-x* 'variable 42))
(defvar *test-equiv-var-x* 42)
(deftest-equiv (mini-meval constante)
(mini-meval 42 etat)
(deftest-equiv (constante)
42
42)
(deftest (mini-meval appel-fonction)
(mini-meval '(+ 2 3) etat)
(deftest-equiv (appel-fonction)
'(+ 2 3)
5)
(deftest (mini-meval appel-fonction)
(mini-meval '(+ 2 (+ 3 4)) etat)
(deftest-equiv (appel-fonction)
'(+ 2 (+ 3 4))
9)
(deftest (mini-meval variable)
(mini-meval 'x (push-local etat 'x 'variable 42))
(deftest-equiv (variable)
'*test-equiv-var-x*
42)
(deftest (mini-meval appel-fonction-et-variable)
(mini-meval '(+ x x 3) (push-local etat 'x 'variable 42))
(deftest-equiv (appel-fonction-et-variable)
'(+ *test-equiv-var-x* *test-equiv-var-x* 3)
87)
(deftest (mini-meval appel-fonction-et-variable)
(mini-meval '(+ x (+ 3 x)) (push-local etat 'x 'variable 42))
(deftest-equiv (appel-fonction-et-variable)
'(+ *test-equiv-var-x* (+ 3 *test-equiv-var-x*))
87)
(deftest (mini-meval lambda extérieur)
(funcall (mini-meval '(lambda (x) x) etat) 3)
3)
(deftest (mini-meval lambda extérieur)
(funcall (mini-meval '(lambda (x) (+ x 3)) etat) 4)
(deftest-equiv (lambda immédiat)
'((lambda (x) (+ x 3)) 4)
7)
(deftest (mini-meval lambda immédiat)
(mini-meval '((lambda (x) (+ x 3)) 4) etat)
(deftest-equiv (let)
'(let ((x 3) (y 4)) (+ x y))
7)
(deftest (mini-meval let)
(mini-meval '(let ((x 3) (y 4)) (+ x y)) etat)
7)
(deftest (mini-meval let)
(mini-meval '(let ((x 3) (y 4) (z 5)) (let ((z (+ x y)) (w z)) (list x y z w))) etat)
(deftest-equiv (let)
'(let ((x 3) (y 4) (z 5)) (let ((z (+ x y)) (w z)) (list x y z w)))
'(3 4 7 5))
(deftest (mini-meval let*)
(mini-meval '(let ((x 3) (y 4) (z 5)) (let* ((z (+ x y)) (w z)) (list x y z w))) etat)
(deftest-equiv (let*)
'(let ((x 3) (y 4) (z 5)) (let* ((z (+ x y)) (w z)) (list x y z w)))
'(3 4 7 7))
;; TODO
;; (deftest (mini-meval let-nil)
;; (mini-meval '(let (a (x 3) y) (list a x y)) etat)
;; (deftest-equiv (let-nil)
;; '(let (a (x 3) y) (list a x y))
;; '(nil 3 nil))
;; (deftest (mini-meval let-nil)
;; (mini-meval '(let* ((x 4) y (z 5)) (list a x y)) etat)
;; (deftest-equiv (let-nil)
;; '(let* ((x 4) y (z 5)) (list a x y))
;; '(4 nil 5))
(deftest (mini-meval progn)
(mini-meval '(progn 1 2 3 4) etat)
(deftest-equiv (progn)
'(progn 1 2 3 4)
4)
(deftest (mini-meval quote)
(mini-meval ''x etat)
(deftest-equiv (quote)
''x
'x)
(deftest (mini-meval macrolet)
(mini-meval '(labels ((qlist (a b) (list a b)))
(list
(qlist 'a 'b)
(macrolet ((qlist (x y) (list 'list (list 'quote x) (list 'quote y))))
(qlist 'a 'b))
(qlist 'a 'b)))
etat)
(deftest-equiv (macrolet)
'(labels ((qlist (a b) (list a b)))
(list
(qlist 'a 'b)
(macrolet ((qlist (x y) (list 'list (list 'quote x) (list 'quote y))))
(qlist 'a 'b))
(qlist 'a 'b)))
'((a b) ('a 'b) (a b)))
(deftest (mini-meval setf setq)
(mini-meval '(let ((x 42)) (list x (setq x 123) x) etat))
(deftest-equiv (setf setq)
'(let ((x 42)) (list x (setq x 123) x))
'(42 123 123))
(deftest (mini-meval funcall)
(mini-meval '(funcall #'+ 1 2 3) etat)
(deftest-equiv (funcall)
'(funcall #'+ 1 2 3)
'6)
(deftest (mini-meval apply)
(mini-meval '(apply #'+ 1 2 (list (+ 1 2) 4)) etat)
(deftest-equiv (apply)
'(apply #'+ 1 2 (list (+ 1 2) 4))
'10)
(deftest (mini-meval function external)
(mini-meval '#'+ etat)
#'+)
(deftest (mini-meval function external)
(mini-meval '(funcall #'+ 1 2 3) etat)
(deftest-equiv (function extérieur)
'(funcall #'+ 1 2 3)
'6)
(deftest (mini-meval call-function external)
(mini-meval '(#'+ 2 3) etat)
5)
(deftest (mini-meval call-function lambda)
(mini-meval '(#'(lambda (x) (+ x 40)) 2) etat)
42)
(deftest (mini-meval lambda optional)
(mini-meval '((lambda (x &optional (y 2)) (list x y)) 1) etat)
(deftest-equiv (lambda optional)
'((lambda (x &optional (y 2)) (list x y)) 1)
'(1 2))
(deftest (mini-meval lambda closure single-instance)
(mini-meval '(let ((foo (let ((y 1)) (cons (lambda (x) (list x y)) (lambda (z) (setq y (+ y z)) nil)))))
(list (funcall (car foo) 4) (funcall (cdr foo) 5) (funcall (car foo) 4))) etat)
(deftest-equiv (lambda closure single-instance)
'(let ((foo (let ((y 1)) (cons (lambda (x) (list x y)) (lambda (z) (setq y (+ y z)) nil)))))
(list (funcall (car foo) 4) (funcall (cdr foo) 5) (funcall (car foo) 4)))
'((4 1) nil (4 6)))
(deftest (mini-meval lambda closure multiple-instances)
(mini-meval '(labels ((counter (&optional (ctr 0)) (cons (lambda () ctr) (lambda (&optional (x 1)) (setq ctr (+ ctr x)) nil))))
(let ((foo0 (counter))
(foo42 (counter 42)))
(list
(funcall (car foo0)) ;; show 0
(funcall (car foo42)) ;; show 42
(funcall (cdr foo0)) ;; add 0
(funcall (car foo0)) ;; show 0
(funcall (cdr foo42)) ;; add 42
(funcall (car foo42)) ;; show 42
(funcall (car foo0)) ;; shwo 0
(funcall (car foo42)) ;; show 42
(funcall (cdr foo42) 6) ;; add 42 (+ 6)
(funcall (cdr foo0) 5) ;; add 0 (+ 5)
(funcall (car foo42)) ;; show 42
(funcall (car foo0))))) ;; show 0
etat)
(deftest-equiv (lambda closure multiple-instances)
'(labels ((counter (&optional (ctr 0)) (cons (lambda () ctr) (lambda (&optional (x 1)) (setq ctr (+ ctr x)) nil))))
(let ((foo0 (counter))
(foo42 (counter 42)))
(list
(funcall (car foo0)) ;; show 0
(funcall (car foo42)) ;; show 42
(funcall (cdr foo0)) ;; add 0
(funcall (car foo0)) ;; show 0
(funcall (cdr foo42)) ;; add 42
(funcall (car foo42)) ;; show 42
(funcall (car foo0)) ;; shwo 0
(funcall (car foo42)) ;; show 42
(funcall (cdr foo42) 6) ;; add 42 (+ 6)
(funcall (cdr foo0) 5) ;; add 0 (+ 5)
(funcall (car foo42)) ;; show 42
(funcall (car foo0))))) ;; show 0
'(0 42 nil 1 nil 43 1 43 nil nil 49 6))
(deftest (mini-meval labels)
(mini-meval '(labels ((foo (x) (+ x 1)))
(list
(foo 3)
(labels ((foo (x) (+ x 3)))
(foo 3))))
etat)
(deftest-equiv (labels)
'(labels ((foo (x) (+ x 1)))
(list
(foo 3)
(labels ((foo (x) (+ x 3)))
(foo 3))))
'(4 6))
(deftest (mini-meval labels)
(mini-meval '(< 2 3) etat)
(deftest-equiv (labels)
'(< 2 3)
t)
(deftest (mini-meval flet)
(mini-meval '(labels ((foo (x) (+ x 1)))
(list
(foo 3)
(flet ((foo (x) (+ x 3)))
(foo 3))))
etat)
'(foo 4 6))
(deftest-equiv (flet)
'(labels ((foo (x) (+ x 1)))
(list
(foo 3)
(flet ((foo (x) (+ x 3)))
(foo 3))))
'(4 6))
(deftest (mini-meval labels)
(mini-meval '(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ...
(list
(fibo 5)
(labels ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ...
(fibo 5))
(fibo 5)))
etat)
'(fibo 8 5 8))
(deftest-equiv (labels)
'(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ...
(list
(fibo 5)
(labels ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ...
(fibo 5))
(fibo 5)))
'(8 5 8))
(deftest (mini-meval flet)
(mini-meval '(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ...
(list
(fibo 5)
(flet ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ...
(fibo 5))))
etat)
(deftest-equiv (flet)
'(labels ((fibo (n) (if (< n 2) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 0 -> 1; 1 -> 1; 2 -> 2 ...
(list
(fibo 5)
(flet ((fibo (n) (if (< n 3) 1 (+ (fibo (- n 1)) (fibo (- n 2)))))) ;; fibo 1 -> 1; 2 -> 1; 3 -> 2 ...
(fibo 5))))
;; Le flet ne permet pas les définitions récursives, donc le fibo
;; de l'extérieur est appellé après le 1er niveau de récursion.
'(fibo 8 8))
'(8 8))
(deftest (mini-meval tagbody)
(mini-meval '(let ((x 0)) (tagbody foo (setq x 1) (go baz) bar (setq x 2) baz) x))
(deftest-equiv (tagbody)
'(let ((x 0)) (tagbody foo (setq x 1) (go baz) bar (setq x 2) baz) x)
1)
(deftest (mini-meval tagbody)
(mini-meval '(let ((x 0)) (tagbody foo (setq x 1) (go 42) bar (setq x 2) 42) x))
(deftest-equiv (tagbody)
'(let ((x 0)) (tagbody foo (setq x 1) (go 42) bar (setq x 2) 42) x)
1)
(deftest (mini-meval tagbody)
(mini-meval '(tagbody foo (list 1) 42 (list 2) baz (list 3)) etat)
(deftest-equiv (tagbody)
'(tagbody foo (list 1) 42 (list 2) baz (list 3))
nil)
(deftest (mini-meval block)
(mini-meval '(block foo 1 (return-from foo 4) 2))
(deftest-equiv (block)
'(block foo 1 (return-from foo 4) 2)
4)
(deftest (mini-meval block)
(mini-meval '(block foo 1 2))
(deftest-equiv (block)
'(block foo 1 2)
2)
(deftest-equiv (tagbody)
'(let ((res nil))
(tagbody
a
1
(setq res (cons 'x res))
b
(setq res (cons 'y res))
(go 3)
d
(setq res (cons 'z res))
3
(setq res (cons 'f res)))
res)
'(f y x))
(deftest-equiv (flet)
'(flet ((foo (x) (+ x 1)) (bar (y z) (cons y z))) (list (foo 3) (bar 4 5)))
'(4 (4 . 5)))
(deftest-equiv (function extérieur)
'#'+
#'+)
(provide 'equiv-tests)

View File

@ -9,6 +9,8 @@
(load "match")
(load "mini-meval")
(load "squash-lisp")
(load "squash-lisp-1")
(load "squash-lisp-2")
(load "equiv-tests")
(provide 'main)

View File

@ -290,7 +290,6 @@ Mini-meval est un meval très simple destiné à évaluer les macros et les autr
Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il faut donc qu'il puisse maintenir son état entre les appels.
|#
(defun mini-meval (expr &optional (etat (list nil nil nil)))
(print etat)
#|
L'algorithme d'évaluation est très simple et suit le schéma donné dans CLTL 5.1.3 :
1) Si l'expression est une forme spéciale, on la traite de manière particulière
@ -514,10 +513,28 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
;; La plupart des tests sont dans eqiv-tests.lisp
(deftest (mini-meval lambda extérieur)
(funcall (mini-meval '(lambda (x) x) etat) 3)
3)
(deftest (mini-meval lambda extérieur)
(funcall (mini-meval '(lambda (x) (+ x 3)) etat) 4)
7)
(deftest (mini-meval defvar)
(mini-meval '(progn (defvar x 42) x) etat)
42)
;; Syntaxe supplémentaire non reconnue par le standard : (#'fun param*)
(deftest (mini-meval call-function extérieur)
(mini-meval '(#'+ 2 3) etat)
5)
;; Syntaxe supplémentaire non reconnue par le standard : (#'(lambda ...) param*)
(deftest (mini-meval call-function lambda)
(mini-meval '(#'(lambda (x) (+ x 40)) 2) etat)
42)
(deftest (mini-meval defvar special)
(mini-meval '(progn
(defun foo1 () var)
@ -547,9 +564,11 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
'((a b) ('a 'b) (a b)))
(deftest (mini-meval setf setq)
(mini-meval '(progn (debug 'a) (print etat) (list (defvar x 42) x (setq x 123) x) etat))
(mini-meval '(list (defvar x 42) x (setq x 123) x) etat)
'(x 42 123 123))
;; TODO : tests setf
(deftest (mini-meval function internal)
(funcall (mini-meval '(progn (defun foo (x) (+ x 40)) #'foo) etat) 2)
'42)

View File

@ -100,8 +100,7 @@
(,block-id-sym (cons nil nil)))
(unwind-catch ,block-id-sym
(progn ,@body)
nil)
,retval-sym)
,retval-sym))
nil
(push-local etat block-name 'squash-block-catch (cons block-id-sym retval-sym)))))
@ -112,7 +111,7 @@
((return-from :block-name $$ :value _)
(let ((association (assoc-etat block-name 'squash-block-catch etat)))
(unless association (error "Squash-Lisp-1 : Can't return from block ~w, it is inexistant or not lexically apparent." block-name))
(squash-lisp-1 `(progn (setq ,(cddr association) value)
(squash-lisp-1 `(progn (setq ,(cddr association) ,value)
(unwind ,(cadr association)))
nil etat)))
@ -158,8 +157,8 @@
((throw :tag _ :result _)
(squash-lisp-1
`(progn (setq singleton-catch-retval value)
(unwind ,tag (progn ,@result)))
`(progn (setq singleton-catch-retval ,result)
(unwind ,tag))
nil etat))
;; Simplification du unwind-protect
@ -190,13 +189,13 @@
;; Transformation des (let[*] (var1 var2 var3) …) en (let[*] ((var1 nil) (var2 nil) (var3 nil)) …)
((:type (? or (eq x 'let) (eq x 'let*)) :bindings (? and consp (find-if #'symbolp x)) :body . _)
(squash-lisp-1 `(,type ,(mapcar (lambda (b) (if (consp b) b `(b nil))) bindings) ,@body)))
(squash-lisp-1 `(,type ,(mapcar (lambda (b) (if (consp b) b `(b nil))) bindings) ,@body) nil etat))
((let ((:name $$ :value _)*) :body _*)
`(let ,(mapcar (lambda (n v) `(,n ,(squash-lisp-1 v nil etat))) name value)
,(squash-lisp-1 `(progn ,@body) nil etat)))
((let* ((:name $$ :value _)*) :body _*)
(((? (eq x 'let*)) ((:name $$ :value _)*) :body _*)
`(let* ,(mapcar (lambda (n v) `(,n ,(squash-lisp-1 v nil etat))) name value)
,(squash-lisp-1 `(progn ,@body) nil etat)))
@ -239,7 +238,7 @@
;; => TODO : définir la fonction apply : (funcall #'apply #'cons '(1 2))
((setq :name $$ :value _)
`(setq ,name ,(squash-lisp-1 value)))
`(setq ,name ,(squash-lisp-1 value nil etat)))
((quote _)
expr)
@ -250,7 +249,7 @@
;; TODO : nil et t devraient être des defconst
;; Doit être avant les symboles
(nil
(quote nil))
''nil)
($$
`(get-var ,expr))
@ -258,16 +257,16 @@
;; Appels de fonction
;; Doivent être après tout le monde.
((:fun $$ :params _*)
(squash-lisp-1 `(funcall (function ,fun) ,@params)))
(squash-lisp-1 `(funcall (function ,fun) ,@params) nil etat))
((:lambda (lambda . _) :params _*)
(squash-lisp-1 `(funcall ,lambda ,@params)))
(squash-lisp-1 `(funcall ,lambda ,@params) nil etat))
(((function :lambda (lambda . _)) :params . _)
(squash-lisp-1 `(funcall ,lambda ,@params)))
(squash-lisp-1 `(funcall ,lambda ,@params) nil etat))
(((function :name $$) :params _*)
(squash-lisp-1 `(funcall (function ,name) ,@params)))
(squash-lisp-1 `(funcall (function ,name) ,@params) nil etat))
(_
(error "squash-lisp-1: Not implemented yet : ~a" expr))))
@ -277,8 +276,7 @@
(let ((bname (make-symbol "block")))
`(block ,bname
(catch ,object (return-from ,bname ,body))
,catch-code
nil)))
,catch-code)))
(tagbody-unwind-catch (object body catch-code)
catch-code ;; unused variable
;; les (progn object) et (progn x) sert à permettre l'expansion des macros sur x
@ -305,21 +303,6 @@
x))
,expr))
(eval (squash-lisp-1-wrap
'(unwind-catch 'foo
(progn (print 1)
(unwind 'foo)
(print 2))
(print 3))))
(eval (squash-lisp-1-wrap (squash-lisp-1 '(flet ((foo (x) (+ x 1)) (bar (y z) (cons y z))) (list (foo 3) (bar 4 5))))))
(eval (squash-lisp-1-wrap (squash-lisp-1 '(tagbody a 1 (print 'x) b (print 'y) (go 3) d (print 'z) 3 (print 'f)))))
;;
;; (squash-lisp-1 '(flet ((foo (x) (+ x 1)) (bar (y z) (cons y z))) (list (foo 3) (bar 4 5))))
(defun squash-lisp-1-check (expr)
"Vérifie si expr est bien un résultat valable de squash-lisp-1.
Permet aussi d'avoir une «grammaire» du simple-lisp niveau 1.
@ -328,6 +311,10 @@ Attention : il y a quelques invariants qui ne sont pas présents dans cette vér
expr
((progn :body _*)
(every #'squash-lisp-1-check body))
((if :condition _ :si-vrai _ :si-faux _)
(and (squash-lisp-1-check condition)
(squash-lisp-1-check si-vrai)
(squash-lisp-1-check si-faux)))
((unwind-protect :body _ :cleanup _)
(and (squash-lisp-1-check body)
(squash-lisp-1-check cleanup)))
@ -347,7 +334,7 @@ Attention : il y a quelques invariants qui ne sont pas présents dans cette vér
t)
(((? (member x '(let let* simple-flet simple-labels))) ((:name $$ :value _)*) :body _)
(every #'squash-lisp-1-check (cons body value)))
((lambda :params ($$*) :body _)
((lambda :params @ :body _)
(squash-lisp-1-check body))
((function :fun $$)
t)
@ -363,6 +350,19 @@ Attention : il y a quelques invariants qui ne sont pas présents dans cette vér
(warn "squash-lisp-1-check: Assertion failed ! This should not be here : ~a" expr)
nil)))
(require 'test-unitaire "test-unitaire")
(erase-tests squash-lisp-1)
(deftest (squash-lisp-1 wrap unwind)
(eval (squash-lisp-1-wrap
'(let ((foo nil))
(unwind-catch 'foo
(progn (push 1 foo)
(unwind 'foo)
(push 2 foo))
(push 3 foo))
foo)))
'(3 1))
#|
Notes sur l'implémentation d'unwind.
Tous les lets qui aparaissent dans un appel de fonction sont regrouppés en un seul. Donc à un appel de fonction correspond un "gros" segment de pile.

View File

@ -9,9 +9,10 @@
expr
((progn :body _*)
`(progn ,@(mapcar (lambda (x) (squash-lisp-2 x env-var env-fun globals)) body)))
;; simple-tagbody est équivalent à un progn, mais nécessaire pour les macrolet.
((simple-tagbody :body _*)
`(simple-tagbody ,@(mapcar (lambda (x) (squash-lisp-2 x env-var env-fun globals)) body)))
((if :condition _ :si-vrai _ :si-faux _)
`(if ,(squash-lisp-2 condition env-var env-fun globals)
,(squash-lisp-2 si-vrai env-var env-fun globals)
,(squash-lisp-2 si-faux env-var env-fun globals)))
((unwind-protect :body _ :cleanup _)
`(unwind-protect ,(squash-lisp-2 body env-var env-fun globals)
,(squash-lisp-2 cleanup env-var env-fun globals)))
@ -62,7 +63,7 @@
name value)
,(squash-lisp-2 body env-var new-env-fun globals))))) ;; env-var -> env-fun
;; TODO
((lambda :params ($$*) :body _)
((lambda :params @ :body _)
;; TODO : simplifier la lambda-list
(squash-lisp-1-check body))
;; TODO