mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-20 14:19:17 +02:00
Match original CPS
This commit is contained in:
Justin Ethier
parent
5396e788cd
commit
973bfe0ef0
1 changed files with 114 additions and 87 deletions
|
|
@ -10,6 +10,7 @@
|
|||
|
||||
(define (analyze:find-named-lets exp)
|
||||
(define (scan exp lp)
|
||||
;(write `(scan ,exp)) (newline)
|
||||
(cond
|
||||
((ast:lambda? exp)
|
||||
(let* ((id (ast:lambda-id exp))
|
||||
|
|
@ -57,10 +58,34 @@
|
|||
((app? exp)
|
||||
(cond
|
||||
;; TODO: need to detect CPS pattern without any optimizations
|
||||
;((and-let* (
|
||||
; )
|
||||
; 'TODO
|
||||
;)
|
||||
((and-let* (
|
||||
;; Find lambda with initial #f assignment
|
||||
((ast:lambda? (car exp)))
|
||||
((pair? (cdr exp)))
|
||||
((not (cadr exp)))
|
||||
(= 1 (length (ast:lambda-args (car exp))))
|
||||
;; Get information for continuation
|
||||
(loop-sym (car (ast:lambda-args (car exp))))
|
||||
(inner-exp (car (ast:lambda-body (car exp))))
|
||||
((app? inner-exp))
|
||||
((ast:lambda? (car inner-exp)))
|
||||
;; Find the set (assumes CPS conversion)
|
||||
(lambda/set (car (ast:lambda-body (car inner-exp))))
|
||||
((app? lambda/set))
|
||||
((ast:lambda? (car lambda/set)))
|
||||
((set!? (cadr lambda/set)))
|
||||
((equal? (set!->var (cadr lambda/set)) loop-sym))
|
||||
; (unused (begin (newline) (newline) (write loop-sym) (write (ast:ast->pp-sexp (cadr lambda/set))) (newline)(newline)))
|
||||
;; Check the set's continuation
|
||||
((app? (car (ast:lambda-body (car lambda/set)))))
|
||||
; (unused2 (begin (newline) (newline) (write (ast:ast->pp-sexp (car lambda/set))) (newline)(newline)))
|
||||
((equal? (caar (ast:lambda-body (car lambda/set))) loop-sym))
|
||||
)
|
||||
(trace:error `(found loop in ,exp))
|
||||
;; TODO: do we want to record the lambda that is a loop?
|
||||
;; Continue scanning, indicating we are in a loop
|
||||
(map (lambda (e) (scan e #t)) exp)
|
||||
))
|
||||
((and-let* (
|
||||
;; Find lambda with initial #f assignment
|
||||
((ast:lambda? (car exp)))
|
||||
|
|
@ -91,91 +116,93 @@
|
|||
(scan exp #f))
|
||||
|
||||
(define sexp
|
||||
(ast:sexp->ast '(define fit
|
||||
(lambda
|
||||
(k$89 i$10$52 j$11$53)
|
||||
((lambda
|
||||
(lp$13$17$56)
|
||||
((lambda (r$91) (lp$13$17$56 k$89 0))
|
||||
(set! lp$13$17$56
|
||||
(lambda
|
||||
(k$93 k$18$57)
|
||||
((lambda
|
||||
(k$98)
|
||||
(if (Cyc-fast-gt
|
||||
k$18$57
|
||||
(vector-ref *piecemax* i$10$52))
|
||||
(k$98 (Cyc-fast-gt
|
||||
k$18$57
|
||||
(vector-ref *piecemax* i$10$52)))
|
||||
(if (vector-ref (vector-ref *p* i$10$52) k$18$57)
|
||||
(k$98 (vector-ref
|
||||
*puzzle*
|
||||
(Cyc-fast-plus j$11$53 k$18$57)))
|
||||
(k$98 #f))))
|
||||
(lambda
|
||||
(r$94)
|
||||
(if r$94
|
||||
(if (Cyc-fast-gt
|
||||
k$18$57
|
||||
(vector-ref *piecemax* i$10$52))
|
||||
(k$93 #t)
|
||||
(k$93 #f))
|
||||
(lp$13$17$56 k$93 (Cyc-fast-plus k$18$57 1)))))))))
|
||||
#f)))))
|
||||
|
||||
;; Before any rounds of optimizations the structure is:
|
||||
; (define fit
|
||||
(ast:sexp->ast
|
||||
; '(define fit
|
||||
; (lambda
|
||||
; (k$89 i$10$52 j$11$53)
|
||||
; ((lambda
|
||||
; (r$90)
|
||||
; ((lambda
|
||||
; (end$12$54)
|
||||
; ((lambda
|
||||
; (k$16$55)
|
||||
; ((lambda
|
||||
; (lp$13$17$56)
|
||||
; ((lambda
|
||||
; (r$92)
|
||||
; ((lambda (r$91) (lp$13$17$56 k$89 k$16$55))
|
||||
; (set! lp$13$17$56 r$92)))
|
||||
; (lambda
|
||||
; (k$93 k$18$57)
|
||||
; ((lambda
|
||||
; (r$97)
|
||||
; ((lambda
|
||||
; (tmp$20$22$58)
|
||||
; ((lambda
|
||||
; (k$98)
|
||||
; (if tmp$20$22$58
|
||||
; (k$98 tmp$20$22$58)
|
||||
; ((lambda
|
||||
; (r$101)
|
||||
; ((lambda
|
||||
; (r$99)
|
||||
; (if r$99
|
||||
; ((lambda
|
||||
; (r$100)
|
||||
; (k$98 (vector-ref *puzzle* r$100)))
|
||||
; (Cyc-fast-plus j$11$53 k$18$57))
|
||||
; (k$98 #f)))
|
||||
; (vector-ref r$101 k$18$57)))
|
||||
; (vector-ref *p* i$10$52))))
|
||||
; (lambda
|
||||
; (r$94)
|
||||
; (if r$94
|
||||
; ((lambda (r$95) (if r$95 (k$93 #t) (k$93 #f)))
|
||||
; (Cyc-fast-gt k$18$57 end$12$54))
|
||||
; ((lambda (r$96) (lp$13$17$56 k$93 r$96))
|
||||
; (Cyc-fast-plus k$18$57 1))))))
|
||||
; r$97))
|
||||
; (Cyc-fast-gt k$18$57 end$12$54)))))
|
||||
; #f))
|
||||
; 0))
|
||||
; r$90))
|
||||
; (vector-ref *piecemax* i$10$52))))
|
||||
; (lp$13$17$56)
|
||||
; ((lambda (r$91) (lp$13$17$56 k$89 0))
|
||||
; (set! lp$13$17$56
|
||||
; (lambda
|
||||
; (k$93 k$18$57)
|
||||
; ((lambda
|
||||
; (k$98)
|
||||
; (if (Cyc-fast-gt
|
||||
; k$18$57
|
||||
; (vector-ref *piecemax* i$10$52))
|
||||
; (k$98 (Cyc-fast-gt
|
||||
; k$18$57
|
||||
; (vector-ref *piecemax* i$10$52)))
|
||||
; (if (vector-ref (vector-ref *p* i$10$52) k$18$57)
|
||||
; (k$98 (vector-ref
|
||||
; *puzzle*
|
||||
; (Cyc-fast-plus j$11$53 k$18$57)))
|
||||
; (k$98 #f))))
|
||||
; (lambda
|
||||
; (r$94)
|
||||
; (if r$94
|
||||
; (if (Cyc-fast-gt
|
||||
; k$18$57
|
||||
; (vector-ref *piecemax* i$10$52))
|
||||
; (k$93 #t)
|
||||
; (k$93 #f))
|
||||
; (lp$13$17$56 k$93 (Cyc-fast-plus k$18$57 1)))))))))
|
||||
; #f)))
|
||||
|
||||
(write (ast:sexp->ast sexp))
|
||||
(newline)
|
||||
;; Before any rounds of optimizations the structure is:
|
||||
'(define fit
|
||||
(lambda
|
||||
(k$89 i$10$52 j$11$53)
|
||||
((lambda
|
||||
(r$90)
|
||||
((lambda
|
||||
(end$12$54)
|
||||
((lambda
|
||||
(k$16$55)
|
||||
((lambda
|
||||
(lp$13$17$56)
|
||||
((lambda
|
||||
(r$92)
|
||||
((lambda (r$91) (lp$13$17$56 k$89 k$16$55))
|
||||
(set! lp$13$17$56 r$92)))
|
||||
(lambda
|
||||
(k$93 k$18$57)
|
||||
((lambda
|
||||
(r$97)
|
||||
((lambda
|
||||
(tmp$20$22$58)
|
||||
((lambda
|
||||
(k$98)
|
||||
(if tmp$20$22$58
|
||||
(k$98 tmp$20$22$58)
|
||||
((lambda
|
||||
(r$101)
|
||||
((lambda
|
||||
(r$99)
|
||||
(if r$99
|
||||
((lambda
|
||||
(r$100)
|
||||
(k$98 (vector-ref *puzzle* r$100)))
|
||||
(Cyc-fast-plus j$11$53 k$18$57))
|
||||
(k$98 #f)))
|
||||
(vector-ref r$101 k$18$57)))
|
||||
(vector-ref *p* i$10$52))))
|
||||
(lambda
|
||||
(r$94)
|
||||
(if r$94
|
||||
((lambda (r$95) (if r$95 (k$93 #t) (k$93 #f)))
|
||||
(Cyc-fast-gt k$18$57 end$12$54))
|
||||
((lambda (r$96) (lp$13$17$56 k$93 r$96))
|
||||
(Cyc-fast-plus k$18$57 1))))))
|
||||
r$97))
|
||||
(Cyc-fast-gt k$18$57 end$12$54)))))
|
||||
#f))
|
||||
0))
|
||||
r$90))
|
||||
(vector-ref *piecemax* i$10$52))))
|
||||
))
|
||||
|
||||
;(write (ast:sexp->ast sexp))
|
||||
;(newline)
|
||||
(analyze:find-named-lets (ast:sexp->ast sexp))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue