;; ========================================================================== ;; test-cek.sx — Tests for the explicit CEK machine evaluator ;; ;; Tests that eval-expr-cek produces identical results to eval-expr. ;; Requires: test-framework.sx, frames.sx, cek.sx loaded. ;; ========================================================================== ;; -------------------------------------------------------------------------- ;; 1. Literals ;; -------------------------------------------------------------------------- (defsuite "cek-literals" (deftest "number" (assert-equal 42 (eval-expr-cek 42 (test-env)))) (deftest "string" (assert-equal "hello" (eval-expr-cek "hello" (test-env)))) (deftest "boolean true" (assert-equal true (eval-expr-cek true (test-env)))) (deftest "boolean false" (assert-equal false (eval-expr-cek false (test-env)))) (deftest "nil" (assert-nil (eval-expr-cek nil (test-env))))) ;; -------------------------------------------------------------------------- ;; 2. Symbol lookup ;; -------------------------------------------------------------------------- (defsuite "cek-symbols" (deftest "env lookup" (assert-equal 42 (cek-eval "(do (define x 42) x)"))) (deftest "primitive call resolves" (assert-equal "hello" (cek-eval "(str \"hello\")")))) ;; -------------------------------------------------------------------------- ;; 3. Special forms ;; -------------------------------------------------------------------------- (defsuite "cek-if" (deftest "if true branch" (assert-equal 1 (cek-eval "(if true 1 2)"))) (deftest "if false branch" (assert-equal 2 (cek-eval "(if false 1 2)"))) (deftest "if no else" (assert-nil (cek-eval "(if false 1)")))) (defsuite "cek-when" (deftest "when true" (assert-equal 42 (cek-eval "(when true 42)"))) (deftest "when false" (assert-nil (cek-eval "(when false 42)"))) (deftest "when multiple body" (assert-equal 3 (cek-eval "(when true 1 2 3)")))) (defsuite "cek-begin" (deftest "do returns last" (assert-equal 3 (cek-eval "(do 1 2 3)"))) (deftest "empty do" (assert-nil (cek-eval "(do)")))) (defsuite "cek-let" (deftest "basic let" (assert-equal 3 (cek-eval "(let ((x 1) (y 2)) (+ x y))"))) (deftest "let body sequence" (assert-equal 10 (cek-eval "(let ((x 5)) 1 2 (+ x 5))"))) (deftest "nested let" (assert-equal 5 (cek-eval "(let ((x 1)) (let ((y 2)) (+ x y (* x y))))")))) (defsuite "cek-and-or" (deftest "and all true" (assert-equal 3 (cek-eval "(and 1 2 3)"))) (deftest "and short circuit" (assert-false (cek-eval "(and 1 false 3)"))) (deftest "or first true" (assert-equal 1 (cek-eval "(or 1 2 3)"))) (deftest "or all false" (assert-false (cek-eval "(or false false false)")))) (defsuite "cek-cond" (deftest "cond first match" (assert-equal "a" (cek-eval "(cond true \"a\" true \"b\")"))) (deftest "cond second match" (assert-equal "b" (cek-eval "(cond false \"a\" true \"b\")"))) (deftest "cond else" (assert-equal "c" (cek-eval "(cond false \"a\" :else \"c\")")))) (defsuite "cek-case" (deftest "case match" (assert-equal "yes" (cek-eval "(case 1 1 \"yes\" 2 \"no\")"))) (deftest "case no match" (assert-nil (cek-eval "(case 3 1 \"yes\" 2 \"no\")"))) (deftest "case else" (assert-equal "default" (cek-eval "(case 3 1 \"yes\" :else \"default\")")))) ;; -------------------------------------------------------------------------- ;; 4. Function calls ;; -------------------------------------------------------------------------- (defsuite "cek-calls" (deftest "primitive call" (assert-equal 3 (cek-eval "(+ 1 2)"))) (deftest "nested calls" (assert-equal 6 (cek-eval "(+ 1 (+ 2 3))"))) (deftest "lambda call" (assert-equal 10 (cek-eval "((fn (x) (* x 2)) 5)"))) (deftest "defined function" (assert-equal 25 (cek-eval "(do (define square (fn (x) (* x x))) (square 5))")))) ;; -------------------------------------------------------------------------- ;; 5. Define and set! ;; -------------------------------------------------------------------------- (defsuite "cek-define" (deftest "define binds" (assert-equal 42 (cek-eval "(do (define x 42) x)"))) (deftest "set! mutates" (assert-equal 10 (cek-eval "(do (define x 1) (set! x 10) x)")))) ;; -------------------------------------------------------------------------- ;; 6. Quote and quasiquote ;; -------------------------------------------------------------------------- (defsuite "cek-quote" (deftest "quote" (let ((result (cek-eval "(quote (1 2 3))"))) (assert-equal 3 (len result)))) (deftest "quasiquote with unquote" (assert-equal (list 1 42 3) (cek-eval "(let ((x 42)) `(1 ,x 3))")))) ;; -------------------------------------------------------------------------- ;; 7. Thread-first ;; -------------------------------------------------------------------------- (defsuite "cek-thread-first" (deftest "simple thread" (assert-equal 3 (cek-eval "(-> 1 (+ 2))"))) (deftest "multi-step thread" (assert-equal 6 (cek-eval "(-> 1 (+ 2) (* 2))")))) ;; -------------------------------------------------------------------------- ;; 8. CEK-specific: stepping ;; -------------------------------------------------------------------------- (defsuite "cek-stepping" (deftest "single step literal" (let ((state (make-cek-state 42 (test-env) (list)))) (let ((stepped (cek-step state))) (assert-equal "continue" (cek-phase stepped)) (assert-equal 42 (cek-value stepped)) (assert-true (cek-terminal? stepped))))) (deftest "single step if pushes frame" (let ((state (make-cek-state (sx-parse-one "(if true 1 2)") (test-env) (list)))) (let ((stepped (cek-step state))) (assert-equal "eval" (cek-phase stepped)) ;; Should have pushed an IfFrame (assert-true (> (len (cek-kont stepped)) 0)) (assert-equal "if" (frame-type (first (cek-kont stepped)))))))) ;; -------------------------------------------------------------------------- ;; 9. Native continuations (shift/reset in CEK) ;; -------------------------------------------------------------------------- (defsuite "cek-continuations" (deftest "reset passthrough" (assert-equal 42 (cek-eval "(reset 42)"))) (deftest "shift abort" (assert-equal 42 (cek-eval "(reset (+ 1 (shift k 42)))"))) (deftest "shift with invoke" (assert-equal 11 (cek-eval "(reset (+ 1 (shift k (k 10))))"))))