mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-07 05:06:36 +02:00
WIP
This commit is contained in:
parent
74078d00b0
commit
10f01e82bb
1 changed files with 25 additions and 2 deletions
|
@ -1,3 +1,7 @@
|
||||||
|
;; Instead of just porting this to cps-optmizations should consider
|
||||||
|
;; creating a new subdirectory under scheme/cyclone/cps-optimizations and starting to place
|
||||||
|
;; things like this there as new libraries, to isolate them, improve testability, and help
|
||||||
|
;; make optimizations easiser to maintain
|
||||||
(import
|
(import
|
||||||
(scheme base)
|
(scheme base)
|
||||||
(scheme cyclone ast)
|
(scheme cyclone ast)
|
||||||
|
@ -8,10 +12,25 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(define (find-direct-recursive-calls exp)
|
(define (find-direct-recursive-calls exp)
|
||||||
|
(define (check-args args)
|
||||||
|
(define (check exp)
|
||||||
|
(cond
|
||||||
|
((quote? exp) #t)
|
||||||
|
((const? exp) #t)
|
||||||
|
((ref? exp) #t)
|
||||||
|
((app? exp)
|
||||||
|
(and
|
||||||
|
;; Very conservative right now
|
||||||
|
(member (car exp) '(car cdr))
|
||||||
|
(check-args (cdr exp))))
|
||||||
|
(else #f)))
|
||||||
|
(every check args))
|
||||||
|
|
||||||
(define (scan exp def-sym)
|
(define (scan exp def-sym)
|
||||||
(write `(scan ,def-sym ,exp)) (newline)
|
(write `(scan ,def-sym ,exp)) (newline)
|
||||||
(cond
|
(cond
|
||||||
((ast:lambda? exp)
|
((ast:lambda? exp)
|
||||||
|
;; Reject if there are nested functions
|
||||||
#f)
|
#f)
|
||||||
((quote? exp) exp)
|
((quote? exp) exp)
|
||||||
((const? exp) exp)
|
((const? exp) exp)
|
||||||
|
@ -20,12 +39,16 @@
|
||||||
((define? exp) #f)
|
((define? exp) #f)
|
||||||
((set!? exp) #f)
|
((set!? exp) #f)
|
||||||
((if? exp)
|
((if? exp)
|
||||||
(scan (if->condition exp) def-sym)
|
(scan (if->condition exp) def-sym) ;; OK to check??
|
||||||
(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)
|
||||||
(write `(possible direct recursive call ,exp)))
|
(if (check-args (cddr exp)) ;; Skip func and continuation
|
||||||
|
(write `(direct recursive call ,exp))
|
||||||
|
(write `(not a direct recursive call ,exp))
|
||||||
|
)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
(else #f)))
|
(else #f)))
|
||||||
(for-each
|
(for-each
|
||||||
|
|
Loading…
Add table
Reference in a new issue