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

Do not beta expand a recursive function w/itself

Browse source
This commit is contained in:
Justin Ethier 2018-06-15 19:04:47 -04:00
parent 79d490292f
commit 6a57b69517
1 changed files with 9 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -11,6 +11,7 @@
(define-library (scheme cyclone cps-optimizations) (define-library (scheme cyclone cps-optimizations)
(import (scheme base) (import (scheme base)
(scheme eval) (scheme eval)
;(scheme write)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone ast) (scheme cyclone ast)
(scheme cyclone primitives) (scheme cyclone primitives)
@ -1355,7 +1356,7 @@
(or (not called-once?) (or (not called-once?)
(= 1 (adbv:app-fnc-count var))) (= 1 (adbv:app-fnc-count var)))
(not (adbv:reassigned? var)) (not (adbv:reassigned? var))
(not (fnc-depth>? (ast:lambda-body fnc) 4)))) (not (fnc-depth>? (ast:lambda-body fnc) 5))))
))) )))
(else #f))) (else #f)))
@ -1398,11 +1399,12 @@
; (if (adbv:cont? var) maybe-cont #f))) ; (if (adbv:cont? var) maybe-cont #f)))
; #f)) ; #f))
) )
;(trace:error `(JAE beta expand ,exp ,var ,fnc ,formals ,cont)) ;(trace:error `(JAE beta expand ,exp ,var ,fnc ,formals ))
(cond (cond
;; TODO: what if fnc has no cont? do we need to handle differently? ;; TODO: what if fnc has no cont? do we need to handle differently?
((and (ast:lambda? fnc) ((and (ast:lambda? fnc)
(not (adbv:reassigned? var)) ;; Failsafe (not (adbv:reassigned? var)) ;; Failsafe
(not (equal? fnc (adbv:assigned-value var))) ;; Do not expand recursive func
(not (adbv:cont? var)) ;; TEST, don't delete a continuation (not (adbv:cont? var)) ;; TEST, don't delete a continuation
(list? formals) (list? formals)
(= (length args) (length formals))) (= (length args) (length formals)))
@ -1413,11 +1415,16 @@
;; Replace function call with body of fnc ;; Replace function call with body of fnc
(define (beta-expansion-app exp fnc rename-lambdas) (define (beta-expansion-app exp fnc rename-lambdas)
;(write `(beta-expansion-app ,exp))
;(newline)
;; Mapping from a formal => actual arg ;; Mapping from a formal => actual arg
(define formals/actuals (define formals/actuals
(map cons (ast:lambda-args fnc) (cdr exp))) (map cons (ast:lambda-args fnc) (cdr exp)))
;; Replace ref with corresponding argument from function call being replaced
(define (replace ref renamed) (define (replace ref renamed)
(let ((r (assoc ref formals/actuals))) (let ((r (assoc ref formals/actuals)))
;(write `(DEBUG2 replace ,ref ,renamed ,r))
;(newline)
(if (and r (if (and r
(not (eq? (car r) (cdr r)))) ;; Prevent an inf loop (not (eq? (car r) (cdr r)))) ;; Prevent an inf loop
(scan (cdr r) renamed) (scan (cdr r) renamed)