;; lib/scheme/tests/syntax.sx — exercises Phase 3 syntactic operators.

(define scm-syn-pass 0)
(define scm-syn-fail 0)
(define scm-syn-fails (list))

(define
  scm-syn-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! scm-syn-pass (+ scm-syn-pass 1))
      (begin
        (set! scm-syn-fail (+ scm-syn-fail 1))
        (append! scm-syn-fails {:name name :actual actual :expected expected})))))

(define scm-syn-eval (fn (src env) (scheme-eval (scheme-parse src) env)))

(define
  scm-syn-eval-all
  (fn (src env) (scheme-eval-program (scheme-parse-all src) env)))

;; Test env with arithmetic primitives.
(define
  scm-syn-env
  (fn
    ()
    (let
      ((env (scheme-make-env)))
      (scheme-env-bind!
        env
        "+"
        (fn (args) (+ (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "-"
        (fn (args) (- (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "*"
        (fn (args) (* (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "/"
        (fn (args) (/ (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "<="
        (fn (args) (<= (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "<"
        (fn (args) (< (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "="
        (fn (args) (= (first args) (nth args 1))))
      (scheme-env-bind! env "list" (fn (args) args))
      (scheme-env-bind!
        env
        "cons"
        (fn (args) (cons (first args) (nth args 1))))
      (scheme-env-bind! env "car" (fn (args) (first (first args))))
      (scheme-env-bind! env "cdr" (fn (args) (rest (first args))))
      env)))

;; ── if ───────────────────────────────────────────────────────────
(scm-syn-test
  "if: true"
  (scm-syn-eval "(if #t 1 2)" (scm-syn-env))
  1)
(scm-syn-test
  "if: false"
  (scm-syn-eval "(if #f 1 2)" (scm-syn-env))
  2)
(scm-syn-test
  "if: predicate"
  (scm-syn-eval "(if (<= 1 2) 99 nope)" (scm-syn-env))
  99)
(scm-syn-test
  "if: no else returns nil"
  (scm-syn-eval "(if #f 99)" (scm-syn-env))
  nil)
(scm-syn-test
  "if: truthy non-#f"
  (scm-syn-eval "(if 0 'yes 'no)" (scm-syn-env))
  "yes")

;; ── define ───────────────────────────────────────────────────────
(scm-syn-test
  "define: bind value"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval "(define x 42)" env)
    (scm-syn-eval "x" env))
  42)
(scm-syn-test
  "define: function sugar"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all "(define (double n) (+ n n)) (double 21)" env))
  42)
(scm-syn-test
  "define: redefine"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all "(define x 1) (define x 2) x" env))
  2)

;; ── set! ─────────────────────────────────────────────────────────
(scm-syn-test
  "set!: mutate"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all "(define x 1) (set! x 99) x" env))
  99)
(scm-syn-test
  "set!: walks parent"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all "(define x 1) ((lambda () (set! x 100))) x" env))
  100)
(scm-syn-test
  "set!: errors on unbound"
  (guard
    (e (true :raised))
    (scm-syn-eval-all "(set! never-defined 1)" (scm-syn-env)))
  :raised)

;; ── begin ────────────────────────────────────────────────────────
(scm-syn-test
  "begin: empty returns nil"
  (scm-syn-eval "(begin)" (scm-syn-env))
  nil)
(scm-syn-test
  "begin: returns last"
  (scm-syn-eval "(begin 1 2 3)" (scm-syn-env))
  3)
(scm-syn-test
  "begin: side effects in order"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define x 0) (begin (set! x 1) (set! x 2) (set! x 3)) x"
      env))
  3)

;; ── lambda ───────────────────────────────────────────────────────
(scm-syn-test
  "lambda: identity"
  (scm-syn-eval "((lambda (x) x) 42)" (scm-syn-env))
  42)
(scm-syn-test
  "lambda: arithmetic"
  (scm-syn-eval "((lambda (x y) (+ x y)) 3 4)" (scm-syn-env))
  7)
(scm-syn-test
  "lambda: zero args"
  (scm-syn-eval "((lambda () 99))" (scm-syn-env))
  99)
(scm-syn-test
  "lambda: multi-body"
  (scm-syn-eval "((lambda (x) (define t (+ x 1)) (+ t t)) 5)" (scm-syn-env))
  12)
(scm-syn-test
  "lambda: rest-arg as bare symbol"
  (scm-syn-eval "((lambda args args) 1 2 3)" (scm-syn-env))
  (list 1 2 3))

;; ── closures ─────────────────────────────────────────────────────
(scm-syn-test
  "closure: captures binding"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define (make-adder n) (lambda (x) (+ x n))) ((make-adder 10) 5)"
      env))
  15)
(scm-syn-test
  "closure: counter via set!"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define (make-counter) (define n 0) (lambda () (set! n (+ n 1)) n)) (define c (make-counter)) (c) (c) (c)"
      env))
  3)
(scm-syn-test
  "closure: curried"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define curry+ (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c)))))) (((curry+ 1) 2) 3)"
      env))
  6)

;; ── recursion ────────────────────────────────────────────────────
(scm-syn-test
  "recursive: factorial 5"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)"
      env))
  120)
(scm-syn-test
  "recursive: factorial 10"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)"
      env))
  3628800)
(scm-syn-test
  "recursive: list length"
  (let
    ((env (scm-syn-env)))
    (scm-syn-eval-all
      "(define (len xs) (if (= 0 (- 0 0)) (if (= xs (quote ())) 0 (+ 1 (len (cdr xs)))) 0)) (len '(a b c d))"
      env))
  4)

;; ── quote vs eval distinction ────────────────────────────────────
(scm-syn-test
  "quote: list literal"
  (scm-syn-eval "'(1 2 3)" (scm-syn-env))
  (list 1 2 3))
(scm-syn-test
  "quote: nested"
  (scm-syn-eval "'(a (b c) d)" (scm-syn-env))
  (list "a" (list "b" "c") "d"))
(scm-syn-test
  "quote: symbol vs evaluated"
  (let ((env (scm-syn-env))) (scm-syn-eval-all "(define x 42) 'x" env))
  "x")

;; ── let / let* ───────────────────────────────────────────────────
(scm-syn-test "let: returns body"
  (scm-syn-eval "(let ((x 5)) (+ x 1))" (scm-syn-env)) 6)
(scm-syn-test "let: multiple bindings"
  (scm-syn-eval "(let ((x 3) (y 4)) (+ x y))" (scm-syn-env)) 7)
(scm-syn-test "let: parallel (RHS sees outer)"
  (let ((env (scm-syn-env)))
    (scm-syn-eval-all "(define x 1) (let ((x 10) (y x)) y)" env)) 1)
(scm-syn-test "let: bindings don't leak"
  (let ((env (scm-syn-env)))
    (scm-syn-eval-all "(define x 1) (let ((x 99)) x) x" env)) 1)
(scm-syn-test "let*: sequential"
  (scm-syn-eval "(let* ((x 1) (y (+ x 1)) (z (+ y 1))) z)"
                (scm-syn-env)) 3)
(scm-syn-test "let*: shadow earlier"
  (scm-syn-eval "(let* ((x 1) (x 2)) x)" (scm-syn-env)) 2)

;; ── cond / when / unless ─────────────────────────────────────────
(scm-syn-test "cond: first match"
  (scm-syn-eval "(cond (#f 1) (#t 2) (#t 3))" (scm-syn-env)) 2)
(scm-syn-test "cond: else"
  (scm-syn-eval "(cond (#f 1) (else 99))" (scm-syn-env)) 99)
(scm-syn-test "cond: untaken not evaluated"
  (scm-syn-eval "(cond (#t 7) (nope ignored))" (scm-syn-env)) 7)
(scm-syn-test "cond: no match returns nil"
  (scm-syn-eval "(cond (#f 1) (#f 2))" (scm-syn-env)) nil)
(scm-syn-test "cond: test-only clause"
  (scm-syn-eval "(cond (42))" (scm-syn-env)) 42)
(scm-syn-test "when: true"
  (scm-syn-eval "(when #t 1 2 3)" (scm-syn-env)) 3)
(scm-syn-test "when: false"
  (scm-syn-eval "(when #f nope)" (scm-syn-env)) nil)
(scm-syn-test "unless: false"
  (scm-syn-eval "(unless #f 42)" (scm-syn-env)) 42)
(scm-syn-test "unless: true"
  (scm-syn-eval "(unless #t nope)" (scm-syn-env)) nil)

;; ── and / or ─────────────────────────────────────────────────────
(scm-syn-test "and: empty"
  (scm-syn-eval "(and)" (scm-syn-env)) true)
(scm-syn-test "and: all truthy returns last"
  (scm-syn-eval "(and 1 2 3)" (scm-syn-env)) 3)
(scm-syn-test "and: short-circuit on #f"
  (scm-syn-eval "(and 1 #f nope)" (scm-syn-env)) false)
(scm-syn-test "or: empty"
  (scm-syn-eval "(or)" (scm-syn-env)) false)
(scm-syn-test "or: first truthy"
  (scm-syn-eval "(or #f 42 nope)" (scm-syn-env)) 42)
(scm-syn-test "or: all #f"
  (scm-syn-eval "(or #f #f #f)" (scm-syn-env)) false)

(define scm-syn-tests-run! (fn () {:total (+ scm-syn-pass scm-syn-fail) :passed scm-syn-pass :failed scm-syn-fail :fails scm-syn-fails}))