From 79d0cd1ba696844f82361a231d4cd7c71f7bc8bc Mon Sep 17 00:00:00 2001
From: russoul <russoulmc@gmail.com>
Date: Thu, 31 Dec 2020 20:36:07 +0300
Subject: [PATCH] Add withIteratorString

---
 libs/contrib/Data/String/Iterator.idr | 11 +++++++++++
 src/Compiler/ES/ES.idr                | 22 ++++++++++------------
 support/chez/support.ss               |  3 +++
 support/gambit/support.scm            |  3 +++
 support/racket/support.rkt            |  3 +++
 5 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/libs/contrib/Data/String/Iterator.idr b/libs/contrib/Data/String/Iterator.idr
index c6066c510..1646e43c8 100644
--- a/libs/contrib/Data/String/Iterator.idr
+++ b/libs/contrib/Data/String/Iterator.idr
@@ -32,6 +32,17 @@ export
 withString : (str : String) -> ((1 it : StringIterator str) -> a) -> a
 withString str f = f (fromString str)
 
+||| Runs the action `f` on the slice `res` of the original string `str` represented by the
+||| iterator `it`
+%foreign
+  "scheme:blodwen-string-iterator-to-string"
+  "javascript:stringIterator:toString"
+export
+withIteratorString : (str : String)
+                  -> (1 it : StringIterator str)
+                  -> (f : (res : String) -> a)
+                  -> a
+
 -- We use a custom data type instead of Maybe (Char, StringIterator)
 -- to remove one level of pointer indirection
 -- in every iteration of something that's likely to be a hot loop,
diff --git a/src/Compiler/ES/ES.idr b/src/Compiler/ES/ES.idr
index 026acb5dc..4b2f4ea54 100644
--- a/src/Compiler/ES/ES.idr
+++ b/src/Compiler/ES/ES.idr
@@ -78,19 +78,16 @@ addStringIteratorToPreamble =
   do
     let defs = "
 function __prim_stringIteratorNew(str) {
-  return str[Symbol.iterator]();
+  return 0;
+}
+function __prim_stringIteratorToString(_, str, it, f) {
+  return f(str.slice(it));
 }
 function __prim_stringIteratorNext(str, it) {
-  const char = it.next();
-  if (char.done) {
-    return {h: 0}; // EOF
-  } else {
-    return {
-      h: 1, // Character
-      a1: char.value,
-      a2: it
-    };
-  }
+  if (it >= str.length)
+    return {h: 0};
+  else
+    return {h: 1, a1: str.charAt(it), a2: it + 1};
 }"
     let name = "stringIterator"
     let newName = esName name
@@ -351,7 +348,8 @@ makeForeign n x =
           case def of
             "new" => pure $ "const " ++ jsName n ++ " = __prim_stringIteratorNew;\n"
             "next" => pure $ "const " ++ jsName n ++ " = __prim_stringIteratorNext;\n"
-            _ => throw (InternalError $ "invalid string iterator function: " ++ def ++ ", supported functions are \"new\", \"next\"")
+            "toString" => pure $ "const " ++ jsName n ++ " = __prim_stringIteratorToString;\n"
+            _ => throw (InternalError $ "invalid string iterator function: " ++ def ++ ", supported functions are \"new\", \"next\", \"toString\"")
 
 
       _ => throw (InternalError $ "invalid foreign type : " ++ ty ++ ", supported types are \"lambda\", \"lambdaRequire\", \"support\"")
diff --git a/support/chez/support.ss b/support/chez/support.ss
index 82cf4b784..9213e6b11 100644
--- a/support/chez/support.ss
+++ b/support/chez/support.ss
@@ -89,6 +89,9 @@
 (define (blodwen-string-iterator-new s)
   0)
 
+(define (blodwen-string-iterator-to-string _ s ofs f)
+  (f (substring s ofs (string-length s))))
+
 (define (blodwen-string-iterator-next s ofs)
   (if (>= ofs (string-length s))
       (vector 0)  ; EOF
diff --git a/support/gambit/support.scm b/support/gambit/support.scm
index f5e22d5df..6e3c43747 100644
--- a/support/gambit/support.scm
+++ b/support/gambit/support.scm
@@ -101,6 +101,9 @@
 (define (blodwen-string-iterator-new s)
   0)
 
+(define (blodwen-string-iterator-to-string _ s ofs f)
+  (f (substring s ofs (string-length s))))
+
 (define (blodwen-string-iterator-next s ofs)
   (if (>= ofs (string-length s))
       (vector 0)  ; EOF
diff --git a/support/racket/support.rkt b/support/racket/support.rkt
index 62ba77261..b4ab68e8c 100644
--- a/support/racket/support.rkt
+++ b/support/racket/support.rkt
@@ -80,6 +80,9 @@
 (define (blodwen-string-iterator-new s)
   0)
 
+(define (blodwen-string-iterator-to-string _ s ofs f)
+  (f (substring s ofs (string-length s))))
+
 (define (blodwen-string-iterator-next s ofs)
   (if (>= ofs (string-length s))
       (vector 0)  ; EOF