summaryrefslogtreecommitdiff
path: root/modules/language/python
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python')
-rw-r--r--modules/language/python/compile.scm117
-rw-r--r--modules/language/python/list.scm32
-rw-r--r--modules/language/python/module.scm4
-rw-r--r--modules/language/python/module/_python.scm16
-rw-r--r--modules/language/python/module/io.scm21
-rw-r--r--modules/language/python/module/optparse.py16
-rw-r--r--modules/language/python/module/os.scm21
-rw-r--r--modules/language/python/module/python.scm5
-rw-r--r--modules/language/python/module/sys.scm11
9 files changed, 153 insertions, 90 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index b2f5ea7..de4299d 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -43,6 +43,8 @@
(define-inlinable (H x) `(@ (language python hash) ,x))
(define-inlinable (W x) `(@ (language python with) ,x))
+(define cvalues (G 'values))
+
(define-syntax-rule (wth code)
(let ((old s/d))
(set! s/d (C 'qset!))
@@ -616,7 +618,7 @@
(_ (error "unhandled addings")))
(get-addings vs l fast?))))))
-
+
(define-syntax-rule (setwrap u)
(call-with-values (lambda () u)
(case-lambda
@@ -760,7 +762,7 @@
(#:decorated
((_ (l ...))
(fluid-set! decorations (map (g vs exp) l))
- '(values)))
+ `(,cvalues)))
(#:string
((_ l)
@@ -1049,7 +1051,7 @@
(if (< ,x ,v)
(begin
(,(C 'let/ec) continue-ret
- (,(C 'with-sp) ((continue (values))
+ (,(C 'with-sp) ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp (+ ,x 1))))))))
@@ -1079,7 +1081,7 @@
(if (< ,x ,v2)
(begin
(,(C 'let/ec) continue-ret
- (,(C 'with-sp) ((continue (values))
+ (,(C 'with-sp) ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp (+ ,x 1)))))))
@@ -1109,7 +1111,7 @@
(begin
(,(C 'let/ec) continue-ret
(,(C 'with-sp)
- ((continue (values))
+ ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp (+ ,x ,st)))))
@@ -1119,7 +1121,7 @@
(begin
(,(C 'let/ec) continue-ret
(,(C 'with-sp)
- ((continue (values))
+ ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp (+ ,x ,st)))))
@@ -1180,7 +1182,7 @@
(if (,(C 'boolit) ,(exp vs test))
(begin
(,(C 'let/ec) continue-ret
- (,(C 'with-sp) ((continue (values))
+ (,(C 'with-sp) ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp)))))
@@ -1203,7 +1205,7 @@
(if (,(C 'boolit) ,(exp vs test))
(begin
(,(C 'let/ec) ,(C 'continue-ret)
- (,(C 'with-sp) ((continue (values))
+ (,(C 'with-sp) ((continue (,cvalues))
(break (break-ret)))
,code2))
(,lp))
@@ -1377,7 +1379,7 @@
(#:global
((_ . _)
- '(values)))
+ `(,cvalues)))
(#:list
((_ x (and e (#:cfor . _)))
@@ -1429,7 +1431,7 @@
(#:stmt
((_ l)
(if (> (length l) 1)
- (cons 'values (map (g vs exp) l))
+ (cons cvalues (map (g vs exp) l))
(exp vs (car l)))))
(#:expr-stmt
@@ -1460,12 +1462,12 @@
(if (= (length l) 1)
`(begin
,(make-set vs op (car l) (exp vs (car u)))
- (values))
+ (,cvalues))
`(begin
,@(map (lambda (l u) (make-set vs op l u))
l
(map (g vs exp) u))
- (values))))
+ (,cvalues))))
((and (= (length u) 1) (not op))
(let ((vars (map (lambda (x) (gensym "v")) l))
@@ -1483,12 +1485,12 @@
,@(map (lambda (l v) (make-set vs op l v))
l vars)))))
,f))
- (values))))
+ (,cvalues))))
((and (= (length l) 1) (not op))
`(begin
,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
- (values)))))))
+ (,cvalues)))))))
((_
((#:test (#:power #f (#:identifier v . _) () . #f) #f))
@@ -1532,7 +1534,7 @@
,@(map (lambda (l u) (make-set vs op l u))
l
(map (g vs exp) u))
- (values ,@(map (g exp vs) l)))))
+ (,cvalues ,@(map (g exp vs) l)))))
((and (= (length u) 1) (not op))
(let ((vars (map (lambda (x) (gensym "v")) l))
@@ -1550,12 +1552,12 @@
,@(map (lambda (l v) (make-set vs op l v))
l vars)))))
,f))
- (values ,@(map (g exp vs) l)))))
+ (,cvalues ,@(map (g exp vs) l)))))
((and (= (length l) 1) (not op))
`(begin
,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
- (values ,(exp vs (car l))))))))))
+ (,cvalues ,(exp vs (car l))))))))))
(#:return
((_ x)
@@ -1624,7 +1626,7 @@
(#:None (E 'None))
(#:null ''())
(#:False #f)
- (#:pass `(values))
+ (#:pass `(,cvalues))
(#:break
(C 'break))
(#:continue
@@ -1675,7 +1677,7 @@
(define ,fnm (make-hash-table))
,@(map (lambda (s)
(if (member s (fluid-ref ignore))
- `(values)
+ `(,cvalues)
`(,(C 'var) ,s))) globs)
,@e
(,(C 'export-all)))))
@@ -1696,7 +1698,7 @@
(fluid-set! (@@ (system base message) %dont-warn-list) '())
,@(map (lambda (s)
(if (member s (fluid-ref ignore))
- `(values)
+ `(,cvalues)
`(,(C 'var) ,s))) globs)
,@e)))))
@@ -1854,15 +1856,15 @@
(x #'x)))
(define (is-ec ret x tail)
- (syntax-case x (let-syntax begin let if define @@)
+ (syntax-case x (let-syntax begin let let* if define @@)
((cond (p a ... b) ...)
(equal? (syntax->datum #'cond)
'(@ (guile) cond))
- (or
- (or-map (lambda (x) (is-ec ret x #f))
- #'(a ... ...))
- (or-map (lambda (x) (is-ec ret x tail))
- #'(b ...))))
+ (or
+ (or-map (lambda (x) (is-ec ret x #f))
+ #'(a ... ...))
+ (or-map (lambda (x) (is-ec ret x tail))
+ #'(b ...))))
((with-self u v a ... b)
(equal? (syntax->datum #'with-self)
@@ -1897,6 +1899,13 @@
(or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
(is-ec ret #'b tail)))
+ ((let* ((y x) ...) a ... b)
+ #t
+ (or
+ (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
+ (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
+ (is-ec ret #'b tail)))
+
((define . _)
#t
#f)
@@ -1930,7 +1939,7 @@
((_ ret l)
(let ((code (analyze #'ret #'l)))
(if (is-ec #'ret #'l #t)
- #`(let/ec ret #,code)
+ #`(let/ec ret l)
code))))))
(define-syntax var
@@ -1978,6 +1987,11 @@
(q (apply f q)))
f)))))))
+(define (gen-temp x)
+ (syntax-case x ()
+ ((x ...) (map gen-temp #'(x ...)))
+ (x (car (generate-temporaries (list #'x))))))
+
(define-syntax cfor
(lambda (x)
(syntax-case x ()
@@ -2048,14 +2062,14 @@
(syntax-case x ()
((_ (x ...) (in) code #f #f)
(with-syntax ((inv (gentemp #'in))
- ((xx ...) (generate-temporaries #'(x ...))))
+ ((xx ...) (gen-temp #'(x ...))))
#'(let ((inv (wrap-in in)))
(catch StopIteration
(lambda ()
(let lp ()
(call-with-values (lambda () (next inv))
(clambda (xx ...)
- (set! x xx) ...
+ (cset! x xx) ...
(with-sp ((break (values))
(continue (values)))
code
@@ -2064,14 +2078,14 @@
((_ (x ...) (in ...) code #f #f)
(with-syntax (((inv ...) (generate-temporaries #'(in ...)))
- ((xx ...) (generate-temporaries #'(x ...))))
+ ((xx ...) (gen-temp #'(x ...))))
#'(let ((inv (wrap-in in)) ...)
(catch StopIteration
(lambda ()
(let lp ()
(call-with-values (lambda () (values (next inv) ...))
(clambda (xx ...)
- (set! x xx) ...
+ (cset! x xx) ...
(with-sp ((break (values))
(continue (values)))
code
@@ -2080,7 +2094,7 @@
((_ (x ...) (in) code #f #t)
(with-syntax ((inv (gentemp #'in))
- ((xx ...) (generate-temporaries #'(x ...))))
+ ((xx ...) (gen-temp #'(x ...))))
#'(let ((inv (wrap-in in)))
(let lp ()
(let/ec break-ret
@@ -2088,7 +2102,7 @@
(lambda ()
(call-with-values (lambda () (next inv))
(clambda (xx ...)
- (set! x xx) ...
+ (cset! x xx) ...
(let/ec continue-ret
(with-sp ((break (break-ret))
(continue (continue-ret)))
@@ -2098,7 +2112,7 @@
((_ (x ...) (in ...) code #f #t)
(with-syntax (((inv ...) (generate-temporaries #'(in ...)))
- ((xx ...) (generate-temporaries #'(x ...))))
+ ((xx ...) (gen-temp #'(x ...))))
#'(let ((inv (wrap-in in)) ...)
(let lp ()
(let/ec break-ret
@@ -2106,7 +2120,7 @@
(lambda ()
(call-with-values (lambda () (values (next inv) ...))
(clambda (xx ...)
- (set! x xx) ...
+ (cset! x xx) ...
(let/ec continue-ret
(with-sp ((break (break-ret))
(continue (continue-ret)))
@@ -2129,11 +2143,6 @@
((x ...) #'(values (next x) ...)))
(syntax-case x ()
((x) #'(next x)))))
-
- (define (gen-temp x)
- (syntax-case x ()
- ((x ...) (map gen-temp #'(x ...)))
- (x (car (generate-temporaries (list #'x))))))
(syntax-case x ()
((_ (x ...) (in) code else p)
@@ -2379,14 +2388,26 @@
(define-syntax boolit
- (syntax-rules (and or not < <= > >=)
- ((_ (and x y)) (and (boolit x) (boolit y)))
- ((_ (or x y)) (or (boolit x) (boolit y)))
- ((_ (not x )) (not (boolit x)))
- ((_ (< x y)) (< x y))
- ((_ (<= x y)) (<= x y))
- ((_ (> x y)) (> x y))
- ((_ (>= x y)) (>= x y))
+ (syntax-rules (and eq? equal? or not < <= > >=)
+ ((_ (and x y)) (and (boolit x) (boolit y)))
+ ((_ (or x y)) (or (boolit x) (boolit y)))
+ ((_ (not x )) (not (boolit x)))
+ ((_ (< x y)) (< x y))
+ ((_ (<= x y)) (<= x y))
+ ((_ (> x y)) (> x y))
+ ((_ (>= x y)) (>= x y))
+ ((_ (eq? x y)) (eq? x y))
+ ((_ (equal? x y)) (equal? x y))
+
+ ((_ ((@ (guile) eq? ) x y)) (eq? x y))
+ ((_ ((@ (guile) equal?) x y)) (equal? x y))
+ ((_ ((@ (guile) and ) x y)) (and (boolit x) (boolit y)))
+ ((_ ((@ (guile) or ) x y)) (or (boolit x) (boolit y)))
+ ((_ ((@ (guile) not ) x )) (not (boolit x)))
+ ((_ ((@ (guile) < ) x y)) (< x y))
+ ((_ ((@ (guile) <= ) x y)) (<= x y))
+ ((_ ((@ (guile) > ) x y)) (> x y))
+ ((_ ((@ (guile) >= ) x y)) (>= x y))
((_ #t) #t)
((_ #f) #f)
((_ x ) (bool x))))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 99c4f59..5cdb3d3 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -182,15 +182,14 @@
;;SLICE
-(define-method (pylist-slice (o <p>) n1 n2 n3)
+(define-method (pylist-slice (o <p>) . l)
(aif it (ref o '__getslice__)
- (it n1 n2 n3)
+ (apply it l)
(next-method)))
(define-method (pylist-slice (o <py-list>) n1 n2 n3)
(define N (slot-ref o 'n))
(define (f n) (if (< n 0) (+ N n) n))
-
(let* ((n1 (f (if (eq? n1 None) 0 n1)))
(n2 (f (if (eq? n2 None) (slot-ref o 'n) n2)))
(n3 (f (if (eq? n3 None) 1 n3)))
@@ -425,16 +424,23 @@
(next-method)))
;;POP!
-(define-method (pylist-pop! (o <py-list>))
- (let* ((n (slot-ref o 'n))
- (m (- n 1))
- (vec (slot-ref o 'vec)))
- (if (> n 0)
- (let ((ret (vector-ref vec m)))
- (slot-set! o 'n m)
- (vector-set! vec m #f)
- ret)
- (raise IndexError "pop from empty list"))))
+(define-method (pylist-pop! (o <py-list>) . l)
+ (let ((index (if (null? l)
+ #f
+ (car l))))
+ (if index
+ (let ((x (pylist-ref o index)))
+ (pylist-delete! o index)
+ x)
+ (let* ((n (slot-ref o 'n))
+ (m (- n 1))
+ (vec (slot-ref o 'vec)))
+ (if (> n 0)
+ (let ((ret (vector-ref vec m)))
+ (slot-set! o 'n m)
+ (vector-set! vec m #f)
+ ret)
+ (raise IndexError "pop from empty list"))))))
(define-method (pylist-pop! (o <p>) . l)
(aif it (ref o 'pop)
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 52ec88b..680cf15 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -180,7 +180,9 @@
(let* ((h (slot-ref self 'h))
(l '())
(m (_m self))
- (add (lambda (k . u) (set! l (cons (symbol->string k) l)))))
+ (add (lambda (k . u)
+ (if (not (in "-" (symbol->string k)))
+ (set! l (cons (symbol->string k) l))))))
(hash-for-each add h)
(module-for-each add m)
(py-list l))))
diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm
index 2fac0a1..d9cb1c9 100644
--- a/modules/language/python/module/_python.scm
+++ b/modules/language/python/module/_python.scm
@@ -9,6 +9,8 @@
#:use-module (language python exceptions )
#:use-module ((language python module string ) #:select ())
#:use-module ((language python module io ) #:select (open))
+ #:use-module ((language python module sys )
+ #:select ((stdout . _stdout)))
#:use-module (language python def )
#:use-module (language python for )
#:use-module (language python try )
@@ -57,10 +59,16 @@
(define vars py-dict)
(define print
- (case-lambda
- (() ((@ (guile) display) "\n"))
- ((x) ((@ (guile) display) x ) (print))
- (l ((@ (guile) display) l ) (print))))
+ (lam ((= file _stdout) (* l))
+ (if file (set! file (ref file '_port)))
+ (with-output-to-port file
+ (lambda ()
+ (apply
+ (case-lambda
+ (() ((@ (guile) display) "\n"))
+ ((x) ((@ (guile) display) x ) (print))
+ (l ((@ (guile) display) l ) (print)))
+ l)))))
(define (repr x) ((@ (guile) format) #f "~a" x))
(define abs py-abs)
diff --git a/modules/language/python/module/io.scm b/modules/language/python/module/io.scm
index 87a2ec8..058e62d 100644
--- a/modules/language/python/module/io.scm
+++ b/modules/language/python/module/io.scm
@@ -369,15 +369,18 @@
(define-python-class FileIO (RawIOBase)
(define __init__
(lam (self name (= mode 'r') (= closefd #t) (= opener None))
- (if (pair? name)
- (set self '_port (car name))
- (set self '_port
- (open- (path-it name)
- #:mode mode
- #:closefd closefd
- #:opener opener)))
- (set self 'mode mode)
- (set self 'name (cdr name)))))
+ (if (port? name)
+ (set self '_port name)
+ (begin
+ (if (pair? name)
+ (set self '_port (car name))
+ (set self '_port
+ (open- (path-it name)
+ #:mode mode
+ #:closefd closefd
+ #:opener opener)))
+ (set self 'mode mode)
+ (set self 'name (cdr name)))))))
(define-python-class BytesIO (BufferedIOBase)
diff --git a/modules/language/python/module/optparse.py b/modules/language/python/module/optparse.py
index 886e685..903b374 100644
--- a/modules/language/python/module/optparse.py
+++ b/modules/language/python/module/optparse.py
@@ -210,12 +210,14 @@ class HelpFormatter:
short_first):
self.parser = None
self.indent_increment = indent_increment
+
if width is None:
try:
width = int(os.environ['COLUMNS'])
except (KeyError, ValueError):
width = 80
width -= 2
+
self.width = width
self.help_position = self.max_help_position = \
min(max_help_position, max(width - 20, indent_increment * 2))
@@ -1102,7 +1104,6 @@ class OptionGroup (OptionContainer):
formatter.dedent()
return result
-
class OptionParser (OptionContainer):
"""
@@ -1186,17 +1187,23 @@ class OptionParser (OptionContainer):
add_help_option=True,
prog=None,
epilog=None):
+
OptionContainer.__init__(
self, option_class, conflict_handler, description)
+
self.set_usage(usage)
self.prog = prog
self.version = version
self.allow_interspersed_args = True
self.process_default_values = True
+
if formatter is None:
formatter = IndentedHelpFormatter()
+
self.formatter = formatter
+
self.formatter.set_parser(self)
+
self.epilog = epilog
# Populate the option list; initial sources are the
@@ -1205,10 +1212,8 @@ class OptionParser (OptionContainer):
# _add_help_option() methods.
self._populate_option_list(option_list,
add_help=add_help_option)
-
self._init_parsing_state()
-
def destroy(self):
"""
Declare that you are done with this OptionParser. This cleans up
@@ -1307,14 +1312,12 @@ class OptionParser (OptionContainer):
if not self.process_default_values:
# Old, pre-Optik 1.5 behaviour.
return Values(self.defaults)
-
defaults = self.defaults.copy()
for option in self._get_all_options():
default = defaults.get(option.dest)
if isinstance(default, str):
opt_str = option.get_opt_string()
defaults[option.dest] = option.check_value(opt_str, default)
-
return Values(defaults)
@@ -1367,6 +1370,7 @@ class OptionParser (OptionContainer):
over after parsing options.
"""
rargs = self._get_args(args)
+
if values is None:
values = self.get_default_values()
@@ -1434,7 +1438,7 @@ class OptionParser (OptionContainer):
del rargs[0]
else:
return # stop now, leave this arg in rargs
-
+
# Say this is the original argument list:
# [arg0, arg1, ..., arg(i-1), arg(i), arg(i+1), ..., arg(N-1)]
# ^
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index afed9d1..16ee6e6 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -212,16 +212,29 @@
(define __getitem__
(lambda (self k)
- (let ((r ((@ (guile) getenv) (slot-ref (pystring k) 'str))))
+ (let ((r ((@ (guile) getenv)
+ (catch #t
+ (lambda ()
+ (pystring k))
+ (lambda x
+ (raise (ValueError "cant stringify k in env[x]")))))))
(if r r (raise IndexError)))))
(define __setitem__
- (lambda (self k v)
- ((@ (guile) putenv) (slot-ref (pystring (+ k "=" v)) 'str))))
+ (lambda (self k v)
+ (call-with-values
+ (lambda ()
+ (catch #t
+ (lambda ()
+ (values (pystring k) (pystring v)))
+ (lambda x
+ (raise (ValueError "not stringable in environ")))))
+ (lambda (k v)
+ ((@ (guile) putenv) (pystring (+ k "=" v)))))))
(define __delitem__
(lambda (self k)
- ((@ (guile) putenv) (slot-ref (pystring k) 'str))))
+ ((@ (guile) putenv) (pystring k))))
(define __iter__
(lambda (self)
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 9f8defe..82c0cab 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -14,9 +14,10 @@
[(_ iface _ li)
(let ((l 'li))
(module-for-each
- (lambda (name . l)
+ (lambda (name . l)
(if (not (member name l))
- (module-re-export! (current-module) ((@ (guile) list) name))))
+ (module-re-export! (current-module)
+ ((@ (guile) list) (pk name)))))
(resolve-interface 'iface)))]))
(set! (@ (language python module os) path)
diff --git a/modules/language/python/module/sys.scm b/modules/language/python/module/sys.scm
index ed52118..fe0a4ea 100644
--- a/modules/language/python/module/sys.scm
+++ b/modules/language/python/module/sys.scm
@@ -2,6 +2,7 @@
#:use-module (rnrs bytevectors)
#:use-module (language python exceptions)
#:use-module (language python hash)
+ #:use-module (language python module io)
#:use-module (language python try)
#:use-module (language python module python)
#:use-module (oop pf-objects)
@@ -13,7 +14,7 @@
tarcebacklimit platform maxsize hash_info
base_prefix))
-(define-syntax stdin
+(define-syntax stdin_
(lambda (x)
(syntax-case x (set!)
((set! stdin port)
@@ -22,7 +23,7 @@
(error "sys.stdin is not a function"))
(s #'(current-input-port)))))
-(define-syntax stdout
+(define-syntax stdout_
(lambda (x)
(syntax-case x (set!)
((set! stdin port)
@@ -31,7 +32,7 @@
(error "sys.stdin is not a function"))
(s #'(current-output-port)))))
-(define-syntax stderr
+(define-syntax stderr_
(lambda (x)
(syntax-case x (set!)
((set! stdin port)
@@ -40,6 +41,10 @@
(error "sys.stdin is not a function"))
(s #'(current-error-port)))))
+(define stdin (FileIO stdin_ ))
+(define stderr (FileIO stderr_))
+(define stdout (FileIO stdout_))
+
(define __stdin__ stdin)
(define __stdout__ stdout)
(define __stderr__ stderr)
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 18:17:57 +0000