diff --git a/lib/haskell/eval.sx b/lib/haskell/eval.sx index 9e62d568..6448e4c4 100644 --- a/lib/haskell/eval.sx +++ b/lib/haskell/eval.sx @@ -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 diff --git a/lib/haskell/parser.sx b/lib/haskell/parser.sx index a4160ded..b4d0b2ef 100644 --- a/lib/haskell/parser.sx +++ b/lib/haskell/parser.sx @@ -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!) diff --git a/lib/haskell/tests/infinite.sx b/lib/haskell/tests/infinite.sx new file mode 100644 index 00000000..3cae6f4a --- /dev/null +++ b/lib/haskell/tests/infinite.sx @@ -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} diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md index 165977d9..adc2c8d7 100644 --- a/plans/haskell-on-sx.md +++ b/plans/haskell-on-sx.md @@ -78,7 +78,7 @@ Key mappings: - [x] Transpile to thunk-wrapped SX: every application arg becomes `(make-thunk (lambda () ))` - [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