giles
3a268e7277
Some checks failed
Build and Deploy / build-and-deploy (push) Has been cancelled
Evaluator: data-first higher-order forms — ho-swap-args auto-detects (map coll fn) vs (map fn coll), both work. Threading + HO: (-> data (map fn)) dispatches through CEK HO machinery via quoted-value splice. 17 new tests in test-cek-advanced.sx. Fix plan pages: add mother-language, isolated-evaluator, rust-wasm-host to page-functions.sx plan() — were in defpage but missing from URL router. Aser error handling: pages.py now catches EvalError separately, renders visible error banner instead of silently sending empty content. All except blocks include traceback in logs. Scope primitives: register collect!/collected/clear-collected!/emitted/ emit!/context in shared/sx/primitives.py so hand-written _aser can resolve them (fixes ~cssx/flush expansion failure). New test file: shared/sx/tests/test_aser_errors.py — 19 pytest tests for error propagation through all aser control flow forms. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
698 lines
23 KiB
Plaintext
698 lines
23 KiB
Plaintext
;; ==========================================================================
|
|
;; test-cek-advanced.sx — Advanced stress tests for the CEK machine evaluator
|
|
;;
|
|
;; Exercises complex evaluation patterns that stress the step/continue
|
|
;; dispatch loop: deep nesting, higher-order forms, macro expansion in
|
|
;; the CEK context, environment pressure, and subtle edge cases.
|
|
;;
|
|
;; Requires: test-framework.sx, frames.sx, cek.sx loaded.
|
|
;; Helpers: cek-eval (source string → value via eval-expr-cek).
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 1. Deep nesting
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "cek-deep-nesting"
|
|
(deftest "deeply nested let — 5 levels"
|
|
;; Each let layer adds a binding; innermost body sees all of them.
|
|
(assert-equal 15
|
|
(cek-eval
|
|
"(let ((a 1))
|
|
(let ((b 2))
|
|
(let ((c 3))
|
|
(let ((d 4))
|
|
(let ((e 5))
|
|
(+ a b c d e))))))")))
|
|
|
|
(deftest "deeply nested let — 7 levels with shadowing"
|
|
;; x is rebound at each level; innermost sees 7.
|
|
(assert-equal 7
|
|
(cek-eval
|
|
"(let ((x 1))
|
|
(let ((x 2))
|
|
(let ((x 3))
|
|
(let ((x 4))
|
|
(let ((x 5))
|
|
(let ((x 6))
|
|
(let ((x 7))
|
|
x)))))))")))
|
|
|
|
(deftest "deeply nested if — 5 levels"
|
|
;; All true branches taken; value propagates through every level.
|
|
(assert-equal 42
|
|
(cek-eval
|
|
"(if true
|
|
(if true
|
|
(if true
|
|
(if true
|
|
(if true
|
|
42
|
|
0)
|
|
0)
|
|
0)
|
|
0)
|
|
0)")))
|
|
|
|
(deftest "deeply nested if — alternating true/false reaching else"
|
|
;; Outer true → inner false → its else → next true → final value.
|
|
(assert-equal "deep"
|
|
(cek-eval
|
|
"(if true
|
|
(if false
|
|
\"wrong\"
|
|
(if true
|
|
(if false
|
|
\"also-wrong\"
|
|
(if true \"deep\" \"no\"))
|
|
\"bad\"))
|
|
\"outer-else\")")))
|
|
|
|
(deftest "deeply nested function calls f(g(h(x)))"
|
|
;; Three composed single-arg functions: inc, double, square.
|
|
;; square(double(inc(3))) = square(double(4)) = square(8) = 64
|
|
(assert-equal 64
|
|
(cek-eval
|
|
"(do
|
|
(define inc-fn (fn (x) (+ x 1)))
|
|
(define double-fn (fn (x) (* x 2)))
|
|
(define square-fn (fn (x) (* x x)))
|
|
(square-fn (double-fn (inc-fn 3))))")))
|
|
|
|
(deftest "5-level deeply nested function call chain"
|
|
;; f1(f2(f3(f4(f5(0))))) with each adding 10.
|
|
(assert-equal 50
|
|
(cek-eval
|
|
"(do
|
|
(define f1 (fn (x) (+ x 10)))
|
|
(define f2 (fn (x) (+ x 10)))
|
|
(define f3 (fn (x) (+ x 10)))
|
|
(define f4 (fn (x) (+ x 10)))
|
|
(define f5 (fn (x) (+ x 10)))
|
|
(f1 (f2 (f3 (f4 (f5 0))))))")))
|
|
|
|
(deftest "deep begin/do chain — 6 sequential expressions"
|
|
;; All expressions evaluated; last value returned.
|
|
(assert-equal 60
|
|
(cek-eval
|
|
"(do
|
|
(define acc 0)
|
|
(set! acc (+ acc 10))
|
|
(set! acc (+ acc 10))
|
|
(set! acc (+ acc 10))
|
|
(set! acc (+ acc 10))
|
|
(set! acc (+ acc 10))
|
|
(set! acc (+ acc 10))
|
|
acc)")))
|
|
|
|
(deftest "let inside if inside let inside cond"
|
|
;; cond dispatches → outer let binds → if selects → inner let computes.
|
|
(assert-equal 30
|
|
(cek-eval
|
|
"(let ((mode \"go\"))
|
|
(cond
|
|
(= mode \"stop\") -1
|
|
(= mode \"go\")
|
|
(let ((base 10))
|
|
(if (> base 5)
|
|
(let ((factor 3))
|
|
(* base factor))
|
|
0))
|
|
:else 0))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 2. Complex call patterns
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "cek-complex-calls"
|
|
(deftest "higher-order function returning higher-order function"
|
|
;; make-adder-factory returns a factory that makes adders.
|
|
;; Exercises three closure levels in the CEK call handler.
|
|
(assert-equal 115
|
|
(cek-eval
|
|
"(do
|
|
(define make-adder-factory
|
|
(fn (base)
|
|
(fn (offset)
|
|
(fn (x) (+ base offset x)))))
|
|
(let ((factory (make-adder-factory 100)))
|
|
(let ((add-10 (factory 10)))
|
|
(add-10 5))))")))
|
|
|
|
(deftest "curried multiplication — 3 application levels"
|
|
;; ((mul a) b) c — each level returns a lambda.
|
|
(assert-equal 60
|
|
(cek-eval
|
|
"(do
|
|
(define mul3
|
|
(fn (a) (fn (b) (fn (c) (* a b c)))))
|
|
(((mul3 3) 4) 5))")))
|
|
|
|
(deftest "function applied to itself — omega-like (non-diverging)"
|
|
;; self-apply passes f to f; f ignores its argument and returns a value.
|
|
;; Tests that call dispatch handles (f f) correctly.
|
|
(assert-equal "done"
|
|
(cek-eval
|
|
"(do
|
|
(define self-apply (fn (f) (f f)))
|
|
(define const-done (fn (anything) \"done\"))
|
|
(self-apply const-done))")))
|
|
|
|
(deftest "Y-combinator-like: recursive factorial without define"
|
|
;; The Z combinator (strict Y) enables self-reference via argument.
|
|
;; Tests that CEK handles the double-application (f f) correctly.
|
|
(assert-equal 120
|
|
(cek-eval
|
|
"(do
|
|
(define Z
|
|
(fn (f)
|
|
((fn (x) (f (fn (v) ((x x) v))))
|
|
(fn (x) (f (fn (v) ((x x) v)))))))
|
|
(define fact
|
|
(Z (fn (self)
|
|
(fn (n)
|
|
(if (<= n 1) 1 (* n (self (- n 1))))))))
|
|
(fact 5))")))
|
|
|
|
(deftest "recursive tree traversal via nested lists"
|
|
;; A tree is a (value left right) triple or nil leaf.
|
|
;; Sum all leaf values: (3 (1 nil nil) (2 nil nil)) → 6.
|
|
(assert-equal 6
|
|
(cek-eval
|
|
"(do
|
|
(define tree-sum
|
|
(fn (node)
|
|
(if (nil? node)
|
|
0
|
|
(let ((val (nth node 0))
|
|
(left (nth node 1))
|
|
(right (nth node 2)))
|
|
(+ val (tree-sum left) (tree-sum right))))))
|
|
(let ((tree
|
|
(list 3
|
|
(list 1 nil nil)
|
|
(list 2 nil nil))))
|
|
(tree-sum tree)))")))
|
|
|
|
(deftest "mutual recursion through 3 functions"
|
|
;; f → g → h → f cycle, counting down to 0.
|
|
;; Tests that CEK handles cross-name call dispatch across 3 branches.
|
|
(assert-equal "zero"
|
|
(cek-eval
|
|
"(do
|
|
(define f (fn (n) (if (<= n 0) \"zero\" (g (- n 1)))))
|
|
(define g (fn (n) (if (<= n 0) \"zero\" (h (- n 1)))))
|
|
(define h (fn (n) (if (<= n 0) \"zero\" (f (- n 1)))))
|
|
(f 9))")))
|
|
|
|
(deftest "higher-order composition pipeline"
|
|
;; A list of single-arg functions applied in sequence via reduce.
|
|
;; Tests map + reduce + closure interaction in a single CEK run.
|
|
(assert-equal 30
|
|
(cek-eval
|
|
"(do
|
|
(define pipeline
|
|
(fn (fns init)
|
|
(reduce (fn (acc f) (f acc)) init fns)))
|
|
(let ((steps (list
|
|
(fn (x) (* x 2))
|
|
(fn (x) (+ x 5))
|
|
(fn (x) (* x 2)))))
|
|
(pipeline steps 5)))")))
|
|
|
|
(deftest "variable-arity: function ignoring nil-padded extra args"
|
|
;; Caller provides more args than the param list; excess are ignored.
|
|
;; The CEK call frame must bind declared params and discard extras.
|
|
(assert-equal 3
|
|
(cek-eval
|
|
"(do
|
|
(define first-two (fn (a b) (+ a b)))
|
|
(first-two 1 2))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 3. Macro interaction
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "cek-macro-interaction"
|
|
(deftest "macro that generates an if expression"
|
|
;; my-unless wraps its condition in (not ...) and emits an if.
|
|
;; CEK must expand the macro then step through the resulting if form.
|
|
(assert-equal "ran"
|
|
(cek-eval
|
|
"(do
|
|
(defmacro my-unless (cond-expr then-expr)
|
|
\`(if (not ,cond-expr) ,then-expr nil))
|
|
(my-unless false \"ran\"))")))
|
|
|
|
(deftest "macro that generates a cond expression"
|
|
;; pick-label expands to a cond clause tree.
|
|
(assert-equal "medium"
|
|
(cek-eval
|
|
"(do
|
|
(defmacro classify-num (n)
|
|
\`(cond (< ,n 0) \"negative\"
|
|
(< ,n 10) \"small\"
|
|
(< ,n 100) \"medium\"
|
|
:else \"large\"))
|
|
(classify-num 42))")))
|
|
|
|
(deftest "macro that generates let bindings"
|
|
;; bind-pair expands to a two-binding let wrapping its body.
|
|
(assert-equal 7
|
|
(cek-eval
|
|
"(do
|
|
(defmacro bind-pair (a av b bv body)
|
|
\`(let ((,a ,av) (,b ,bv)) ,body))
|
|
(bind-pair x 3 y 4 (+ x y)))")))
|
|
|
|
(deftest "macro inside macro expansion (chained expansion)"
|
|
;; outer-mac expands to a call of inner-mac, which is also a macro.
|
|
;; CEK must re-enter step-eval after each expansion.
|
|
(assert-equal 20
|
|
(cek-eval
|
|
"(do
|
|
(defmacro double-it (x) \`(* ,x 2))
|
|
(defmacro quadruple-it (x) \`(double-it (double-it ,x)))
|
|
(quadruple-it 5))")))
|
|
|
|
(deftest "macro with quasiquote and splice in complex position"
|
|
;; wrap-args splices its rest args into a list call.
|
|
(assert-equal (list 1 2 3 4)
|
|
(cek-eval
|
|
"(do
|
|
(defmacro wrap-args (&rest items)
|
|
\`(list ,@items))
|
|
(wrap-args 1 2 3 4))")))
|
|
|
|
(deftest "macro generating a define"
|
|
;; defconst expands to a define, introducing a binding into env.
|
|
(assert-equal 99
|
|
(cek-eval
|
|
"(do
|
|
(defmacro defconst (name val)
|
|
\`(define ,name ,val))
|
|
(defconst answer 99)
|
|
answer)")))
|
|
|
|
(deftest "macro used inside lambda body"
|
|
;; The macro is expanded each time the lambda is called.
|
|
(assert-equal (list 2 4 6)
|
|
(cek-eval
|
|
"(do
|
|
(defmacro double-it (x) \`(* 2 ,x))
|
|
(let ((double-fn (fn (n) (double-it n))))
|
|
(map double-fn (list 1 2 3))))")))
|
|
|
|
(deftest "nested macro call — macro output feeds another macro"
|
|
;; negate-add: (negate-add a b) → (- (+ a b))
|
|
;; Expands in two macro steps; CEK must loop through both.
|
|
(assert-equal -7
|
|
(cek-eval
|
|
"(do
|
|
(defmacro my-add (a b) \`(+ ,a ,b))
|
|
(defmacro negate-add (a b) \`(- (my-add ,a ,b)))
|
|
(negate-add 3 4))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 4. Environment stress
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "cek-environment-stress"
|
|
(deftest "10 bindings in a single let — all accessible"
|
|
;; One large let frame; CEK env-extend must handle all 10 at once.
|
|
(assert-equal 55
|
|
(cek-eval
|
|
"(let ((a 1) (b 2) (c 3) (d 4) (e 5)
|
|
(f 6) (g 7) (h 8) (i 9) (j 10))
|
|
(+ a b c d e f g h i j))")))
|
|
|
|
(deftest "10 bindings — correct value for each binding"
|
|
;; Spot-check that the env frame stores each binding at the right slot.
|
|
(assert-equal "ok"
|
|
(cek-eval
|
|
"(let ((v1 \"a\") (v2 \"b\") (v3 \"c\") (v4 \"d\") (v5 \"e\")
|
|
(v6 \"f\") (v7 \"g\") (v8 \"h\") (v9 \"i\") (v10 \"j\"))
|
|
(if (and (= v1 \"a\") (= v5 \"e\") (= v10 \"j\"))
|
|
\"ok\"
|
|
\"fail\"))")))
|
|
|
|
(deftest "shadowing chain — x shadows x shadows x (3 levels)"
|
|
;; After 3 let layers, x == 3; unwinding restores x at each level.
|
|
;; Inner let must not mutate the outer env frames.
|
|
(assert-equal (list 3 2 1)
|
|
(cek-eval
|
|
"(let ((results (list)))
|
|
(let ((x 1))
|
|
(let ((x 2))
|
|
(let ((x 3))
|
|
(append! results x)) ;; records 3
|
|
(append! results x)) ;; records 2 after inner unwinds
|
|
(append! results x)) ;; records 1 after middle unwinds
|
|
results)")))
|
|
|
|
(deftest "closure capturing 5 variables from enclosing let"
|
|
;; All 5 captured vars remain accessible after the let exits.
|
|
(assert-equal 150
|
|
(cek-eval
|
|
"(do
|
|
(define make-closure
|
|
(fn ()
|
|
(let ((a 10) (b 20) (c 30) (d 40) (e 50))
|
|
(fn () (+ a b c d e)))))
|
|
(let ((f (make-closure)))
|
|
(f)))")))
|
|
|
|
(deftest "set! visible through 3 closure levels"
|
|
;; Top-level define → lambda → lambda → lambda modifies top binding.
|
|
;; CEK set! must walk the env chain and find the outermost slot.
|
|
(assert-equal 999
|
|
(cek-eval
|
|
"(do
|
|
(define shared 0)
|
|
(define make-level1
|
|
(fn ()
|
|
(fn ()
|
|
(fn ()
|
|
(set! shared 999)))))
|
|
(let ((level2 (make-level1)))
|
|
(let ((level3 (level2)))
|
|
(level3)))
|
|
shared)")))
|
|
|
|
(deftest "define inside let inside define — scope chain"
|
|
;; outer define → let body → inner define. The inner define mutates
|
|
;; the env that the let body executes in; later exprs must see it.
|
|
(assert-equal 42
|
|
(cek-eval
|
|
"(do
|
|
(define outer-fn
|
|
(fn (base)
|
|
(let ((step 1))
|
|
(define result (* base step))
|
|
(set! result (+ result 1))
|
|
result)))
|
|
(outer-fn 41))")))
|
|
|
|
(deftest "env not polluted across sibling lambda calls"
|
|
;; Two separate calls to the same lambda must not share param state.
|
|
(assert-equal (list 10 20)
|
|
(cek-eval
|
|
"(do
|
|
(define f (fn (x) (* x 2)))
|
|
(list (f 5) (f 10)))")))
|
|
|
|
(deftest "large closure env — 8 closed-over variables"
|
|
;; A lambda closing over 8 variables; all used in the body.
|
|
(assert-equal 36
|
|
(cek-eval
|
|
"(let ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7) (h 8))
|
|
(let ((sum-all (fn () (+ a b c d e f g h))))
|
|
(sum-all)))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 5. Edge cases
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "cek-edge-cases"
|
|
(deftest "empty begin/do returns nil"
|
|
;; The step-sf-begin handler with an empty arg list must yield nil.
|
|
(assert-nil (cek-eval "(do)")))
|
|
|
|
(deftest "single-expression begin/do returns value"
|
|
;; A do with exactly one expression is equivalent to that expression.
|
|
(assert-equal 42 (cek-eval "(do 42)")))
|
|
|
|
(deftest "begin/do with side-effecting expressions returns last"
|
|
;; All intermediate expressions run; only the last value is kept.
|
|
(assert-equal "last"
|
|
(cek-eval "(do \"first\" \"middle\" \"last\")")))
|
|
|
|
(deftest "if with only true branch — false path returns nil"
|
|
;; No else clause: the make-if-frame must default else to nil.
|
|
(assert-nil (cek-eval "(if false 42)")))
|
|
|
|
(deftest "if with only true branch — true path returns value"
|
|
(assert-equal 7 (cek-eval "(if true 7)")))
|
|
|
|
(deftest "and with all truthy values returns last"
|
|
;; SX and: short-circuit stops at first falsy; last truthy is returned.
|
|
(assert-equal "c"
|
|
(cek-eval "(and \"a\" \"b\" \"c\")")))
|
|
|
|
(deftest "and with leading falsy short-circuits — returns false"
|
|
(assert-false (cek-eval "(and 1 false 3)")))
|
|
|
|
(deftest "and with no args returns true"
|
|
(assert-true (cek-eval "(and)")))
|
|
|
|
(deftest "or with all falsy returns last falsy"
|
|
;; SX or: if all falsy, the last falsy value is returned.
|
|
(assert-false (cek-eval "(or false false false)")))
|
|
|
|
(deftest "or returns first truthy value"
|
|
(assert-equal 1 (cek-eval "(or false nil 1 2 3)")))
|
|
|
|
(deftest "or with no args returns false"
|
|
(assert-false (cek-eval "(or)")))
|
|
|
|
(deftest "keyword evaluated as string in call position"
|
|
;; A keyword in non-call position evaluates to its string name.
|
|
(assert-equal "color"
|
|
(cek-eval "(let ((k :color)) k)")))
|
|
|
|
(deftest "keyword as dict key in evaluation context"
|
|
;; Dict literal with keyword key; the keyword must be converted to
|
|
;; string so (get d \"color\") succeeds.
|
|
(assert-equal "red"
|
|
(cek-eval
|
|
"(let ((d {:color \"red\"}))
|
|
(get d \"color\"))")))
|
|
|
|
(deftest "quote preserves list structure — no evaluation inside"
|
|
;; (quote (+ 1 2)) must return the list (+ 1 2), not 3.
|
|
(assert-equal 3
|
|
(cek-eval "(len (quote (+ 1 2)))")))
|
|
|
|
(deftest "quote preserves nested structure"
|
|
;; Deeply nested quoted form is returned verbatim as a list tree.
|
|
(assert-equal 2
|
|
(cek-eval "(len (quote (a (b c))))")))
|
|
|
|
(deftest "quasiquote with nested unquote"
|
|
;; `(a ,(+ 1 2) c) → the list (a 3 c).
|
|
(assert-equal 3
|
|
(cek-eval
|
|
"(let ((x (+ 1 2)))
|
|
(nth \`(a ,x c) 1))")))
|
|
|
|
(deftest "quasiquote with splice — list flattened into result"
|
|
;; `(1 ,@(list 2 3) 4) → (1 2 3 4).
|
|
(assert-equal (list 1 2 3 4)
|
|
(cek-eval
|
|
"(let ((mid (list 2 3)))
|
|
\`(1 ,@mid 4))")))
|
|
|
|
(deftest "quasiquote with nested unquote-splice at multiple positions"
|
|
;; Mixed literal and spliced elements across the template.
|
|
(assert-equal (list 0 1 2 3 10 11 12 99)
|
|
(cek-eval
|
|
"(let ((xs (list 1 2 3))
|
|
(ys (list 10 11 12)))
|
|
\`(0 ,@xs ,@ys 99))")))
|
|
|
|
(deftest "cond with no matching clause returns nil"
|
|
;; No branch taken, no :else → nil.
|
|
(assert-nil
|
|
(cek-eval "(cond false \"a\" false \"b\")")))
|
|
|
|
(deftest "nested cond: outer selects branch, inner dispatches value"
|
|
;; Two cond forms nested; CEK must handle the double-dispatch.
|
|
(assert-equal "cold"
|
|
(cek-eval
|
|
"(let ((season \"winter\") (temp -5))
|
|
(cond
|
|
(= season \"winter\")
|
|
(cond (< temp 0) \"cold\"
|
|
:else \"cool\")
|
|
(= season \"summer\") \"hot\"
|
|
:else \"mild\"))")))
|
|
|
|
(deftest "lambda with no params — nullary function"
|
|
;; () → 42 via CEK call dispatch with empty arg list.
|
|
(assert-equal 42
|
|
(cek-eval "((fn () 42))")))
|
|
|
|
(deftest "immediately invoked lambda with multiple body forms"
|
|
;; IIFE with a do-style body; last expression is the value.
|
|
(assert-equal 6
|
|
(cek-eval
|
|
"((fn ()
|
|
(define a 1)
|
|
(define b 2)
|
|
(define c 3)
|
|
(+ a b c)))")))
|
|
|
|
(deftest "thread-first through 5 steps"
|
|
;; (-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))
|
|
;; 1+1=2, *3=6, +1=7, *2=14, 14-2=12
|
|
;; Tests that each -> step creates the correct frame and threads value.
|
|
(assert-equal 12
|
|
(cek-eval "(-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))")))
|
|
|
|
(deftest "case falls through to :else"
|
|
(assert-equal "unknown"
|
|
(cek-eval "(case 99 1 \"one\" 2 \"two\" :else \"unknown\")")))
|
|
|
|
(deftest "case with no :else and no match returns nil"
|
|
(assert-nil (cek-eval "(case 99 1 \"one\" 2 \"two\")")))
|
|
|
|
(deftest "when with multiple body forms returns last"
|
|
(assert-equal "last"
|
|
(cek-eval "(when true \"first\" \"middle\" \"last\")")))
|
|
|
|
(deftest "when false body not evaluated — no side effects"
|
|
(assert-equal 0
|
|
(cek-eval
|
|
"(do
|
|
(define side-ct 0)
|
|
(when false (set! side-ct 1))
|
|
side-ct)")))
|
|
|
|
(deftest "define followed by symbol lookup returns bound value"
|
|
;; define evaluates its RHS and returns the value.
|
|
;; The subsequent symbol reference must find the binding in env.
|
|
(assert-equal 7
|
|
(cek-eval "(do (define q 7) q)")))
|
|
|
|
(deftest "set! in deeply nested scope updates the correct frame"
|
|
;; set! inside a 4-level let must find the binding defined at level 1.
|
|
(assert-equal 100
|
|
(cek-eval
|
|
"(let ((target 0))
|
|
(let ((a 1))
|
|
(let ((b 2))
|
|
(let ((c 3))
|
|
(set! target 100))))
|
|
target)")))
|
|
|
|
(deftest "list literal (non-call) evaluated element-wise"
|
|
;; A list whose head is a number — treated as data list, not a call.
|
|
;; All elements are evaluated; numbers pass through unchanged.
|
|
(assert-equal 3
|
|
(cek-eval "(len (list 10 20 30))")))
|
|
|
|
(deftest "recursive fibonacci — tests non-tail call frame stacking"
|
|
;; fib(7) = 13. Non-tail recursion stacks O(n) CEK frames; tests
|
|
;; that the continuation frame list handles deep frame accumulation.
|
|
(assert-equal 13
|
|
(cek-eval
|
|
"(do
|
|
(define fib
|
|
(fn (n)
|
|
(if (< n 2)
|
|
n
|
|
(+ (fib (- n 1)) (fib (- n 2))))))
|
|
(fib 7))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 8. Data-first higher-order forms
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "data-first-ho"
|
|
(deftest "map — data-first arg order"
|
|
(assert-equal (list 2 4 6)
|
|
(map (list 1 2 3) (fn (x) (* x 2)))))
|
|
|
|
(deftest "filter — data-first arg order"
|
|
(assert-equal (list 3 4 5)
|
|
(filter (list 1 2 3 4 5) (fn (x) (> x 2)))))
|
|
|
|
(deftest "reduce — data-first arg order"
|
|
(assert-equal 10
|
|
(reduce (list 1 2 3 4) + 0)))
|
|
|
|
(deftest "some — data-first arg order"
|
|
(assert-true
|
|
(some (list 1 2 3) (fn (x) (> x 2))))
|
|
(assert-false
|
|
(some (list 1 2 3) (fn (x) (> x 5)))))
|
|
|
|
(deftest "every? — data-first arg order"
|
|
(assert-true
|
|
(every? (list 2 4 6) (fn (x) (> x 1))))
|
|
(assert-false
|
|
(every? (list 2 4 6) (fn (x) (> x 3)))))
|
|
|
|
(deftest "for-each — data-first arg order"
|
|
(let ((acc (list)))
|
|
(for-each (list 10 20 30)
|
|
(fn (x) (set! acc (append acc (list x)))))
|
|
(assert-equal (list 10 20 30) acc)))
|
|
|
|
(deftest "map-indexed — data-first arg order"
|
|
(assert-equal (list "0:a" "1:b" "2:c")
|
|
(map-indexed (list "a" "b" "c")
|
|
(fn (i v) (str i ":" v)))))
|
|
|
|
(deftest "fn-first still works — map"
|
|
(assert-equal (list 2 4 6)
|
|
(map (fn (x) (* x 2)) (list 1 2 3))))
|
|
|
|
(deftest "fn-first still works — reduce"
|
|
(assert-equal 10
|
|
(reduce + 0 (list 1 2 3 4)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 9. Threading with HO forms
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "thread-ho"
|
|
(deftest "-> map"
|
|
(assert-equal (list 2 4 6)
|
|
(-> (list 1 2 3) (map (fn (x) (* x 2))))))
|
|
|
|
(deftest "-> filter"
|
|
(assert-equal (list 3 4 5)
|
|
(-> (list 1 2 3 4 5) (filter (fn (x) (> x 2))))))
|
|
|
|
(deftest "-> filter then map pipeline"
|
|
(assert-equal (list 30 40 50)
|
|
(-> (list 1 2 3 4 5)
|
|
(filter (fn (x) (> x 2)))
|
|
(map (fn (x) (* x 10))))))
|
|
|
|
(deftest "-> reduce"
|
|
(assert-equal 15
|
|
(-> (list 1 2 3 4 5) (reduce + 0))))
|
|
|
|
(deftest "-> map then reduce"
|
|
(assert-equal 12
|
|
(-> (list 1 2 3)
|
|
(map (fn (x) (* x 2)))
|
|
(reduce + 0))))
|
|
|
|
(deftest "-> some"
|
|
(assert-true
|
|
(-> (list 1 2 3) (some (fn (x) (> x 2)))))
|
|
(assert-false
|
|
(-> (list 1 2 3) (some (fn (x) (> x 5))))))
|
|
|
|
(deftest "-> every?"
|
|
(assert-true
|
|
(-> (list 2 4 6) (every? (fn (x) (> x 1))))))
|
|
|
|
(deftest "-> full pipeline: map filter reduce"
|
|
;; Double each, keep > 4, sum
|
|
(assert-equal 24
|
|
(-> (list 1 2 3 4 5)
|
|
(map (fn (x) (* x 2)))
|
|
(filter (fn (x) (> x 4)))
|
|
(reduce + 0)))))
|