From 4ed7ffe9dd974efa82080db041688630b8dd0529 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 08:53:47 +0000 Subject: [PATCH] haskell: classic program fib.hs + source-order top-level binding (+2 tests, 388/388) --- lib/haskell/eval.sx | 26 ++++++++++++------ lib/haskell/tests/program-fib.sx | 45 +++++++++++++++++++++++++++++++ lib/haskell/tests/programs/fib.hs | 15 +++++++++++ plans/haskell-on-sx.md | 19 ++++++++++++- 4 files changed, 96 insertions(+), 9 deletions(-) create mode 100644 lib/haskell/tests/program-fib.sx create mode 100644 lib/haskell/tests/programs/fib.hs diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index a626180b..4b605ca3 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -677,16 +677,22 @@ plus a b = a + b hk-bind-decls! (fn (env decls) - (let ((groups (dict)) (pat-binds (list))) - ;; Pass 1: collect fun-clause groups by name; collect pat-binds - ;; in source order. Pre-seed env so any name can already be - ;; looked up by closures built in pass 2. + (let + ((groups (dict)) + (group-order (list)) + (pat-binds (list))) + ;; Pass 1: collect fun-clause groups by name; track first-seen + ;; order so pass 3 can evaluate 0-arity bodies in source order + ;; (forward references to other 0-arity definitions still need + ;; the earlier name to be bound first). (for-each (fn (d) (cond ((= (first d) "fun-clause") (let ((name (nth d 1))) + (when (not (has-key? groups name)) + (append! group-order name)) (dict-set! groups name @@ -703,8 +709,9 @@ plus a b = a + b (append! pat-binds d)) (:else nil))) decls) - ;; Pass 2: install multifuns for arity > 0; mark 0-arity for - ;; pass 3. The mutable env means recursive references work. + ;; Pass 2: install multifuns (arity > 0) — order doesn't matter + ;; because they're closures; collect 0-arity names in source + ;; order for pass 3. (let ((zero-arity (list))) (for-each (fn (name) @@ -717,8 +724,11 @@ plus a b = a + b name (hk-mk-multifun arity clauses env))) (:else (append! zero-arity name)))))) - (keys groups)) - ;; Pass 3: evaluate 0-arity bodies and pat-binds. + group-order) + ;; Pass 3: evaluate 0-arity bodies and pat-binds in source + ;; order — forward references to a later 0-arity name will + ;; still see its placeholder (nil) and fail noisily, but the + ;; common case of a top-down program works. (for-each (fn (name) (let ((clauses (get groups name))) diff --git a/lib/haskell/tests/program-fib.sx b/lib/haskell/tests/program-fib.sx new file mode 100644 index 00000000..3271debc --- /dev/null +++ b/lib/haskell/tests/program-fib.sx @@ -0,0 +1,45 @@ +;; fib.hs — infinite Fibonacci stream classic program. +;; +;; The canonical artefact lives at lib/haskell/tests/programs/fib.hs. +;; The source is mirrored here as an SX string because the evaluator +;; doesn't have read-file in the default env. If you change one, keep +;; the other in sync — there's a runner-level cross-check against the +;; expected first-15 list. + +(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-fib-source + "zipPlus (x:xs) (y:ys) = x + y : zipPlus xs ys +zipPlus _ _ = [] +myFibs = 0 : 1 : zipPlus myFibs (tail myFibs) +result = take 15 myFibs +") + +(hk-test + "fib.hs — first 15 Fibonacci numbers" + (hk-as-list (hk-prog-val hk-fib-source "result")) + (list 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377)) + +;; Spot-check that the user-defined zipPlus is also reachable +(hk-test + "fib.hs — zipPlus is a multi-clause user fn" + (hk-as-list + (hk-prog-val + (str hk-fib-source "extra = zipPlus [1, 2, 3] [10, 20, 30]\n") + "extra")) + (list 11 22 33)) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/lib/haskell/tests/programs/fib.hs b/lib/haskell/tests/programs/fib.hs new file mode 100644 index 00000000..beb7ab8e --- /dev/null +++ b/lib/haskell/tests/programs/fib.hs @@ -0,0 +1,15 @@ +-- fib.hs — infinite Fibonacci stream. +-- +-- The classic two-line definition: `fibs` is a self-referential +-- lazy list built by zipping itself with its own tail, summing the +-- pair at each step. Without lazy `:` (cons cell with thunked head +-- and tail) this would diverge before producing any output; with +-- it, `take 15 fibs` evaluates exactly as much of the spine as +-- demanded. + +zipPlus (x:xs) (y:ys) = x + y : zipPlus xs ys +zipPlus _ _ = [] + +myFibs = 0 : 1 : zipPlus myFibs (tail myFibs) + +result = take 15 myFibs diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md index 443f8696..6f92faf4 100644 --- a/plans/haskell-on-sx.md +++ b/plans/haskell-on-sx.md @@ -82,7 +82,7 @@ Key mappings: - [x] `seq`, `deepseq` from Prelude - [x] Do-notation for a stub `IO` monad (just threading, no real side effects yet) - [ ] Classic programs in `lib/haskell/tests/programs/`: - - [ ] `fib.hs` — infinite Fibonacci stream + - [x] `fib.hs` — infinite Fibonacci stream - [ ] `sieve.hs` — lazy sieve of Eratosthenes - [ ] `quicksort.hs` — naive QS - [ ] `nqueens.hs` @@ -114,6 +114,23 @@ Key mappings: _Newest first._ +- **2026-04-25** — First classic program: `fib.hs`. Canonical Haskell + source lives at `lib/haskell/tests/programs/fib.hs` (the + two-cons-cell self-referential fibs definition plus a hand-rolled + `zipPlus`). The runner at `lib/haskell/tests/program-fib.sx` + mirrors the source as an SX string (the OCaml server's + `read-file` lives in the page-helpers env, not the default load + env, so direct file reads from inside `eval` aren't available). + Tests: `take 15 myFibs == [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377]`, + plus a spot-check that the user-defined `zipPlus` is also + reachable. Found and fixed an ordering bug in `hk-bind-decls!`: + pass 3 (0-arity body evaluation) iterated `(keys groups)` whose + order is implementation-defined, so a top-down program where + `result = take 15 myFibs` came after `myFibs = …` could see + `myFibs` still bound to its `nil` placeholder. Now group names + are tracked in source order via a parallel list and pass 3 walks + that. 388/388 green. + - **2026-04-25** — Phase 3 do-notation + stub IO monad. Added a `hk-desugar-do` pass that follows Haskell 98 §3.14 verbatim: `do { e } = e`, `do { e ; ss } = e >> do { ss }`,