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 (define (caddr l) (car (cdr (cdr l))))
105 ; (if <condition> <if-true>)
106 ; (if <condition> <if-true> <if-false)
110 (cond ((null? (cdr args))
111 (list cond (list test (car args)))
115 (list test (car args))
116 (list 'else (cadr args))
124 (if (> 3 2) 'yes 'no)
125 (if (> 2 3) 'no 'yes)
128 ; simple math operators
130 (define zero? (macro (value) (list eqv? value 0)))
136 (define positive? (macro (value) (list > value 0)))
141 (define negative? (macro (value) (list < value 0)))
146 (define (abs a) (if (>= a 0) a (- a)))
151 (define max (lambda (a . b)
152 (while (not (null? b))
164 (define min (lambda (a . b)
165 (while (not (null? b))
177 (define (even? a) (zero? (% a 2)))
184 (define (odd? a) (not (even? a)))
192 (define (list-tail a b)
195 (list-tail (cdr a (- b 1)))
199 (define (list-ref a b)
200 (car (list-tail a b))
203 (define (list-tail a b)
206 (list-tail (cdr a) (- b 1))))
208 (list-tail '(1 2 3) 2)
210 (define (list-ref a b) (car (list-tail a b)))
212 (list-ref '(1 2 3) 2)
215 ; define a set of local
216 ; variables one at a time and
217 ; then evaluate a list of
220 ; (let* (var-defines) sexprs)
222 ; where var-defines are either
232 ; (let* ((x 1) (y)) (set! y (+ x 1)) y)
238 ; make the list of names in the let
242 (cond ((not (null? a))
249 ; the set of expressions is
250 ; the list of set expressions
252 ; expressions to evaluate
255 (cond ((null? a) b) (else
261 (cond ((null? (cdr (car a))) ())
262 (else (cadr (car a))))
270 ; the parameters to the lambda is a list
271 ; of nils of the right length
275 (else (cons () (_z (cdr a))))
280 (cons (cons lambda (cons (_n a) (_v a b))) (_z a))
284 (let* ((a 1) (y a)) (+ a y))
293 (cond ((equal? (car a) (car b))
294 (equal? (cdr a) (cdr b)))
302 (equal? '(a b c) '(a b c))
303 (equal? '(a b c) '(a b b))
305 (define member (lambda (obj a . test?)
310 (if (null? test?) (set! test? equal?) (set! test? (car test?)))
311 (if (test? obj (car a))
313 (member obj (cdr a) test?))
319 (member '(2) '((1) (2) (3)))
321 (member '(4) '((1) (2) (3)))
323 (define (memq obj a) (member obj a eq?))
329 (memq '(2) '((1) (2) (3)))
331 (define (_assoc a b t?)
336 (_assoc a (cdr b) t?)
341 (define (assq a b) (_assoc a b eq?))
342 (define (assoc a b) (_assoc a b equal?))
344 (assq 'a '((a 1) (b 2) (c 3)))
345 (assoc '(c) '((a 1) (b 2) ((c) 3)))
347 (define string (lambda a (list->string a)))
357 (cons (caar b) (args (cdr b)))
364 (cons (cdr (car b)) (next (cdr b)))
369 (cond ((null? (car b)) ())
371 (cons (apply a (args b)) (domap (next b)))
379 (map cadr '((a b) (d e) (g h)))
381 (define for-each (lambda (a . b)
385 (for-each display '("hello" " " "world" "\n"))
387 (define (newline) (write-char #\newline))