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 ;; TESTING
  91
  92 (define-macro (backwards . body)
  93               (cons 'begin (reverse body)))
  94
  95 ; Test for the while macro.
  96 (define (count)
  97   (define counter 10)
  98   (while (> counter 0)
  99          (display counter) (newline)
 100          (set! counter (- counter 1))))
 101
 102 ; Basic iterative summation.  Run this on large numbers to
 103 ; test garbage collection and tail-call optimization.
 104 (define (sum n)
 105
 106   (define (sum-iter total count maxcount)
 107     (if (> count maxcount)
 108       total
 109       (sum-iter (+ total count) (+ count 1) maxcount)))
 110
 111   (sum-iter 0 1 n))
 112
 113 ; Recursive summation. Use this to compare with tail call
 114 ; optimized iterative algorithm.
 115 (define (sum-recurse n)
 116   (if (= n 0)
 117     0
 118     (+ n (sum-recurse (- n 1)))))