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 if (macro (test args)
73 (cond ((null? (cdr args))
76 (list test (car args)))
81 (list test (car args))
82 (list 'else (cadr args))
94 ; define a set of local
95 ; variables and then evaluate
98 ; (let (var-defines) sexprs)
100 ; where var-defines are either
110 ; (let ((x 1) (y)) (set! y (+ x 1)) y)
112 (define let (macro (vars exprs)
113 ((lambda (make-names make-exprs make-nils)
116 ; make the list of names in the let
119 (set! make-names (lambda (vars)
120 (cond ((not (null? vars))
121 (cons (car (car vars))
122 (make-names (cdr vars))))
127 ; the set of expressions is
128 ; the list of set expressions
130 ; expressions to evaluate
132 (set! make-exprs (lambda (vars exprs)
133 (cond ((not (null? vars)) (cons
140 (make-exprs (cdr vars) exprs)
148 ; the parameters to the lambda is a list
149 ; of nils of the right length
151 (set! make-nils (lambda (vars)
152 (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
156 ; prepend the set operations
159 (set! exprs (make-exprs vars exprs))
163 (cons (cons 'lambda (cons (make-names vars) exprs))
178 (define or (lexpr (l)
180 (while (not (null? l))
181 (cond ((car l) (set! ret #t) (set! l ()))
188 ; execute to resolve macros
192 (define and (lexpr (l)
194 (while (not (null? l))
207 ; execute to resolve macros
213 ((and (pair? a) (pair? b))
214 (and (equal? (car a) (car b))
215 (equal? (cdr a) (cdr b)))
221 (equal? '(a b c) '(a b c))
222 (equal? '(a b c) '(a b b))