From 24009e6db017602198f2f7e344fd9d0b6f084a5a Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Thu, 7 Sep 2017 23:03:08 +0200
Subject: string loops

---
 modules/language/python/compile.scm | 50 ++++++++++++++++++++++++++-----------
 1 file changed, 35 insertions(+), 15 deletions(-)

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 7785195..ce503d9 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -716,15 +716,16 @@
     ((_ (x) (a) code next #f)
      (if (pair? a)
          (let/ec break-ret
-         (let ((x (let lp ((l a) (old #f))
-                    (if (pair? l)
-                        (let ((x (car l)))
-                          (with-sp ((continue (lp (cdr l) x))
-                                    (break    (break-ret)))
-                              code
-                              (lp (cdr l))))
-                        old))))
-           next)
+           (let ((x (let lp ((l a) (old #f))
+                      (if (pair? l)                          
+                          (let ((x (car l)))
+                            (let/ec continue-ret
+                              (with-sp ((continue (continue-ret))
+                                        (break    (break-ret)))
+                                code))
+                            (lp (cdr l)))
+                          old))))
+             next))
          (for/adv1 (x) (a) code next #f)))
     
     ((_ x a code next p)
@@ -815,7 +816,8 @@
                      (lambda (x ...) else)))))))))))
     
 
-(define-class <scm-list> () (x) l)
+(define-class <scm-list>   () (x) l)
+(define-class <scm-string> () (x) s i)
 
 (define-method (next (l <scm-list>))
   (let ((ll (slot-ref l 'l)))
@@ -825,10 +827,28 @@
           (car ll))
         #:nil)))
 
+(define-method (next (l <scm-string>))
+  (let ((s (slot-ref l 's))
+        (i (slot-ref l 'i)))
+    (if (= i (string-length s))
+        #:nil
+        (begin
+          (slot-set! l 'i (+ i 1))
+          (string-ref s i)))))
+
 (define (wrap-in x)
-  (if (pair? x)
-      (let ((o (make <scm-list>)))
-        (slot-set! o 'l x)
-        o)
-      x))
+  (cond
+   ((pair? x)
+    (let ((o (make <scm-list>)))
+      (slot-set! o 'l x)
+      o))
+   
+   ((string? x)
+    (let ((o (make <scm-string>)))
+      (slot-set! o 's x)
+      (slot-set! o 'i 0)
+      o))
+   
+    (else
+     x)))
 
-- 
cgit v1.2.3