Fixed implementation of boolean? and not.

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: ")
+(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 (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)

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, "")
 
@@ -2329,9 +2334,14 @@ let /* Booleans */
 
             else if tape[ip].opcode = OPCODE_DEBUG
                   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