projects
/
fw
/
altos
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
altos/stm: Support SPI modes other than 0
[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)
-(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,28
+92,86
@@
'define
)
'define
)
- ; b
asic list access
ors
+ ; b
oolean operat
ors
-(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
; (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
))
)
)
)
)
)
)
@@
-127,7
+185,7
@@
; simple math operators
; simple math operators
-(define zero? (macro (value) (list eq
v
? value 0)))
+(define zero? (macro (value) (list eq? value 0)))
(zero? 1)
(zero? 0)
(zero? 1)
(zero? 0)
@@
-189,26
+247,10
@@
(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))
)
-(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)
(list-ref '(1 2 3) 2)
@@
-231,7
+273,7
@@
;
; (let* ((x 1) (y)) (set! y (+ x 1)) y)
;
; (let* ((x 1) (y)) (set! y (+ x 1)) y)
-(define let
*
+(define let
rec
(macro (a . b)
;
(macro (a . b)
;
@@
-252,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
@@
-281,9
+324,10
@@
)
)
)
)
-(let
*
((a 1) (y a)) (+ a y))
+(let
rec
((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)
@@
-302,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))
@@
-328,62
+371,56
@@
(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)))
(define string (lambda a (list->string a)))
(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 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)
)
)
(map cadr '((a b) (d e) (g h)))
)
)
(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)
(define (newline) (write-char #\newline))
(newline)