1 files changed, 65 insertions, 34 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 3bf81ef..619ef1b 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -21,7 +21,7 @@
   #:use-module ((language python format2) #:select (fnm))
   #:use-module ((language python with) #:select ())
   #:use-module (ice-9 pretty-print)
-  #:export (comp))
+  #:export (comp exit-fluid exit-prompt))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -43,6 +43,29 @@
 (define-inlinable (H   x) `(@  (language python hash)    ,x))
 (define-inlinable (W   x) `(@  (language python with)    ,x))
 
+(define exit-prompt (make-prompt-tag))
+(define exit-fluid  (make-fluid #f))
+
+(define-syntax-rule (with-exit code ...)
+  (with-fluids ((exit-fluid #t))
+    (call-with-prompt exit-prompt
+      (lambda () code ...)
+      (lambda (k val)
+        (if (not (= val 0))
+            (format #t "exit with error ~a~%" val))))))
+
+(define (get-exported-symbols x)
+  (aif it (resolve-module x)
+       (aif it (module-public-interface it)
+            (let ((l '()))
+              (module-for-each
+               (lambda (k b)
+                 (set! l (cons k l)))
+               it)
+              l)
+            '())
+       '()))
+
 (define cvalues (G 'values))
 
 (define-syntax-rule (wth code)
@@ -118,12 +141,16 @@
       (fold f (f (car l) init) (cdr l))
       init))
 
+(define do-pr #t)
+
 (define (pr . x)
-  (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
-  (with-output-to-port port
-    (lambda ()
-      (pretty-print (syntax->datum x))))
-  (close port)
+  (if do-pr
+      (let ()
+        (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
+        (with-output-to-port port
+          (lambda ()
+            (pretty-print (syntax->datum x))))
+        (close port)))
   (car (reverse x)))
 
 (define (pf x)
@@ -1010,29 +1037,39 @@
  
  (#:import
   ((_ (#:from (() . nm) . #f))
-   `(,(C 'use) (language python module ,@(map (lambda (nm) (exp vs nm))
-						nm))))
+   (let* ((xl  (map (lambda (nm) (exp vs nm)) nm))
+          (l `(language python module ,@xl)))
+
+     ;; Make sure to load the module in
+     (catch #t
+       (lambda () (Module (reverse l) (reverse xl)))
+       (lambda x #f))
+     
+     (for-each dont-warn (get-exported-symbols l))
+     
+     `(,(C 'use) ,l)))
+  
   ((_ (#:from (() . nm)  l))
-   `(,(C 'use)  ((language python module ,@(map (lambda (nm) (exp vs nm))
-						 nm))
-                 #:select ,(map (lambda (x)
-                                  (match x
-                                    ((a . #f)
-                                     (let ((s (exp vs a)))
-                                       (fluid-set! ignore
-                                                   (cons s (fluid-ref ignore)))
-				       (dont-warn s)
-                                       s))
+   `(,(C 'use)  ((language python module ,@(map (lambda (nm) (exp vs nm)) nm))
+                 #:select
+                 ,(map (lambda (x)
+                         (match x
+                           ((a . #f)
+                            (let ((s (exp vs a)))
+                              (fluid-set! ignore
+                                          (cons s (fluid-ref ignore)))
+                              (dont-warn s)
+                              s))
                                      
-                                    ((a . b)
-                                     (let ((s1 (exp vs a))
-					   (s2 (exp vs b)))
-                                       (fluid-set! ignore
-                                                   (cons s2
-                                                         (fluid-ref ignore)))
-				       (dont-warn s2)
-                                       (cons s1 s2)))))
-                                l))))
+                           ((a . b)
+                            (let ((s1 (exp vs a))
+                                  (s2 (exp vs b)))
+                              (fluid-set! ignore
+                                          (cons s2
+                                                (fluid-ref ignore)))
+                              (dont-warn s2)
+                              (cons s1 s2)))))
+                       l))))
 					      
   
   ((_ (#:name ((ids ...) . as) ...) ...)
@@ -1717,13 +1754,10 @@
 	(if (pair? start)
 	    (set! x (cdr x)))
 
-	(clear-warning-data)
-	
 	(let* ((globs (get-globals x))
 	       (e     (map (g globs exp) x)))
 	  `(begin
 	     ,@start
-	     (fluid-set! (@@ (system base message) %dont-warn-list) '())
 	     (define ,fnm (make-hash-table))
 	     ,@(map (lambda (s)
 		      (if (member s (fluid-ref ignore))
@@ -1740,19 +1774,16 @@
         (if (pair? start)
             (set! x (cdr x)))
 
-	(clear-warning-data)
-	
         (let* ((globs (get-globals x))
                (res   (gensym "res"))
                (e     (map (g globs exp) x)))
           `(begin
              ,@start
-             (fluid-set! (@@ (system base message) %dont-warn-list) '())
              ,@(map (lambda (s)
                       (if (member s (fluid-ref ignore))
                           `(,cvalues)
                           `(,(C 'var) ,s))) globs)
-             ,@e)))))
+             (,(C 'with-exit) ,@e))))))