diff options
| -rw-r--r-- | modules/language/python/compile.scm | 13 | ||||
| -rw-r--r-- | modules/language/python/exceptions.scm | 6 | ||||
| -rw-r--r-- | modules/language/python/module/python.scm | 15 | ||||
| -rw-r--r-- | modules/language/python/try.scm | 26 | ||||
| -rw-r--r-- | modules/language/python/with.scm | 53 | ||||
| -rw-r--r-- | modules/oop/pf-objects.scm | 1 |
6 files changed, 94 insertions, 20 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 7585a15..49c6a64 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -14,6 +14,7 @@ #:use-module (language python bytes) #:use-module (language python number) #:use-module (language python def) + #:use-module ((language python with) #:select ()) #:use-module (ice-9 pretty-print) #:export (comp)) @@ -35,6 +36,7 @@ (define-inlinable (O x) `(@@ (oop pf-objects) ,x)) (define-inlinable (G x) `(@ (guile) ,x)) (define-inlinable (H x) `(@ (language python hash) ,x)) +(define-inlinable (W x) `(@ (language python with) ,x)) (define s/d 'set!) @@ -706,7 +708,16 @@ (fin (get-addings vs (list fin))) (f (exp vs base))) `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin)))) - + + (#:with + ((_ (l ...) code) + (let ((l (map (lambda (x) + (match x + ((a b) (list (exp vs a) (exp vs b))) + ((b) (list (exp vs b))))) + l))) + `(,(W 'with) ,l ,(exp vs code))))) + (#:if ((_ test a ((tests . as) ...) . else) `(,(G 'cond) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index ce96f16..646a0a3 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -22,12 +22,12 @@ (case-lambda ((self) (values)) - ((self str . l) - (set self 'str str)))) + ((self val . l) + (set self 'value val)))) (define __repr__ (lambda (self) - (aif it (ref self 'str #f) + (aif it (ref self 'value #f) (format #f "~a:~a" (ref self '__name__) it) (format #f "~a" diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index f3b68c1..7022ff1 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -25,11 +25,16 @@ #:use-module (language python tuple ) #:replace (list abs min max hash round) - #:re-export (Exception StopIteration send sendException next - GeneratorExit sendClose RuntimeError - len dir next dict None property range - tuple bytes bytearray - ) + + #:re-export (StopIteration GeneratorExit RuntimeError + Exception ValueError TypeError + IndexError KeyError AttributeError + send sendException next + GeneratorExit sendClose RuntimeError + len dir next dict None property range + tuple bytes bytearray + ) + #:export (print repr complex float int set all any bin callable reversed chr classmethod staticmethod diff --git a/modules/language/python/try.scm b/modules/language/python/try.scm index 9778f3b..a36263b 100644 --- a/modules/language/python/try.scm +++ b/modules/language/python/try.scm @@ -11,17 +11,21 @@ (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define-inlinable (standard-check class obj l) - (if (struct? obj) - (if (is-a? obj <p>) - (if (is-a? class <p>) - (is-a? obj (ref class '__goops__)) - (is-a? obj class)) - (if (is-a? obj <object>) - (is-a? obj class) - (eq? obj class))) - (if (and (procedure? class) (not (pyclass? class))) - (apply class obj l) - (eq? class obj)))) + (cond + ((eq? class #t) + #t) + ((struct? obj) + (if (is-a? obj <p>) + (if (is-a? class <p>) + (is-a? obj (ref class '__goops__)) + (is-a? obj class)) + (if (is-a? obj <object>) + (is-a? obj class) + (eq? obj class)))) + ((and (procedure? class) (not (pyclass? class))) + (apply class obj l)) + (else + (eq? class obj)))) (define (check class obj l) diff --git a/modules/language/python/with.scm b/modules/language/python/with.scm new file mode 100644 index 0000000..eab5c55 --- /dev/null +++ b/modules/language/python/with.scm @@ -0,0 +1,53 @@ +(define-module (language python with) + #:use-module (language python try) + #:use-module (language python exceptions) + #:use-module (oop pf-objects) + #:export (with)) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define-syntax with + (syntax-rules () + ((_ () . code) + (begin . code)) + ((_ (x . l) . code) + (with0 x (with l . code))))) + +(define-syntax with0 + (syntax-rules () + ((_ (id exp) . code) + (let ((type None) + (value None) + (trace None)) + (aif exit (ref exp '__exit__) + (aif enter (ref exp '__enter__) + (try + (lambda () + (let ((id (enter))) . code)) + (#:except #t => + (lambda (tag l) + (set! type (if (pyclass? tag) + tag + (aif it (ref tag '__class__) + it + tag))) + (set! value + (aif it (ref tag 'value) + it + (if (pair? l) + (car l) + None))))) + #:finally + (lambda () + (exit type value trace))) + (raise TypeError "no __enter__ member")) + (raise TypeError "no __exit__ member")))) + + ((_ (exp) . code) + (with0 (id exp) . code)))) + + + + + + diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index d7ca1a3..13edec8 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -238,6 +238,7 @@ explicitly tell it to not update etc. (unx mrefx-py mref-pyq) (unx mrefx-py- mref-py-q) +(define-method (ref x key . l) (if (pair? l) (car l) #f)) (define-method (ref (x <pf> ) key . l) (mref x key l)) (define-method (ref (x <p> ) key . l) (mref- x key l)) (define-method (ref (x <pyf>) key . l) (mref-py x key l)) |