projects
/
fw
/
altos
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
altos/lisp: Add 'else' sematics to cond
[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 6fbc35b67993fc2798effb659063db749d247c9a..df277fce9b263e6a03b4ba086d1f2fd18d4ea646 100644
(file)
--- a/
src/lisp/ao_lisp_const.lisp
+++ b/
src/lisp/ao_lisp_const.lisp
@@
-46,17
+46,11
@@
(list
def
name
(list
def
name
- (list
- 'lambda
- args
- (cond ((cdr exprs)
- (cons progn exprs))
- ((car exprs))
- )
- )
+ (cons 'lambda (cons args exprs))
)
)
)
)
)
)
+
; basic list accessors
; basic list accessors
@@
-95,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 ((not (null? 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 ((not (null? 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 ((not (null? vars)) (cons ()
(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)
+ )
)
()
()
)
()
()
@@
-166,13
+149,14
@@
)
)
)
)
+(let ((x 1)) x)
+
; boolean operators
(def or (lexpr (l)
; boolean operators
(def or (lexpr (l)
- (let ((ret nil))
- (while l
- (cond ((setq ret (car l))
- (setq l nil))
+ (let ((ret #f))
+ (while (not (null? l))
+ (cond ((car l) (setq ret #t) (setq l ()))
((setq l (cdr l)))))
ret
)
((setq l (cdr l)))))
ret
)
@@
-181,14
+165,16
@@
; execute to resolve macros
; execute to resolve macros
-(or
nil
t)
+(or
#f #
t)
(def and (lexpr (l)
(def and (lexpr (l)
- (let ((ret t))
- (while
l
- (cond ((
setq ret (car l)
)
+ (let ((ret
#
t))
+ (while
(not (null? l))
+ (cond ((
car l
)
(setq l (cdr l)))
(setq l (cdr l)))
- ((setq ret (setq l nil)))
+ (#t
+ (setq ret #f)
+ (setq l ()))
)
)
ret
)
)
ret
@@
-198,5
+184,4
@@
; execute to resolve macros
; execute to resolve macros
-(and t nil)
-
+(and #t #f)