projects
/
fw
/
altos
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
altos/lisp: More schemisms
[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 df277fce9b263e6a03b4ba086d1f2fd18d4ea646..37307a6877758938bb1f9258a701940770560c30 100644
(file)
--- a/
src/lisp/ao_lisp_const.lisp
+++ b/
src/lisp/ao_lisp_const.lisp
@@
-23,17
+23,17
@@
; having lots of output generated
;
; having lots of output generated
;
-(set
q def
(macro (name val rest)
- (list
- 'progn
- (list
- 'set
- (list 'quote name)
- val)
- (list 'quote name)
- )
- )
-
)
+(set
(quote define)
(macro (name val rest)
+
(list
+
'progn
+
(list
+
'set
+
(list 'quote name)
+
val)
+
(list 'quote name)
+
)
+
)
+ )
;
; A slightly more convenient form
;
; A slightly more convenient form
@@
-42,9
+42,9
@@
; (defun <name> (<params>) s-exprs)
;
; (defun <name> (<params>) s-exprs)
;
-(def defun (macro (name args exprs)
+(def
ine
defun (macro (name args exprs)
(list
(list
- def
+ def
ine
name
(cons 'lambda (cons args exprs))
)
name
(cons 'lambda (cons args exprs))
)
@@
-69,6
+69,28
@@
(defun 1+ (x) (+ x 1))
(defun 1- (x) (- x 1))
(defun 1+ (x) (+ x 1))
(defun 1- (x) (- x 1))
+(define if (macro (test args)
+ (cond ((null? (cdr args))
+ (list
+ cond
+ (list test (car args)))
+ )
+ (else
+ (list
+ cond
+ (list test (car args))
+ (list 'else (cadr args))
+ )
+ )
+ )
+ )
+ )
+
+(if (> 3 2) 'yes)
+(if (> 3 2) 'yes 'no)
+(if (> 2 3) 'no 'yes)
+(if (> 2 3) 'no)
+
; define a set of local
; variables and then evaluate
; a list of sexprs
; define a set of local
; variables and then evaluate
; a list of sexprs
@@
-85,16
+107,16
@@
;
; e.g.
;
;
; e.g.
;
- ; (let ((x 1) (y)) (set
q
y (+ x 1)) y)
+ ; (let ((x 1) (y)) (set
!
y (+ x 1)) y)
-(def let (macro (vars exprs)
+(def
ine
let (macro (vars exprs)
((lambda (make-names make-exprs make-nils)
;
; make the list of names in the let
;
((lambda (make-names make-exprs make-nils)
;
; make the list of names in the let
;
- (set
q
make-names (lambda (vars)
+ (set
!
make-names (lambda (vars)
(cond ((not (null? vars))
(cons (car (car vars))
(make-names (cdr vars))))
(cond ((not (null? vars))
(cons (car (car vars))
(make-names (cdr vars))))
@@
-107,7
+129,7
@@
; pre-pended to the
; expressions to evaluate
; pre-pended to the
; expressions to evaluate
- (set
q
make-exprs (lambda (vars exprs)
+ (set
!
make-exprs (lambda (vars exprs)
(cond ((not (null? vars)) (cons
(list set
(list quote
(cond ((not (null? vars)) (cons
(list set
(list quote
@@
-126,7
+148,7
@@
; 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
- (set
q
make-nils (lambda (vars)
+ (set
!
make-nils (lambda (vars)
(cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
)
)
(cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
)
)
@@
-134,7
+156,7
@@
; prepend the set operations
; to the expressions
; prepend the set operations
; to the expressions
- (set
q
exprs (make-exprs vars exprs))
+ (set
!
exprs (make-exprs vars exprs))
; build the lambda.
; build the lambda.
@@
-153,11
+175,11
@@
; boolean operators
; boolean operators
-(def or (lexpr (l)
+(def
ine
or (lexpr (l)
(let ((ret #f))
(while (not (null? l))
(let ((ret #f))
(while (not (null? l))
- (cond ((car l) (set
q ret #t) (setq
l ()))
- ((set
q
l (cdr l)))))
+ (cond ((car l) (set
! ret #t) (set!
l ()))
+ ((set
!
l (cdr l)))))
ret
)
)
ret
)
)
@@
-167,14
+189,14
@@
(or #f #t)
(or #f #t)
-(def and (lexpr (l)
+(def
ine
and (lexpr (l)
(let ((ret #t))
(while (not (null? l))
(cond ((car l)
(let ((ret #t))
(while (not (null? l))
(cond ((car l)
- (set
q
l (cdr l)))
+ (set
!
l (cdr l)))
(#t
(#t
- (set
q
ret #f)
- (set
q
l ()))
+ (set
!
ret #f)
+ (set
!
l ()))
)
)
ret
)
)
ret
@@
-185,3
+207,16
@@
; execute to resolve macros
(and #t #f)
; execute to resolve macros
(and #t #f)
+
+(defun equal? (a b)
+ (cond ((eq? a b) #t)
+ ((and (pair? a) (pair? b))
+ (and (equal? (car a) (car b))
+ (equal? (cdr a) (cdr b)))
+ )
+ (else #f)
+ )
+ )
+
+(equal? '(a b c) '(a b c))
+(equal? '(a b c) '(a b b))