From ba807137c9ec4b1cc4e2328dee4a83a0350114a9 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Sun, 24 Sep 2017 21:59:53 +0200
Subject: import f as g etc now  works

---
 modules/language/python/compile.scm | 727 ++++++++++++++++++++----------------
 1 file changed, 398 insertions(+), 329 deletions(-)

(limited to 'modules/language')

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index ec4215b..2e3a283 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -28,6 +28,25 @@
     (cons v
           (@@ (system base message) %dont-warn-list))))
 
+(define *prefixes* (make-fluid '()))
+(define (add-prefix id)
+  (if (fluid-ref (@@ (system base compile) %in-compile))
+      (fluid-set! *prefixes* (cons id (fluid-ref *prefixes*)))
+      (begin
+        (when (not (module-defined? (current-module) '__prefixes__))
+          (module-define! (current-module) '__prefixes__ (make-fluid '())))
+        
+        (let ((p (module-ref (current-module) '__prefixes__)))
+          (fluid-set! p (cons id (fluid-ref p)))))))
+
+(define (is-prefix? id)
+  (if (fluid-ref (@@ (system base compile) %in-compile))
+      (member id (fluid-ref *prefixes*))
+      (if (not (module-defined? (current-module) '__prefixes__))
+          #f
+          (let ((p (module-ref (current-module) '__prefixes__)))
+            (member id (fluid-ref p))))))
+  
 (define-syntax call
   (syntax-rules ()
     ((_ (f) . l) (f . l))))
@@ -353,7 +372,14 @@
   
   (match x
     ((#:test (#:power kind (#:identifier v . _) addings . _) . _)
-     (let ((addings (get-addings vs addings)))
+     (let* ((v.add   (if (is-prefix? (string->symbol v))
+                         (let ((w (symbol->string (exp vs (car addings)))))
+                           (cons (string-append v "." w)
+                                 (cdr addings)))
+                         (cons v addings)))
+            (v       (car v.add))
+            (addings (cdr addings))
+            (addings (get-addings vs addings)))
        (define q (lambda (x) `',x))
        (if kind
            (let ((v (string->symbol v)))
@@ -406,13 +432,24 @@
    (exp vs x))
   
   ((_ #f vf trailer . **)
-   (let ()
+   (let* ((vf    (exp vs vf))
+          (vf.tr (if (is-prefix? vf)
+                     (cons
+                      (string->symbol
+                       (string-append
+                        (symbol->string vf)
+                        "."
+                        (symbol->string (exp vs (car trailer)))))
+                      (cdr trailer))
+                     (cons vf trailer)))
+          (vf      (car vf.tr))
+          (trailer (cdr vf.tr)))
      (define (pw x)
        (if **
            `(expt ,x ,(exp vs **))
            x))
      (pw
-      (let lp ((e (exp vs vf)) (trailer trailer))
+      (let lp ((e vf) (trailer trailer))
         (match trailer
           (()
            e)
@@ -558,7 +595,7 @@
   ((_  (#:power #f base (l ... fin) . #f))
    (let ((add (get-addings vs l))
          (fin (get-addings vs (list fin)))
-         (f   (exp vs base)))
+         (f   (exp vs base)))     
      `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin))))
            
  (#:if
@@ -631,147 +668,162 @@
                            #: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)
-    (if fin
-        `(,(T 'try) ,(exp vs x) #:finally (lambda () fin))
-        (exp vs x)))
+ (#:import
+  ((_ (#:from (() nm) . #f))
+   `(use-modules (language python module ,(exp vs nm))))
+  
+  ((_ (#:name ((ids ...) . as) ...))
+   `(begin
+      ,@(map (lambda (ids as)
+               (let* ((syms (map (g vs exp) ids))
+                      (id   (if as (exp vs as) (car (reverse syms)))))
+                 (add-prefix id)
+                 `(use-modules ((language python module ,@syms)
+                                #:prefix
+                                ,(string->symbol
+                                  (string-append (symbol->string id) "."))))))
+             ids as))))
+                             
+                                   
+  
+ 
+ (#: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)
+   (if fin
+       `(,(T 'try) ,(exp vs x) #:finally (lambda () fin))
+       (exp vs x)))
     
     
-   ((_ 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)))
+  ((_ 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))))
-    
-   ((_ code . #f)
-    `(,(T 'raise) ,(exp vs code)))
+ (#:raise
+  ((_ #f   . #f)
+   `(,(T 'raise) (,(O 'Exception))))
+  
+  ((_ 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))))))
+  ((_ 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
+ (#:yield
    ((_ args)
     (let ((f (gensym "f")))
       `(begin
@@ -788,198 +840,198 @@
          (let ((,g (,f ,@(gen-yargs vs args))))
            (,g))))))
   
-  (#:def
-   ((_ f
-       (#:types-args-list
-        args
-        *e **e)
-       #f
-       code)
-    (let* ((args (get-kwarg-def vs args))
-           (c?   (fluid-ref is-class?))
-           (f    (exp vs f))
-           (y?   (is-yield f #f code))
-           (r    (gensym "return"))
-           (*f   (match *e
-                   (((e . #f) ()) (list (list '* (exp vs e))))
-                   (#f '())))
-           (dd2  (match *e
-                   (((e . #f) ()) (list (exp vs e)))
-                   (#f '())))
-           (**f   (match **e
+ (#:def
+  ((_ f
+      (#:types-args-list
+       args
+       *e **e)
+      #f
+      code)
+   (let* ((args (get-kwarg-def vs args))
+          (c?   (fluid-ref is-class?))
+          (f    (exp vs f))
+          (y?   (is-yield f #f code))
+          (r    (gensym "return"))
+          (*f   (match *e
+                  (((e . #f) ()) (list (list '* (exp vs e))))
+                  (#f '())))
+          (dd2  (match *e
+                  (((e . #f) ()) (list (exp vs e)))
+                  (#f '())))
+          (**f   (match **e
                    ((e . #f) (list (list '** (exp vs e))))
                    (#f '())))
-           (dd3  (match **e
-                   ((e . #f) (list (exp vs e)))
-                   (#f '())))
-           (as   (map (lambda (x) (match x
-                                    (('= a _) a)
-                                    (a        a)))
-                      args))
-           (ab  (gensym "ab"))
-           (vs  (union dd3 (union dd2 (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
-                    (,(D 'lam) (,@args ,@*f ,@**f)
-                      (,(C 'with-return) ,r
-                       ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                               ,(with-fluids ((return r))
-                                  (exp ns code))))))))
-                
-                `(define ,f (,(D 'lam) (,@args ,@*f ,@**f)
-                               (,(C 'with-return) ,r
-                                ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
-                                        ,(with-fluids ((return r))
-                                           (exp ns code))))))))
+          (dd3  (match **e
+                  ((e . #f) (list (exp vs e)))
+                  (#f '())))
+          (as   (map (lambda (x) (match x
+                                   (('= a _) a)
+                                   (a        a)))
+                     args))
+          (ab  (gensym "ab"))
+          (vs  (union dd3 (union dd2 (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
+                   (,(D 'lam) (,@args ,@*f ,@**f)
+                    (,(C 'with-return) ,r
+                     ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                             ,(with-fluids ((return r))
+                                (exp ns code))))))))
+               
+               `(define ,f (,(D 'lam) (,@args ,@*f ,@**f)
+                            (,(C 'with-return) ,r
+                             ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                                     ,(with-fluids ((return r))
+                                        (exp ns code))))))))
             
-            (if y?
-                `(define ,f
-                   (,(C 'def-wrap) ,y? ,f ,ab
-                    (,(D 'lam) (,@args ,@*f ,@**f)
-                      (,(C 'with-return) ,r
-                       (let ,(map (lambda (x) (list x #f)) ls)
-                         ,(with-fluids ((return r))
-                            (mk
-                             (exp ns code))))))))
-                `(define ,f
+           (if y?
+               `(define ,f
+                  (,(C 'def-wrap) ,y? ,f ,ab
                    (,(D 'lam) (,@args ,@*f ,@**f)
-                     (,(C 'with-return) ,r
-                      (let ,(map (lambda (x) (list x #f)) ls)
-                        ,(with-fluids ((return r))
-                           (exp ns code))))))))))))
-  
-  (#:global
-   ((_ . _)
-    '(values)))
-
-  (#:list
-   ((_ . l)
-    (list (L 'to-pylist) (let lp ((l l))
-                           (match l                             
-                             ((or () #f) ''())                            
-                             (((#:starexpr  #:power #f (#:list . l) . _) . _)
-                              (lp l))
-                             (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
-                              (lp l))
-                             (((#:starexpr . l) . _)
-                              `(,(L 'to-list) ,(exp vs l)))
-                             ((x . l)
-                              `(cons ,(exp vs x) ,(lp l))))))))
-  (#:tuple
-   ((_ . l)
-    (let lp ((l l))
-      (match l
-        (() ''())
-        (((#:starexpr  #:power #f (#:list . l) . _) . _)
-         (lp l))
-        (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
-         (lp l))
-        (((#:starexpr . l) . _)
-         `(,(L 'to-list) ,(exp vs l)))
-        ((x . l)
-         `(cons ,(exp vs x) ,(lp 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)))))
+                    (,(C 'with-return) ,r
+                     (let ,(map (lambda (x) (list x #f)) ls)
+                       ,(with-fluids ((return r))
+                          (mk
+                           (exp ns code))))))))
+               `(define ,f
+                  (,(D 'lam) (,@args ,@*f ,@**f)
+                   (,(C 'with-return) ,r
+                    (let ,(map (lambda (x) (list x #f)) ls)
+                      ,(with-fluids ((return r))
+                         (exp ns code))))))))))))
+ 
+ (#:global
+  ((_ . _)
+   '(values)))
+ 
+ (#:list
+  ((_ . l)
+   (list (L 'to-pylist) (let lp ((l l))
+                          (match l                             
+                            ((or () #f) ''())                            
+                            (((#:starexpr  #:power #f (#:list . l) . _) . _)
+                             (lp l))
+                            (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
+                             (lp l))
+                            (((#:starexpr . l) . _)
+                             `(,(L 'to-list) ,(exp vs l)))
+                            ((x . l)
+                             `(cons ,(exp vs x) ,(lp l))))))))
+ (#:tuple
+  ((_ . l)
+   (let lp ((l l))
+     (match l
+       (() ''())
+       (((#:starexpr  #:power #f (#:list . l) . _) . _)
+        (lp l))
+       (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
+        (lp l))
+       (((#:starexpr . l) . _)
+        `(,(L 'to-list) ,(exp vs l)))
+       ((x . l)
+        `(cons ,(exp vs x) ,(lp 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) (#: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))))
+  ((_ 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)))))))))
-   
-    ((_
-      ((#:test (#:power #f (#:identifier v . _) () . #f) #f))
-      (#:assign (l)))
-     (let ((s (string->symbol v)))
-       `(,s/d ,s ,(exp vs l)))))
+     (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)))))
             
 
-  (#:return
-   ((_ . x)
-    `(,(fluid-ref return) ,@(map (g vs exp) x))))
+ (#:return
+  ((_ . x)
+   `(,(fluid-ref return) ,@(map (g vs exp) x))))
 
-  (#:dict
-   ((_ . #f)
-    `(,(Di 'make-py-hashtable)))
+ (#:dict
+  ((_ . #f)
+   `(,(Di 'make-py-hashtable)))
    
-   ((_  (k . v) ...)
-    (let ((dict (gensym "dict")))
-      `(let ((,dict (,(Di 'make-py-hashtable))))
-         ,@(map (lambda (k v)
-                  `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
-                k v)
-         ,dict))))
+  ((_  (k . v) ...)
+   (let ((dict (gensym "dict")))
+     `(let ((,dict (,(Di 'make-py-hashtable))))
+        ,@(map (lambda (k v)
+                 `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
+               k v)
+        ,dict))))
                   
                            
-  (#: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 (G 'not) (list (G 'equal?) x y)))
-        ("=="    (list (G 'equal?) x y))
-        ("is"    (list (G 'eq?) x y))
-        ("isnot" (list (G 'not) (list (G 'eq?)    x y)))
-        ("in"    (list (L 'in) x y))
-        ("notin" (list (G 'not) (list (L 'in)     x y)))
-        ("<>"    (list (G 'not) (list (G 'equal?) x y)))))
-    (tr op (exp vs x) (exp vs y)))))
+ (#: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 (G 'not) (list (G 'equal?) x y)))
+       ("=="    (list (G 'equal?) x y))
+       ("is"    (list (G 'eq?) x y))
+       ("isnot" (list (G 'not) (list (G 'eq?)    x y)))
+       ("in"    (list (L 'in) x y))
+       ("notin" (list (G 'not) (list (L 'in)     x y)))
+       ("<>"    (list (G 'not) (list (G 'equal?) x y)))))
+   (tr op (exp vs x) (exp vs y)))))
 
 (define (exp vs x)
   (match (pr x)
@@ -1022,19 +1074,36 @@
       (x '())))
 
   (if (fluid-ref (@@ (system base compile) %in-compile))
-      (set! s/d 'set!)
-      (set! s/d 'define))
+      (with-fluids ((*prefixes* '()))             
+        (if (fluid-ref (@@ (system base compile) %in-compile))
+            (set! s/d 'set!)
+            (set! s/d 'define))
   
-  (if (pair? start)
-      (set! x (cdr x)))
-
-  (let ((globs (get-globals x)))
-    `(begin
-       ,@start
-       ,(C 'clear-warning-data)
-       (set! (@@ (system base message) %dont-warn-list) '())
-       ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
-       ,@(map (g globs exp) x))))
+        (if (pair? start)
+            (set! x (cdr x)))
+        
+        (let ((globs (get-globals x)))
+          `(begin
+             ,@start
+             ,(C 'clear-warning-data)
+             (set! (@@ (system base message) %dont-warn-list) '())
+             ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
+             ,@(map (g globs exp) x))))
+      (begin
+        (if (fluid-ref (@@ (system base compile) %in-compile))
+            (set! s/d 'set!)
+            (set! s/d 'define))
+  
+        (if (pair? start)
+            (set! x (cdr x)))
+        
+        (let ((globs (get-globals x)))
+          `(begin
+             ,@start
+             ,(C 'clear-warning-data)
+             (set! (@@ (system base message) %dont-warn-list) '())
+             ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
+             ,@(map (g globs exp) x))))))
 
 (define-syntax-parameter break
   (lambda (x) #'(values)))
-- 
cgit v1.2.3