haskell: Phase 7 conformance — runlength-str.hs + ++ thunk-tail fix (+9 tests, 9/9)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -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=()
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
83
lib/haskell/tests/program-runlength-str.sx
Normal file
83
lib/haskell/tests/program-runlength-str.sx
Normal file
@@ -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}
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user