mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-14 08:17:35 +02:00
Check continuation for direct rec calls
This commit is contained in:
parent
da56bfafa1
commit
ff94309bcc
2 changed files with 20 additions and 6 deletions
|
@ -8,6 +8,12 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(define (find-direct-recursive-calls exp)
|
(define (find-direct-recursive-calls exp)
|
||||||
|
;; Verify the continuation is simple and there is no closure allocation
|
||||||
|
(define (check-cont k)
|
||||||
|
(cond
|
||||||
|
((ref? k) #t)
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
(define (check-args args)
|
(define (check-args args)
|
||||||
(define (check exp)
|
(define (check exp)
|
||||||
(cond
|
(cond
|
||||||
|
@ -35,12 +41,14 @@
|
||||||
((define? exp) #f)
|
((define? exp) #f)
|
||||||
((set!? exp) #f)
|
((set!? exp) #f)
|
||||||
((if? exp)
|
((if? exp)
|
||||||
(scan (if->condition exp) def-sym) ;; OK to check??
|
;;(scan (if->condition exp) def-sym) ;; Not a tail call
|
||||||
(scan (if->then exp) def-sym)
|
(scan (if->then exp) def-sym)
|
||||||
(scan (if->else exp) def-sym))
|
(scan (if->else exp) def-sym))
|
||||||
((app? exp)
|
((app? exp)
|
||||||
(when (equal? (car exp) def-sym)
|
(when (equal? (car exp) def-sym)
|
||||||
(if (check-args (cddr exp)) ;; Skip func and continuation
|
(if (and
|
||||||
|
(check-args (cddr exp))
|
||||||
|
(check-cont (cadr exp)))
|
||||||
(write `(direct recursive call ,exp))
|
(write `(direct recursive call ,exp))
|
||||||
(write `(not a direct recursive call ,exp))
|
(write `(not a direct recursive call ,exp))
|
||||||
)
|
)
|
||||||
|
|
|
@ -1725,6 +1725,12 @@
|
||||||
|
|
||||||
;; Find any top-level functions that call themselves directly
|
;; Find any top-level functions that call themselves directly
|
||||||
(define (analyze:find-direct-recursive-calls exp)
|
(define (analyze:find-direct-recursive-calls exp)
|
||||||
|
;; Verify the continuation is simple and there is no closure allocation
|
||||||
|
(define (check-cont k)
|
||||||
|
(cond
|
||||||
|
((ref? k) #t)
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
;; Check arguments to the top level function to make sure
|
;; Check arguments to the top level function to make sure
|
||||||
;; they are "safe" for further optimizations.
|
;; they are "safe" for further optimizations.
|
||||||
;; Right now this is very conservative.
|
;; Right now this is very conservative.
|
||||||
|
@ -1761,16 +1767,16 @@
|
||||||
((app? exp)
|
((app? exp)
|
||||||
(when (equal? (car exp) def-sym)
|
(when (equal? (car exp) def-sym)
|
||||||
(cond
|
(cond
|
||||||
((check-args (cddr exp)) ;; Skip func and continuation
|
((and
|
||||||
|
(check-cont (cadr exp))
|
||||||
|
(check-args (cddr exp)))
|
||||||
(trace:info `("direct recursive call" ,exp))
|
(trace:info `("direct recursive call" ,exp))
|
||||||
;; TODO: No, not good enough! consider _list-index from scheme base. At the
|
|
||||||
;; least we need to account for newly-allocated closures being passed as the cont.
|
|
||||||
;; But it seems neither that function or foldr is a direct call
|
|
||||||
(with-var! def-sym (lambda (var)
|
(with-var! def-sym (lambda (var)
|
||||||
(adbv:set-direct-rec-call! var #t))))
|
(adbv:set-direct-rec-call! var #t))))
|
||||||
(else
|
(else
|
||||||
(trace:info `("not a direct recursive call" ,exp))))))
|
(trace:info `("not a direct recursive call" ,exp))))))
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
(if (pair? exp)
|
(if (pair? exp)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (exp)
|
(lambda (exp)
|
||||||
|
|
Loading…
Add table
Reference in a new issue