Paths for first' and rest'

svn: r17654
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-14 20:00:37 +00:00
parent 33592b4f6c
commit 1ab2a41092
2 changed files with 12 additions and 6 deletions

View File

@ -12,10 +12,10 @@
(cond (cond
[(if (empty? l) #t (empty? k)) [(if (empty? l) #t (empty? k))
empty] empty]
[(and (number? (car l)) (number? (car k))) [(and (number? (first l)) (number? (first k)))
(cons (+ (car l) (car k)) (mrg (cdr l) (cdr k)))] (cons (+ (first l) (first k)) (mrg (rest l) (rest k)))]
[(number? (car l)) [(number? (first l))
(cons (car l) (mrg (rest l) (rest k)))] (cons (first l) (mrg (rest l) (rest k)))]
[else [else
(error 'fail)])) (error 'fail)]))

View File

@ -32,7 +32,10 @@
[cddr (-poly (a) (-> (-lst a) (-lst a)))] [cddr (-poly (a) (-> (-lst a) (-lst a)))]
[cdddr (-poly (a) (-> (-lst a) (-lst a)))] [cdddr (-poly (a) (-> (-lst a) (-lst a)))]
[first (-poly (a b) (cl-> [((-pair a b)) a] [((-lst a)) a]))] [first (-poly (a b)
(cl->*
(->acc (list (-pair a b)) a (list -car))
(->* (list (-lst a)) a)))]
[second (-poly (a b c) [second (-poly (a b c)
(cl-> [((-pair a (-pair b c))) b] (cl-> [((-pair a (-pair b c))) b]
[((-lst a)) a]))] [((-lst a)) a]))]
@ -42,7 +45,10 @@
[fourth (-poly (a) ((-lst a) . -> . a))] [fourth (-poly (a) ((-lst a) . -> . a))]
[fifth (-poly (a) ((-lst a) . -> . a))] [fifth (-poly (a) ((-lst a) . -> . a))]
[sixth (-poly (a) ((-lst a) . -> . a))] [sixth (-poly (a) ((-lst a) . -> . a))]
[rest (-poly (a) ((-lst a) . -> . (-lst a)))] [rest (-poly (a b)
(cl->*
(->acc (list (-pair a b)) b (list -cdr))
(->* (list (-lst a)) (-lst a))))]
[cons (-poly (a b) [cons (-poly (a b)
(cl-> [(a (-lst a)) (-lst a)] (cl-> [(a (-lst a)) (-lst a)]