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 ;; LIBRARY FORMS
  37
  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               (define loop (gensym))
  59               `(begin
  60                  (define (,loop)
  61                    (if ,condition
  62                      (begin ,@body (,loop))))
  63                  (,loop)))
  64
  65 ;; TESTING
  66
  67 (define-macro (backwards . body)
  68               (cons 'begin (reverse body)))
  69
  70 ; Test for the while macro.
  71 (define (count)
  72   (define counter 10)
  73   (while (> counter 0)
  74          (display counter) (newline)
  75          (set! counter (- counter 1))))
  76
  77 ; Basic iterative summation.  Run this on large numbers to
  78 ; test garbage collection and tail-call optimization.
  79 (define (sum n)
  80
  81   (define (sum-iter total count maxcount)
  82     (if (> count maxcount)
  83       total
  84       (sum-iter (+ total count) (+ count 1) maxcount)))
  85
  86   (sum-iter 0 1 n))
  87
  88 ; Recursive summation. Use this to compare with tail call
  89 ; optimized iterative algorithm.
  90 (define (sum-recurse n)
  91   (if (= n 0)
  92     0
  93     (+ n (sum-recurse (- n 1)))))