484f500efaa87092da9fa0f3e8097fe64a975a50
[scheme.forth.jl.git] / src / 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 ; Return number of items in list
17 (define (length l)
18   (define (iter a count)
19     (if (null? a)
20       count
21       (iter (cdr a) (+ count 1))))
22   (iter l 0))
23
24 ; Join two lists together
25 (define (join l1 l2)
26   (if (null? l1)
27     l2
28     (cons (car l1) (join (cdr l1) l2))))
29
30 ; Append an arbitrary number of lists together
31 (define (append . lists)
32   (if (null? lists)
33     ()
34     (if (null? (cdr lists))
35       (car lists)
36       (join (car lists) (apply append (cdr lists))))))
37
38 ; Reverse the contents of a list
39 (define (reverse l)
40   (if (null? l)
41     ()
42     (append (reverse (cdr l)) (list (car l)))))
43
44
45 ;; LIBRARY SPECIAL FORMS
46
47 ; let
48
49 (define (let-vars args)
50   (if (null? args)
51     '()
52     (cons (caar args) (let-vars (cdr args)))))
53
54 (define (let-inits args)
55   (if (null? args)
56     '()
57   (cons (cadar args) (let-inits (cdr args)))))
58
59 (define-macro (let args . body)
60               `((lambda ,(let-vars args)
61                  ,@body) ,@(let-inits args)))
62
63 ; while
64
65 (define-macro (while condition . body)
66               (let ((loop (gensym)))
67                 `(begin
68                    (define (,loop)
69                      (if ,condition
70                        (begin ,@body (,loop))))
71                    (,loop))))
72
73 ; cond
74
75 (define (cond-predicate clause) (car clause))
76 (define (cond-actions clause) (cdr clause))
77 (define (cond-else-clause? clause)
78   (eq? (cond-predicate clause) 'else))
79
80 (define (expand-clauses clauses)
81   (if (null? clauses)
82     (none)
83     (let ((first (car clauses))
84           (rest (cdr clauses)))
85       (if (cond-else-clause? first)
86         (if (null? rest)
87           `(begin ,@(cond-actions first))
88           (error "else clause isn't last in cond expression."))
89         `(if ,(cond-predicate first)
90            (begin ,@(cond-actions first))
91            ,(expand-clauses rest))))))
92
93 (define-macro (cond . clauses)
94               (if (null? clauses)
95                 (error "cond requires at least one clause.")
96                 (expand-clauses clauses)))
97
98 ; and
99
100 (define (expand-and-expressions expressions)
101   (let ((first (car expressions))
102         (rest (cdr expressions)))
103     (if (null? rest)
104       first
105       `(if ,first
106          ,(expand-and-expressions rest)
107          #f))))
108
109 (define-macro (and . expressions)
110               (if (null? expressions)
111                 #t
112                 (expand-and-expressions expressions)))
113
114 ; or
115
116 (define (expand-or-expressions expressions)
117   (if (null? expressions)
118     #f
119     (let ((first (car expressions))
120           (rest (cdr expressions))
121           (val (gensym)))
122       `(let ((,val ,first))
123          (if ,val
124             ,val
125             ,(expand-or-expressions rest))))))
126
127 (define-macro (or . expressions)
128               (expand-or-expressions expressions))
129
130
131 ;; TESTING
132
133 (define-macro (backwards . body)
134               (cons 'begin (reverse body)))
135
136 ; Test for the while macro.
137 (define (count)
138   (define counter 10)
139   (while (> counter 0)
140          (display counter) (newline)
141          (set! counter (- counter 1))))
142
143 ; Basic iterative summation.  Run this on large numbers to
144 ; test garbage collection and tail-call optimization.
145 (define (sum n)
146
147   (define (sum-iter total count maxcount)
148     (if (> count maxcount)
149       total
150       (sum-iter (+ total count) (+ count 1) maxcount)))
151   
152   (sum-iter 0 1 n))
153
154 ; Recursive summation. Use this to compare with tail call
155 ; optimized iterative algorithm.
156 (define (sum-recurse n)
157   (if (= n 0)
158     0
159     (+ n (sum-recurse (- n 1)))))