Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-10-17 13:23:31 -04:00
parent bea7cfe242
commit f110c1d219
1 changed files with 41 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1951,22 +1951,34 @@
;; Does given symbol refer to a recursive call to given lambda ID? ;; Does given symbol refer to a recursive call to given lambda ID?
(define (rec-call? sym lid) (define (rec-call? sym lid)
(trace:info `(rec-call? ,sym ,lid)) (cond
(and-let* ((var (adb:get/default sym #f)) ((ref? sym)
((not (adbv:reassigned? var))) (let ((var (adb:get/default sym #f)))
(var-lam (adbv:assigned-value var)) (trace:info `(rec-call? ,sym ,lid
((ast:lambda? var-lam)) ,(if var (not (adbv:reassigned? var)) #f)
(fnc (adb:get/default lid #f)) ,(if var (adbv:assigned-value var) #f)
) ;,((ast:lambda? var-lam))
(trace:info `(equal? ,lid ,(ast:lambda-id var-lam))) ,(adb:get/default lid #f)
(equal? lid (ast:lambda-id var-lam)))) )
)
(and-let* (((ref? sym))
((var))
((not (adbv:reassigned? var)))
(var-lam (adbv:assigned-value var))
((ast:lambda? var-lam))
(fnc (adb:get/default lid #f))
)
(trace:info `(equal? ,lid ,(ast:lambda-id var-lam)))
(equal? lid (ast:lambda-id var-lam)))))
(else
#f)))
;; Find functions that call themselves. This is not as restrictive ;; Find functions that call themselves. This is not as restrictive
;; as finding "direct" calls. ;; as finding "direct" calls.
(define (analyze:find-recursive-calls exp) (define (analyze:find-recursive-calls exp)
(define (scan exp def-sym lid) (define (scan exp def-sym lid)
;(trace:info `(analyze:find-recursive-calls scan ,def-sym ,exp)) (trace:info `(analyze:find-recursive-calls scan ,def-sym ,exp ,lid))
(cond (cond
((ast:lambda? exp) ((ast:lambda? exp)
(for-each (for-each
@ -1978,33 +1990,44 @@
((ref? exp) ((ref? exp)
exp) exp)
((define? exp) #f) ;; TODO ?? ((define? exp) #f) ;; TODO ??
((set!? exp) #f) ;; TODO ?? ((set!? exp)
(for-each
(lambda (e)
(scan e def-sym lid))
(cdr exp))
)
((if? exp) ((if? exp)
(scan (if->condition exp) def-sym lid) (scan (if->condition exp) def-sym lid)
(scan (if->then exp) def-sym lid) (scan (if->then exp) def-sym lid)
(scan (if->else exp) def-sym lid)) (scan (if->else exp) def-sym lid))
((app? exp) ((app? exp)
(when (or (equal? (car exp) def-sym) (when (or ;(equal? (car exp) def-sym) TODO: def-sym is obsolete, remove it
(rec-call? (car exp) lid)) (rec-call? (car exp) lid))
(trace:info `("recursive call" ,exp)) (trace:info `("recursive call" ,exp))
(with-var! def-sym (lambda (var) (with-var! (car exp) (lambda (var)
(adbv:set-self-rec-call! var #t))))) (adbv:set-self-rec-call! var #t))))
(for-each
(lambda (e)
(scan e def-sym lid))
exp)
)
(else #f))) (else #f)))
;; TODO: probably not good enough, what about recursive functions that are not top-level?? ;; TODO: probably not good enough, what about recursive functions that are not top-level??
TODO: need to address those now, I think we have the support now via (rec-call?) ;TODO: need to address those now, I think we have the support now via (rec-call?)
(if (pair? exp) (if (pair? exp)
(for-each (for-each
(lambda (exp) (lambda (exp)
;;(write exp) (newline) (trace:info `(analyze:find-recursive-calls ,exp))
(and-let* (((define? exp)) (and-let* (((define? exp))
(def-exps (define->exp exp)) (def-exps (define->exp exp))
((vector? (car def-exps))) ((vector? (car def-exps)))
((ast:lambda? (car def-exps))) ((ast:lambda? (car def-exps)))
(id (ast:lambda-id (car def-exps))) (id (ast:lambda-id (car def-exps)))
) )
(scan (car (ast:lambda-body (car def-exps))) (define->var exp) id))) (scan (car (ast:lambda-body (car def-exps))) (define->var exp) id)
exp)) ))
exp))
) )
;; well-known-lambda :: symbol -> Either (AST Lambda | Boolean) ;; well-known-lambda :: symbol -> Either (AST Lambda | Boolean)