haskell: classic program fib.hs + source-order top-level binding (+2 tests, 388/388)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -677,16 +677,22 @@ plus a b = a + b
|
|||||||
hk-bind-decls!
|
hk-bind-decls!
|
||||||
(fn
|
(fn
|
||||||
(env decls)
|
(env decls)
|
||||||
(let ((groups (dict)) (pat-binds (list)))
|
(let
|
||||||
;; Pass 1: collect fun-clause groups by name; collect pat-binds
|
((groups (dict))
|
||||||
;; in source order. Pre-seed env so any name can already be
|
(group-order (list))
|
||||||
;; looked up by closures built in pass 2.
|
(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
|
(for-each
|
||||||
(fn (d)
|
(fn (d)
|
||||||
(cond
|
(cond
|
||||||
((= (first d) "fun-clause")
|
((= (first d) "fun-clause")
|
||||||
(let
|
(let
|
||||||
((name (nth d 1)))
|
((name (nth d 1)))
|
||||||
|
(when (not (has-key? groups name))
|
||||||
|
(append! group-order name))
|
||||||
(dict-set!
|
(dict-set!
|
||||||
groups
|
groups
|
||||||
name
|
name
|
||||||
@@ -703,8 +709,9 @@ plus a b = a + b
|
|||||||
(append! pat-binds d))
|
(append! pat-binds d))
|
||||||
(:else nil)))
|
(:else nil)))
|
||||||
decls)
|
decls)
|
||||||
;; Pass 2: install multifuns for arity > 0; mark 0-arity for
|
;; Pass 2: install multifuns (arity > 0) — order doesn't matter
|
||||||
;; pass 3. The mutable env means recursive references work.
|
;; because they're closures; collect 0-arity names in source
|
||||||
|
;; order for pass 3.
|
||||||
(let ((zero-arity (list)))
|
(let ((zero-arity (list)))
|
||||||
(for-each
|
(for-each
|
||||||
(fn (name)
|
(fn (name)
|
||||||
@@ -717,8 +724,11 @@ plus a b = a + b
|
|||||||
name
|
name
|
||||||
(hk-mk-multifun arity clauses env)))
|
(hk-mk-multifun arity clauses env)))
|
||||||
(:else (append! zero-arity name))))))
|
(:else (append! zero-arity name))))))
|
||||||
(keys groups))
|
group-order)
|
||||||
;; Pass 3: evaluate 0-arity bodies and pat-binds.
|
;; 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
|
(for-each
|
||||||
(fn (name)
|
(fn (name)
|
||||||
(let ((clauses (get groups name)))
|
(let ((clauses (get groups name)))
|
||||||
|
|||||||
45
lib/haskell/tests/program-fib.sx
Normal file
45
lib/haskell/tests/program-fib.sx
Normal file
@@ -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}
|
||||||
15
lib/haskell/tests/programs/fib.hs
Normal file
15
lib/haskell/tests/programs/fib.hs
Normal file
@@ -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
|
||||||
@@ -82,7 +82,7 @@ Key mappings:
|
|||||||
- [x] `seq`, `deepseq` from Prelude
|
- [x] `seq`, `deepseq` from Prelude
|
||||||
- [x] Do-notation for a stub `IO` monad (just threading, no real side effects yet)
|
- [x] Do-notation for a stub `IO` monad (just threading, no real side effects yet)
|
||||||
- [ ] Classic programs in `lib/haskell/tests/programs/`:
|
- [ ] Classic programs in `lib/haskell/tests/programs/`:
|
||||||
- [ ] `fib.hs` — infinite Fibonacci stream
|
- [x] `fib.hs` — infinite Fibonacci stream
|
||||||
- [ ] `sieve.hs` — lazy sieve of Eratosthenes
|
- [ ] `sieve.hs` — lazy sieve of Eratosthenes
|
||||||
- [ ] `quicksort.hs` — naive QS
|
- [ ] `quicksort.hs` — naive QS
|
||||||
- [ ] `nqueens.hs`
|
- [ ] `nqueens.hs`
|
||||||
@@ -114,6 +114,23 @@ Key mappings:
|
|||||||
|
|
||||||
_Newest first._
|
_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
|
- **2026-04-25** — Phase 3 do-notation + stub IO monad. Added a
|
||||||
`hk-desugar-do` pass that follows Haskell 98 §3.14 verbatim:
|
`hk-desugar-do` pass that follows Haskell 98 §3.14 verbatim:
|
||||||
`do { e } = e`, `do { e ; ss } = e >> do { ss }`,
|
`do { e } = e`, `do { e ; ss } = e >> do { ss }`,
|
||||||
|
|||||||
Reference in New Issue
Block a user