Tune Data.String.Iterator.

libs/contrib/Data/List/Lazy.idr

@@ -8,7 +8,7 @@ module Data.List.Lazy
 public export
 data LazyList : Type -> Type where
   Nil : LazyList a
-  (::) : a -> Lazy (LazyList a) -> LazyList a
+  (::) : (1 x : a) -> (1 xs : Lazy (LazyList a)) -> LazyList a
 
 public export
 Semigroup (LazyList a) where
@@ -53,16 +53,3 @@ public export
 traverse : Applicative f => (a -> f b) -> LazyList a -> f (List b)
 traverse g [] = pure []
 traverse g (x :: xs) = [| g x :: traverse g xs |]
-
--- This function is unsafe because it asserts
--- that the seed gets smaller in every iteration
--- but the type system does not check that.
---
--- Use cautiously.
-public export
-unsafeUnfoldr : (b -> Maybe (a, b)) -> b -> LazyList a
-unsafeUnfoldr next seed =
-  case next seed of
-    Nothing => []
-    Just (x, seed') =>
-      x :: Delay (unsafeUnfoldr next $ assert_smaller seed seed')

libs/contrib/Data/String/Iterator.idr

@@ -4,19 +4,59 @@ import public Data.List.Lazy
 
 %default total
 
+-- Backend-dependent string iteration type.
 export
 data StringIterator : Type where [external]
 
+-- This function is private
+-- to avoid subverting the linearity guarantees of withString.
 %foreign
   "scheme:blodwen-string-iterator-new"
-export
+private
 fromString : String -> StringIterator
 
+-- This function uses a linear string iterator
+-- so that backends can use mutating iterators.
+export
+withString : String -> ((1 it : StringIterator) -> a) -> a
+withString str f = f (fromString str)
+
+-- 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,
+-- and to avoid one allocation per character.
+--
+-- The Char field of Character is unrestricted for flexibility.
+public export
+data UnconsResult : Type where
+  EOF : UnconsResult
+  Character : (c : Char) -> (1 it : StringIterator) -> UnconsResult
+
+-- We pass the whole string to the uncons function
+-- to avoid yet another allocation per character
+-- because for many backends, StringIterator can be simply an integer
+-- (e.g. byte offset into an UTF-8 string).
 %foreign
   "scheme:blodwen-string-iterator-next"
 export
-uncons : StringIterator -> Maybe (Char, StringIterator)
+uncons : String -> (1 it : StringIterator) -> UnconsResult
+
+export
+foldl : (accTy -> Char -> accTy) -> accTy -> String -> accTy
+foldl op acc str = withString str (loop acc)
+  where
+    loop : accTy -> (1 it : StringIterator) -> accTy
+    loop acc it =
+      case uncons str it of
+        EOF => acc
+        Character c it' => loop (acc `op` c) (assert_smaller it it')
 
 export
 unpack : String -> LazyList Char
-unpack = unsafeUnfoldr uncons . fromString
+unpack str = withString str unpack'
+  where
+    unpack' : (1 it : StringIterator) -> LazyList Char
+    unpack' it =
+      case uncons str it of
+        EOF => []
+        Character c it' => c :: Delay (unpack' $ assert_smaller it it')

src/Core/Hash.idr

@@ -58,7 +58,7 @@ Hashable a => Hashable (Maybe a) where
 
 export
 Hashable String where
-  hashWithSalt h = foldl hashWithSalt h . String.Iterator.unpack
+  hashWithSalt h = String.Iterator.foldl hashWithSalt h
 
 export
 Hashable Namespace where

support/chez/support.ss

@@ -87,13 +87,12 @@
               (substring s b end))))
 
 (define (blodwen-string-iterator-new s)
-  (cons s 0))
+  0)
 
-(define (blodwen-string-iterator-next s-ofs)
-  (let ((s (car s-ofs)) (ofs (cdr s-ofs)))
-    (if (>= ofs (string-length s))
-        (vector 0)  ; Nothing
-        (vector 1 (vector 0 (string-ref s ofs) (cons s (+ ofs 1)))))))
+(define (blodwen-string-iterator-next s ofs)
+  (if (>= ofs (string-length s))
+      (vector 0)  ; EOF
+      (vector 1 (string-ref s ofs) (+ ofs 1))))
 
 (define either-left
   (lambda (x)

support/gambit/support.scm

@@ -99,13 +99,12 @@
 (define-macro (get-tag x) `(vector-ref ,x 0))
 
 (define (blodwen-string-iterator-new s)
-  (cons s 0))
+  0)
 
-(define (blodwen-string-iterator-next s-ofs)
-  (let ((s (car s-ofs)) (ofs (cdr s-ofs)))
-    (if (>= ofs (string-length s))
-        (vector 0)  ; Nothing
-        (vector 1 (vector 0 (string-ref s ofs) (cons s (+ ofs 1)))))))
+(define (blodwen-string-iterator-next s ofs)
+  (if (>= ofs (string-length s))
+      (vector 0)  ; EOF
+      (vector 1 (string-ref s ofs) (+ ofs 1))))
 
 ;; These two are only used in this file
 (define-macro (either-left x) `(vector 0 ,x))

support/racket/support.rkt

@@ -78,13 +78,12 @@
           (substring s b end)))
 
 (define (blodwen-string-iterator-new s)
-  (cons s 0))
+  0)
 
-(define (blodwen-string-iterator-next s-ofs)
-  (let ((s (car s-ofs)) (ofs (cdr s-ofs)))
-    (if (>= ofs (string-length s))
-        (vector 0)  ; Nothing
-        (vector 1 (vector 0 (string-ref s ofs) (cons s (+ ofs 1)))))))
+(define (blodwen-string-iterator-next s ofs)
+  (if (>= ofs (string-length s))
+      (vector 0)  ; EOF
+      (vector 1 (string-ref s ofs) (+ ofs 1))))
 
 (define either-left
   (lambda (x)