summaryrefslogtreecommitdiff
path: root/modules/language/python/compile.scm
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-24 22:23:23 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-24 22:23:23 +0200
commit582d1c6f0be332ad4cb9f421bea5c2be56a12408 (patch)
tree3c0f8e487d1c57b509ae19ee4d858a90728ea7b3 /modules/language/python/compile.scm
parent333a82328a53024f341a74a0f738ce0d6f0f6d4f (diff)
socket.py
Diffstat (limited to 'modules/language/python/compile.scm')
-rw-r--r--modules/language/python/compile.scm91
1 files changed, 55 insertions, 36 deletions
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))))
-