haskell: Phase 7 string=[Char] — O(1) string-view head/tail + chr/ord/toUpper/toLower/++ (+35 tests, 810/810)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

lib/haskell/eval.sx

@@ -433,10 +433,10 @@
   (fn
     (a b)
     (cond
+      ((hk-str? a) (str (hk-str-to-native a) (hk-str-to-native b)))
       ((and (list? a) (= (first a) "[]")) b)
       ((and (list? a) (= (first a) ":"))
         (hk-mk-cons (nth a 1) (hk-list-append (nth a 2) b)))
-      ((string? a) (str a b))
       (:else (raise "++: not a list")))))
 
 ;; Eager finite-range spine — handles [from..to] and [from,next..to].
@@ -839,7 +839,12 @@
           (dict-set!
             env
             "ord"
-            (hk-mk-builtin "ord" (fn (c) (char-code (hk-force c))) 1))
+            (hk-mk-builtin
+              "ord"
+              (fn
+                (c)
+                (let ((v (hk-force c))) (if (number? v) v (char-code v))))
+              1))
           (dict-set!
             env
             "isAlpha"
@@ -848,11 +853,13 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool
-                    (or
-                      (and (>= code 65) (<= code 90))
-                      (and (>= code 97) (<= code 122))))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool
+                      (or
+                        (and (>= code 65) (<= code 90))
+                        (and (>= code 97) (<= code 122)))))))
               1))
           (dict-set!
             env
@@ -862,12 +869,14 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool
-                    (or
-                      (and (>= code 65) (<= code 90))
-                      (and (>= code 97) (<= code 122))
-                      (and (>= code 48) (<= code 57))))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool
+                      (or
+                        (and (>= code 65) (<= code 90))
+                        (and (>= code 97) (<= code 122))
+                        (and (>= code 48) (<= code 57)))))))
               1))
           (dict-set!
             env
@@ -877,8 +886,10 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool (and (>= code 48) (<= code 57)))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool (and (>= code 48) (<= code 57))))))
               1))
           (dict-set!
             env
@@ -888,9 +899,11 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool
-                    (or (= code 32) (= code 9) (= code 10) (= code 13)))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool
+                      (or (= code 32) (= code 9) (= code 10) (= code 13))))))
               1))
           (dict-set!
             env
@@ -900,8 +913,10 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool (and (>= code 65) (<= code 90)))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool (and (>= code 65) (<= code 90))))))
               1))
           (dict-set!
             env
@@ -911,15 +926,47 @@
               (fn
                 (c)
                 (let
-                  ((code (char-code (hk-force c))))
-                  (hk-of-bool (and (>= code 97) (<= code 122)))))
+                  ((v (hk-force c)))
+                  (let
+                    ((code (if (number? v) v (char-code v))))
+                    (hk-of-bool (and (>= code 97) (<= code 122))))))
+              1))
+          (dict-set!
+            env
+            "chr"
+            (hk-mk-builtin "chr" (fn (n) (char-from-code (hk-force n))) 1))
+          (dict-set!
+            env
+            "toUpper"
+            (hk-mk-builtin
+              "toUpper"
+              (fn
+                (n)
+                (let
+                  ((code (hk-force n)))
+                  (if (and (>= code 97) (<= code 122)) (- code 32) code)))
+              1))
+          (dict-set!
+            env
+            "toLower"
+            (hk-mk-builtin
+              "toLower"
+              (fn
+                (n)
+                (let
+                  ((code (hk-force n)))
+                  (if (and (>= code 65) (<= code 90)) (+ code 32) code)))
               1))
           (dict-set!
             env
             "digitToInt"
             (hk-mk-builtin
               "digitToInt"
-              (fn (c) (- (char-code (hk-force c)) 48))
+              (fn
+                (c)
+                (let
+                  ((v (hk-force c)))
+                  (- (if (number? v) v (char-code v)) 48)))
               1))
           (dict-set!
             env

lib/haskell/match.sx

@@ -87,45 +87,41 @@
                   ((nil? res) nil)
                   (:else (assoc res (nth pat 1) val)))))
             (:else
-              (let ((fv (hk-force val)))
+              (let
+                ((fv (hk-force val)))
                 (cond
                   ((= tag "p-int")
-                    (if
-                      (and (number? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (number? fv) (= fv (nth pat 1))) env nil))
                   ((= tag "p-float")
-                    (if
-                      (and (number? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (number? fv) (= fv (nth pat 1))) env nil))
                   ((= tag "p-string")
-                    (if
-                      (and (string? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (string? fv) (= fv (nth pat 1))) env nil))
                   ((= tag "p-char")
-                    (if
-                      (and (string? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (string? fv) (= fv (nth pat 1))) env nil))
                   ((= tag "p-con")
                     (let
                       ((pat-name (nth pat 1)) (pat-args (nth pat 2)))
                       (cond
+                        ((and (= pat-name ":") (hk-str? fv) (not (hk-str-null? fv)))
+                          (let
+                            ((str-head (hk-str-head fv))
+                              (str-tail (hk-str-tail fv)))
+                            (let
+                              ((head-pat (nth pat-args 0))
+                                (tail-pat (nth pat-args 1)))
+                              (let
+                                ((res (hk-match head-pat str-head env)))
+                                (cond
+                                  ((nil? res) nil)
+                                  (:else (hk-match tail-pat str-tail res)))))))
                         ((not (hk-is-con-val? fv)) nil)
                         ((not (= (hk-val-con-name fv) pat-name)) nil)
                         (:else
                           (let
                             ((val-args (hk-val-con-args fv)))
                             (cond
-                              ((not (= (len pat-args) (len val-args)))
-                                nil)
-                              (:else
-                                (hk-match-all
-                                  pat-args
-                                  val-args
-                                  env))))))))
+                              ((not (= (len val-args) (len pat-args))) nil)
+                              (:else (hk-match-all pat-args val-args env))))))))
                   ((= tag "p-tuple")
                     (let
                       ((items (nth pat 1)))
@@ -134,13 +130,8 @@
                         ((not (= (hk-val-con-name fv) "Tuple")) nil)
                         ((not (= (len (hk-val-con-args fv)) (len items)))
                           nil)
-                        (:else
-                          (hk-match-all
-                            items
-                            (hk-val-con-args fv)
-                            env)))))
-                  ((= tag "p-list")
-                    (hk-match-list-pat (nth pat 1) fv env))
+                        (:else (hk-match-all items (hk-val-con-args fv) env)))))
+                  ((= tag "p-list") (hk-match-list-pat (nth pat 1) fv env))
                   (:else nil))))))))))
 
 (define
@@ -161,17 +152,26 @@
   hk-match-list-pat
   (fn
     (items val env)
-    (let ((fv (hk-force val)))
+    (let
+      ((fv (hk-force val)))
       (cond
         ((empty? items)
           (if
-            (and
-              (hk-is-con-val? fv)
-              (= (hk-val-con-name fv) "[]"))
+            (or
+              (and (hk-is-con-val? fv) (= (hk-val-con-name fv) "[]"))
+              (and (hk-str? fv) (hk-str-null? fv)))
             env
             nil))
         (:else
           (cond
+            ((and (hk-str? fv) (not (hk-str-null? fv)))
+              (let
+                ((h (hk-str-head fv)) (t (hk-str-tail fv)))
+                (let
+                  ((res (hk-match (first items) h env)))
+                  (cond
+                    ((nil? res) nil)
+                    (:else (hk-match-list-pat (rest items) t res))))))
             ((not (hk-is-con-val? fv)) nil)
             ((not (= (hk-val-con-name fv) ":")) nil)
             (:else
@@ -183,11 +183,7 @@
                     ((res (hk-match (first items) h env)))
                     (cond
                       ((nil? res) nil)
-                      (:else
-                        (hk-match-list-pat
-                          (rest items)
-                          t
-                          res)))))))))))))
+                      (:else (hk-match-list-pat (rest items) t res)))))))))))))
 
 ;; ── Convenience: parse a pattern from source for tests ─────
 ;; (Uses the parser's case-alt entry — `case _ of pat -> 0` —

lib/haskell/runtime.sx

@@ -128,3 +128,48 @@
 (hk-register-con! "LT" 0 "Ordering")
 (hk-register-con! "EQ" 0 "Ordering")
 (hk-register-con! "GT" 0 "Ordering")
+
+(define
+  hk-str?
+  (fn (v) (or (string? v) (and (dict? v) (has-key? v "hk-str")))))
+
+(define
+  hk-str-head
+  (fn
+    (v)
+    (if
+      (string? v)
+      (char-code (char-at v 0))
+      (char-code (char-at (get v "hk-str") (get v "hk-off"))))))
+
+(define
+  hk-str-tail
+  (fn
+    (v)
+    (let
+      ((buf (if (string? v) v (get v "hk-str")))
+        (off (if (string? v) 1 (+ (get v "hk-off") 1))))
+      (if (>= off (string-length buf)) (list "[]") {:hk-off off :hk-str buf}))))
+
+(define
+  hk-str-null?
+  (fn
+    (v)
+    (if
+      (string? v)
+      (= (string-length v) 0)
+      (>= (get v "hk-off") (string-length (get v "hk-str"))))))
+
+(define
+  hk-str-to-native
+  (fn
+    (v)
+    (if
+      (string? v)
+      v
+      (let
+        ((buf (get v "hk-str")) (off (get v "hk-off")))
+        (reduce
+          (fn (acc i) (str acc (char-at buf i)))
+          ""
+          (range off (string-length buf)))))))

lib/haskell/tests/string-char.sx

@@ -0,0 +1,139 @@
+;; String / Char tests — Phase 7 items 1-4.
+;;
+;; Covers:
+;;   hk-str? / hk-str-head / hk-str-tail / hk-str-null?   (runtime helpers)
+;;   chr / ord / toUpper / toLower                          (builtins in eval)
+;;   cons-pattern on strings via match.sx                   (":"-intercept)
+;;   empty-list pattern on strings via match.sx             ("[]"-intercept)
+
+;; ── hk-str? predicate ────────────────────────────────────────────────────
+(hk-test "hk-str? native string" (hk-str? "hello") true)
+
+(hk-test "hk-str? empty string" (hk-str? "") true)
+
+(hk-test "hk-str? view dict" (hk-str? {:hk-off 1 :hk-str "hi"}) true)
+
+(hk-test "hk-str? rejects number" (hk-str? 42) false)
+
+;; ── hk-str-null? predicate ───────────────────────────────────────────────
+(hk-test "hk-str-null? empty string" (hk-str-null? "") true)
+
+(hk-test "hk-str-null? non-empty" (hk-str-null? "a") false)
+
+(hk-test "hk-str-null? exhausted view" (hk-str-null? {:hk-off 2 :hk-str "hi"}) true)
+
+(hk-test "hk-str-null? live view" (hk-str-null? {:hk-off 1 :hk-str "hi"}) false)
+
+;; ── hk-str-head ──────────────────────────────────────────────────────────
+(hk-test "hk-str-head native string" (hk-str-head "hello") 104)
+
+(hk-test "hk-str-head view at offset" (hk-str-head {:hk-off 1 :hk-str "hello"}) 101)
+
+;; ── hk-str-tail ──────────────────────────────────────────────────────────
+(hk-test "hk-str-tail of single char is nil" (hk-str-tail "h") (list "[]"))
+
+(hk-test
+  "hk-str-tail of two-char string is live view"
+  (hk-str-null? (hk-str-tail "hi"))
+  false)
+
+(hk-test
+  "hk-str-tail head of tail of hi is i"
+  (hk-str-head (hk-str-tail "hi"))
+  105)
+
+;; ── chr / ord ────────────────────────────────────────────────────────────
+(hk-test "chr 65 = A" (hk-eval-expr-source "chr 65") "A")
+
+(hk-test "chr 104 = h" (hk-eval-expr-source "chr 104") "h")
+
+(hk-test "ord char literal 'A' = 65" (hk-eval-expr-source "ord 'A'") 65)
+
+(hk-test "ord char literal 'a' = 97" (hk-eval-expr-source "ord 'a'") 97)
+
+(hk-test
+  "ord of head string = char code"
+  (hk-eval-expr-source "ord (head \"hello\")")
+  104)
+
+;; ── toUpper / toLower ────────────────────────────────────────────────────
+(hk-test "toUpper 97 = 65 (a->A)" (hk-eval-expr-source "toUpper 97") 65)
+
+(hk-test
+  "toUpper 65 = 65 (already upper)"
+  (hk-eval-expr-source "toUpper 65")
+  65)
+
+(hk-test
+  "toUpper 48 = 48 (digit unchanged)"
+  (hk-eval-expr-source "toUpper 48")
+  48)
+
+(hk-test "toLower 65 = 97 (A->a)" (hk-eval-expr-source "toLower 65") 97)
+
+(hk-test
+  "toLower 97 = 97 (already lower)"
+  (hk-eval-expr-source "toLower 97")
+  97)
+
+(hk-test
+  "toLower 48 = 48 (digit unchanged)"
+  (hk-eval-expr-source "toLower 48")
+  48)
+
+;; ── Pattern matching on strings ──────────────────────────────────────────
+(hk-test
+  "cons pattern: head of hello = 104"
+  (hk-eval-expr-source "case \"hello\" of { (x:_) -> x }")
+  104)
+
+(hk-test
+  "cons pattern: tail is traversable"
+  (hk-eval-expr-source "case \"hi\" of { (_:xs) -> case xs of { (y:_) -> y } }")
+  105)
+
+(hk-test
+  "empty list pattern matches empty string"
+  (hk-eval-expr-source "case \"\" of { [] -> True; _ -> False }")
+  (list "True"))
+
+(hk-test
+  "empty list pattern fails on non-empty"
+  (hk-eval-expr-source "case \"a\" of { [] -> True; _ -> False }")
+  (list "False"))
+
+(hk-test
+  "cons pattern fails on empty string"
+  (hk-eval-expr-source "case \"\" of { (_:_) -> True; _ -> False }")
+  (list "False"))
+
+;; ── Haskell programs using string traversal ──────────────────────────────
+(hk-test
+  "null prelude on empty string"
+  (hk-eval-expr-source "null \"\"")
+  (list "True"))
+
+(hk-test
+  "null prelude on non-empty string"
+  (hk-eval-expr-source "null \"abc\"")
+  (list "False"))
+
+(hk-test
+  "length of string via cons recursion"
+  (hk-eval-expr-source "let { f [] = 0; f (_:xs) = 1 + f xs } in f \"hello\"")
+  5)
+
+(hk-test
+  "map ord over string gives char codes"
+  (hk-deep-force (hk-eval-expr-source "map ord \"abc\""))
+  (list ":" 97 (list ":" 98 (list ":" 99 (list "[]")))))
+
+(hk-test
+  "map toUpper over char codes then chr"
+  (hk-eval-expr-source "chr (toUpper (ord (head \"abc\")))")
+  "A")
+
+(hk-test
+  "head then ord using prelude head"
+  (hk-eval-expr-source "ord (head \"hello\")")
+  104)