altos/lisp: Evaluate macros once, then smash them into place
[fw/altos] / src / lisp / ao_lisp_const.lisp
1                                         ; basic list accessors
2
3
4 (setq cadr (lambda (l) (car (cdr l))))
5 (setq caddr (lambda (l) (car (cdr (cdr l)))))
6 (setq list (lexpr (l) l))
7
8                                         ; evaluate a list of sexprs
9
10 ;(setq progn (lexpr (l) (last l)))
11
12
13                                         ;
14                                         ; Define a variable without returning the value
15                                         ; Useful when defining functions to avoid
16                                         ; having lots of output generated
17                                         ;
18
19 (setq def (macro (def-param)
20                  (list
21                   'progn
22                   (list
23                    'set
24                    (list
25                     'quote
26                     (car def-param))
27                    (cadr def-param)
28                    )
29                   (list
30                    'quote
31                    (car def-param)
32                    )
33                   )
34                  )
35      )
36
37                                         ; define a set of local
38                                         ; variables and then evaluate
39                                         ; a list of sexprs
40                                         ;
41                                         ; (let (var-defines) sexprs)
42                                         ;
43                                         ; where var-defines are either
44                                         ;
45                                         ; (name value)
46                                         ;
47                                         ; or
48                                         ;
49                                         ; (name)
50                                         ;
51                                         ; e.g.
52                                         ;
53                                         ; (let ((x 1) (y)) (setq y (+ x 1)) y)
54
55 (def let (macro (let-param)
56                 ((lambda (vars exprs make-names make-exprs make-nils)
57                    (progn
58
59                                         ;
60                                         ; make the list of names in the let
61                                         ;
62
63                      (setq make-names (lambda (vars)
64                                        (cond (vars
65                                               (cons (car (car vars))
66                                                     (make-names (cdr vars))))
67                                              )
68                                        )
69                           )
70                                         ;
71                                         ; the set of expressions is
72                                         ; the list of set expressions
73                                         ; pre-pended to the
74                                         ; expressions to evaluate
75                                         ;
76                      (setq make-exprs (lambda (vars exprs)
77                                        (progn
78                                          (cond (vars (cons
79                                                       (list set
80                                                             (list quote
81                                                                   (car (car vars))
82                                                                   )
83                                                             (cadr (car vars))
84                                                             )
85                                                       (make-exprs (cdr vars) exprs)
86                                                       )
87                                                      )
88                                                (exprs)
89                                                )
90                                          )
91                                        )
92                           )
93                      (setq exprs (make-exprs vars exprs))
94
95                                         ;
96                                         ; the parameters to the lambda is a list
97                                         ; of nils of the right length
98                                         ;
99                      (setq make-nils (lambda (vars)
100                                       (cond (vars (cons nil (make-nils (cdr vars))))
101                                             )
102                                       )
103                           )
104                                         ;
105                                         ; build the lambda.
106                                         ;
107                      (cons
108                       (list
109                        'lambda
110                        (make-names vars)
111                        (cond ((cdr exprs) (cons 'progn exprs))
112                              ((car exprs))
113                              )
114                        )
115                       (make-nils vars)
116                       )
117                      )
118                    )
119                  (car let-param)
120                  (cdr let-param)
121                  ()
122                  ()
123                  ()
124                  )
125                 )
126      )
127
128                                         ;
129                                         ; A slightly more convenient form
130                                         ; for defining lambdas.
131                                         ;
132                                         ; (defun <name> (<params>) s-exprs)
133                                         ;
134
135 (def defun (macro (defun-param)
136                     (let ((name (car defun-param))
137                           (args (cadr defun-param))
138                           (exprs (cdr (cdr defun-param))))
139                       (list
140                        def
141                        name
142                        (list
143                         'lambda
144                         args
145                         (cond ((cdr exprs)
146                                (cons progn exprs))
147                               ((car exprs))
148                               )
149                         )
150                        )
151                       )
152                     )
153      )
154
155                                         ; simple math operators
156                                         ;
157                                         ; Do these last to run defun
158                                         ; at least once so the let macro
159                                         ; is resolved
160
161 (defun 1+ (x) (+ x 1))
162 (defun 1- (x) (- x 1))