)
'append)
-(append '(a b c) '(d e f) '(g h i))
+(append '(a) '(b))
;
; Define a variable without returning the value
(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))
'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))
)
)
)
; simple math operators
-(define zero? (macro (value) (list eqv? value 0)))
+(define zero? (macro (value) (list eq? value 0)))
(zero? 1)
(zero? 0)
(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)
;
; (let* ((x 1) (y)) (set! y (+ x 1)) y)
-(define let*
+(define letrec
(macro (a . b)
;
; expressions to evaluate
(define (_v a b)
- (cond ((null? a) b) (else
+ (cond ((null? a) b)
+ (else
(cons
(list set
(list quote
)
)
-(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)
(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))
(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)