MultiSource/Applications/siod/test.scm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These are some really basic tests of SIOD that I wrote for the LLVM
;; testsuite... later we should replace these with code that actually does
;; something, I guess. -Brian

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some standard-Scheme compatibility routines
(define else #t)
(define (display x) 
	(cond ((number? x) (puts (number->string x)))
		  ((string? x) (puts x))
		  ((symbol? x) (puts x))
		  (else (err "can't display errobj" x))))
(define (newline) (puts "\n"))
(define (cadddr x) (caddr (cdr x)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Property lists like in LISP.
(define *properties* '())
(define (get table key)
	(let ((result (assoc (cons key table) *properties*)))
		(if result
			(cadr result)
			#f)))
(define (put table key value)
     (let* ((real-key (cons key table))
	        (result (assoc real-key *properties*)))
		(if result
			(set-car! (cdr result) value)
			(set! *properties* (cons (list real-key value) *properties*)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; simple test code for proplist code, presented above
(define (simple-proplist-test)
	(put 'answer 'value 42)
	(display "the value of (get 'answer 'value) is ")
	(display (get 'answer 'value))
	(newline)
	(put 'answer 'value 'xyzzy)
	(display "the value of (get 'answer 'value) is ")
	(display (get 'answer 'value))
	(newline))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; recursively count down from COUNTER, printing out the numbers
(define (print-countdown counter)
	(if (equal? counter 0)
		#t
		(begin
			(display counter) 
			(newline)
            (print-countdown (- counter 1)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; print out whether VALUE is positive, zero, or negative
(define (print-signum value)
    (display value)
    (display " is ")
	(display (cond ((> value 0) "positive")
	               ((< value 0) "negative")
	               (else "zero")))
    (newline))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fibonacci test

(define (fib n)
  (if (< n 2)
     n
     (+ (fib (- n 1)) (fib (- n 2)))))

(define (fib-test)
  (display "the 33rd Fibonacci number is ")
  (display (fib 33))
  (newline))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Run some simple tests
(print-countdown 10)
(print-signum -42)
(print-signum 0)
(print-signum 42)
(simple-proplist-test)
(fib-test)