altos/lisp: Optimize chunk searching in collect
[fw/altos] / src / lisp / ao_lisp_const.lisp
index c6f50e346c9dd8bb61fcbc12eee7c6525af1ea23..6fbc35b67993fc2798effb659063db749d247c9a 100644 (file)
@@ -1,18 +1,21 @@
-                                       ; basic list accessors
-
-
-(setq cadr (lambda (l) (car (cdr l))))
-(setq caddr (lambda (l) (car (cdr (cdr l)))))
-(setq list (lexpr (l) l))
-
-                                       ; evaluate a list of sexprs
+;
+; Copyright © 2016 Keith Packard <keithp@keithp.com>
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 2 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+; General Public License for more details.
+;
+; Lisp code placed in ROM
 
-;(setq progn (lexpr (l) (last l)))
+                                       ; return a list containing all of the arguments
 
-                                       ; simple math operators
-
-(setq 1+ (lambda (x) (+ x 1)))
-(setq 1- (lambda (x) (- x 1)))
+(set (quote list) (lexpr (l) l))
 
                                        ;
                                        ; Define a variable without returning the value
                                        ; having lots of output generated
                                        ;
 
-(setq def (macro (def-param)
+(setq def (macro (name val rest)
                 (list
                  'progn
                  (list
                   'set
-                  (list
-                   'quote
-                   (car def-param))
-                  (cadr def-param)
-                  )
+                  (list 'quote name)
+                  val)
+                 (list 'quote name)
+                 )
+                )
+      )
+
+                                       ;
+                                       ; A slightly more convenient form
+                                       ; for defining lambdas.
+                                       ;
+                                       ; (defun <name> (<params>) s-exprs)
+                                       ;
+
+(def defun (macro (name args exprs)
                  (list
-                  'quote
-                  (car def-param)
+                  def
+                  name
+                  (list
+                   'lambda
+                   args
+                   (cond ((cdr exprs)
+                          (cons progn exprs))
+                         ((car exprs))
+                         )
+                   )
                   )
                  )
-                )
      )
+                                       ; basic list accessors
+
+
+(defun cadr (l) (car (cdr l)))
+
+(defun caddr (l) (car (cdr (cdr l))))
+
+(defun nth (list n)
+  (cond ((= n 0) (car list))
+       ((nth (cdr list) (1- n)))
+       )
+  )
+
+                                       ; simple math operators
+
+(defun 1+ (x) (+ x 1))
+(defun 1- (x) (- x 1))
 
                                        ; define a set of local
                                        ; variables and then evaluate
                                        ;
                                        ; (let ((x 1) (y)) (setq y (+ x 1)) y)
 
-(def let (macro (let-param)
-               ((lambda (vars exprs make-names make-exprs make-nils)
+(def let (macro (vars exprs)
+               ((lambda (make-names make-exprs make-nils)
                   (progn
 
                                        ;
                                        ; make the list of names in the let
                                        ;
 
-                    (set 'make-names (lambda (vars)
+                    (setmake-names (lambda (vars)
                                       (cond (vars
                                              (cons (car (car vars))
                                                    (make-names (cdr vars))))
                                             )
                                       )
                          )
-                                       ;
+
                                        ; the set of expressions is
                                        ; the list of set expressions
                                        ; pre-pended to the
                                        ; expressions to evaluate
-                                       ;
-                    (set 'make-exprs (lambda (vars exprs)
+
+                    (setmake-exprs (lambda (vars exprs)
                                       (progn
                                         (cond (vars (cons
                                                      (list set
                                         )
                                       )
                          )
-                    (set 'exprs (make-exprs vars exprs))
 
-                                       ;
                                        ; the parameters to the lambda is a list
                                        ; of nils of the right length
-                                       ;
-                    (set 'make-nils (lambda (vars)
+
+                    (setmake-nils (lambda (vars)
                                      (cond (vars (cons nil (make-nils (cdr vars))))
                                            )
                                      )
                          )
-                                       ;
+                                       ; prepend the set operations
+                                       ; to the expressions
+
+                    (setq exprs (make-exprs vars exprs))
+
                                        ; build the lambda.
-                                       ;
-                    (set 'last-let-value 
+
                     (cons
                      (list
                       'lambda
                      (make-nils vars)
                      )
                     )
-                    )
-                    
                   )
-                (car let-param)
-                (cdr let-param)
                 ()
                 ()
                 ()
                )
      )
 
-                                       ;
-                                       ; A slightly more convenient form
-                                       ; for defining lambdas.
-                                       ;
-                                       ; (defun <name> (<params>) s-exprs)
-                                       ;
+                                       ; boolean operators
 
-(def defun (macro (defun-param)
-                   (let ((name (car defun-param))
-                         (args (cadr defun-param))
-                         (exprs (cdr (cdr defun-param))))
-                     (list
-                      def
-                      name
-                      (list
-                       'lambda
-                       args
-                       (cond ((cdr exprs)
-                              (cons progn exprs))
-                             ((car exprs))
-                             )
-                       )
-                      )
-                     )
-                   )
+(def or (lexpr (l)
+              (let ((ret nil))
+                (while l
+                  (cond ((setq ret (car l))
+                         (setq l nil))
+                        ((setq l (cdr l)))))
+                ret
+                )
+              )
      )
+
+                                       ; execute to resolve macros
+
+(or nil t)
+
+(def and (lexpr (l)
+              (let ((ret t))
+                (while l
+                  (cond ((setq ret (car l))
+                         (setq l (cdr l)))
+                        ((setq ret (setq l nil)))
+                        )
+                  )
+                ret
+                )
+              )
+     )
+
+                                       ; execute to resolve macros
+
+(and t nil)
+