1
0

Fixed implementation of boolean? and not.

This commit is contained in:
Jon Michael Aanes 2018-12-30 11:44:54 +01:00
parent 380f73683f
commit 0303bcbeaa
2 changed files with 83 additions and 55 deletions

View File

@ -80,6 +80,36 @@
(display (cdr y)) (newline) (display (cdr y)) (newline)
(display (append '(1 2 3) '(4 5 6))) (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 "\n* R5RS: Quotation and quasi-quotation *\n")
(display "Testing quotation!\n\tExpect: (1 2 3)\n\tGotten: ") (display "Testing quotation!\n\tExpect: (1 2 3)\n\tGotten: ")
@ -121,29 +151,43 @@
(display "* R5RS: Testing booleans *") (display "* R5RS: Testing booleans *")
(newline) (newline)
(display "Testing not\n\tExpect: #f #t #f #f\n\tGotten: ") (define fun-test
(display (not #t)) (display " ") (lambda (name f cases)
(display (not #f)) (display " ") (test (string-append "Testing function " name "")
(display (not "hi")) (display " ") (map (lambda (a) (cons (car a) (f (cdr a))))
(display (not 6)) (newline) cases))))
(newline) (fun-test "not" not
(display "* R5RS: Testing numerical operators *") '( (#f . #t)
(newline) (#t . #f)
(#f . "hi")
(#f . 7)
(#f . a)
(#f . ())
))
(display "Testing number?\n\tExpect: #t #f #f #f\n\tGotten: ") (fun-test "boolean?" boolean?
(display (number? 5)) '( (#t . #t)
(display " ") (#t . #f)
(display (number? #f)) (#f . "hi")
(display " ") (#f . 7)
(display (number? "hello")) (#f . a)
(display " ") (#f . ())
(display (number? '(1 2))) ))
(newline)
(newline) (header "R5RS: Testing numerical operators")
(display "* R5RS: Testing fold and map *")
(newline) (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 "Testing sum over foldl!\n\tExpect: 28\n\tGotten: ")
(display (foldl + 0 '(1 2 3 4 5 6 7))) (display (foldl + 0 '(1 2 3 4 5 6 7)))
@ -173,32 +217,6 @@
(display (string-append "Hello" " " "World")) (display (string-append "Hello" " " "World"))
(newline) (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 (define do-stuffer
(lambda (name_i arg1_i arg2_i) (lambda (name_i arg1_i arg2_i)
(lambda (x) (lambda (x)

View File

@ -1031,27 +1031,27 @@ let /* Booleans */
/* R5RS: Boolean */ /* R5RS: Boolean */
; stdfun("not") ; stdfun("not")
; app(OPCODE_TYPEOF, 0, "")
; app2(OPCODE_PUSH, bool_val(false)) ; app2(OPCODE_PUSH, bool_val(false))
; app(OPCODE_EQV, 0, "") ; app(OPCODE_EQV, 0, "")
; app(OPCODE_RET, 1, "") ; app(OPCODE_RET, 1, "")
; stdfun("boolean?") ; stdfun("boolean?")
/* Test for false */ /* Test for false */
; app(OPCODE_TYPEOF, 0, "")
; app(OPCODE_DUPL, 0, "") ; app(OPCODE_DUPL, 0, "")
; app2(OPCODE_PUSH, bool_val(false)) ; app2(OPCODE_PUSH, bool_val(false))
; app(OPCODE_EQV, 0, "") ; 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? */ /* Not false, maybe true? */
; app2(OPCODE_PUSH, bool_val(true)) ; app2(OPCODE_PUSH, bool_val(true))
; app(OPCODE_EQV, 0, "") ; app(OPCODE_EQV, 0, "")
; app(OPCODE_RET, 1, "") ; app(OPCODE_RET, 1, "")
/* Is true, remove top and return */
; app(OPCODE_POP, 0, "")
; app(OPCODE_RET, 1, "")
/* R5RS: Pairs and Lists */ /* R5RS: Pairs and Lists */
@ -1224,6 +1224,11 @@ let /* Booleans */
; app2(OPCODE_PUSH, VALUE_UNSPECIFIED) ; app2(OPCODE_PUSH, VALUE_UNSPECIFIED)
; app(OPCODE_RET, 1, "") ; app(OPCODE_RET, 1, "")
; stdfun("debug-show-stack")
; app(OPCODE_DEBUG, 2, "")
; app2(OPCODE_PUSH, VALUE_UNSPECIFIED)
; app(OPCODE_RET, 1, "")
; stdfun("exit") ; stdfun("exit")
; app(OPCODE_EXIT, true, "") ; app(OPCODE_EXIT, true, "")
@ -2329,9 +2334,14 @@ let /* Booleans */
else if tape[ip].opcode = OPCODE_DEBUG 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 ; ip := ip + 1
end end