From 973bfe0ef0636c4ffb3b6bd5ed5280c2d0dc4551 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 14 Aug 2018 13:34:25 -0400 Subject: [PATCH] Match original CPS --- test-find-loop.scm | 201 +++++++++++++++++++++++++-------------------- 1 file changed, 114 insertions(+), 87 deletions(-) diff --git a/test-find-loop.scm b/test-find-loop.scm index e03e3bf5..3350ecd0 100644 --- a/test-find-loop.scm +++ b/test-find-loop.scm @@ -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))