altos/lambdakey-v1.0: Fix obvious build errors

[fw/altos] / src / lambdakey-v1.0 / ao_lambdakey_const.scheme

diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
index d0c0e57895d54c883ddbd82f8507bee22b7b5076..a37e1a2b3cc5c5dc820b9ae084ada2fad46bc43b 100644 (file)
--- a/src/lambdakey-v1.0/ao_lambdakey_const.scheme
+++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
@@ -49,7 +49,7 @@
    )
  'append)
 
-(append '(a b c) '(d e f) '(g h i))
+(append '(a) '(b))
 
                                        ;
                                        ; Define a variable without returning the value
@@ -66,7 +66,7 @@
    (macro (a . b)
                                        ; check for alternate lambda definition form
 
-         (cond ((list? a)
+         (cond ((pair? a)
                 (set! b
                       (cons lambda (cons (cdr a) b)))
                 (set! a (car a))
@@ -92,28 +92,86 @@
  'define
  )
 
-                                       ; basic list accessors
+                                       ; boolean operators
 
-(define (caar l) (car (car l)))
+(begin
+ (def! or
+   (macro a
+         (def! _or
+           (lambda (a)
+             (cond ((null? a) #f)
+                   ((null? (cdr a))
+                    (car a))
+                   (else
+                    (list
+                     cond
+                     (list
+                      (car a))
+                     (list
+                      'else
+                      (_or (cdr a))
+                      )
+                     )
+                    )
+                   )
+             )
+           )
+         (_or a)))
+ 'or)
 
-(define (cadr l) (car (cdr l)))
+                                       ; execute to resolve macros
 
-(define (cdar l) (cdr (car l)))
+(or #f #t)
 
-(define (caddr l) (car (cdr (cdr l))))
+(begin
+ (def! and
+   (macro a
+         (def! _and
+           (lambda (a)
+             (cond ((null? a) #t)
+                   ((null? (cdr a))
+                    (car a))
+                   (else
+                    (list
+                     cond
+                     (list
+                      (car a)
+                      (_and (cdr a))
+                      )
+                     )
+                    )
+                   )
+             )
+           )
+         (_and a)
+         )
+   )
+ 'and)
+
+                                       ; execute to resolve macros
+
+(and #t #f)
+
+                                       ; basic list accessors
+
+(define (caar a) (car (car a)))
+
+(define (cadr a) (car (cdr a)))
+
+; (define (cdar a) (cdr (car a)))
 
                                        ; (if <condition> <if-true>)
                                        ; (if <condition> <if-true> <if-false)
 
 (define if
-  (macro (test . args)
-    (cond ((null? (cdr args))
-          (list cond (list test (car args)))
+  (macro (test . b)
+    (cond ((null? (cdr b))
+          (list cond (list test (car b)))
                )
          (else
           (list cond
-                (list test (car args))
-                (list 'else (cadr args))
+                (list test (car b))
+                (list 'else (cadr b))
                 )
           )
          )
@@ -127,7 +185,7 @@
 
                                        ; simple math operators
 
-(define zero? (macro (value) (list eqv? value 0)))
+(define zero? (macro (value) (list eq? value 0)))
 
 (zero? 1)
 (zero? 0)
@@ -189,26 +247,10 @@
 (odd? -1)
 
 
-(define (list-tail a b)
-  (if (zero? b)
-      a
-    (list-tail (cdr a (- b 1)))
-    )
-  )
-
 (define (list-ref a b)
   (car (list-tail a b))
   )
 
-(define (list-tail a b)
-  (if (zero? b)
-      a
-    (list-tail (cdr a) (- b 1))))
-
-(list-tail '(1 2 3) 2)
-
-(define (list-ref a b) (car (list-tail a b)))
-
 (list-ref '(1 2 3) 2)
     
 
@@ -231,7 +273,7 @@
                                        ;
                                        ; (let* ((x 1) (y)) (set! y (+ x 1)) y)
 
-(define let*
+(define letrec
   (macro (a . b)
 
                                        ;
@@ -252,7 +294,8 @@
                                        ; expressions to evaluate
 
         (define (_v a b)
-          (cond ((null? a) b)           (else
+          (cond ((null? a) b)
+                (else
                  (cons
                   (list set
                         (list quote
@@ -281,9 +324,10 @@
         )
      )
 
-(let* ((a 1) (y a)) (+ a y))
+(letrec ((a 1) (y a)) (+ a y))
 
-(define let let*)
+(define let letrec)
+(define let* letrec)
                                        ; recursive equality
 
 (define (equal? a b)
@@ -302,25 +346,24 @@
 (equal? '(a b c) '(a b c))
 (equal? '(a b c) '(a b b))
 
-(define member (lambda (obj a . test?)
-                     (cond ((null? a)
-                            #f
-                            )
-                           (else
-                            (if (null? test?) (set! test? equal?) (set! test? (car test?)))
-                            (if (test? obj (car a))
-                                a
-                              (member obj (cdr a) test?))
-                            )
-                           )
-                     )
+(define (member a b . t?)
+  (cond ((null? b)
+        #f
+        )
+       (else
+        (if (null? t?) (set! t? equal?) (set! t? (car t?)))
+        (if (t? a (car b))
+            b
+            (member a (cdr b) t?))
+        )
+       )
   )
 
 (member '(2) '((1) (2) (3)))
 
 (member '(4) '((1) (2) (3)))
 
-(define (memq obj a) (member obj a eq?))
+(define (memq a b) (member a b eq?))
 
 (memq 2 '(1 2 3))
 
@@ -328,62 +371,56 @@
 
 (memq '(2) '((1) (2) (3)))
 
-(define (_assoc a b t?)
+(define (assoc a b . t?)
+  (if (null? t?)
+      (set! t? equal?)
+      (set! t? (car t?))
+      )
   (if (null? b)
       #f
     (if (t? a (caar b))
        (car b)
-      (_assoc a (cdr b) t?)
+      (assoc a (cdr b) t?)
       )
     )
   )
 
-(define (assq a b) (_assoc a b eq?))
-(define (assoc a b) (_assoc a b equal?))
+(define (assq a b) (assoc a b eq?))
 
 (assq 'a '((a 1) (b 2) (c 3)))
 (assoc '(c) '((a 1) (b 2) ((c) 3)))
 
 (define string (lambda a (list->string a)))
 
-(display "apply\n")
-(apply cons '(a b))
-
 (define map
   (lambda (a . b)
-        (define (args b)
+        (define (_a b)
           (cond ((null? b) ())
                 (else
-                 (cons (caar b) (args (cdr b)))
+                 (cons (caar b) (_a (cdr b)))
                  )
                 )
           )
-        (define (next b)
+        (define (_n b)
           (cond ((null? b) ())
                 (else
-                 (cons (cdr (car b)) (next (cdr b)))
+                 (cons (cdr (car b)) (_n (cdr b)))
                  )
                 )
           )
-        (define (domap b)
+        (define (_d b)
           (cond ((null? (car b)) ())
                 (else
-                 (cons (apply a (args b)) (domap (next b)))
+                 (cons (apply a (_a b)) (_d (_n b)))
                  )
                 )
           )
-        (domap b)
+        (_d b)
         )
   )
 
 (map cadr '((a b) (d e) (g h)))
 
-(define for-each (lambda (a . b)
-                       (apply map a b)
-                       #t))
-
-(for-each display '("hello" " " "world" "\n"))
-
 (define (newline) (write-char #\newline))
 
 (newline)