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
                                        ;
 
-(setq 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
@@ -42,9 +42,9 @@
                                        ; (defun <name> (<params>) s-exprs)
                                        ;
 
-(def defun (macro (name args exprs)
+(define defun (macro (name args exprs)
                  (list
-                  def
+                  define
                   name
                   (cons 'lambda (cons args exprs))
                   )
@@ -69,6 +69,28 @@
 (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
@@ -85,16 +107,16 @@
                                        ;
                                        ; e.g.
                                        ;
-                                       ; (let ((x 1) (y)) (setq y (+ x 1)) y)
+                                       ; (let ((x 1) (y)) (set! y (+ x 1)) y)
 
-(def let (macro (vars exprs)
+(define let (macro (vars exprs)
                ((lambda (make-names make-exprs make-nils)
 
                                        ;
                                        ; make the list of names in the let
                                        ;
 
-                  (setq make-names (lambda (vars)
+                  (set! make-names (lambda (vars)
                                      (cond ((not (null? vars))
                                             (cons (car (car vars))
                                                   (make-names (cdr vars))))
@@ -107,7 +129,7 @@
                                        ; pre-pended to the
                                        ; expressions to evaluate
 
-                  (setq make-exprs (lambda (vars exprs)
+                  (set! make-exprs (lambda (vars exprs)
                                      (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
 
-                  (setq make-nils (lambda (vars)
+                  (set! make-nils (lambda (vars)
                                     (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
                                           )
                                     )
@@ -134,7 +156,7 @@
                                        ; prepend the set operations
                                        ; to the expressions
 
-                  (setq exprs (make-exprs vars exprs))
+                  (set! exprs (make-exprs vars exprs))
 
                                        ; build the lambda.
 
@@ -153,11 +175,11 @@
 
                                        ; boolean operators
 
-(def or (lexpr (l)
+(define or (lexpr (l)
               (let ((ret #f))
                 (while (not (null? l))
-                  (cond ((car l) (setq ret #t) (setq l ()))
-                        ((setq l (cdr l)))))
+                  (cond ((car l) (set! ret #t) (set! l ()))
+                        ((set! l (cdr l)))))
                 ret
                 )
               )
@@ -167,14 +189,14 @@
 
 (or #f #t)
 
-(def and (lexpr (l)
+(define and (lexpr (l)
               (let ((ret #t))
                 (while (not (null? l))
                   (cond ((car l)
-                         (setq l (cdr l)))
+                         (set! l (cdr l)))
                         (#t
-                         (setq ret #f)
-                         (setq l ()))
+                         (set! ret #f)
+                         (set! l ()))
                         )
                   )
                 ret
@@ -185,3 +207,16 @@
                                        ; 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))