haskell: lazy : + ranges + Prelude (repeat/iterate/fibs/take, +25 tests, 359/359)

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