From 582d1c6f0be332ad4cb9f421bea5c2be56a12408 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Fri, 24 Aug 2018 22:23:23 +0200
Subject: socket.py

---
 modules/language/python/compile.scm | 91 ++++++++++++++++++++++---------------
 1 file changed, 55 insertions(+), 36 deletions(-)

(limited to 'modules/language/python/compile.scm')

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index aec886b..983eb66 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -76,9 +76,11 @@
       r)))
 
 
-(define-syntax-rule (use a ...)
+(define-syntax-rule (use p l a ...)
   (catch #t
-    (lambda () (use-modules a ...))
+    (lambda ()
+      (if (not p) (reload-module (resolve-module l)))
+      (use-modules a ...))
     (lambda x
       (warn "failed to load " x)
       (raise (ImportError '(a ...))))))
@@ -105,6 +107,12 @@
 
 (define (pre) (warn "Patching guile will lead to way better experience use 'python.patch' on guile-2.2 e.g. (use-modules (language python guilemod))"))
 
+(define (gw-persson x l)
+  (if (or (member x (fluid-ref (@@ (system base message) %dont-warn-list)))
+          (member x l))
+      x
+      #f))
+
 (define-syntax clear-warning-data
   (lambda (x)
     (catch #t
@@ -1012,6 +1020,7 @@
                           (fluid-set! decorations '())
                           r))               
                (class   (exp vs class))
+               (vo  vs)
                (vs  (union (list class) vs))
                (ns  (scope code '()))
                (ls  ns #;(diff ns vs))
@@ -1029,7 +1038,7 @@
                 ,(if parents
                      (arglist->pkw (clean parents))
                      `(,(G 'cons) '() '()))
-                ,(map (lambda (x) `(define ,x #f)) ls)
+                ,(map (lambda (x) `(define ,x ,(gw-persson x vo))) ls)
                 ,(wth (exp vs code)))))))))))
  (#:verb
   ((_ x) x))
@@ -1039,45 +1048,53 @@
  
  (#:import
   ((_ (#:from (() . nm) . #f))
-   (let* ((xl  (map (lambda (nm) (exp vs nm)) nm))
-          (l `(language python module ,@xl)))
+   (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)))
+     (let ((? (catch #t
+                (lambda () (Module (reverse l) (reverse xl)) #t)
+                (lambda x #f))))
+       (if (eq? ? #t) (for-each dont-warn (get-exported-symbols l)))       
+       `(,(C 'use) ,? ',l ,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))
-                                     
-                           ((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))))
+   ;; Make sure to load the module in
+   (let* ((xl  (map (lambda (nm) (exp vs nm)) nm))
+          (ll `(language python module ,@xl))
+          (?  (catch #t
+                (lambda () (Module (reverse ll) (reverse xl)) #t)
+                (lambda x #f))))
+     
+     (if ? (for-each dont-warn (get-exported-symbols ll)))
+     
+     `(,(C 'use) ,? ',ll
+       (,ll
+        #: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)))))
 					      
   
   ((_ (#:name ((ids ...) . as) ...) ...)
    `(begin
       ,@(map
-	 (lambda (ids as)
+         (lambda (ids as)
            `(begin
               ,@(map (lambda (ids as)
                        (let ((path (map (g vs exp) ids)))
@@ -1103,7 +1120,8 @@
                                  ((#:verb
                                    ((@ (language python module) import)
                                     ((@ (language python module) Module)
-                                     ',(append '(language python module) path))
+                                     ',(append '(language python module)
+                                               path))
                                     ,(exp vs (car ids)))))))))))
                      ids as)))
          ids as))))
@@ -2027,6 +2045,8 @@
              #`(let/ec ret l)
              code))))))
 
+(define void (list 'void))
+
 (define-syntax var
   (lambda (x)
     (syntax-case x (cons quote)
@@ -2039,7 +2059,7 @@
          (dont-warn (syntax->datum #'v))
          #'(if (and #f (module-defined? (current-module) 'v))
                (values)
-               (define! 'v #f)))))))
+               (define! 'v void)))))))
 
 (define-inlinable (non? x) (eq? x #:nil))
 
@@ -2570,4 +2590,3 @@
     ((_ '() v) (values))
     ((_  x  v)
      (define! 'x v))))
-
-- 
cgit v1.2.3