diff --git a/example.scm b/example.scm index 0c14ae5..c8749a3 100644 --- a/example.scm +++ b/example.scm @@ -80,6 +80,36 @@ (display (cdr y)) (newline) (display (append '(1 2 3) '(4 5 6))) (newline) +; Test system + +(define (concat-string s sep) + (foldr (lambda (e a) (string-append (datum->string e) sep a)) + "" + s)) + +(define test + (lambda (name tests) + (begin (display name) + (display "\n\tExpect: ") + (display (concat-string (map car tests) " ")) + (display "\n\tGotten: ") + (display (concat-string (map cdr tests) " ")) + (newline)))) + +(define (header name) (display (string-append "\n * " name " *\n"))) + +(header "R5RS: Test equivalence") + +(define (list-tail ls index) + (if (zero? index) + ls + (list-tail (cdr ls) (+ index -1)))) + +(define (list-ref ls index) + (car (list-tail ls index))) + +; Actual Tests + (display "\n* R5RS: Quotation and quasi-quotation *\n") (display "Testing quotation!\n\tExpect: (1 2 3)\n\tGotten: ") @@ -121,29 +151,43 @@ (display "* R5RS: Testing booleans *") (newline) -(display "Testing not\n\tExpect: #f #t #f #f\n\tGotten: ") -(display (not #t)) (display " ") -(display (not #f)) (display " ") -(display (not "hi")) (display " ") -(display (not 6)) (newline) +(define fun-test + (lambda (name f cases) + (test (string-append "Testing function " name "") + (map (lambda (a) (cons (car a) (f (cdr a)))) + cases)))) -(newline) -(display "* R5RS: Testing numerical operators *") -(newline) +(fun-test "not" not + '( (#f . #t) + (#t . #f) + (#f . "hi") + (#f . 7) + (#f . a) + (#f . ()) + )) -(display "Testing number?\n\tExpect: #t #f #f #f\n\tGotten: ") -(display (number? 5)) -(display " ") -(display (number? #f)) -(display " ") -(display (number? "hello")) -(display " ") -(display (number? '(1 2))) -(newline) +(fun-test "boolean?" boolean? + '( (#t . #t) + (#t . #f) + (#f . "hi") + (#f . 7) + (#f . a) + (#f . ()) + )) -(newline) -(display "* R5RS: Testing fold and map *") -(newline) +(header "R5RS: Testing numerical operators") + +(fun-test "number?" number? + '( (#f . #t) + (#f . #f) + (#f . "hi") + (#t . 7) + (#t . 5232) + (#f . a) + (#f . ()) + )) + +(header "R5RS: Testing fold and map") (display "Testing sum over foldl!\n\tExpect: 28\n\tGotten: ") (display (foldl + 0 '(1 2 3 4 5 6 7))) @@ -173,32 +217,6 @@ (display (string-append "Hello" " " "World")) (newline) -(define (concat-string s sep) - (foldr (lambda (e a) (string-append (datum->string e) sep a)) - "" - s)) - -(define test - (lambda (name tests) - (begin (display name) - (display "\n\tExpect: ") - (display (concat-string (map car tests) " ")) - (display "\n\tGotten: ") - (display (concat-string (map cdr tests) " ")) - (newline)))) - -(define (header name) (display (string-append "\n * " name " *\n"))) - -(header "R5RS: Test equivalence") - -(define (list-tail ls index) - (if (zero? index) - ls - (list-tail (cdr ls) (+ index -1)))) - -(define (list-ref ls index) - (car (list-tail ls index))) - (define do-stuffer (lambda (name_i arg1_i arg2_i) (lambda (x) diff --git a/tigerscheme.tig b/tigerscheme.tig index 66f0dfd..de7c3d4 100644 --- a/tigerscheme.tig +++ b/tigerscheme.tig @@ -1031,27 +1031,27 @@ let /* Booleans */ /* R5RS: Boolean */ ; stdfun("not") - ; app(OPCODE_TYPEOF, 0, "") ; app2(OPCODE_PUSH, bool_val(false)) ; app(OPCODE_EQV, 0, "") ; app(OPCODE_RET, 1, "") ; stdfun("boolean?") /* Test for false */ - ; app(OPCODE_TYPEOF, 0, "") ; app(OPCODE_DUPL, 0, "") ; app2(OPCODE_PUSH, bool_val(false)) ; app(OPCODE_EQV, 0, "") - ; app(OPCODE_CSKIP, 2, "") + ; app(OPCODE_CSKIP, 4, "") + + /* Is true, remove top and return */ + ; app(OPCODE_POP, 0, "") + ; app2(OPCODE_PUSH, bool_val(1)) + ; app(OPCODE_RET, 1, "") /* Not false, maybe true? */ ; app2(OPCODE_PUSH, bool_val(true)) ; app(OPCODE_EQV, 0, "") ; app(OPCODE_RET, 1, "") - /* Is true, remove top and return */ - ; app(OPCODE_POP, 0, "") - ; app(OPCODE_RET, 1, "") /* R5RS: Pairs and Lists */ @@ -1224,6 +1224,11 @@ let /* Booleans */ ; app2(OPCODE_PUSH, VALUE_UNSPECIFIED) ; app(OPCODE_RET, 1, "") + ; stdfun("debug-show-stack") + ; app(OPCODE_DEBUG, 2, "") + ; app2(OPCODE_PUSH, VALUE_UNSPECIFIED) + ; app(OPCODE_RET, 1, "") + ; stdfun("exit") ; app(OPCODE_EXIT, true, "") @@ -2328,10 +2333,15 @@ let /* Booleans */ end else if tape[ip].opcode = OPCODE_DEBUG - then let var arg := stack_pop(stack) + then let var arg := stack_pop(stack) + var val_b := (arg = nil | is_truthy(arg)) + + in if tape[ip].arg1 = 1 + then DEBUG_PRINT_TAPE := val_b + else if tape[ip].arg1 = 2 + then DEBUG_PRINT_STACK := val_b + else run_error("Attempting to use unknown debug option!") - in if tape[ip].arg1 - then DEBUG_PRINT_TAPE := (arg = nil | is_truthy(arg)) ; ip := ip + 1 end