refactoring of compiler

1 files changed, 451 insertions, 422 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 9467413..6dd12a5 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -50,6 +50,8 @@
 
 (define (C x) `(@@ (language python compile) ,x))
 (define (Y x) `(@@ (language python yield) ,x))
+(define (T x) `(@@ (language python try) ,x))
+(define (F x) `(@@ (language python for) ,x))
 (define (O x) `(@@ (oop pf-objects) ,x))
 (define (G x) `(@ (guile) ,x))
 
@@ -219,476 +221,503 @@
 
 (define inhibit-finally #f)
 
-(define (exp vs x)
-  (match (pr x)
-    ((#:power _ (x) () . #f)
-     (exp vs x))
-    ((#:power _ x () . #f)
-     (exp vs x))
-    
-    
-    ;; Function calls (x1:x1.y.f(1) + x2:x2.y.f(2)) will do functional calls
-    ((#:power #f vf trailer . **)
-     (let ()
-       (define (pw x)
-         (if **
-             `(expt ,x ,(exp vs **))
-             x))
-       (pw
-        (let lp ((e (exp vs vf)) (trailer trailer))
-          (match trailer
-            (()
-             e)
-            ((#f)          
-             (list e))
-            ((x . trailer)
-             (match (pr x)
+(define tagis (make-hash-table))
+(define-syntax-rule (gen-table x vs (tag code ...) ...)
+  (begin
+    (hash-set! tagis tag
+               (lambda (x vs)
+                 (match x code ...)))
+                   
+    ...))
+
+(gen-table x vs
+ (#:power
+  ((#:power _ (x) () . #f)
+   (exp vs x))
+  ((#:power _ x () . #f)
+   (exp vs x))
+  ((#:power #f vf trailer . **)
+   (let ()
+     (define (pw x)
+       (if **
+           `(expt ,x ,(exp vs **))
+           x))
+     (pw
+      (let lp ((e (exp vs vf)) (trailer trailer))
+        (match trailer
+          (()
+           e)
+          ((#f)          
+           (list e))
+          ((x . trailer)
+           (match (pr x)
                ((#:identifier . _)
                 (lp `(,(O 'ref) ,e ',(exp vs x) #f) trailer))
                
                ((#:arglist args #f #f)
                 (lp `(,e ,@(map (g vs exp) args)) trailer))
-               (_ (error "unhandled trailer")))))))))
-                                                    
-    ((#:identifier x . _)
-     (string->symbol x))
-
-    ((#:string #f x)
-     x)
+               (_ (error "unhandled trailer"))))))))))
+
+ (#:identifier
+  ((#:identifier x . _)
+   (string->symbol x)))
+
+ (#:string
+  ((#:string #f x)
+   x))
+
+ (#:+
+  ((_ . l)
+   (cons '+ (map (g vs exp) l))))
+ (#:-
+  ((_ . l)
+   (cons '- (map (g vs exp) l))))
+ (#:*
+  ((_ . l)
+   (cons '* (map (g vs exp) l))))
+ (#:/
+  ((_ . l)
+   (cons '/ (map (g vs exp) l))))
+
+ (#:%
+  ((_ . l)
+   (cons 'modulo (map (g vs exp) l))))
     
-    (((and x (or #:+ #:- #:* #:/)) . l)
-     (cons (keyword->symbol x) (map (g vs exp) l)))
+ (#://
+  ((_ . l)
+   (cons 'floor-quotient (map (g vs exp) l))))
 
-    ((#:% . l)
-     (cons 'modulo (map (g vs exp) l)))
-    
-    ((#:// . l)
-     (cons 'floor-quotient (map (g vs exp) l)))
+ (#:<<
+  ((_ . l)
+   (cons (C '<<) (map (g vs exp) l))))
 
-    ((#:<< . l)
-     (cons (C '<<) (map (g vs exp) l)))
+ (#:>>
+  ((_ . l)
+   (cons (C '>>) (map (g vs exp) l))))
 
-    ((#:>> . l)
-     (cons (C '>>) (map (g vs exp) l)))
-    
-    ((#:u~ x)
-     (list 'lognot (exp vs x)))
+ (#:u~
+  ((_ x)
+   (list 'lognot (exp vs x))))
 
-    ((#:band . l)
-     (cons 'logand (map (g vs exp) l)))
+ (#:band
+  ((_ . l)
+   (cons 'logand (map (g vs exp) l))))
     
-    ((#:bxor . l)
-     (cons 'logxor (map (g vs exp) l)))
+ (#:bxor
+  ((_ . l)
+   (cons 'logxor (map (g vs exp) l))))
 
-    ((#:bor . l)
-     (cons 'logior (map (g vs exp) l)))
+ (#:bor
+  ((_ . l)
+   (cons 'logior (map (g vs exp) l))))
     
-    ((#:not x)
-     (list 'not (exp vs x)))
+ (#:not
+  ((_ x)
+   (list 'not (exp vs x))))
 
-    ((#:or . x)
-     (cons 'or (map (g vs exp) x)))
+ (#:or
+  ((_ . x)
+   (cons 'or (map (g vs exp) x))))
     
-    ((#:and . x)
-     (cons 'and (map (g vs exp) x)))
+ (#:and
+  ((_ . x)
+   (cons 'and (map (g vs exp) x))))
     
-    ((#:test e1 #f)
-     (exp vs e1))
+ (#:test
+  ((_ e1 #f)
+   (exp vs e1))
     
-    ((#:test e1 e2 e3)
-     (list 'if (exp vs e2) (exp vs e1) (exp vs e3)))
+  ((_ e1 e2 e3)
+   (list 'if (exp vs e2) (exp vs e1) (exp vs e3))))
 
-    ((#:if test a ((tests . as) ...) . else)
-     `(,(G 'cond)
-       (,(exp vs test) ,(exp vs a))
-       ,@(map (lambda (p a) (list (exp vs p) (exp vs a))) tests as)
-       ,@(if else `((else ,(exp vs else))) '())))
-    
-    ((#:suite . l) (cons 'begin (map (g vs exp) l)))
 
-    (#:True  #t)
-    (#:False #f)
-    (#:pass  `(values))
-    ((#:while test code . #f)
-     (let ((lp (gensym "lp")))
-       `(let ,lp ()
-          (if ,(exp vs test)
-              (begin
-                ,(exp vs code)
-                (,lp))))))
 
-    ((#:classdef (#:identifier class . _) parents defs)
-     (with-fluids ((is-class? #t))
-       (let ()
-         (define (filt l)
-           (reverse
-            (fold (lambda (x s)
-                    (match x
-                      ((or 'fast 'functional) s)
-                      (x (cons x s))))
-                  '() l)))
-         (define (is-functional l)
-           (fold (lambda (x pred)
-                   (if pred
-                       pred
-                       (match x
-                         ('functional #t)
-                         (_ #f))))
-                 #f l))
-         (define (is-fast l)
-           (fold (lambda (x pred)
-                   (if pred
-                       pred
-                       (match x
-                         ('fast #t)
-                         (_ #f))))
-                 #f l))
-         
-         
-         (let* ((class   (string->symbol class))
-                (parents (match parents
-                           (()
-                            '())
-                           (#f
-                            '())
-                           ((#:arglist args . _)
-                            (map (g vs exp) args))))
-                (is-func (is-functional parents))
-                (is-fast (is-fast       parents))
-                (kind    (if is-func
-                             (if is-fast
-                                 'mk-pf-class
-                                 'mk-pyf-class)
-                             (if is-fast
-                                 'mk-p-class
-                                 'mk-py-class)))              
-                (parents (filt parents)))
-           `(define ,class (,(O kind) 
-                            ,class
-                            ,(map (lambda (x) `(,(O 'get-class) ,x)) parents)
-                            #:const
-                            ,(match (exp vs defs)
-                               (('begin . l)
-                                l)
-                               ((('begin . l))
-                                l)
-                               (l l))
-                            #:dynamic
-                            ()))))))
-
-    ((#:import ((() nm) . #f))
-     `(use-modules (language python module ,(exp vs nm))))
-       
-    (#:break
-     (C 'break))
+ (#:if
+  ((_ test a ((tests . as) ...) . else)
+   `(,(G 'cond)
+       (,(exp vs test) ,(exp vs a))
+       ,@(map (lambda (p a) (list (exp vs p) (exp vs a))) tests as)
+       ,@(if else `((else ,(exp vs else))) '()))))
     
-    (#:continue
-     (C 'continue))
+ (#:suite
+  ((_ . l) (cons 'begin (map (g vs exp) l))))
     
-    ((#:for e in code . #f)
-     (=> next)
-     (match e
-       (((#:power #f (#:identifier x . _) () . #f))
-        (match in
-          (((#:test power . _))
-           (match power
-             ((#:power #f
-               (#:identifier "range" . _)
-               ((#:arglist arglist . _))
-               . _)
-              (match arglist
-                ((arg)
-                 (let ((v   (gensym "v"))
-                       (x   (string->symbol x))
-                       (lp  (gensym "lp")))
-                   `(let ((,v ,(exp vs arg)))
-                      (let ,lp ((,x 0))
-                           (if (< ,x ,v)
-                               (begin
-                                 ,(exp vs code)
-                                 (,lp (+ ,x 1))))))))
-                ((arg1 arg2)
-                 (let ((v1   (gensym "va"))
-                       (v2   (gensym "vb"))
-                       (lp  (gensym "lp")))
-                   `(let ((,v1 ,(exp vs arg1))
-                          (,v2 ,(exp vs arg2)))
-                      (let ,lp ((,x ,v1))
-                           (if (< ,x ,v2)
-                               (begin
-                                 ,(exp vs code)
-                                 (,lp (+ ,x 1))))))))
-                ((arg1 arg2 arg3)
-                 (let ((v1   (gensym "va"))
-                       (v2   (gensym "vb"))
-                       (st   (gensym "vs"))
-                       (lp  (gensym "lp")))
-                   `(let ((,v1 ,(exp vs arg1))
-                          (,st ,(exp vs arg2))
-                          (,v2 ,(exp vs arg3)))
-                      (if (> st 0)
-                          (let ,lp ((,x ,v1))
-                               (if (< ,x ,v2)
-                                   (begin
-                                     ,(exp vs code)
-                                     (,lp (+ ,x ,st)))))
-                          (if (< st 0)
-                              (let ,lp ((,x ,v1))
-                                   (if (> ,x ,v2)
-                                       (begin
-                                         ,(exp vs code)
-                                         (,lp (+ ,x ,st)))))
-                              (error "range with step 0 not allowed"))))))
-                (_ (next))))
-             (_ (next))))
-          (_ (next))))
-       (_ (next))))
-
-    ((#:for es in code . else)
-     (let* ((es2   (map (g vs exp) es))
-            (vs2   (union es2 vs))
-            (code2 (exp vs2 code))
-            (p     (is-ec #t code2 #t (list (C 'break) (C 'continue))))
-            (else2 (if else (exp vs2 else) #f))
-            (in2   (map (g vs exp) in)))
-       (list (C 'for) es2 in2 code2 else2 p)))
-           
-    ((#:while test code else)
+ (#:classdef
+   ((_ (#:identifier class . _) parents defs)
+    (with-fluids ((is-class? #t))
+      (let ()
+        (define (filt l)
+          (reverse
+           (fold (lambda (x s)
+                   (match x
+                     ((or 'fast 'functional) s)
+                     (x (cons x s))))
+                 '() l)))
+        (define (is-functional l)
+          (fold (lambda (x pred)
+                  (if pred
+                      pred
+                      (match x
+                        ('functional #t)
+                        (_ #f))))
+                #f l))
+        (define (is-fast l)
+          (fold (lambda (x pred)
+                  (if pred
+                      pred
+                      (match x
+                        ('fast #t)
+                        (_ #f))))
+                #f l))
+        
+         
+        (let* ((class   (string->symbol class))
+               (parents (match parents
+                          (()
+                           '())
+                          (#f
+                           '())
+                          ((#:arglist args . _)
+                           (map (g vs exp) args))))
+               (is-func (is-functional parents))
+               (is-fast (is-fast       parents))
+               (kind    (if is-func
+                            (if is-fast
+                                'mk-pf-class
+                                'mk-pyf-class)
+                            (if is-fast
+                                'mk-p-class
+                                'mk-py-class)))              
+               (parents (filt parents)))
+          `(define ,class (,(O kind) 
+                           ,class
+                           ,(map (lambda (x) `(,(O 'get-class) ,x)) parents)
+                           #:const
+                           ,(match (exp vs defs)
+                              (('begin . l)
+                               l)
+                              ((('begin . l))
+                               l)
+                              (l l))
+                           #:dynamic
+                           ())))))))
+
+  (#:import
+   ((_ ((() nm) . #f))
+    `(use-modules (language python module ,(exp vs nm)))))
+
+  (#:for
+   ((_ e in code . #f)
+    (=> next)
+    (match e
+      (((#:power #f (#:identifier x . _) () . #f))
+       (match in
+         (((#:test power . _))
+          (match power
+            ((#:power #f
+                      (#:identifier "range" . _)
+                      ((#:arglist arglist . _))
+                      . _)
+             (match arglist
+               ((arg)
+                (let ((v   (gensym "v"))
+                      (x   (string->symbol x))
+                      (lp  (gensym "lp")))
+                  `(let ((,v ,(exp vs arg)))
+                     (let ,lp ((,x 0))
+                          (if (< ,x ,v)
+                              (begin
+                                ,(exp vs code)
+                                (,lp (+ ,x 1))))))))
+               ((arg1 arg2)
+                (let ((v1   (gensym "va"))
+                      (v2   (gensym "vb"))
+                      (lp  (gensym "lp")))
+                  `(let ((,v1 ,(exp vs arg1))
+                         (,v2 ,(exp vs arg2)))
+                     (let ,lp ((,x ,v1))
+                          (if (< ,x ,v2)
+                              (begin
+                                ,(exp vs code)
+                                (,lp (+ ,x 1))))))))
+               ((arg1 arg2 arg3)
+                (let ((v1   (gensym "va"))
+                      (v2   (gensym "vb"))
+                      (st   (gensym "vs"))
+                      (lp  (gensym "lp")))
+                  `(let ((,v1 ,(exp vs arg1))
+                         (,st ,(exp vs arg2))
+                         (,v2 ,(exp vs arg3)))
+                     (if (> st 0)
+                         (let ,lp ((,x ,v1))
+                              (if (< ,x ,v2)
+                                  (begin
+                                    ,(exp vs code)
+                                    (,lp (+ ,x ,st)))))
+                         (if (< st 0)
+                             (let ,lp ((,x ,v1))
+                                  (if (> ,x ,v2)
+                                      (begin
+                                        ,(exp vs code)
+                                        (,lp (+ ,x ,st)))))
+                             (error "range with step 0 not allowed"))))))
+               (_ (next))))
+            (_ (next))))
+         (_ (next))))
+      (_ (next))))
+
+   ((_ es in code . else)
+    (let* ((es2   (map (g vs exp) es))
+           (vs2   (union es2 vs))
+           (code2 (exp vs2 code))
+           (p     (is-ec #t code2 #t (list (C 'break) (C 'continue))))
+           (else2 (if else (exp vs2 else) #f))
+           (in2   (map (g vs exp) in)))
+      (list (C 'for) es2 in2 code2 else2 p))))
+
+
+  (#:while
+   ((_ test code . #f)
+    (let ((lp (gensym "lp")))
+      `(let ,lp ()
+            (if ,(exp vs test)
+                (begin
+                  ,(exp vs code)
+                  (,lp))))))
+
+    ((_ test code else)
      (let ((lp (gensym "lp")))
        `(let ,lp ()
              (if test
                  (begin
                    ,(exp vs code)
                    (,lp))
-                 ,(exp vs else)))))
-
-    ((#:try x (or #f ()) #f . fin)
-     `(dynamic-wind
-        (lambda () #f)
-        (lambda () ,(exp vs x))
-        (lambda ()
-          (if (not ,(C 'inhibit-finally))
-              ,(exp vs fin)))))
-
-    ((#:subexpr . l)
-     (exp vs l))
+                 ,(exp vs else))))))
+
+  (#:try
+   ((_ x (or #f ()) #f . fin)
+    (if fin
+        `(,(T 'try) ,(exp vs x) #:finally (lambda () fin))
+        (exp vs x)))
     
-    ((#:try x exc else . fin)
-     (define (guard x)
-       (if fin
-           `(dynamic-wind
-              (lambda () #f)
-              (lambda () ,x)
-              (lambda ()
-                (if (not ,(C 'inhibit-finally))
-                    ,(exp vs fin))))
-           x))
-     (define tag (gensym "tag"))
-     (define o   (gensym "o"))
-     (define l   (gensym "l"))
-     (guard
-      `(catch #t
-         (lambda () ,(exp vs x))         
-         (lambda (,tag ,o . ,l)
-           ,(let lp ((it  (if else (exp vs else) `(apply throw 'python
-                                                         ,tag ,o ,l)))
-                     (exc  exc))
-              (match exc
-                ((((test . #f) code) . exc)
-                 (lp `(if (,(O 'testex) ,tag ,o ,(exp vs test) ,l)
-                          ,(exp vs code)
-                          ,it)
-                     exc))
-                ((((test . as) code) . exc)
-                 (let ((a (exp vs as)))
-                   (lp `(if (,(O 'testex) ,tag ,o ,(exp vs test) ,l)
-                            (let ((,a ,o))
-                              (,(O 'set) ,a '__excargs__ ,l)
-                              ,(exp vs code))
-                            ,it)
-                       exc)))
-                (()
-                 it)))))))
-
-    ((#:raise #f   . #f)
-     `(throw 'python (,(O 'Exception))))
     
-    ((#:raise code . #f)
-     (let ((c (gensym "c")))
-       `(throw 'python
-               (let ((,c ,(exp vs code)))
-                 (if (,(O 'pyclass?) ,c)
-                     (,c)
-                     ,c)))))
+   ((_ x exc else . fin)
+    `(,(T 'try) ,(exp vs x)
+      ,@(let lp ((exc exc) (r (if else (exp vs else) '())))
+          (match exc
+            ((((test . #f) code) . exc)
+             (lp exc (cons `(#:except ,(exp vs code)) r)))
+             
+            ((((test . as) code) . exc)
+             (let ((l (gensym "l")))
+               (lp exc
+                   (cons
+                    `(#:except ,(exp vs test) => (lambda (,(exp vs as) . ,l)
+                                                   ,(exp vs code)))
+                    r))))
+            (() 
+             (reverse r))))
+      ,@(if fin `(#:finally (lambda () ,(exp vs fin))) '()))))
+
+  (#:subexpr
+   ((_ . l)
+    (exp vs l)))
+   
+  (#:raise
+   ((_ #f   . #f)
+    `(,(T 'raise) (,(O 'Exception))))
     
-    ((#:raise code . from)
-     (let ((o (gensym "o"))
-           (c (gensym "c")))              
-       `(throw 'python
-               (let ((,c ,(exp vs code)))
-                 (let ((,o (if (,(O 'pyclass?) ,c)
-                               (,c)
-                               ,c)))
-                   (,(O 'set) ,o '__cause__ ,(exp vs from))
-                   ,o)))))
+   ((_ code . #f)
+    `(,(T 'raise) ,(exp vs code)))
+   
+   ((_ code . from)
+    (let ((o (gensym "o"))
+          (c (gensym "c")))              
+      `(,(T 'raise)
+        (let ((,c ,(exp vs code)))
+          (let ((,o (if (,(O 'pyclass?) ,c)
+                        (,c)
+                        ,c)))
+            (,(O 'set) ,o '__cause__ ,(exp vs from))
+            ,o))))))
              
       
-    ((#:yield args)
-     (let ((f (gensym "f")))
-       `(begin
-          (fluid-set! ,(Y 'in-yield) #t)
-          (let ((,f (scm.yield ,@(gen-yargs vs args))))
-            (,f)))))
+  (#:yield
+   ((_ args)
+    (let ((f (gensym "f")))
+      `(begin
+         (fluid-set! ,(Y 'in-yield) #t)
+         (let ((,f (scm.yield ,@(gen-yargs vs args))))
+           (,f)))))
 
     
-    ((#:yield f args)
-     (let ((f (gen-yield (exp vs f)))
-           (g (gensym "f")))
-       `(begin
-          (set! ,(C 'inhibit-finally) #t)
-          (let ((,g (,f ,@(gen-yargs vs args))))
-            (,g)))))
+   ((_ f args)
+    (let ((f (gen-yield (exp vs f)))
+          (g (gensym "f")))
+      `(begin
+         (set! ,(C 'inhibit-finally) #t)
+         (let ((,g (,f ,@(gen-yargs vs args))))
+           (,g))))))
     
-    ((#:def f
-            (#:types-args-list
-             args
-             #f #f)
-            #f
-            code)
-     (let* ((c?  (fluid-ref is-class?))
-            (f   (exp vs f))
-            (y?  (is-yield f #f code))
-            (r   (gensym "return"))
-            (as  (map (lambda (x) (match x
-                                    ((((#:identifier x . _) . #f) #f)
-                                     (string->symbol x))))
-                      args))
-            (ab  (gensym "ab"))
-            (vs  (union as vs))
-            (ns  (scope code vs))
-            (df  (defs code '()))
-            (ex  (gensym "ex"))
-            (y   'scm.yield)
-            (y.f (gen-yield f))
-            (ls  (diff (diff ns vs) df)))
-       
-       (define (mk code)
-         `(let-syntax ((,y   (syntax-rules ()
-                               ((_ . args)
-                                (abort-to-prompt ,ab . args))))
-                       (,y.f (syntax-rules ()
-                               ((_ . args)
-                                (abort-to-prompt ,ab . args)))))
-            ,code))
-       
-       (with-fluids ((is-class? #f))
-         (if c?
-             (if y?
-                 `(define ,f
-                    (,(C 'def-wrap) ,y? ,f ,ab
-                     (lambda (,@as)
-                       (,(C 'with-return) ,r
-                        ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                                ,(with-fluids ((return r))
-                                   (exp ns code))))))))
-                 
-                 `(define ,f
-                    (letrec ((,f
-                              (case-lambda
-                                ((,ex ,@as)
-                                 (,f ,@as))
-                                ((,@as)
-                                 (,(C 'with-return) ,r
-                                  ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                                          ,(with-fluids ((return r))
-                                             (exp ns code)))))))))
-                      ,f)))
-
-             (if y?
-                 `(define ,f
-                    (,(C 'def-wrap) ,y? ,f ,ab
-                     (lambda (,@as)
-                       (,(C 'with-return) ,r
-                        (let ,(map (lambda (x) (list x #f)) ls)
-                          ,(with-fluids ((return r))
-                             (mk
-                              (exp ns code))))))))
-                 `(define ,f
+  (#:def
+   ((_ f
+       (#:types-args-list
+        args
+        #f #f)
+       #f
+       code)
+    (let* ((c?  (fluid-ref is-class?))
+           (f   (exp vs f))
+           (y?  (is-yield f #f code))
+           (r   (gensym "return"))
+           (as  (map (lambda (x) (match x
+                                   ((((#:identifier x . _) . #f) #f)
+                                    (string->symbol x))))
+                     args))
+           (ab  (gensym "ab"))
+           (vs  (union as vs))
+           (ns  (scope code vs))
+           (df  (defs code '()))
+           (ex  (gensym "ex"))
+           (y   'scm.yield)
+           (y.f (gen-yield f))
+           (ls  (diff (diff ns vs) df)))
+      
+      (define (mk code)
+        `(let-syntax ((,y   (syntax-rules ()
+                              ((_ . args)
+                               (abort-to-prompt ,ab . args))))
+                      (,y.f (syntax-rules ()
+                              ((_ . args)
+                               (abort-to-prompt ,ab . args)))))
+           ,code))
+      
+      (with-fluids ((is-class? #f))
+        (if c?
+            (if y?
+                `(define ,f
+                   (,(C 'def-wrap) ,y? ,f ,ab
+                    (lambda (,@as)
+                      (,(C 'with-return) ,r
+                       ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                               ,(with-fluids ((return r))
+                                  (exp ns code))))))))
+                
+                `(define ,f
+                   (letrec ((,f
+                             (case-lambda
+                               ((,ex ,@as)
+                                (,f ,@as))
+                               ((,@as)
+                                (,(C 'with-return) ,r
+                                 ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                                         ,(with-fluids ((return r))
+                                            (exp ns code)))))))))
+                     ,f)))
+            
+            (if y?
+                `(define ,f
+                   (,(C 'def-wrap) ,y? ,f ,ab
                     (lambda (,@as)
                       (,(C 'with-return) ,r
                        (let ,(map (lambda (x) (list x #f)) ls)
                          ,(with-fluids ((return r))
-                            (exp ns code)))))))))))
-     
-    ((#:global . _)
-     '(values))
+                            (mk
+                             (exp ns code))))))))
+                `(define ,f
+                   (lambda (,@as)
+                     (,(C 'with-return) ,r
+                      (let ,(map (lambda (x) (list x #f)) ls)
+                        ,(with-fluids ((return r))
+                           (exp ns code))))))))))))
+   
+  (#:global
+   ((_ . _)
+    '(values)))
     
-    ((#:lambdef v e)
-     (list `lambda v (exp vs e)))
-
-    ((#:stmt l)
-     (if (> (length l) 1)
-         (cons 'values (map (g vs exp) l))
-         (exp vs (car l))))
+  (#:lambdef
+   ((_ v e)
+    (list `lambda v (exp vs e))))
+
+  (#:stmt
+   ((_ l)
+    (if (> (length l) 1)
+        (cons 'values (map (g vs exp) l))
+        (exp vs (car l)))))
      
 
-    ((#:expr-stmt (l) (#:assign))
-     (exp vs l))
-
-    ((#:expr-stmt l type)
-     (=> fail)
-     (call-with-values
-         (lambda () (match type
-                      ((#:assign u)
-                       (values #f u))
-                      ((#:augassign op u)
-                       (values op u))
-                      (_ (fail))))
-                 
-       (lambda (op u)
-         (cond
-          ((= (length l) (length u))
-           (if (= (length l) 1)
-               (make-set vs op (car l) (exp vs (car u)))
-               (cons 'begin
-                     (map (lambda (l u) (make-set vs op l u))
-                          l
-                          (map (g vs exp) u)))))
-          ((and (= (length u) 1) (not op))
-           (let ((vars (map (lambda (x) (gensym "v")) l)))
-             `(call-with-values (lambda () (exp vs (car u)))
-                (lambda vars
-                  ,@(map (lambda (l v) (make-set vs op l v))
-                         l vars)))))))))
+  (#:expr-stmt
+   ((_ (l) (#:assign))
+    (exp vs l))
+
+   ((_ l type)
+    (=> fail)
+    (call-with-values
+        (lambda () (match type
+                     ((#:assign u)
+                      (values #f u))
+                     ((#:augassign op u)
+                      (values op u))
+                     (_ (fail))))
       
-            
-
-    ((#:return . x)
-     `(,(fluid-ref return) ,@(map (g vs exp) x)))
-    
-    ((#:expr-stmt
+      (lambda (op u)
+        (cond
+         ((= (length l) (length u))
+          (if (= (length l) 1)
+              (make-set vs op (car l) (exp vs (car u)))
+              (cons 'begin
+                    (map (lambda (l u) (make-set vs op l u))
+                         l
+                         (map (g vs exp) u)))))
+         ((and (= (length u) 1) (not op))
+          (let ((vars (map (lambda (x) (gensym "v")) l)))
+            `(call-with-values (lambda () (exp vs (car u)))
+               (lambda vars
+                 ,@(map (lambda (l v) (make-set vs op l v))
+                        l vars)))))))))
+   
+    ((_
       ((#:test (#:power #f (#:identifier v . _) () . #f) #f))
       (#:assign (l)))
      (let ((s (string->symbol v)))
-       `(,s/d ,s ,(exp vs l))))
-                           
-    ((#:comp x #f)
-     (exp vs x))
-
-    ((#:comp x (op . y))
-     (define (tr op x y)
-       (match op
-         ((or "<" ">" "<=" ">=")
-          (list (G (string->symbol op)) x y))
-         ("!="    (list 'not (list 'equal? x y)))
-         ("=="    (list 'equal? x y))
-         ("is"    (list 'eq? x y))
-         ("isnot" (list 'not (list 'eq? x y)))
-         ("in"    (list 'member x y))
-         ("notin" (list 'not (list 'member x y)))
-         ("<>"    (list 'not (list 'equal? x y)))))
-     (tr op (exp vs x) (exp vs y)))
+       `(,s/d ,s ,(exp vs l)))))
+            
+
+  (#:return
+   ((_ . x)
+    `(,(fluid-ref return) ,@(map (g vs exp) x))))
     
+                           
+  (#:comp
+   ((_ x #f)
+    (exp vs x))
+
+   ((_ x (op . y))
+    (define (tr op x y)
+      (match op
+        ((or "<" ">" "<=" ">=")
+         (list (G (string->symbol op)) x y))
+        ("!="    (list 'not (list 'equal? x y)))
+        ("=="    (list 'equal? x y))
+        ("is"    (list 'eq? x y))
+        ("isnot" (list 'not (list 'eq? x y)))
+        ("in"    (list 'member x y))
+        ("notin" (list 'not (list 'member x y)))
+        ("<>"    (list 'not (list 'equal? x y)))))
+    (tr op (exp vs x) (exp vs y)))))
+
+(define (exp vs x)
+  (match (pr x)
+    ((tag . l)
+     ((hash-ref tagis tag (lambda y (warn "not tag in tagis") x)) x vs))
+
+    (#:True  #t)
+    (#:False #f)
+    (#:pass  `(values))
+    (#:break
+     (C 'break))    
+    (#:continue
+     (C 'continue))
     (x x)))
 
 (define (comp x)