2 ; Copyright © 2018 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 ; Basic syntax placed in ROM
16 (def (quote list) (lambda l l))
33 (else (cons (car a) (_a (cdr a) b)))
41 ((null? (cdr l)) (car l))
42 (else (_a (car l) (_b (cdr l))))
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 x y z) sexprs ...)
67 ; check for alternate lambda definition form
83 (cons (cons quote (cons a '()))
88 (cons quote (cons a '()))
121 ; execute to resolve macros
148 ; execute to resolve macros
152 ; (if <condition> <if-true>)
153 ; (if <condition> <if-true> <if-false)
157 (cond ((null? (cdr b))
158 (list cond (list a (car b)))
163 (list 'else (car (cdr b)))
171 (if (> 3 2) 'yes 'no)
172 (if (> 2 3) 'no 'yes)
179 ; make the list of names in the let
183 (cond ((not (null? a))
190 ; the set of expressions is
191 ; the list of set expressions
193 ; expressions to evaluate
203 (cond ((null? (cdr (car a)))
217 ; the parameters to the lambda is a list
218 ; of nils of the right length
222 (else (cons () (_c (cdr a))))
227 (cons (cons lambda (cons (_a a) (_b a b))) (_c a))
231 (letrec ((a 1) (b a)) (+ a b))
233 ; letrec is sufficient for let*
237 ; use letrec for let in basic
243 ; equality. Replaced with
244 ; vector-capable version in
251 (cond ((equal? (car a) (car b))
252 (equal? (cdr a) (cdr b)))
260 (equal? '(a b c) '(a b c))
262 ; basic list accessors
264 (define (caar a) (car (car a)))
266 (define (cadr a) (car (cdr a)))
268 (define (list-ref a b)
269 (car (list-tail a b))
272 (list-ref '(1 2 3) 2)
274 (define (member a b . t?)
279 (if (null? t?) (set! t? equal?) (set! t? (car t?)))
282 (member a (cdr b) t?))
287 (member '(2) '((1) (2) (3)))
288 (member '(4) '((1) (2) (3)))
290 (define (memq a b) (member a b eq?))
294 (memq '(2) '((1) (2) (3)))
296 (define (assoc a b . t?)
310 (assoc '(c) '((a 1) (b 2) ((c) 3)))
312 (define (assq a b) (assoc a b eq?))
314 (assq 'a '((a 1) (b 2) (c 3)))
317 (lambda (proc . lists)
319 (cond ((null? lists) ())
321 (cons (caar lists) (_a (cdr lists)))
326 (cond ((null? lists) ())
328 (cons (cdr (car lists)) (_n (cdr lists)))
333 (cond ((null? (car lists)) ())
335 (cons (apply proc (_a lists)) (_m (_n lists)))
343 (map cadr '((a b) (d e) (g h)))
345 ; use map as for-each in basic
348 (define for-each map)
349 ; simple math operators
351 (define zero? (macro (value) (list eq? value 0)))
357 (define positive? (macro (value) (list > value 0)))
362 (define negative? (macro (value) (list < value 0)))
367 (define (abs a) (if (>= a 0) a (- a)))
372 (define max (lambda (a . b)
373 (while (not (null? b))
385 (define min (lambda (a . b)
386 (while (not (null? b))
398 (define (even? a) (zero? (% a 2)))
405 (define (odd? a) (not (even? a)))
412 (define (newline) (write-char #\newline))