2 ; Copyright © 2016 Keith Packard <keithp@keithp.com>
4 ; This program is free software; you can redistribute it and/or modify
5 ; it under the terms of the GNU General Public License as published by
6 ; the Free Software Foundation, either version 2 of the License, or
7 ; (at your option) any later version.
9 ; This program is distributed in the hope that it will be useful, but
10 ; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ; General Public License for more details.
14 ; Lisp code placed in ROM
16 ; return a list containing all of the arguments
17 (def (quote list) (lambda l l))
34 (else (cons (car a) (a-l (cdr a) b)))
42 ((null? (cdr l)) (car l))
43 (else (a-l (car l) (a-ls (cdr l))))
52 (append '(a b c) '(d e f) '(g h i))
55 ; Define a variable without returning the value
56 ; Useful when defining functions to avoid
57 ; having lots of output generated.
59 ; Also accepts the alternate
60 ; form for defining lambdas of
61 ; (define (name a y z) sexprs ...)
67 ; check for alternate lambda definition form
71 (cons lambda (cons (cdr a) b)))
81 (cons (cons quote (cons a '()))
86 (cons quote (cons a '()))
95 ; basic list accessors
97 (define (caar l) (car (car l)))
99 (define (cadr l) (car (cdr l)))
101 (define (cdar l) (cdr (car l)))
103 ; (if <condition> <if-true>)
104 ; (if <condition> <if-true> <if-false)
108 (cond ((null? (cdr args))
109 (list cond (list test (car args)))
113 (list test (car args))
114 (list 'else (cadr args))
122 (if (> 3 2) 'yes 'no)
123 (if (> 2 3) 'no 'yes)
126 ; simple math operators
128 (define zero? (macro (value) (list eqv? value 0)))
134 (define positive? (macro (value) (list > value 0)))
139 (define negative? (macro (value) (list < value 0)))
144 (define (abs a) (if (>= a 0) a (- a)))
149 (define max (lambda (a . b)
150 (while (not (null? b))
162 (define min (lambda (a . b)
163 (while (not (null? b))
175 (define (even? a) (zero? (% a 2)))
182 (define (odd? a) (not (even? a)))
190 (define (list-tail a b)
193 (list-tail (cdr a) (- b 1))
197 (define (list-ref a b)
198 (car (list-tail a b))
201 (list-ref '(1 2 3) 2)
204 ; define a set of local
205 ; variables one at a time and
206 ; then evaluate a list of
209 ; (let* (var-defines) sexprs)
211 ; where var-defines are either
221 ; (let* ((x 1) (y)) (set! y (+ x 1)) y)
227 ; make the list of names in the let
231 (cond ((not (null? a))
238 ; the set of expressions is
239 ; the list of set expressions
241 ; expressions to evaluate
244 (cond ((null? a) b) (else
250 (cond ((null? (cdr (car a))) ())
251 (else (cadr (car a))))
259 ; the parameters to the lambda is a list
260 ; of nils of the right length
264 (else (cons () (_z (cdr a))))
269 (cons (cons lambda (cons (_n a) (_v a b))) (_z a))
273 (let* ((a 1) (y a)) (+ a y))
282 (cond ((equal? (car a) (car b))
283 (equal? (cdr a) (cdr b)))
291 (equal? '(a b c) '(a b c))
292 (equal? '(a b c) '(a b b))
294 (define member (lambda (obj a . test?)
299 (if (null? test?) (set! test? equal?) (set! test? (car test?)))
300 (if (test? obj (car a))
302 (member obj (cdr a) test?))
308 (member '(2) '((1) (2) (3)))
310 (member '(4) '((1) (2) (3)))
312 (define (memq obj a) (member obj a eq?))
318 (memq '(2) '((1) (2) (3)))
320 (define (_assoc a b t?)
325 (_assoc a (cdr b) t?)
330 (define (assq a b) (_assoc a b eq?))
331 (define (assoc a b) (_assoc a b equal?))
333 (assq 'a '((a 1) (b 2) (c 3)))
334 (assoc '(c) '((a 1) (b 2) ((c) 3)))
336 (define string (lambda a (list->string a)))
343 (cons (caar b) (args (cdr b)))
350 (cons (cdr (car b)) (next (cdr b)))
355 (cond ((null? (car b)) ())
357 (cons (apply a (args b)) (domap (next b)))
365 (map cadr '((a b) (d e) (g h)))
367 (define (newline) (write-char #\newline))