5 (define-macro (define args . body)
7 (list 'define (car args) (join-lists (list 'lambda (cdr args)) body))
17 (define-macro (let args . body)
19 (list (join-lists (list 'lambda (map (lambda (x) (car x)) args)) body))
20 (map (lambda (x) (car (cdr x))) args)))
22 ;; quasiquote/unquote (one nesting level only)
32 (if (eq? (car head) 'unquote)
33 (list 'cons (car (cdr head)) (qqhelper tail))
34 (if (eq? (car head) 'unquote-splicing)
35 (list 'join-lists (car (cdr head)) (qqhelper tail))
36 (list 'cons (list 'quasiquote head) (qqhelper tail))))
38 (list 'cons (list 'quote head) (qqhelper tail))
39 (list 'cons head (qqhelper tail)))))))
41 (define-macro (quasiquote arg)
48 (define-macro (begin . sequence)
49 `((lambda () ,@sequence)))
53 (define-macro (caar l) `(car (car ,l)))
54 (define-macro (cadr l) `(car (cdr ,l)))
55 (define-macro (cdar l) `(cdr (car ,l)))
56 (define-macro (cddr l) `(cdr (cdr ,l)))
57 (define-macro (caaar l) `(car (car (car ,l))))
58 (define-macro (caadr l) `(car (car (cdr ,l))))
59 (define-macro (cadar l) `(car (cdr (car ,l))))
60 (define-macro (caddr l) `(car (cdr (cdr ,l))))
61 (define-macro (cdaar l) `(cdr (car (car ,l))))
62 (define-macro (cdadr l) `(cdr (car (cdr ,l))))
63 (define-macro (cddar l) `(cdr (cdr (car ,l))))
64 (define-macro (cdddr l) `(cdr (cdr (cdr ,l))))
65 (define-macro (cadddr l) `(car (cdr (cdr (cdr ,l)))))
69 (define-macro (let* args . body)
73 (let* ,(cdr args) ,@body))))
77 (define-macro (while condition . body)
78 (let ((loop (gensym)))
82 (begin ,@body (,loop))))
88 (define (cond-predicate clause) (car clause))
89 (define (cond-actions clause) (cdr clause))
90 (define (cond-else-clause? clause)
91 (eq? (cond-predicate clause) 'else))
93 (define (expand-clauses clauses)
96 (let ((first (car clauses))
98 (if (cond-else-clause? first)
100 `(begin ,@(cond-actions first))
101 (error "else clause isn't last in cond expression."))
102 `(if ,(cond-predicate first)
103 (begin ,@(cond-actions first))
104 ,(expand-clauses rest))))))
106 (define-macro (cond . clauses)
108 (error "cond requires at least one clause.")
109 (expand-clauses clauses)))))
114 (define (expand-and-expressions expressions)
115 (let ((first (car expressions))
116 (rest (cdr expressions)))
120 ,(expand-and-expressions rest)
123 (define-macro (and . expressions)
124 (if (null? expressions)
126 (expand-and-expressions expressions)))))
131 (define (expand-or-expressions expressions)
132 (let ((first (car expressions))
133 (rest (cdr expressions)))
138 ,(expand-or-expressions rest)))))
140 (define-macro (or . expressions)
141 (if (null? expressions)
143 (expand-or-expressions expressions)))))