with
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 17 Oct 2017 13:32:46 +0000 (15:32 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 17 Oct 2017 13:32:46 +0000 (15:32 +0200)
modules/language/python/compile.scm
modules/language/python/exceptions.scm
modules/language/python/module/python.scm
modules/language/python/try.scm
modules/language/python/with.scm [new file with mode: 0644]
modules/oop/pf-objects.scm

index 7585a1521001274bf29b223333a231ad50089368..49c6a6499eb11a8be3e5b280c3fa54dbf59ab5bf 100644 (file)
@@ -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!)
 
          (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)
index ce96f160540d4f2c304f088150675341615010e5..646a0a383939e89802a31fe263e486e195065f37 100644 (file)
     (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"
index f3b68c1a1bd59066a64a3f8e4eb1d918432f235d..7022ff1e16787e6b84d8b95ee0268d2c8a426bfd 100644 (file)
   #: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
index 9778f3ba6b40ddbe4b07560d27c8f5d41c5edf4c..a36263b029102fe5f27c2b0a7f367b209528f366 100644 (file)
 (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 (file)
index 0000000..eab5c55
--- /dev/null
@@ -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))))
+                 
+         
+     
+                 
+
+  
index d7ca1a3d3eed9c4b7a2cf06d644abffd8ae1c93c..13edec89cbdc6b7b8fb9d18c4833adc79bff5ce0 100644 (file)
@@ -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))