altos: Add bit-bang i2c driver

[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 503732723e7088880858e80a8a1956a1af98f423..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)
 

-(append '(a b c) '(d e f) '(g h i))
+(append '(a) '(b))

 
                                        ;
                                        ; Define a variable without returning the value
 
                                        ;
                                        ; Define a variable without returning the value


@@ -66,7 +66,7 @@
    (macro (a . b)
                                        ; check for alternate lambda definition form
 
    (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))
                 (set! b
                       (cons lambda (cons (cdr a) b)))
                 (set! a (car a))


@@ -92,26 +92,86 @@
  'define
  )
 
  'define
  )
 

+                                       ; boolean operators
+
+(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)
+
+                                       ; execute to resolve macros
+
+(or #f #t)
+
+(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
 
                                        ; basic list accessors
 

-(define (caar l) (car (car l)))
+(define (caar a) (car (car a)))

 
 

-(define (cadr l) (car (cdr l)))
+(define (cadr a) (car (cdr a)))

 
 

-(define (cdar l) (cdr (car l)))
+; (define (cdar a) (cdr (car a)))

 
                                        ; (if <condition> <if-true>)
                                        ; (if <condition> <if-true> <if-false)
 
 (define if
 
                                        ; (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
                )
          (else
           (list cond

-                (list test (car args))
-                (list 'else (cadr args))
+                (list test (car b))
+                (list 'else (cadr b))

                 )
           )
          )
                 )
           )
          )


@@ -125,7 +185,7 @@
 
                                        ; simple math operators
 
 
                                        ; simple math operators
 

-(define zero? (macro (value) (list eqv? value 0)))
+(define zero? (macro (value) (list eq? value 0)))

 
 (zero? 1)
 (zero? 0)
 
 (zero? 1)
 (zero? 0)


@@ -187,13 +247,6 @@
 (odd? -1)
 
 
 (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-ref a b)
   (car (list-tail a b))
   )


@@ -220,7 +273,7 @@
                                        ;
                                        ; (let* ((x 1) (y)) (set! y (+ x 1)) y)
 
                                        ;
                                        ; (let* ((x 1) (y)) (set! y (+ x 1)) y)
 

-(define let*
+(define letrec

   (macro (a . b)
 
                                        ;
   (macro (a . b)
 
                                        ;


@@ -241,7 +294,8 @@
                                        ; expressions to evaluate
 
         (define (_v a b)
                                        ; expressions to evaluate
 
         (define (_v a b)

-          (cond ((null? a) b)           (else
+          (cond ((null? a) b)
+                (else

                  (cons
                   (list set
                         (list quote
                  (cons
                   (list set
                         (list quote


@@ -270,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)
                                        ; recursive equality
 
 (define (equal? a b)


@@ -291,25 +346,24 @@
 (equal? '(a b c) '(a b c))
 (equal? '(a b c) '(a b b))
 
 (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)))
 
   )
 
 (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))
 
 
 (memq 2 '(1 2 3))
 


@@ -317,18 +371,21 @@
 
 (memq '(2) '((1) (2) (3)))
 
 
 (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)
   (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)))
 
 (assq 'a '((a 1) (b 2) (c 3)))
 (assoc '(c) '((a 1) (b 2) ((c) 3)))


@@ -337,28 +394,28 @@
 
 (define map
   (lambda (a . b)
 
 (define map
   (lambda (a . b)

-        (define (args b)
+        (define (_a b)

           (cond ((null? b) ())
                 (else
           (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
           (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
           (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)

         )
   )
 
         )
   )