bugfixes
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 16 Sep 2017 10:28:12 +0000 (12:28 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 16 Sep 2017 10:28:12 +0000 (12:28 +0200)
modules/language/python/for.scm
modules/language/python/yield.scm

index bc0dfbf0e08ec17b7da39db6425923559a824372..bb0afa4f9c07625bf0fa87fefe0e46b869eac7ea 100644 (file)
@@ -40,7 +40,9 @@
        (with-syntax (((It ...)       (generate-temporaries #'(E ...)))
                      ((cc ...)       (generate-temporaries #'(c ...)))
                      (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...)))
-                     (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...))))
+                     (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))
+                     (llp            (if (syntax->datum #'lp) #'lp #'lpu)))
+         
          #`(let/ec lp-break
              (syntax-parameterize ((break (lambda (z)
                                             (syntax-case z ()
                                                #'(lp-break . l))
                                               (_ #'lp-break)))))
                                   
-               (let ((It E) ... (c n) ... (x 'None) ... ... (x1 #f) ... ...)
+               (let ((It (wrap-in E)) ...
+                     (c  n          ) ...
+                     (x  'None      ) ... ...
+                     (x1 #f         ) ... ...)
                  (catch StopIteration
                    (lambda ()
-                     (let lp ((cc c) ...)                                
+                     (let llp ((cc c) ...)                                
                        (set! c cc) ...
                        (call-with-values
                            (lambda () (next It))
@@ -62,7 +67,7 @@
                        ... ...
                        (call-with-values
                            #,(wrap-continue #'lp #'(code ...))
-                         lp)))
+                         (lambda (cc ... . q) (llp cc ...)))))
                    (lambda q fin))))))))))
 
 (define-class <scm-list>   () l)
index 22ad8727f684b87d70c8849615f9a8dd304df9de..95397c70e88d5ba0a9e92460f5b0403da8fc52a0 100644 (file)
@@ -5,9 +5,10 @@
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
   #:replace (send)
-  #:export (<yield> in-yield yield define-generator
-                    make-generator
-                    sendException sendClose))
+  #:export (<yield>
+            in-yield define-generator
+            make-generator
+            sendException sendClose))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
       ((_ x ...)
        #'(begin
            (fluid-set! in-yield #t)
-           abort-to-prompt YIELD x ...))
+           (abort-to-prompt YIELD x ...)))
       (x
        #'(lambda x
            (fluid-set! in-yield #t)
            (apply abort-to-prompt YIELD x))))))
 
-(define-syntax-rule (make-generator (args) code ...)
+(define (make-generator closure)
   (lambda args
     (let ()
       (define obj   (make <yield>))
                      (call-with-prompt
                       ab
                       (lambda ()
-                        code ...
+                        (apply closure yield args)
                         (slot-set! obj 'closed #t)
                         (throw StopIteration))
                       (letrec ((lam
                                 (lambda (k . l)
-                                  (set! in-yield #f)
+                                  (fluid-set! in-yield #f)
                                   (slot-set! obj 'k
                                              (lambda (a)
                                                (call-with-prompt
@@ -58,7 +59,8 @@
         obj))))
 
 (define-syntax-rule (define-generator (f . args) code ...)
-  (define f (make-generator args code ...)))
+  (define f (make-generator args (lambda args code ...))))
+
 (define-class <yield>      () s k closed)
 
 (define-method (send (l <yield>) . u)