scheme-library.scm

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; Standard Library Procedures and Macros ;;
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 ;; LISTS
   6
   7 (define (null? args)
   8   (eq? args ()))
   9
  10 (define (caar l) (car (car l)))
  11 (define (cadr l) (car (cdr l)))
  12 (define (cdar l) (cdr (car l)))
  13 (define (cddr l) (cdr (cdr l)))
  14 (define (cadar l) (car (cdr (car l))))
  15
  16 ; Join two lists together
  17 (define (join l1 l2)
  18   (if (null? l1)
  19     l2
  20     (cons (car l1) (join (cdr l1) l2))))
  21
  22 ; Append an arbitrary number of lists together
  23 (define (append . lists)
  24   (if (null? lists)
  25     ()
  26     (if (null? (cdr lists))
  27       (car lists)
  28       (join (car lists) (apply append (cdr lists))))))
  29
  30 ; Reverse the contents of a list
  31 (define (reverse l)
  32   (if (null? l)
  33     ()
  34     (append (reverse (cdr l)) (list (car l)))))
  35
  36
  37 ;; LIBRARY SPECIAL FORMS
  38
  39 ; let
  40
  41 (define (let-vars args)
  42   (if (null? args)
  43     '()
  44     (cons (caar args) (let-vars (cdr args)))))
  45
  46 (define (let-inits args)
  47   (if (null? args)
  48     '()
  49   (cons (cadar args) (let-inits (cdr args)))))
  50
  51 (define-macro (let args . body)
  52               `((lambda ,(let-vars args)
  53                  ,@body) ,@(let-inits args)))
  54
  55 ; while
  56
  57 (define-macro (while condition . body)
  58               (let ((loop (gensym)))
  59                 `(begin
  60                    (define (,loop)
  61                      (if ,condition
  62                        (begin ,@body (,loop))))
  63                    (,loop))))
  64
  65 ; cond
  66
  67
  68 ;; TESTING
  69
  70 (define-macro (backwards . body)
  71               (cons 'begin (reverse body)))
  72
  73 ; Test for the while macro.
  74 (define (count)
  75   (define counter 10)
  76   (while (> counter 0)
  77          (display counter) (newline)
  78          (set! counter (- counter 1))))
  79
  80 ; Basic iterative summation.  Run this on large numbers to
  81 ; test garbage collection and tail-call optimization.
  82 (define (sum n)
  83
  84   (define (sum-iter total count maxcount)
  85     (if (> count maxcount)
  86       total
  87       (sum-iter (+ total count) (+ count 1) maxcount)))
  88
  89   (sum-iter 0 1 n))
  90
  91 ; Recursive summation. Use this to compare with tail call
  92 ; optimized iterative algorithm.
  93 (define (sum-recurse n)
  94   (if (= n 0)
  95     0
  96     (+ n (sum-recurse (- n 1)))))