From 2050e8565493ca0491ae4b4c44764eda56626427 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Fri, 16 Mar 2018 23:50:39 +0100
Subject: os module now compiles

---
 modules/language/python/for.scm | 39 +++++++++++++++++++++++++--------------
 1 file changed, 25 insertions(+), 14 deletions(-)

(limited to 'modules/language/python/for.scm')

diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index 4541df2..fcd562b 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -18,44 +18,55 @@
 (define-syntax for
   (syntax-rules (:)
     ((for ((x ... : E) ...) ((c n) ...) code ... #:final fin)
-     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin))
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+
+    ((for ((x ... : E) ...) ((c n) ...) code ... #:else fin)
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values)
+               (lambda () fin)))
     
     ((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin)
-     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin))
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+
+    ((for lp ((x ... : E) ...) ((c n) ...) code ... #:else fin)
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values)
+               (lambda () fin)))
     
     ((for ((x ... : E) ...) ((c n) ...) code ...)
-     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values)))
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values) values))
     
     ((for lp ((x ... : E) ...) ((c n) ...) code ...)
-     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values)))))
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values) values))))
     
 (define-syntax for-work
-  (lambda (x)
+  (lambda (z)
     (define (wrap-continue lp code)
       (if (syntax->datum lp)
           #`(lambda () (let/ec #,lp #,@code))
           #`(lambda ()              #,@code)))
       
-    (syntax-case x ()
-      ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin)
+    (syntax-case z ()
+      ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin er)
        (with-syntax (((It ...)       (generate-temporaries #'(E ...)))
                      ((cc ...)       (generate-temporaries #'(c ...)))
                      (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      ((N ...)        (map length #'((x ...) ...)))
+                     (else-          (datum->syntax #'for 'else-))
                      (llp            (if (syntax->datum #'lp) #'lp #'lpu)))
          
-         #`(let/ec lp-break
+         #`(let/ec lp-break0                                  
+             (let ((It    (wrap-in E)) ...
+                   (c     n          ) ...
+                   (x     'None      ) ... ...
+                   (x1    #f         ) ... ...)
+             (let* ((else-    er      )
+                    (lp-break (lambda q (else-) (apply lp-break0 q))))
              (syntax-parameterize ((break (lambda (z)
                                             (syntax-case z ()
                                               ((_ . l)
                                                #'(lp-break . l))
                                               (_ #'lp-break)))))
-                                  
-               (let ((It (wrap-in E)) ...
-                     (c  n          ) ...
-                     (x  'None      ) ... ...
-                     (x1 #f         ) ... ...)
+
                  (catch StopIteration
                    (lambda ()
                      (let llp ((cc c) ...)                                
@@ -81,7 +92,7 @@
 			      #'lp
 			      #'((let ((x x) ... ...) code ...)))
                          (lambda (cc ... . q) (llp cc ...)))))
-                   (lambda q fin))))))))))
+                   (lambda q (else-) fin)))))))))))
 
 (define-class <scm-list>   () l)
 (define-class <scm-string> () s i)
-- 
cgit v1.2.3