;; Phase 1 — reader + interpret mode + core words.
;; Simple assertion driver: (forth-test label input expected-stack)
;; forth-run returns (state, output, stack-bottom-to-top).

(define forth-tests-passed 0)
(define forth-tests-failed 0)
(define forth-tests-failures (list))

(define
  forth-assert
  (fn
    (label expected actual)
    (if
      (= expected actual)
      (set! forth-tests-passed (+ forth-tests-passed 1))
      (begin
        (set! forth-tests-failed (+ forth-tests-failed 1))
        (set!
          forth-tests-failures
          (concat
            forth-tests-failures
            (list
              (str label ": expected " (str expected) " got " (str actual)))))))))

(define
  forth-check-stack
  (fn
    (label src expected)
    (let ((r (forth-run src))) (forth-assert label expected (nth r 2)))))

(define
  forth-check-output
  (fn
    (label src expected)
    (let ((r (forth-run src))) (forth-assert label expected (nth r 1)))))

(define
  forth-reader-tests
  (fn
    ()
    (forth-assert
      "tokens split"
      (list "1" "2" "+")
      (forth-tokens "  1  2 +  "))
    (forth-assert "tokens empty" (list) (forth-tokens ""))
    (forth-assert
      "tokens tab/newline"
      (list "a" "b" "c")
      (forth-tokens "a\tb\nc"))
    (forth-assert "number decimal" 42 (forth-parse-number "42" 10))
    (forth-assert "number negative" -7 (forth-parse-number "-7" 10))
    (forth-assert "number hex prefix" 255 (forth-parse-number "$ff" 10))
    (forth-assert "number binary prefix" 10 (forth-parse-number "%1010" 10))
    (forth-assert
      "number decimal override under hex base"
      123
      (forth-parse-number "#123" 16))
    (forth-assert "number none" nil (forth-parse-number "abc" 10))
    (forth-assert "number in hex base" 255 (forth-parse-number "ff" 16))
    (forth-assert
      "number negative hex prefix"
      -16
      (forth-parse-number "-$10" 10))
    (forth-assert "char literal" 65 (forth-parse-number "'A'" 10))
    (forth-assert
      "mixed-case digit in base 10"
      nil
      (forth-parse-number "1A" 10))
    (forth-assert
      "mixed-case digit in base 16"
      26
      (forth-parse-number "1a" 16))))

(define
  forth-stack-tests
  (fn
    ()
    (forth-check-stack "push literal" "42" (list 42))
    (forth-check-stack "push multiple" "1 2 3" (list 1 2 3))
    (forth-check-stack "DUP" "7 DUP" (list 7 7))
    (forth-check-stack "DROP" "1 2 DROP" (list 1))
    (forth-check-stack "SWAP" "1 2 SWAP" (list 2 1))
    (forth-check-stack "OVER" "1 2 OVER" (list 1 2 1))
    (forth-check-stack "ROT" "1 2 3 ROT" (list 2 3 1))
    (forth-check-stack "-ROT" "1 2 3 -ROT" (list 3 1 2))
    (forth-check-stack "NIP" "1 2 NIP" (list 2))
    (forth-check-stack "TUCK" "1 2 TUCK" (list 2 1 2))
    (forth-check-stack "?DUP non-zero" "5 ?DUP" (list 5 5))
    (forth-check-stack "?DUP zero" "0 ?DUP" (list 0))
    (forth-check-stack "DEPTH empty" "DEPTH" (list 0))
    (forth-check-stack "DEPTH non-empty" "1 2 3 DEPTH" (list 1 2 3 3))
    (forth-check-stack "PICK 0" "10 20 30 0 PICK" (list 10 20 30 30))
    (forth-check-stack "PICK 1" "10 20 30 1 PICK" (list 10 20 30 20))
    (forth-check-stack "PICK 2" "10 20 30 2 PICK" (list 10 20 30 10))
    (forth-check-stack "ROLL 0 is no-op" "10 20 30 0 ROLL" (list 10 20 30))
    (forth-check-stack "ROLL 2" "10 20 30 2 ROLL" (list 20 30 10))
    (forth-check-stack "2DUP" "1 2 2DUP" (list 1 2 1 2))
    (forth-check-stack "2DROP" "1 2 3 4 2DROP" (list 1 2))
    (forth-check-stack "2SWAP" "1 2 3 4 2SWAP" (list 3 4 1 2))
    (forth-check-stack "2OVER" "1 2 3 4 2OVER" (list 1 2 3 4 1 2))))

(define
  forth-arith-tests
  (fn
    ()
    (forth-check-stack "+" "3 4 +" (list 7))
    (forth-check-stack "-" "10 3 -" (list 7))
    (forth-check-stack "*" "6 7 *" (list 42))
    (forth-check-stack "/ positive" "7 2 /" (list 3))
    (forth-check-stack "/ negative numerator" "-7 2 /" (list -3))
    (forth-check-stack "/ both negative" "-7 -2 /" (list 3))
    (forth-check-stack "MOD positive" "7 3 MOD" (list 1))
    (forth-check-stack "MOD negative" "-7 3 MOD" (list -1))
    (forth-check-stack "/MOD positive" "7 3 /MOD" (list 1 2))
    (forth-check-stack "NEGATE" "5 NEGATE" (list -5))
    (forth-check-stack "ABS negative" "-5 ABS" (list 5))
    (forth-check-stack "ABS positive" "5 ABS" (list 5))
    (forth-check-stack "MIN a<b" "3 5 MIN" (list 3))
    (forth-check-stack "MIN a>b" "5 3 MIN" (list 3))
    (forth-check-stack "MAX a<b" "3 5 MAX" (list 5))
    (forth-check-stack "MAX a>b" "5 3 MAX" (list 5))
    (forth-check-stack "1+" "5 1+" (list 6))
    (forth-check-stack "1-" "5 1-" (list 4))
    (forth-check-stack "2+" "5 2+" (list 7))
    (forth-check-stack "2-" "5 2-" (list 3))
    (forth-check-stack "2*" "5 2*" (list 10))
    (forth-check-stack "2/" "7 2/" (list 3))))

(define
  forth-cmp-tests
  (fn
    ()
    (forth-check-stack "= true" "5 5 =" (list -1))
    (forth-check-stack "= false" "5 6 =" (list 0))
    (forth-check-stack "<> true" "5 6 <>" (list -1))
    (forth-check-stack "<> false" "5 5 <>" (list 0))
    (forth-check-stack "< true" "3 5 <" (list -1))
    (forth-check-stack "< false" "5 3 <" (list 0))
    (forth-check-stack "> true" "5 3 >" (list -1))
    (forth-check-stack "> false" "3 5 >" (list 0))
    (forth-check-stack "<= equal" "5 5 <=" (list -1))
    (forth-check-stack "<= less" "3 5 <=" (list -1))
    (forth-check-stack ">= equal" "5 5 >=" (list -1))
    (forth-check-stack ">= greater" "5 3 >=" (list -1))
    (forth-check-stack "0= true" "0 0=" (list -1))
    (forth-check-stack "0= false" "1 0=" (list 0))
    (forth-check-stack "0<> true" "1 0<>" (list -1))
    (forth-check-stack "0<> false" "0 0<>" (list 0))
    (forth-check-stack "0< true" "-5 0<" (list -1))
    (forth-check-stack "0< false" "5 0<" (list 0))
    (forth-check-stack "0> true" "5 0>" (list -1))
    (forth-check-stack "0> false" "-5 0>" (list 0))))

(define
  forth-bitwise-tests
  (fn
    ()
    (forth-check-stack "AND flags" "-1 0 AND" (list 0))
    (forth-check-stack "AND flags 2" "-1 -1 AND" (list -1))
    (forth-check-stack "AND 12 10" "12 10 AND" (list 8))
    (forth-check-stack "OR flags" "-1 0 OR" (list -1))
    (forth-check-stack "OR 12 10" "12 10 OR" (list 14))
    (forth-check-stack "XOR 12 10" "12 10 XOR" (list 6))
    (forth-check-stack "XOR same" "15 15 XOR" (list 0))
    (forth-check-stack "INVERT 0" "0 INVERT" (list -1))
    (forth-check-stack "INVERT 5" "5 INVERT" (list -6))
    (forth-check-stack "double INVERT" "7 INVERT INVERT" (list 7))))

(define
  forth-io-tests
  (fn
    ()
    (forth-check-output "." "42 ." "42 ")
    (forth-check-output ". two values" "1 2 . ." "2 1 ")
    (forth-check-output ".S empty" ".S" "<0> ")
    (forth-check-output ".S three" "1 2 3 .S" "<3> 1 2 3 ")
    (forth-check-output "EMIT A" "65 EMIT" "A")
    (forth-check-output "CR" "CR" "\n")
    (forth-check-output "SPACE" "SPACE" " ")
    (forth-check-output "SPACES 3" "3 SPACES" "   ")
    (forth-check-output "SPACES 0" "0 SPACES" "")
    (forth-check-stack "BL" "BL" (list 32))))

(define
  forth-case-tests
  (fn
    ()
    (forth-check-stack "case-insensitive DUP" "5 dup" (list 5 5))
    (forth-check-stack "case-insensitive SWAP" "1 2 Swap" (list 2 1))))

(define
  forth-mixed-tests
  (fn
    ()
    (forth-check-stack "chained arith" "1 2 3 + +" (list 6))
    (forth-check-stack "(3+4)*2" "3 4 + 2 *" (list 14))
    (forth-check-stack "max of three" "5 3 MAX 7 MAX" (list 7))
    (forth-check-stack "abs chain" "-5 ABS 1+" (list 6))
    (forth-check-stack "swap then add" "5 7 SWAP -" (list 2))
    (forth-check-stack "hex literal" "$10 $20 +" (list 48))
    (forth-check-stack "binary literal" "%1010 %0011 +" (list 13))))

(define
  forth-run-all-phase1-tests
  (fn
    ()
    (set! forth-tests-passed 0)
    (set! forth-tests-failed 0)
    (set! forth-tests-failures (list))
    (forth-reader-tests)
    (forth-stack-tests)
    (forth-arith-tests)
    (forth-cmp-tests)
    (forth-bitwise-tests)
    (forth-io-tests)
    (forth-case-tests)
    (forth-mixed-tests)
    (dict
      "passed"
      forth-tests-passed
      "failed"
      forth-tests-failed
      "failures"
      forth-tests-failures)))