Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Match original CPS

Browse source
This commit is contained in:
Justin Ethier 2018-08-14 13:34:25 -04:00
parent 5396e788cd
commit 973bfe0ef0
1 changed files with 114 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

201
test-find-loop.scm
View file

@ -10,6 +10,7 @@
(define (analyze:find-named-lets exp) (define (analyze:find-named-lets exp)
(define (scan exp lp) (define (scan exp lp)
;(write `(scan ,exp)) (newline)
(cond (cond
((ast:lambda? exp) ((ast:lambda? exp)
(let* ((id (ast:lambda-id exp)) (let* ((id (ast:lambda-id exp))
@ -57,10 +58,34 @@
((app? exp) ((app? exp)
(cond (cond
;; TODO: need to detect CPS pattern without any optimizations ;; TODO: need to detect CPS pattern without any optimizations
;((and-let* ( ((and-let* (
; ) ;; Find lambda with initial #f assignment
; 'TODO ((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* ( ((and-let* (
;; Find lambda with initial #f assignment ;; Find lambda with initial #f assignment
((ast:lambda? (car exp))) ((ast:lambda? (car exp)))
@ -91,91 +116,93 @@
(scan exp #f)) (scan exp #f))
(define sexp (define sexp
(ast:sexp->ast '(define fit (ast:sexp->ast
(lambda ; '(define fit
(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
; (lambda ; (lambda
; (k$89 i$10$52 j$11$53) ; (k$89 i$10$52 j$11$53)
; ((lambda ; ((lambda
; (r$90) ; (lp$13$17$56)
; ((lambda ; ((lambda (r$91) (lp$13$17$56 k$89 0))
; (end$12$54) ; (set! lp$13$17$56
; ((lambda ; (lambda
; (k$16$55) ; (k$93 k$18$57)
; ((lambda ; ((lambda
; (lp$13$17$56) ; (k$98)
; ((lambda ; (if (Cyc-fast-gt
; (r$92) ; k$18$57
; ((lambda (r$91) (lp$13$17$56 k$89 k$16$55)) ; (vector-ref *piecemax* i$10$52))
; (set! lp$13$17$56 r$92))) ; (k$98 (Cyc-fast-gt
; (lambda ; k$18$57
; (k$93 k$18$57) ; (vector-ref *piecemax* i$10$52)))
; ((lambda ; (if (vector-ref (vector-ref *p* i$10$52) k$18$57)
; (r$97) ; (k$98 (vector-ref
; ((lambda ; *puzzle*
; (tmp$20$22$58) ; (Cyc-fast-plus j$11$53 k$18$57)))
; ((lambda ; (k$98 #f))))
; (k$98) ; (lambda
; (if tmp$20$22$58 ; (r$94)
; (k$98 tmp$20$22$58) ; (if r$94
; ((lambda ; (if (Cyc-fast-gt
; (r$101) ; k$18$57
; ((lambda ; (vector-ref *piecemax* i$10$52))
; (r$99) ; (k$93 #t)
; (if r$99 ; (k$93 #f))
; ((lambda ; (lp$13$17$56 k$93 (Cyc-fast-plus k$18$57 1)))))))))
; (r$100) ; #f)))
; (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)) ;; Before any rounds of optimizations the structure is:
(newline) '(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)) (analyze:find-named-lets (ast:sexp->ast sexp))