Assignment 6: Continuation-Passing Style
Show pagesource
Log In
null? add1 assv car < empty-k
(define empty-k
(lambda ()
(let ((once-only #f))
(lambda (v)
(if once-only
(error 'empty-k "You can only invoke the empty continuation once")
(begin (set! once-only #t) v))))))
empty-k
binary-to-decimal
binary-to-decimal-cps
(define empty-k
(lambda ()
(lambda (v) v)))
(define binary-to-decimal
(lambda (n)
(cond
[(null? n) 0]
[else (+ (car n) (* 2 (binary-to-decimal (cdr n))))])))
:erudecorp
gniwollof eht fo noisrev deSPC a si taht erudecorp a tset dna enfieD .1
.gniSPC ni ekatsim a edam evah uoy fi tceted retteb uoy pleh lliw ti taht ni ,retteb hcum si evoba eno eht ,revewoH
.snoitatnemelpmi deSPC ruoy fo snoitacovni eb ot tnemngissa siht ni dedivorp sllac eht yfidom dluohs uoY !nuf eht liops nac snoisserpxe eseht fo snoitacovni gnidivorp ;smelborp eseht rof etius tset a edivorp t'nod eW . morf denruter noitaunitnoc laitini eht gnisu serudecorp deSPC ruoy tseT .¡±elpmis¡° , , , sa hcus serudecorp ni-tliub taert yam uoy ,gniSPC nehW
sa ekil eht dna , ,
.gniwollof eht sa denfied nees evah yam uoY
:senilediug gniwollof eht evresbo esaelP .elyts gnissap-noitaunitnoc ot smargorp trohs lareves trevnoc lliw uoy ,tnemngissa siht roF
.SPC ot serudecorp gnitrevnoc no IA suoiverp a morf setoN .elyts gnissap-noitaunitnoc no erutcel 0102 ,61 beF eht morf setoN .elyts gnissap-noitaunitnoc ot serudecorp gnitrevnoc no rehserfeR SPC A
tnemngissa siht hguorht krow uoy sa lufpleh secruoser gniwollof eht dnfi yam uoy ,ssalc morf seton ruoy ot noitidda nI
.ti tae uoy oS .enog era ti ekam ot desu slairetam eht lla dna ,retnuoc eht no hciwdnas a s'ereht ,yletanutrof tuB .hciwdnas a tuoba gnikniht ,niaga rotaregirfer eht fo tnorf ni gnidnats flesruoy dnfi uoy dna ,tekcop ruoy ni noitaunitnoc eht ekovni uoY .retnuoc eht no gnittis won si hcihw ,hciwdnas a flesruoy ekam dna rotaregirfer eht fo tuo daerb dna yekrut emos teg uoy nehT .tekcop ruoy ni ti kcits dna ereht thgir noitaunitnoc a ekat uoY .hciwdnas a tuoba gnikniht ,rotaregirfer eht fo tnorf ni nehctik eht ni er'uoy yaS
tnemngissA
etoN
binary-to-decimal
0
> (binary-to-decimal ‘())
0
> (binary-to-decimal ‘(1))
1
> (binary-to-decimal ‘(0 1))
2
> (binary-to-decimal ‘(1 1 0 1))
11
k
zero?
times plus
times-cps
times
times-cps
plus-cps
plus
remv-first-9*-cps
9
times
(define times
(lambda (ls)
(cond
[(null? ls) 1]
[(zero? (car ls)) 0]
[else (* (car ls) (times (cdr ls)))])))
> (times ‘(1 2 3 4 5))
120
> (times ‘(1 2 3 0 3))
0
times-cps-shortcut
(define plus
(lambda (m)
(lambda (n)
(+ m n))))
> ((plus 2) 3)
5
> ((plus ((plus 2) 3)) 5)
10
first-9*
remv- ls
(define remv-first-9*
(lambda (ls)
(cond
[(null? ls) ‘()]
[(pair? (car ls))
(cond
[(equal? (car ls) (remv-first-9* (car ls)))
(cons (car ls) (remv-first-9* (cdr ls)))]
[else (cons (remv-first-9* (car ls)) (cdr ls))])]
[(eqv? (car ls) ‘9) (cdr ls)]
[else (cons (car ls) (remv-first-9* (cdr ls)))])))
remv-first-9*
: tsil detsen ylirartibra eht fo klaw redroerp a ni gniwollof eht fo noisrev deSPC a si taht
tsrfi eht sevomer hcihw ,erudecorp
erudecorp a tset dna enfieD .5
:erudecorp gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .4
.su swolla gniSPC snoitazimitpo ta kool gnitseretni na sedivorp ti ,margorp eht gniSPC fo selur dradnats eht setaloiv ylniatrec siht elihW .noitatupmoc rehtruf gnimrofrep ton dna 0 eht
gninruter ylpmis – t’nseod taht
ni esac eht fo roivaheb eht niatniam ,daetsnI .esac orez eht ni ylppa
.erudecorp
gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .2
dellac ,evoba
ruoy fo noisrev defiidom a enfieD .3
.raelc gninaem eht ekam ot sllac elpmas wef a era ereH .)atad dab( srebmun yranib demrof-lli eb ot s gniliart erom ro
eno htiw secneuqes yranib redisnoc dluohs uoy ;srebmun yranib naidne-elttil sesu
:
ot sllac elpmaxe emos era ereH
:
ot sllac fo selpmaxe emos era ereH
:
ot sllac fo selpmaxe emos era ereH
> (remv-first-9* ‘((1 2 (3) 9)))
((1 2 (3)))
> (remv-first-9* ‘(9 (9 (9 (9)))))
((9 (9 (9))))
> (remv-first-9* ‘(((((9) 9) 9) 9) 9))
((((() 9) 9) 9) 9)
cell-count
(define cons-cell-count
(lambda (ls)
(cond
[(pair? ls)
cons-cell-count-cps
cons-
(add1 (+ (cons-cell-count (car ls)) (cons-cell-count (cdr ls))))]
[else 0])))
find-cps find
(define find
(lambda (u s)
(let ((pr (assv u s)))
(if pr (find (cdr pr) s) u))))
find
> (find 5 ‘((5 . a) (6 . b) (7 . c)))
a
> (find 7 ‘((5 . a) (6 . 5) (7 . 6)))
a
> (find 5 ‘((5 . 6) (9 . 6) (2 . 9)))
6
ack-cps ack
;; ack: computes the Ackermann function
;; (http://en.wikipedia.org/wiki/Ackermann_function). Warning: if you
;; run this program with m >= 4 and n >= 2, you’ll be in for a long
;; wait.
(define ack
(lambda (m n)
(cond
[(zero? m) (add1 n)]
[(zero? n) (ack (sub1 m) 1)]
[else (ack (sub1 m)
(ack m (sub1 n)))])))
fib-cps fib
(define fib
(lambda (n)
((lambda (fib)
(fib fib n))
(lambda (fib n)
(cond
[(zero? n) 0]
[(zero? (sub1 n)) 1]
[else (+ (fib fib (sub1 n)) (fib fib (sub1 (sub1 n))))])))))
:erudecorp gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .01
:erudecorp
gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .9
:erudecorp
gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .8
:erudecorp
gniwollof eht fo noisrev deSPC a si taht
erudecorp a tset dna enfieD .7
gniwollof eht fo noisrev deSPC a si taht
:erudecorp
erudecorp a tset dna enfieD .6
:
ot sllac elpmas emos era ereH
(define unfold
(lambda (p f g seed)
((lambda (h)
((h h) seed ‘()))
(lambda (h)
(lambda (seed ans)
unfold-cps
unfold
> (unfold null? car cdr ‘(a b c d e))
(e d c b a)
unfold-cps
> (define null?-cps
(lambda (ls k)
(k (null? ls))))
> (define car-cps
(lambda (pr k)
(k (car pr))))
> (define cdr-cps
(lambda (pr k)
(k (cdr pr))))
> (unfold-cps null?-cps car-cps cdr-cps ‘(a b c d e) (empty-k))
(e d c b a)
find-cps
unify find
unify-cps
(define empty-s
(lambda ()
‘()))
(define unify
(lambda (u v s)
(cond
((eqv? u v) s)
((number? u) (cons (cons u v) s))
((number? v) (unify v u s))
((pair? u)
(if (pair? v)
(let ((s (unify (find (car u) s) (find (car v) s) s)))
(if s (unify (find (cdr u) s) (find (cdr v) s) s) #f))
#f))
(else #f))))
unify
> (unify ‘x 5 (empty-s))
((5 . x))
> (unify ‘x 5 (unify ‘y 6 (empty-s)))
((5 . x) (6 . y))
> (unify ‘(x y) ‘(5 6) (empty-s))
((6 . y) (5 . x))
> (unify ‘x 5 (unify ‘x 6 (empty-s)))
((5 . x) (6 . x))
> (unify ‘(x x) ‘(5 6) (empty-s))
((6 . x) (5 . x))
> (unify ‘(1 2 3) ‘(x 1 2) (empty-s))
((3 . x) (2 . x) (1 . x))
> (unify ‘x ‘y (empty-s))
#f
M-cps M f
map
find
(if (p seed)
ans
((h h) (g seed) (cons (f seed) ans))))))))
.deSPC eb osla lliw ni dessap yna taht noisrev deSPC eht rof emussA . fo noisrev deirruc a si hcihw , fo noisrev deSPC a si taht erudecorp a tset dna enfieD .21
.taht od ot deen a diova ot nesohc yllaiceps neeb evah stset esehT .stnemugra owt tsrfi eht no gnisu retfa ylno yfinu ekovni yllamron dluow ew ,llac evisrucer eht morf llet nac uoy sA
.7 noitseuq morf ruoy sesu taht erudecorp a tset dna enfieD .7 noitseuq ni nevig fo noisrev eht sesu noisrev tnerruc ehT .noitacfiinu citcatnys ,redro-tsrfi stnemelpmi tI .srepleh sti htiw fo noitinfied eht si ereH .11
.edoc ruoy gnitset nehw snoitinfied repleh gniwollof eht edulcni os ,suoires eb ot stnemugra sti redisnoc dluohs uoy , ruoy gnitset nehW
: ot sllac elpmaxe emos era ereH
:woleb detartsnomed si esu sti fo elpmaxe nA
M M-cps M-cps
(define use-of-M
((M (lambda (n) (add1 n))) ‘(1 2 3 4 5)))
use-of-strange
of-strange-cps
M use-of-M
strange-cps
M-cps
use-of-
use-of-
(define strange
(lambda (x)
((lambda (g) (lambda (x) (g g)))
(lambda (g) (lambda (x) (g g))))))
strange
strange-cps
why-cps
use-of-strange
strange use-
(define use-of-strange
(let ([strange^ (((strange 5) 6) 7)])
(((strange^ 8) 9) 10)))
(define why
(lambda (f)
((lambda (g)
(f (lambda (x) ((g g) x))))
(lambda (g)
(f (lambda (x) ((g g) x)))))))
why
> (define almost-length
(lambda (f)
(lambda (ls)
(if (null? ls)
0
(add1 (f (cdr ls)))))))
> ((why almost-length) ‘(a b c d e))
5
why-cps
why-cps-cps
(define M
(lambda (f)
(lambda (ls)
(cond
((null? ls) ‘())
(else (cons (f (car ls)) ((M f) (cdr ls))))))))
cvm yb 25:90 21/20/0202 :defiidom tsaL ¡¤ txt.6-tnemngissa
-er ,
ti emaN .segnahc etairporppa eht lla ekam dna , deSPC ruoy gnisU . dellac ,
llac ot
etirw
:
ti llac dna ,margorp gniwollof eht SPC .41 resaetniarB
ti emaN .)tnemugra eht gniSPC gnidulcni( segnahc etairporppa eht lla ekam dna , llac ot etirw-er , deSPC ruoy gnisU . dellac , ot llac gnidnopserroc eht redisnoC .31
. ti llac dna , SPC .71
. ot llac-gniwollof eht ees ot lufesu ti dnfi yam uoy ,detrats uoy teg oT
:
ti llac dna ,margorp gniwollof eht SPC .61
(: yadot tressed oN tresseD tsuJ
.
fo esu gniwollof eht redisnoC .51