projects
/
fw
/
altos
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
altos/lisp: Take advantage of implicit progn in ROM code
[fw/altos]
/
src
/
lisp
/
ao_lisp_const.lisp
diff --git
a/src/lisp/ao_lisp_const.lisp
b/src/lisp/ao_lisp_const.lisp
index 13bb81391fd570e95a41544a1a4e921a65705c4d..3c8fd21b73165a6c3d2bd95c40b5c73ddec010bb 100644
(file)
--- a/
src/lisp/ao_lisp_const.lisp
+++ b/
src/lisp/ao_lisp_const.lisp
@@
-46,20
+46,11
@@
(list
def
name
(list
def
name
- (list
- 'lambda
- args
- (cond (exprs
- (cond ((cdr exprs)
- (cons progn exprs))
- ((car exprs))
- )
- )
- )
- )
+ (cons 'lambda (cons args exprs))
)
)
)
)
)
)
+
; basic list accessors
; basic list accessors
@@
-98,69
+89,58
@@
(def let (macro (vars exprs)
((lambda (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
;
;
; make the list of names in the let
;
-
(setq make-names (lambda (vars)
-
(cond (vars
-
(cons (car (car vars))
-
(make-names (cdr vars))))
-
)
-
)
-
)
+ (setq make-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
; the set of expressions is
; the list of set expressions
; pre-pended to the
; expressions to evaluate
- (setq make-exprs (lambda (vars exprs)
- (progn
- (cond (vars (cons
- (list set
- (list quote
- (car (car vars))
- )
- (cadr (car vars))
- )
- (make-exprs (cdr vars) exprs)
- )
- )
- (exprs)
- )
- )
- )
- )
+ (setq make-exprs (lambda (vars exprs)
+ (cond (vars (cons
+ (list set
+ (list quote
+ (car (car vars))
+ )
+ (cadr (car vars))
+ )
+ (make-exprs (cdr vars) exprs)
+ )
+ )
+ (exprs)
+ )
+ )
+ )
; the parameters to the lambda is a list
; of nils of the right length
; the parameters to the lambda is a list
; of nils of the right length
-
(setq make-nils (lambda (vars)
-
(cond (vars (cons nil (make-nils (cdr vars))))
-
)
-
)
-
)
+ (setq make-nils (lambda (vars)
+ (cond (vars (cons nil (make-nils (cdr vars))))
+ )
+ )
+ )
; prepend the set operations
; to the expressions
; prepend the set operations
; to the expressions
-
(setq exprs (make-exprs vars exprs))
+ (setq exprs (make-exprs vars exprs))
; build the lambda.
; build the lambda.
- (cons
- (list
- 'lambda
- (make-names vars)
- (cond ((cdr exprs) (cons 'progn exprs))
- ((car exprs))
- )
- )
- (make-nils vars)
- )
- )
+ (cons (cons 'lambda (cons (make-names vars) exprs))
+ (make-nils vars)
+ )
)
()
()
)
()
()
@@
-202,4
+182,3
@@
; execute to resolve macros
(and t nil)
; execute to resolve macros
(and t nil)
-