diff options
author | Bdale Garbee <bdale@gag.com> | 2018-03-18 15:47:31 -0600 |
---|---|---|
committer | Bdale Garbee <bdale@gag.com> | 2018-03-18 15:47:31 -0600 |
commit | 7b614380f307cb5e27f2a05281bc76c4ace93334 (patch) | |
tree | d243b069a134233f4b98e35769193a1244fc57f8 /src/lambdakey-v1.0/ao_lambdakey_const.scheme | |
parent | 16a9d8617b2d2092d166a85ada4349601afb0dce (diff) | |
parent | 39023ed6e29103a85bfad505506fa0dbf4dc1112 (diff) |
Merge branch 'master' into branch-1.8
Diffstat (limited to 'src/lambdakey-v1.0/ao_lambdakey_const.scheme')
-rw-r--r-- | src/lambdakey-v1.0/ao_lambdakey_const.scheme | 30 |
1 files changed, 14 insertions, 16 deletions
diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme index a912b8ae..a37e1a2b 100644 --- a/src/lambdakey-v1.0/ao_lambdakey_const.scheme +++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme @@ -185,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) @@ -247,13 +247,6 @@ (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)) ) @@ -280,7 +273,7 @@ ; ; (let* ((x 1) (y)) (set! y (+ x 1)) y) -(define let* +(define letrec (macro (a . b) ; @@ -301,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 @@ -330,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) @@ -376,18 +371,21 @@ (memq '(2) '((1) (2) (3))) -(define (_as 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) - (_as a (cdr b) t?) + (assoc a (cdr b) t?) ) ) ) -(define (assq a b) (_as a b eq?)) -(define (assoc a b) (_as 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))) |