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
18 (set (quote list) (lexpr (l) l))
21 ; Define a variable without returning the value
22 ; Useful when defining functions to avoid
23 ; having lots of output generated
26 (set (quote define) (macro (name val rest)
39 ; A slightly more convenient form
40 ; for defining lambdas.
42 ; (defun <name> (<params>) s-exprs)
45 (define defun (macro (name args exprs)
49 (cons 'lambda (cons args exprs))
54 ; basic list accessors
57 (defun cadr (l) (car (cdr l)))
59 (defun caddr (l) (car (cdr (cdr l))))
62 (cond ((= n 0) (car list))
63 ((nth (cdr list) (1- n)))
67 ; simple math operators
69 (defun 1+ (x) (+ x 1))
70 (defun 1- (x) (- x 1))
72 (define zero? (macro (value rest)
84 (define positive? (macro (value rest)
95 (define negative? (macro (value rest)
106 (defun abs (x) (cond ((>= x 0) x)
113 (define max (lexpr (first rest)
114 (while (not (null? rest))
115 (cond ((< first (car rest))
116 (set! first (car rest)))
118 (set! rest (cdr rest))
126 (define min (lexpr (first rest)
127 (while (not (null? rest))
128 (cond ((> first (car rest))
129 (set! first (car rest)))
131 (set! rest (cdr rest))
139 (defun even? (x) (zero? (% x 2)))
146 (defun odd? (x) (not (even? x)))
153 (define exact? number?)
154 (defun inexact? (x) #f)
156 ; (if <condition> <if-true>)
157 ; (if <condition> <if-true> <if-false)
159 (define if (macro (test args)
160 (cond ((null? (cdr args))
163 (list test (car args)))
168 (list test (car args))
169 (list 'else (cadr args))
177 (if (> 3 2) 'yes 'no)
178 (if (> 2 3) 'no 'yes)
181 ; define a set of local
182 ; variables and then evaluate
185 ; (let (var-defines) sexprs)
187 ; where var-defines are either
197 ; (let ((x 1) (y)) (set! y (+ x 1)) y)
199 (define let (macro (vars exprs)
200 ((lambda (make-names make-exprs make-nils)
203 ; make the list of names in the let
206 (set! make-names (lambda (vars)
207 (cond ((not (null? vars))
208 (cons (car (car vars))
209 (make-names (cdr vars))))
214 ; the set of expressions is
215 ; the list of set expressions
217 ; expressions to evaluate
219 (set! make-exprs (lambda (vars exprs)
220 (cond ((not (null? vars)) (cons
227 (make-exprs (cdr vars) exprs)
235 ; the parameters to the lambda is a list
236 ; of nils of the right length
238 (set! make-nils (lambda (vars)
239 (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
243 ; prepend the set operations
246 (set! exprs (make-exprs vars exprs))
250 (cons (cons 'lambda (cons (make-names vars) exprs))
265 (define or (lexpr (l)
267 (while (not (null? l))
268 (cond ((car l) (set! ret #t) (set! l ()))
275 ; execute to resolve macros
279 (define and (lexpr (l)
281 (while (not (null? l))
294 ; execute to resolve macros
299 (define append (lexpr (args)
300 (let ((append-list (lambda (a b)
302 (else (cons (car a) (append-list (cdr a) b)))
306 (append-lists (lambda (lists)
307 (cond ((null? lists) lists)
308 ((null? (cdr lists)) (car lists))
309 (else (append-list (car lists) (append-lists (cdr lists))))
319 (append '(a b c) '(d e f) '(g h i))
321 (defun reverse (list)
323 (while (not (null? list))
324 (set! result (cons (car list) result))
325 (set! list (cdr list))
336 (list-tail (cdr x) (- k 1)))))
338 (list-tail '(1 2 3) 2)
343 ((and (pair? a) (pair? b))
344 (and (equal? (car a) (car b))
345 (equal? (cdr a) (cdr b)))
351 (equal? '(a b c) '(a b c))
352 (equal? '(a b c) '(a b b))
354 ;(define number->string (lexpr (arg opt)
355 ; (let ((base (if (null? opt) 10 (car opt)))