From 685fcd11d5af59932a9ccf101554275869e83ebc Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 21:45:23 +0000 Subject: [PATCH] =?UTF-8?q?haskell:=20Phase=207=20conformance=20=E2=80=94?= =?UTF-8?q?=20runlength-str.hs=20+=20++=20thunk-tail=20fix=20(+9=20tests,?= =?UTF-8?q?=209/9)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Sonnet 4.6 --- lib/haskell/conformance.sh | 2 +- lib/haskell/eval.sx | 14 ++-- lib/haskell/tests/program-runlength-str.sx | 83 ++++++++++++++++++++++ plans/haskell-completeness.md | 15 +++- 4 files changed, 106 insertions(+), 8 deletions(-) create mode 100644 lib/haskell/tests/program-runlength-str.sx diff --git a/lib/haskell/conformance.sh b/lib/haskell/conformance.sh index dba69251..6249f8fc 100755 --- a/lib/haskell/conformance.sh +++ b/lib/haskell/conformance.sh @@ -20,7 +20,7 @@ if [ ! -x "$SX_SERVER" ]; then fi fi -PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers caesar) +PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers caesar runlength-str) PASS_COUNTS=() FAIL_COUNTS=() diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index 0a59fb17..f11de7fe 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -432,12 +432,14 @@ hk-list-append (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))) - (:else (raise "++: not a list"))))) + (let + ((a (hk-force a))) + (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))) + (:else (raise "++: not a list")))))) ;; Eager finite-range spine — handles [from..to] and [from,next..to]. ;; Step direction is governed by the sign of `step`; when step > 0 we diff --git a/lib/haskell/tests/program-runlength-str.sx b/lib/haskell/tests/program-runlength-str.sx new file mode 100644 index 00000000..bfcca36f --- /dev/null +++ b/lib/haskell/tests/program-runlength-str.sx @@ -0,0 +1,83 @@ +;; runlength-str.hs — run-length encoding on a String. +;; Source: https://rosettacode.org/wiki/Run-length_encoding#Haskell (adapted). +;; +;; Exercises String pattern matching `(x:xs)`, `span` over a string view, +;; tuple construction `(Int, Char)`, character equality, and tuple-in-cons +;; patterns `((n, c) : rest)` — all enabled by Phase 7 string=[Char]. + +(define + hk-prog-val + (fn + (src name) + (hk-deep-force (get (hk-eval-program (hk-core src)) name)))) + +(define + hk-as-list + (fn + (xs) + (cond + ((and (list? xs) (= (first xs) "[]")) (list)) + ((and (list? xs) (= (first xs) ":")) + (cons (nth xs 1) (hk-as-list (nth xs 2)))) + (:else xs)))) + +(define + hk-rle-source + "encodeRL [] = []\nencodeRL (x:xs) = let (same, rest) = span eqX xs\n eqX y = y == x\n in (1 + length same, x) : encodeRL rest\n\nreplicateRL 0 _ = []\nreplicateRL n c = c : replicateRL (n - 1) c\n\ndecodeRL [] = []\ndecodeRL ((n, c) : rest) = replicateRL n c ++ decodeRL rest\n") + +(hk-test + "rle.hs — encodeRL [] = []" + (hk-as-list (hk-prog-val (str hk-rle-source "r = encodeRL \"\"\n") "r")) + (list)) + +(hk-test + "rle.hs — length (encodeRL \"aabbbcc\") = 3" + (hk-prog-val (str hk-rle-source "r = length (encodeRL \"aabbbcc\")\n") "r") + 3) + +(hk-test + "rle.hs — map fst (encodeRL \"aabbbcc\") = [2,3,2]" + (hk-as-list + (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"aabbbcc\")\n") "r")) + (list 2 3 2)) + +(hk-test + "rle.hs — map snd (encodeRL \"aabbbcc\") = [97,98,99]" + (hk-as-list + (hk-prog-val (str hk-rle-source "r = map snd (encodeRL \"aabbbcc\")\n") "r")) + (list 97 98 99)) + +(hk-test + "rle.hs — counts of encodeRL \"aabbbccddddee\" = [2,3,2,4,2]" + (hk-as-list + (hk-prog-val + (str hk-rle-source "r = map fst (encodeRL \"aabbbccddddee\")\n") + "r")) + (list 2 3 2 4 2)) + +(hk-test + "rle.hs — chars of encodeRL \"aabbbccddddee\" = [97,98,99,100,101]" + (hk-as-list + (hk-prog-val + (str hk-rle-source "r = map snd (encodeRL \"aabbbccddddee\")\n") + "r")) + (list 97 98 99 100 101)) + +(hk-test + "rle.hs — singleton encodeRL \"x\"" + (hk-as-list + (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"x\")\n") "r")) + (list 1)) + +(hk-test + "rle.hs — decodeRL round-trip preserves \"aabbbcc\"" + (hk-as-list + (hk-prog-val (str hk-rle-source "r = decodeRL (encodeRL \"aabbbcc\")\n") "r")) + (list 97 97 98 98 98 99 99)) + +(hk-test + "rle.hs — replicateRL 4 65 = [65,65,65,65]" + (hk-as-list (hk-prog-val (str hk-rle-source "r = replicateRL 4 65\n") "r")) + (list 65 65 65 65)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/plans/haskell-completeness.md b/plans/haskell-completeness.md index 28ba1e20..7dfacaac 100644 --- a/plans/haskell-completeness.md +++ b/plans/haskell-completeness.md @@ -89,7 +89,7 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. - [x] Tests in `lib/haskell/tests/string-char.sx` (≥ 15 tests: head/tail on string literal, map over string, filter chars, chr/ord roundtrip, toUpper, toLower, null/empty string view). -- [ ] Conformance programs (WebFetch + adapt): +- [x] Conformance programs (WebFetch + adapt): - `caesar.hs` — Caesar cipher. Exercises `map`, `chr`, `ord`, `toUpper`, `toLower` on characters. - `runlength-str.hs` — run-length encoding on a String. Exercises string @@ -284,6 +284,19 @@ No OCaml changes are needed. The view type is fully representable as an SX dict. _Newest first._ +**2026-05-06** — Phase 7 conformance complete (runlength-str.hs) + `++` thunk fix: +- New `lib/haskell/tests/program-runlength-str.sx` (9 tests). Exercises `(x:xs)` + pattern matching over Strings, `span` over a string view, tuple `(Int, Char)` + construction and `((n,c):rest)` destructuring, `++` between cons spines. +- `runlength-str` added to `PROGRAMS` in `conformance.sh`. +- `eval.sx`: `hk-list-append` now `(hk-force a)` on entry. Pre-existing latent + bug — when a cons's tail was a thunk (e.g. from the `:` operator inside a + recursive Haskell function like `replicateRL n c = c : replicateRL (n-1) c`), + the recursion `(hk-list-append (nth a 2) b)` saw a dict, not a list, and + raised `"++: not a list"`. Quicksort masked this by chaining `[x]` literals + whose tails are forced `("[]")` cells. Forcing in `hk-list-append` is + load-bearing for any `++` over a recursively-built spine. + **2026-05-06** — Phase 7 conformance (caesar.hs): - New `lib/haskell/tests/program-caesar.sx` (8 tests). Caesar cipher exercising `chr`, `ord`, `isUpper`, `isLower`, `mod`, `map`, and `(x:xs)` pattern matching