From bea7cfe242f525ff9956049814dc588947686bf2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 16 Oct 2018 22:52:34 -0400 Subject: [PATCH] Added (rec-call?) --- scheme/cyclone/cps-optimizations.sld | 29 +++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index e8eae029..543ba69e 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1949,17 +1949,29 @@ exp)) ) +;; Does given symbol refer to a recursive call to given lambda ID? +(define (rec-call? sym lid) + (trace:info `(rec-call? ,sym ,lid)) + (and-let* ((var (adb:get/default sym #f)) + ((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)))) + ;; Find functions that call themselves. This is not as restrictive ;; as finding "direct" calls. (define (analyze:find-recursive-calls exp) - (define (scan exp def-sym) + (define (scan exp def-sym lid) ;(trace:info `(analyze:find-recursive-calls scan ,def-sym ,exp)) (cond ((ast:lambda? exp) (for-each (lambda (e) - (scan e def-sym)) + (scan e def-sym (ast:lambda-id exp))) (ast:lambda-body exp))) ((quote? exp) exp) ((const? exp) exp) @@ -1968,17 +1980,19 @@ ((define? exp) #f) ;; TODO ?? ((set!? exp) #f) ;; TODO ?? ((if? exp) - (scan (if->condition exp) def-sym) - (scan (if->then exp) def-sym) - (scan (if->else exp) def-sym)) + (scan (if->condition exp) def-sym lid) + (scan (if->then exp) def-sym lid) + (scan (if->else exp) def-sym lid)) ((app? exp) - (when (equal? (car exp) def-sym) + (when (or (equal? (car exp) def-sym) + (rec-call? (car exp) lid)) (trace:info `("recursive call" ,exp)) (with-var! def-sym (lambda (var) (adbv:set-self-rec-call! var #t))))) (else #f))) ;; 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?) (if (pair? exp) (for-each (lambda (exp) @@ -1987,8 +2001,9 @@ (def-exps (define->exp exp)) ((vector? (car def-exps))) ((ast:lambda? (car def-exps))) + (id (ast:lambda-id (car def-exps))) ) - (scan (car (ast:lambda-body (car def-exps))) (define->var exp)))) + (scan (car (ast:lambda-body (car def-exps))) (define->var exp) id))) exp)) )