Created
July 24, 2013 18:18
-
-
Save mtornwall/6073070 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(define (fib n) | |
(if (<= n 1) n | |
(+ (fib (- n 1)) (fib (- n 2))))) | |
;; (define (fib-iter n1 n2) | |
;; (if (< n2 2) | |
;; (+ n1 n2) | |
;; (fib-iter n2 (+ n1 n2)))) | |
;; (define (fib-iter-cps n1 n2 k) | |
;; (if (< n2 2) | |
;; (k (+ n1 n2)) | |
;; (fib-iter-cps n2 (+ n1 n2) | |
;; (lambda (v) | |
;; (k v))))) | |
(define (length l) | |
(if (null? l) 0 | |
(+ 1 (length (rest l))))) | |
(define (length-cps l k) | |
(if (null? l) | |
(k 0) | |
(length-cps (rest l) | |
(lambda (v) | |
(k (+ v 1)))))) | |
;; After closure conversion | |
(define (length-cps l k) | |
(if (null? l) | |
(k 0) | |
(length-cps (rest l) | |
(closure `#(,k) (lambda* (c v) ; k maps to index 0 | |
((vector-ref c 0) (+ v 1))))))) | |
;; After closure conversion, lambda lifting | |
(define $lambda0 (lambda* (c v) ((vector-ref c 0) (+ v 1)))) | |
(define (length-cps l k) | |
(if (null? l) | |
(k 0) | |
(length-cps (rest l) | |
(closure `#(,k) $lambda0)))) | |
;; After "register allocation" (imagine regs r0...rN) | |
(define $lambda0 (lambda* (r0 r1) ((vector-ref r0 0) #;(0 = index of k) (+ r1 1)))) | |
(define length-cps (lambda* (r0 r1) | |
(if (null? r0) | |
(r1 0) | |
(length-cps (rest r0) | |
(closure `#(,r1) $lambda0))))) | |
;; After pseudo-MIPS code generation | |
(procedure $lambda0 | |
(lw ra (+ r0 8)) ; assuming vec+0 = size, vec+8 = first el | |
(addi r1 r1 1) ; r1 = r1+1 | |
(jr ra)) | |
(procedure length-cps | |
(bne r0 0 L0) | |
(move ra r1) | |
(move r0 0) | |
(jr ra) | |
(:L0) | |
(lw r0 (+ r0 8)) ; CONS = [CAR:8|CDR:8] so CONS+8 = CDR | |
(malloc t0 16) ; allocate closure env vector | |
(move t1 1) | |
(sw t1 (+ t0 0)) ; length = 1 | |
(sw r1 (+ t0 8)) ; element 0 = k (continuation) | |
(malloc r1 16) ; allocate closure record | |
(sw t0 (+ r1 0)) ; closure[0] = closure env | |
(la t0 $lambda0) ; load address of $lambda0 | |
(sw t0 (+ r1 8)) ; closure[1] = closure funptr | |
(j length-cps)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment