From 88a40ffe9b1df10e33059b0876a5cd5857145ca2 Mon Sep 17 00:00:00 2001
From: Antti Holvikari <mail@anttih.com>
Date: Wed, 15 May 2024 07:50:58 +0300
Subject: [PATCH] Use string cursor instead of primitive uncons (#10)

* Use string cursor instead of primitive uncons

`pstring-uncons-code-point` was removed in favor of a string cursor
which is much faster.

* Use latest purescm
---
 .github/workflows/ci.yml              |  2 +-
 strings/src/Data/String/CodePoints.ss | 43 ++++++++++++++-------------
 2 files changed, 23 insertions(+), 22 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 98d3f98f..57bb521b 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,7 +21,7 @@ jobs:
           nix_path: nixpkgs=channel:nixos-unstable
 
       - name: Setup PureScript dependencies
-        run: npm i --global purescript@0.15.10 spago@next purescm@next
+        run: npm i --global purescript@0.15.10 spago@next purescm@latest
 
       - name: Build source
         run: spago build
diff --git a/strings/src/Data/String/CodePoints.ss b/strings/src/Data/String/CodePoints.ss
index 94f8d4e2..cc333671 100644
--- a/strings/src/Data/String/CodePoints.ss
+++ b/strings/src/Data/String/CodePoints.ss
@@ -18,8 +18,9 @@
                                  pstring-length-code-points
                                  pstring-ref-code-point
                                  pstring-take-code-points
-                                 pstring-uncons-code-point
-                                 string->pstring)
+                                 pstring-cursor-read-code-point
+                                 pstring->cursor
+                                 cursor->pstring)
     (only (chezscheme) fx1+ fx=?))
 
   (define length pstring-length-code-points)
@@ -33,24 +34,23 @@
       (lambda (Nothing)
         (lambda (index)
           (lambda (s)
-            (let loop ([i 0] [cur s])
-              (if (pstring-empty? cur)
-                Nothing
-                (let-values ([(head tail) (pstring-uncons-code-point cur)])
-                  (if (fx=? i index)
-                    (Just head)
-                    (loop (fx1+ i) tail))))))))))
+            (let ([cur (pstring->cursor s)])
+              (let loop ([i 0] [cp (pstring-cursor-read-code-point cur)])
+                (cond
+                  [(eof-object? cp) Nothing]
+                  [(fx=? i index) (Just cp)]
+                  [else (loop (fx1+ i) (pstring-cursor-read-code-point cur))]))))))))
 
   (define countPrefix
     (lambda (pred)
       (lambda (s)
-        (let loop ([count 0] [rest s])
-          (if (pstring-empty? rest)
-            count
-            (let-values ([(head tail) (pstring-uncons-code-point rest)])
-              (if (pred head)
-                (loop (fx1+ count) tail)
-                count)))))))
+        (let ([cursor (pstring->cursor s)])
+          (let loop ([count 0])
+            (let ([cp (pstring-cursor-read-code-point cursor)])
+              (cond
+                [(eof-object? cp) count]
+                [(pred cp) (loop (fx1+ count))]
+                [else count])))))))
 
   (define fromCodePointArray
     (lambda (cps)
@@ -67,12 +67,13 @@
     (lambda (Just)
       (lambda (Nothing)
         (lambda (s)
-          (if (pstring-empty? s)
-            Nothing
-            (let-values ([(c tail) (pstring-uncons-code-point s)])
+          (let* ([cur (pstring->cursor s)]
+                 [cp (pstring-cursor-read-code-point cur)])
+            (if (eof-object? cp)
+              Nothing
               (Just (list
-                      (cons 'head c)
-                      (cons 'tail tail)))))))))
+                    (cons 'head cp)
+                    (cons 'tail (cursor->pstring cur))))))))))
 
   (define toCodePointArray pstring->code-point-flexvector)