diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/lambdakey-v1.0/ao_lambdakey_const.scheme | 127 |
1 files changed, 93 insertions, 34 deletions
diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme index 50373272..a912b8ae 100644 --- 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,26 +92,86 @@ '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 -(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 - (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)) ) ) ) @@ -291,25 +351,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)) @@ -317,18 +376,18 @@ (memq '(2) '((1) (2) (3))) -(define (_assoc a b t?) +(define (_as a b t?) (if (null? b) #f (if (t? a (caar b)) (car b) - (_assoc a (cdr b) t?) + (_as a (cdr b) t?) ) ) ) -(define (assq a b) (_assoc a b eq?)) -(define (assoc a b) (_assoc a b equal?)) +(define (assq a b) (_as a b eq?)) +(define (assoc a b) (_as a b equal?)) (assq 'a '((a 1) (b 2) (c 3))) (assoc '(c) '((a 1) (b 2) ((c) 3))) @@ -337,28 +396,28 @@ (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) ) ) |