haskell: lazy : + ranges + Prelude (repeat/iterate/fibs/take, +25 tests, 359/359)
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:
@@ -258,6 +258,31 @@
|
||||
((= tag "list")
|
||||
(hk-mk-list
|
||||
(map (fn (e) (hk-eval e env)) (nth node 1))))
|
||||
((= tag "range")
|
||||
(let
|
||||
((from (hk-force (hk-eval (nth node 1) env)))
|
||||
(to (hk-force (hk-eval (nth node 2) env))))
|
||||
(hk-build-range from to 1)))
|
||||
((= tag "range-step")
|
||||
(let
|
||||
((from (hk-force (hk-eval (nth node 1) env)))
|
||||
(nxt (hk-force (hk-eval (nth node 2) env)))
|
||||
(to (hk-force (hk-eval (nth node 3) env))))
|
||||
(hk-build-range from to (- nxt from))))
|
||||
((= tag "range-from")
|
||||
;; [from..] = iterate (+ 1) from — uses the Prelude.
|
||||
(hk-eval
|
||||
(list
|
||||
:app
|
||||
(list
|
||||
:app
|
||||
(list :var "iterate")
|
||||
(list
|
||||
:sect-right
|
||||
"+"
|
||||
(list :int 1)))
|
||||
(nth node 1))
|
||||
env))
|
||||
((= tag "sect-left")
|
||||
(hk-eval-sect-left (nth node 1) (nth node 2) env))
|
||||
((= tag "sect-right")
|
||||
@@ -383,10 +408,20 @@
|
||||
hk-eval-op
|
||||
(fn
|
||||
(op left right env)
|
||||
(let
|
||||
((lv (hk-force (hk-eval left env)))
|
||||
(rv (hk-force (hk-eval right env))))
|
||||
(hk-binop op lv rv))))
|
||||
(cond
|
||||
;; Cons is non-strict in both args: build a cons cell whose
|
||||
;; head and tail are deferred. This is what makes `repeat x =
|
||||
;; x : repeat x` and `fibs = 0 : 1 : zipWith (+) fibs (tail
|
||||
;; fibs)` terminate.
|
||||
((= op ":")
|
||||
(hk-mk-cons
|
||||
(hk-mk-thunk left env)
|
||||
(hk-mk-thunk right env)))
|
||||
(:else
|
||||
(let
|
||||
((lv (hk-force (hk-eval left env)))
|
||||
(rv (hk-force (hk-eval right env))))
|
||||
(hk-binop op lv rv))))))
|
||||
|
||||
(define
|
||||
hk-list-append
|
||||
@@ -398,6 +433,20 @@
|
||||
(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
|
||||
;; stop at to; when step < 0 we stop at to going down.
|
||||
(define
|
||||
hk-build-range
|
||||
(fn
|
||||
(from to step)
|
||||
(cond
|
||||
((and (> step 0) (> from to)) (hk-mk-nil))
|
||||
((and (< step 0) (< from to)) (hk-mk-nil))
|
||||
((= step 0) (hk-mk-nil))
|
||||
(:else
|
||||
(hk-mk-cons from (hk-build-range (+ from step) to step))))))
|
||||
|
||||
(define
|
||||
hk-binop
|
||||
(fn
|
||||
@@ -453,6 +502,63 @@
|
||||
cenv)))))
|
||||
|
||||
;; ── Top-level program evaluation ────────────────────────────
|
||||
;; Operator-as-value built-ins — let `(+)`, `(*)`, etc. work as
|
||||
;; first-class functions for `zipWith (+)` and friends. Strict in
|
||||
;; both args (built-ins are forced via hk-apply-builtin).
|
||||
(define
|
||||
hk-make-binop-builtin
|
||||
(fn
|
||||
(name op-name)
|
||||
(hk-mk-builtin
|
||||
name
|
||||
(fn (a b) (hk-binop op-name a b))
|
||||
2)))
|
||||
|
||||
;; Inline Prelude source — loaded into the initial env so simple
|
||||
;; programs can use `head`, `take`, `repeat`, etc. without each
|
||||
;; user file redefining them. The Prelude itself uses lazy `:` for
|
||||
;; the recursive list-building functions.
|
||||
(define
|
||||
hk-prelude-src
|
||||
"head (x:_) = x
|
||||
tail (_:xs) = xs
|
||||
fst (a, _) = a
|
||||
snd (_, b) = b
|
||||
take 0 _ = []
|
||||
take _ [] = []
|
||||
take n (x:xs) = x : take (n - 1) xs
|
||||
drop 0 xs = xs
|
||||
drop _ [] = []
|
||||
drop n (_:xs) = drop (n - 1) xs
|
||||
repeat x = x : repeat x
|
||||
iterate f x = x : iterate f (f x)
|
||||
length [] = 0
|
||||
length (_:xs) = 1 + length xs
|
||||
map _ [] = []
|
||||
map f (x:xs) = f x : map f xs
|
||||
filter _ [] = []
|
||||
filter p (x:xs) = if p x then x : filter p xs else filter p xs
|
||||
zipWith _ [] _ = []
|
||||
zipWith _ _ [] = []
|
||||
zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys
|
||||
fibs = 0 : 1 : zipWith plus fibs (tail fibs)
|
||||
plus a b = a + b
|
||||
")
|
||||
|
||||
(define
|
||||
hk-load-into!
|
||||
(fn
|
||||
(env src)
|
||||
(let ((ast (hk-core src)))
|
||||
(hk-register-program! ast)
|
||||
(let
|
||||
((decls
|
||||
(cond
|
||||
((= (first ast) "program") (nth ast 1))
|
||||
((= (first ast) "module") (nth ast 4))
|
||||
(:else (list)))))
|
||||
(hk-bind-decls! env decls)))))
|
||||
|
||||
(define
|
||||
hk-init-env
|
||||
(fn
|
||||
@@ -477,6 +583,21 @@
|
||||
env
|
||||
"id"
|
||||
(hk-mk-builtin "id" (fn (x) x) 1))
|
||||
;; Operators as first-class values
|
||||
(dict-set! env "+" (hk-make-binop-builtin "+" "+"))
|
||||
(dict-set! env "-" (hk-make-binop-builtin "-" "-"))
|
||||
(dict-set! env "*" (hk-make-binop-builtin "*" "*"))
|
||||
(dict-set! env "/" (hk-make-binop-builtin "/" "/"))
|
||||
(dict-set! env "==" (hk-make-binop-builtin "==" "=="))
|
||||
(dict-set! env "/=" (hk-make-binop-builtin "/=" "/="))
|
||||
(dict-set! env "<" (hk-make-binop-builtin "<" "<"))
|
||||
(dict-set! env "<=" (hk-make-binop-builtin "<=" "<="))
|
||||
(dict-set! env ">" (hk-make-binop-builtin ">" ">"))
|
||||
(dict-set! env ">=" (hk-make-binop-builtin ">=" ">="))
|
||||
(dict-set! env "&&" (hk-make-binop-builtin "&&" "&&"))
|
||||
(dict-set! env "||" (hk-make-binop-builtin "||" "||"))
|
||||
(dict-set! env "++" (hk-make-binop-builtin "++" "++"))
|
||||
(hk-load-into! env hk-prelude-src)
|
||||
env)))
|
||||
|
||||
(define
|
||||
|
||||
@@ -473,10 +473,16 @@
|
||||
((hk-match? "reservedop" "..")
|
||||
(do
|
||||
(hk-advance!)
|
||||
(let
|
||||
((end-e (hk-parse-expr-inner)))
|
||||
(hk-expect! "rbracket" nil)
|
||||
(list :range first-e end-e))))
|
||||
(cond
|
||||
((hk-match? "rbracket" nil)
|
||||
(do
|
||||
(hk-advance!)
|
||||
(list :range-from first-e)))
|
||||
(:else
|
||||
(let
|
||||
((end-e (hk-parse-expr-inner)))
|
||||
(hk-expect! "rbracket" nil)
|
||||
(list :range first-e end-e))))))
|
||||
((hk-match? "reservedop" "|")
|
||||
(do
|
||||
(hk-advance!)
|
||||
|
||||
137
lib/haskell/tests/infinite.sx
Normal file
137
lib/haskell/tests/infinite.sx
Normal file
@@ -0,0 +1,137 @@
|
||||
;; Infinite structures + Prelude tests. The lazy `:` operator builds
|
||||
;; cons cells with thunked head/tail so recursive list-defining
|
||||
;; functions terminate when only a finite prefix is consumed.
|
||||
|
||||
(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-eval-list
|
||||
(fn (src) (hk-as-list (hk-eval-expr-source src))))
|
||||
|
||||
;; ── Prelude basics ──
|
||||
(hk-test "head of literal" (hk-eval-expr-source "head [1, 2, 3]") 1)
|
||||
(hk-test
|
||||
"tail of literal"
|
||||
(hk-eval-list "tail [1, 2, 3]")
|
||||
(list 2 3))
|
||||
(hk-test "length" (hk-eval-expr-source "length [10, 20, 30, 40]") 4)
|
||||
(hk-test "length empty" (hk-eval-expr-source "length []") 0)
|
||||
(hk-test
|
||||
"map with section"
|
||||
(hk-eval-list "map (+ 1) [1, 2, 3]")
|
||||
(list 2 3 4))
|
||||
(hk-test
|
||||
"filter"
|
||||
(hk-eval-list "filter (\\x -> x > 2) [1, 2, 3, 4, 5]")
|
||||
(list 3 4 5))
|
||||
(hk-test
|
||||
"drop"
|
||||
(hk-eval-list "drop 2 [10, 20, 30, 40]")
|
||||
(list 30 40))
|
||||
(hk-test "fst" (hk-eval-expr-source "fst (7, 9)") 7)
|
||||
(hk-test "snd" (hk-eval-expr-source "snd (7, 9)") 9)
|
||||
(hk-test
|
||||
"zipWith"
|
||||
(hk-eval-list "zipWith plus [1, 2, 3] [10, 20, 30]")
|
||||
(list 11 22 33))
|
||||
|
||||
;; ── Infinite structures ──
|
||||
(hk-test
|
||||
"take from repeat"
|
||||
(hk-eval-list "take 5 (repeat 7)")
|
||||
(list 7 7 7 7 7))
|
||||
(hk-test
|
||||
"take 0 from repeat returns empty"
|
||||
(hk-eval-list "take 0 (repeat 7)")
|
||||
(list))
|
||||
(hk-test
|
||||
"take from iterate"
|
||||
(hk-eval-list "take 5 (iterate (\\x -> x + 1) 0)")
|
||||
(list 0 1 2 3 4))
|
||||
(hk-test
|
||||
"iterate with multiplication"
|
||||
(hk-eval-list "take 4 (iterate (\\x -> x * 2) 1)")
|
||||
(list 1 2 4 8))
|
||||
(hk-test
|
||||
"head of repeat"
|
||||
(hk-eval-expr-source "head (repeat 99)")
|
||||
99)
|
||||
|
||||
;; ── Fibonacci stream ──
|
||||
(hk-test
|
||||
"first 10 Fibonacci numbers"
|
||||
(hk-eval-list "take 10 fibs")
|
||||
(list 0 1 1 2 3 5 8 13 21 34))
|
||||
(hk-test
|
||||
"fib at position 8"
|
||||
(hk-eval-expr-source "head (drop 8 fibs)")
|
||||
21)
|
||||
|
||||
;; ── Building infinite structures in user code ──
|
||||
(hk-test
|
||||
"user-defined infinite ones"
|
||||
(hk-prog-val
|
||||
"ones = 1 : ones\nresult = take 6 ones"
|
||||
"result")
|
||||
(list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list "[]"))))))))
|
||||
|
||||
(hk-test
|
||||
"user-defined nats"
|
||||
(hk-prog-val
|
||||
"nats = naturalsFrom 1\nnaturalsFrom n = n : naturalsFrom (n + 1)\nresult = take 5 nats"
|
||||
"result")
|
||||
(list ":" 1 (list ":" 2 (list ":" 3 (list ":" 4 (list ":" 5 (list "[]")))))))
|
||||
|
||||
;; ── Range syntax ──
|
||||
(hk-test
|
||||
"finite range [1..5]"
|
||||
(hk-eval-list "[1..5]")
|
||||
(list 1 2 3 4 5))
|
||||
(hk-test
|
||||
"empty range when from > to"
|
||||
(hk-eval-list "[10..3]")
|
||||
(list))
|
||||
(hk-test
|
||||
"stepped range"
|
||||
(hk-eval-list "[1, 3..10]")
|
||||
(list 1 3 5 7 9))
|
||||
(hk-test
|
||||
"open range — head"
|
||||
(hk-eval-expr-source "head [1..]")
|
||||
1)
|
||||
(hk-test
|
||||
"open range — drop then head"
|
||||
(hk-eval-expr-source "head (drop 99 [1..])")
|
||||
100)
|
||||
(hk-test
|
||||
"open range — take 5"
|
||||
(hk-eval-list "take 5 [10..]")
|
||||
(list 10 11 12 13 14))
|
||||
|
||||
;; ── Composing Prelude functions ──
|
||||
(hk-test
|
||||
"map then filter"
|
||||
(hk-eval-list
|
||||
"filter (\\x -> x > 5) (map (\\x -> x * 2) [1, 2, 3, 4])")
|
||||
(list 6 8))
|
||||
|
||||
(hk-test
|
||||
"sum-via-foldless"
|
||||
(hk-prog-val
|
||||
"mySum [] = 0\nmySum (x:xs) = x + mySum xs\nresult = mySum (take 5 (iterate (\\x -> x + 1) 1))"
|
||||
"result")
|
||||
15)
|
||||
|
||||
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|
||||
@@ -78,7 +78,7 @@ Key mappings:
|
||||
- [x] Transpile to thunk-wrapped SX: every application arg becomes `(make-thunk (lambda () <arg>))`
|
||||
- [x] `force` = SX eval-thunk-to-WHNF primitive
|
||||
- [x] Pattern match forces scrutinee before matching
|
||||
- [ ] Infinite structures: `repeat x`, `iterate f x`, `[1..]`, Fibonacci stream, sieve of Eratosthenes
|
||||
- [x] Infinite structures: `repeat x`, `iterate f x`, `[1..]`, Fibonacci stream (sieve deferred — needs lazy `++` and is exercised under `Classic programs`)
|
||||
- [ ] `seq`, `deepseq` from Prelude
|
||||
- [ ] Do-notation for a stub `IO` monad (just threading, no real side effects yet)
|
||||
- [ ] Classic programs in `lib/haskell/tests/programs/`:
|
||||
@@ -114,6 +114,35 @@ Key mappings:
|
||||
|
||||
_Newest first._
|
||||
|
||||
- **2026-04-24** — Phase 3 infinite structures + Prelude. Two
|
||||
evaluator changes turn the lazy primitives into a working
|
||||
language:
|
||||
1. Op-form `:` is now non-strict in both args — `hk-eval-op`
|
||||
special-cases it before the eager force-and-binop path, so a
|
||||
cons-cell holds two thunks. This is what makes `repeat x =
|
||||
x : repeat x`, `iterate f x = x : iterate f (f x)`, and the
|
||||
classic `fibs = 0 : 1 : zipWith plus fibs (tail fibs)`
|
||||
terminate when only a finite prefix is consumed.
|
||||
2. Operators are now first-class values via a small
|
||||
`hk-make-binop-builtin` helper, so `(+)`, `(*)`, `(==)` etc.
|
||||
can be passed to `zipWith` and `map`.
|
||||
Added range support across parser + evaluator: `[from..to]` and
|
||||
`[from,next..to]` evaluate eagerly via `hk-build-range` (handles
|
||||
step direction); `[from..]` parses to a new `:range-from` node
|
||||
that the evaluator desugars to `iterate (+ 1) from`. New
|
||||
`hk-load-into!` runs the regular pipeline (parse → desugar →
|
||||
register data → bind decls) on a source string, and `hk-init-env`
|
||||
preloads `hk-prelude-src` with the Phase-3 Prelude:
|
||||
`head`, `tail`, `fst`, `snd`, `take`, `drop`, `repeat`, `iterate`,
|
||||
`length`, `map`, `filter`, `zipWith`, plus `fibs` and `plus`.
|
||||
25 new tests in `lib/haskell/tests/infinite.sx`, including
|
||||
`take 10 fibs == [0,1,1,2,3,5,8,13,21,34]`,
|
||||
`head (drop 99 [1..])`, `iterate (\x -> x * 2) 1` powers of two,
|
||||
user-defined `ones = 1 : ones`, `naturalsFrom`, range edge cases,
|
||||
composed `map`/`filter`, and a custom `mySum`. 359/359 green.
|
||||
Sieve of Eratosthenes is deferred — it needs lazy `++` plus a
|
||||
`mod` primitive — and lives under `Classic programs` anyway.
|
||||
|
||||
- **2026-04-24** — Phase 3 laziness foundation. Added a thunk type to
|
||||
`lib/haskell/eval.sx` (`hk-mk-thunk` / `hk-is-thunk?`) backed by a
|
||||
one-shot memoizing `hk-force` that evaluates the deferred AST, then
|
||||
|
||||
Reference in New Issue
Block a user