Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 17:27:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Detect loops before optimizing CPS

Browse source
This commit is contained in:
Justin Ethier 2018-08-14 17:22:01 -04:00
parent 973bfe0ef0
commit 7b5fd98695
2 changed files with 36 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
scheme/cyclone/cps-optimizations.sld
View file

@ -1710,6 +1710,39 @@
,(scan (if->else exp) lp))) ,(scan (if->else exp) lp)))
((app? exp) ((app? exp)
(cond (cond
;; Detect CPS pattern without any optimizations
((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)
((pair? (cdr inner-exp)))
((ast:lambda? (car inner-exp)))
(lambda/set (car (ast:lambda-body (car inner-exp))))
((app? lambda/set))
((ast:lambda? (car lambda/set)))
((pair? (cdr 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)
))
;; Detect optimized CPS pattern
((and-let* ( ((and-let* (
;; Find lambda with initial #f assignment ;; Find lambda with initial #f assignment
((ast:lambda? (car exp))) ((ast:lambda? (car exp)))

3
test-find-loop.scm
View file

@ -70,9 +70,12 @@
((app? inner-exp)) ((app? inner-exp))
((ast:lambda? (car inner-exp))) ((ast:lambda? (car inner-exp)))
;; Find the set (assumes CPS conversion) ;; Find the set (assumes CPS conversion)
((pair? (cdr inner-exp)))
((ast:lambda? (car inner-exp)))
(lambda/set (car (ast:lambda-body (car inner-exp)))) (lambda/set (car (ast:lambda-body (car inner-exp))))
((app? lambda/set)) ((app? lambda/set))
((ast:lambda? (car lambda/set))) ((ast:lambda? (car lambda/set)))
((pair? (cdr lambda/set)))
((set!? (cadr lambda/set))) ((set!? (cadr lambda/set)))
((equal? (set!->var (cadr lambda/set)) loop-sym)) ((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))) ; (unused (begin (newline) (newline) (write loop-sym) (write (ast:ast->pp-sexp (cadr lambda/set))) (newline)(newline)))