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 (define (cond-predicate clause) (car clause))
  68 (define (cond-actions clause) (cdr clause))
  69 (define (cond-else-clause? clause)
  70   (eq? (cond-predicate clause) 'else))
  71
  72 (define (expand-clauses clauses)
  73   (if (null? clauses)
  74     (none)
  75     (let ((first (car clauses))
  76           (rest (cdr clauses)))
  77       (if (cond-else-clause? first)
  78         (if (null? rest)
  79           `(begin ,@(cond-actions first))
  80           (error "else clause isn't last in cond expression."))
  81         `(if ,(cond-predicate first)
  82            (begin ,@(cond-actions first))
  83            ,(expand-clauses rest))))))
  84
  85 (define-macro (cond . clauses)
  86               (if (null? clauses)
  87                 (error "cond requires at least one clause.")
  88                 (expand-clauses clauses)))
  89
  90 ; and
  91
  92 (define (expand-and-expressions expressions)
  93   (let ((first (car expressions))
  94         (rest (cdr expressions)))
  95     (if (null? rest)
  96       first
  97       `(if ,first
  98          ,(expand-and-expressions rest)
  99          #f))))
 100
 101 (define-macro (and . expressions)
 102               (if (null? expressions)
 103                 #t
 104                 (expand-and-expressions expressions)))
 105
 106 ; or
 107
 108 (define (expand-or-expressions expressions)
 109   (if (null? expressions)
 110     #f
 111     (let ((first (car expressions))
 112           (rest (cdr expressions))
 113           (val (gensym)))
 114       `(let ((,val ,first))
 115          (if ,val
 116             ,val
 117             ,(expand-or-expressions rest))))))
 118
 119 (define-macro (or . expressions)
 120               (expand-or-expressions expressions))
 121
 122
 123 ;; TESTING
 124
 125 (define-macro (backwards . body)
 126               (cons 'begin (reverse body)))
 127
 128 ; Test for the while macro.
 129 (define (count)
 130   (define counter 10)
 131   (while (> counter 0)
 132          (display counter) (newline)
 133          (set! counter (- counter 1))))
 134
 135 ; Basic iterative summation.  Run this on large numbers to
 136 ; test garbage collection and tail-call optimization.
 137 (define (sum n)
 138
 139   (define (sum-iter total count maxcount)
 140     (if (> count maxcount)
 141       total
 142       (sum-iter (+ total count) (+ count 1) maxcount)))
 143
 144   (sum-iter 0 1 n))
 145
 146 ; Recursive summation. Use this to compare with tail call
 147 ; optimized iterative algorithm.
 148 (define (sum-recurse n)
 149   (if (= n 0)
 150     0
 151     (+ n (sum-recurse (- n 1)))))