altos/scheme: Split tests out from build sources

Run tests on both tiny and full scheme test programs.

Signed-off-by: Keith Packard <keithp@keithp.com>

1 files changed, 19 insertions, 42 deletions

diff --git a/src/scheme/ao_scheme_basic_syntax.scheme b/src/scheme/ao_scheme_basic_syntax.scheme
index 563364a9..4cd3e167 100644
--- a/src/scheme/ao_scheme_basic_syntax.scheme
+++ b/src/scheme/ao_scheme_basic_syntax.scheme
@@ -13,8 +13,6 @@
 ;
 ; Basic syntax placed in ROM
 
-(def (quote _?_) (lambda (a b) (cond ((eq? a b) a) (else (exit 1)))))
-
 (def (quote list) (lambda l l))
 
 (def (quote def!)
@@ -28,7 +26,7 @@
 
 (begin
  (def! append
-   (lambda args
+   (lambda a
 	  (def! _a
 	    (lambda (a b)
 	      (cond ((null? a) b)
@@ -45,7 +43,7 @@
 		    )
 	      )
 	    )
-	  (_b args)
+	  (_b a)
 	  )
    )
  'append)
@@ -122,7 +120,7 @@
 
 					; execute to resolve macros
 
-(_?_ (or #f #t) #t)
+(or #f #t)
 
 (define and
   (macro a
@@ -149,7 +147,7 @@
 
 					; execute to resolve macros
 
-(_?_ (and #t #f) #f)
+(and #t #f)
 
 					; (if <condition> <if-true>)
 					; (if <condition> <if-true> <if-false)
@@ -169,10 +167,10 @@
     )
   )
 
-(_?_ (if (> 3 2) 'yes) 'yes)
-(_?_ (if (> 3 2) 'yes 'no) 'yes)
-(_?_ (if (> 2 3) 'no 'yes) 'yes)
-(_?_ (if (> 2 3) 'no) #f)
+(if (> 3 2) 'yes)
+(if (> 3 2) 'yes 'no)
+(if (> 2 3) 'no 'yes)
+(if (> 2 3) 'no)
 
 (define letrec
   (macro (a . b)
@@ -230,7 +228,7 @@
 	 )
      )
 
-(_?_ (letrec ((a 1) (b a)) (+ a b)) 2)
+(letrec ((a 1) (b a)) (+ a b))
 
 					; letrec is sufficient for let*
 
@@ -259,10 +257,7 @@
 	)
   )
 
-(_?_ (equal? '(a b c) '(a b c)) #t)
-(_?_ (equal? '(a b c) '(a b b)) #f)
-
-(def (quote _??_) (lambda (a b) (cond ((equal? a b) a) (else (exit 1)))))
+(equal? '(a b c) '(a b c))
 
 					; basic list accessors
 
@@ -270,18 +265,6 @@
 
 (define (cadr a) (car (cdr a)))
 
-(define (cdar l) (cdr (car l)))
-
-(_??_ (cdar '((1 2) (3 4))) '(2))
-
-(define (cddr l) (cdr (cdr l)))
-
-(_??_ (cddr '(1 2 3)) '(3))
-
-(define (caddr l) (car (cdr (cdr l))))
-
-(_??_ (caddr '(1 2 3 4)) 3)
-
 (define (list-ref a b)
   (car (list-tail a b))
   )
@@ -301,14 +284,14 @@
 	)
   )
 
-(_??_ (member '(2) '((1) (2) (3)))  '((2) (3)))
-(_??_ (member '(4) '((1) (2) (3))) #f)
+(member '(2) '((1) (2) (3)))
+(member '(4) '((1) (2) (3)))
 
 (define (memq a b) (member a b eq?))
 
-(_??_ (memq 2 '(1 2 3)) '(2 3))
-(_??_ (memq 4 '(1 2 3)) #f)
-(_??_ (memq '(2) '((1) (2) (3))) #f)
+(memq 2 '(1 2 3))
+(memq 4 '(1 2 3))
+(memq '(2) '((1) (2) (3)))
 
 (define (assoc a b . t?)
   (if (null? t?)
@@ -324,12 +307,11 @@
     )
   )
 
+(assoc '(c) '((a 1) (b 2) ((c) 3)))
+
 (define (assq a b) (assoc a b eq?))
-(define assv assq)
 
-(_??_ (assq 'a '((a 1) (b 2) (c 3))) '(a 1))
-(_??_ (assv 'b '((a 1) (b 2) (c 3))) '(b 2))
-(_??_ (assoc '(c) '((a 1) (b 2) ((c) 3))) '((c) 3))
+(assq 'a '((a 1) (b 2) (c 3)))
 
 (define map
   (lambda (proc . lists)
@@ -358,7 +340,7 @@
 	 )
   )
 
-(_??_ (map cadr '((a b) (d e) (g h))) '(b e h))
+(map cadr '((a b) (d e) (g h)))
 
 					; use map as for-each in basic
 					; mode
@@ -430,8 +412,3 @@
 (define (newline) (write-char #\newline))
 
 (newline)
-
-(define (eof-object? a)
-  (equal? a 'eof)
-  )
-