giles
3ab01b271d
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
102 lines
2.3 KiB
Plaintext
102 lines
2.3 KiB
Plaintext
;; Phase 5 — Core Extension + memory primitives.
|
|
|
|
(define forth-p5-passed 0)
|
|
(define forth-p5-failed 0)
|
|
(define forth-p5-failures (list))
|
|
|
|
(define
|
|
forth-p5-assert
|
|
(fn
|
|
(label expected actual)
|
|
(if
|
|
(= expected actual)
|
|
(set! forth-p5-passed (+ forth-p5-passed 1))
|
|
(begin
|
|
(set! forth-p5-failed (+ forth-p5-failed 1))
|
|
(set!
|
|
forth-p5-failures
|
|
(concat
|
|
forth-p5-failures
|
|
(list
|
|
(str label ": expected " (str expected) " got " (str actual)))))))))
|
|
|
|
(define
|
|
forth-p5-check-stack
|
|
(fn
|
|
(label src expected)
|
|
(let ((r (forth-run src))) (forth-p5-assert label expected (nth r 2)))))
|
|
|
|
(define
|
|
forth-p5-check-top
|
|
(fn
|
|
(label src expected)
|
|
(let
|
|
((r (forth-run src)))
|
|
(let
|
|
((stk (nth r 2)))
|
|
(forth-p5-assert label expected (nth stk (- (len stk) 1)))))))
|
|
|
|
(define
|
|
forth-p5-create-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-top
|
|
"CREATE pushes HERE-at-creation"
|
|
"HERE CREATE FOO FOO ="
|
|
-1)
|
|
(forth-p5-check-top
|
|
"CREATE + ALLOT advances HERE"
|
|
"HERE 5 ALLOT HERE SWAP -"
|
|
5)
|
|
(forth-p5-check-top
|
|
"CREATE + , stores cell"
|
|
"CREATE FOO 42 , FOO @"
|
|
42)
|
|
(forth-p5-check-stack
|
|
"CREATE multiple ,"
|
|
"CREATE TBL 1 , 2 , 3 , TBL @ TBL CELL+ @ TBL CELL+ CELL+ @"
|
|
(list 1 2 3))
|
|
(forth-p5-check-top
|
|
"C, stores byte"
|
|
"CREATE B 65 C, 66 C, B C@"
|
|
65)))
|
|
|
|
(define
|
|
forth-p5-unsigned-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-top "1 2 U<" "1 2 U<" -1)
|
|
(forth-p5-check-top "2 1 U<" "2 1 U<" 0)
|
|
(forth-p5-check-top "0 1 U<" "0 1 U<" -1)
|
|
(forth-p5-check-top "-1 1 U< (since -1 unsigned is huge)" "-1 1 U<" 0)
|
|
(forth-p5-check-top "1 -1 U<" "1 -1 U<" -1)
|
|
(forth-p5-check-top "1 2 U>" "1 2 U>" 0)
|
|
(forth-p5-check-top "-1 1 U>" "-1 1 U>" -1)))
|
|
|
|
(define
|
|
forth-p5-2bang-tests
|
|
(fn
|
|
()
|
|
(forth-p5-check-stack
|
|
"2! / 2@"
|
|
"CREATE X 0 , 0 , 11 22 X 2! X 2@"
|
|
(list 11 22))))
|
|
|
|
(define
|
|
forth-p5-run-all
|
|
(fn
|
|
()
|
|
(set! forth-p5-passed 0)
|
|
(set! forth-p5-failed 0)
|
|
(set! forth-p5-failures (list))
|
|
(forth-p5-create-tests)
|
|
(forth-p5-unsigned-tests)
|
|
(forth-p5-2bang-tests)
|
|
(dict
|
|
"passed"
|
|
forth-p5-passed
|
|
"failed"
|
|
forth-p5-failed
|
|
"failures"
|
|
forth-p5-failures)))
|