Add RefC StringIterator support

Author: madman-bob

libs/contrib/Data/String/Iterator.idr

@@ -23,6 +23,7 @@ data StringIterator : String -> Type where [external]
 -- to avoid subverting the linearity guarantees of withString.
 %foreign
   "scheme:blodwen-string-iterator-new"
+  "C:stringIteratorNew"
   "javascript:stringIterator:new"
 private
 fromString : (str : String) -> StringIterator str
@@ -37,6 +38,7 @@ withString str f = f (fromString str)
 ||| iterator `it`
 %foreign
   "scheme:blodwen-string-iterator-to-string"
+  "C:stringIteratorToString"
   "javascript:stringIterator:toString"
 export
 withIteratorString : (str : String)
@@ -61,6 +63,7 @@ data UnconsResult : String -> Type where
 -- (e.g. byte offset into an UTF-8 string).
 %foreign
   "scheme:blodwen-string-iterator-next"
+  "C:stringIteratorNext"
   "javascript:stringIterator:next"
 export
 uncons : (str : String) -> (1 it : StringIterator str) -> UnconsResult str

src/Libraries/Data/String/Iterator.idr

@@ -22,6 +22,7 @@ data StringIterator : String -> Type where [external]
 -- to avoid subverting the linearity guarantees of withString.
 %foreign
   "scheme:blodwen-string-iterator-new"
+  "C:stringIteratorNew"
   "javascript:stringIterator:new"
 private
 fromString : (str : String) -> StringIterator str
@@ -49,6 +50,7 @@ data UnconsResult : String -> Type where
 -- (e.g. byte offset into an UTF-8 string).
 %foreign
   "scheme:blodwen-string-iterator-next"
+  "C:stringIteratorNext"
   "javascript:stringIterator:next"
 export
 uncons : (str : String) -> (1 it : StringIterator str) -> UnconsResult str

support/refc/stringOps.c

@@ -185,3 +185,65 @@ char *fastConcat(Value *strList)
 
     return retVal;
 }
+
+typedef struct
+{
+    char *str;
+    int pos;
+} String_Iterator;
+
+Value *stringIteratorNew(char *str)
+{
+    int l = strlen(str);
+
+    String_Iterator *it = (String_Iterator *)malloc(sizeof(String_Iterator));
+    it->str = (char *)malloc(l + 1);
+    it->pos = 0;
+    memcpy(it->str, str, l + 1); // Take a copy of str, in case it gets GCed
+
+    Value_Arglist *arglist = newArglist(2, 2);
+    Value *(*onCollectRaw)(Value_Arglist*) = onCollectStringIterator_arglist;
+    Value_Closure *onCollect = makeClosureFromArglist(onCollectRaw, arglist);
+
+    return (Value *)makeGCPointer(it, onCollect);
+}
+
+Value *onCollectStringIterator(Value_Pointer *ptr, void *null)
+{
+    String_Iterator *it = (String_Iterator *)ptr->p;
+    free(it->str);
+    free(it);
+    return NULL;
+}
+
+Value *onCollectStringIterator_arglist(Value_Arglist *arglist)
+{
+    return onCollectStringIterator(
+        (Value_Pointer *)arglist->args[0],
+        arglist->args[1]
+    );
+}
+
+Value *stringIteratorToString(void *a, char *str, Value *it_p, Value_Closure *f)
+{
+    String_Iterator *it = ((Value_GCPointer *)it_p)->p->p;
+    return apply_closure((Value *)f, (Value *)makeString(it->str + it->pos));
+}
+
+Value *stringIteratorNext(char *s, Value *it_p)
+{
+    String_Iterator *it = (String_Iterator *)((Value_GCPointer *)it_p)->p->p;
+    char c = it->str[it->pos];
+
+    if (c == '\0') {
+        return (Value *)newConstructor(0, 0, "Data_String_Iterator_EOF");
+    }
+
+    it->pos ++; // Ok to do this as StringIterator linear
+
+    Value_Constructor *retVal = newConstructor(2, 1, "Data_String_Iterator_Character");
+    retVal->args[0] = (Value *)makeChar(c);
+    retVal->args[1] = newReference(it_p);
+
+    return (Value *)retVal;
+}

support/refc/stringOps.h

@@ -15,4 +15,10 @@ char *fastPack(Value *charList);
 Value *fastUnpack(char *str);
 char *fastConcat(Value *strList);
 
+Value *stringIteratorNew(char *str);
+Value *onCollectStringIterator(Value_Pointer *ptr, void *null);
+Value *onCollectStringIterator_arglist(Value_Arglist *arglist);
+Value *stringIteratorToString(void *a, char *str, Value *it_p, Value_Closure *f);
+Value *stringIteratorNext(char *s, Value *it_p);
+
 #endif

tests/refc/strings/TestStrings.idr

@@ -1,6 +1,14 @@
 module TestStrings
 
 import Data.String
+import Data.String.Iterator
+
+iteratorTail : String -> String
+iteratorTail str = withString str $ \it => unconsTail str (uncons str it)
+  where
+    unconsTail : (str : String) -> (1 _ : UnconsResult str) -> String
+    unconsTail str EOF = ""
+    unconsTail str (Character _ tailIt) = withIteratorString str tailIt id
 
 main : IO ()
 main = do
@@ -20,13 +28,16 @@ main = do
     putStrLn $ show $ fastUnpack "unpack"
     putStrLn $ fastConcat ["con", "cat", "en", "ate"]
 
-    let chars = ['a', 'A', '~', '0', ' ', '\n', '\x9f']
+    let chars = the (List Char) ['a', 'A', '~', '0', ' ', '\n', '\x9f']
     putStrLn $ show $ map isUpper chars
     putStrLn $ show $ map isLower chars
     putStrLn $ show $ map isDigit chars
     putStrLn $ show $ map isSpace chars
     putStrLn $ show $ map isNL chars
     putStrLn $ show $ map isControl chars
 
-    putStrLn $ show $ map chr [97, 65, 126, 48, 32, 10, 159]
+    putStrLn $ show $ map {f = List} chr [97, 65, 126, 48, 32, 10, 159]
     putStrLn $ show $ map ord chars
+
+    putStrLn $ show $ Data.String.Iterator.unpack "iterator unpack"
+    putStrLn $ show $ iteratorTail "iterator tail"

tests/refc/strings/expected

@@ -16,3 +16,5 @@ concatenate
 [False, False, False, False, False, True, True]
 ['a', 'A', '~', '0', ' ', '\LF', '\159']
 [97, 65, 126, 48, 32, 10, 159]
+['i', 't', 'e', 'r', 'a', 't', 'o', 'r', ' ', 'u', 'n', 'p', 'a', 'c', 'k']
+"terator tail"

tests/refc/strings/run

@@ -1,4 +1,4 @@
-$1 --no-banner --no-color --console-width 0 --cg refc -o refc_strings TestStrings.idr > /dev/null
+$1 --no-banner --no-color --console-width 0 --cg refc -p contrib -o refc_strings TestStrings.idr > /dev/null
 ./build/exec/refc_strings
 
 rm -rf build