suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs & schemify: fix [non-]loop detection in lifting pass

Browse Source 
When a would-be loop is called in a would-be loop that turns out not
to be a loop due to an intervening non-loop layer, the outer would-be
loop was not detected as a non-loop.
This commit is contained in:
Matthew Flatt 2020-10-21 11:42:56 -06:00
parent 5304ff5327
commit 279412d316
3 changed files with 48 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -3414,4 +3414,34 @@ case of module-leve bindings; it doesn't cover local bindings.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module regression-test-for-loop-detection racket/base
(provide go)
(define (f pick)
(let would-be-loop ([v #f])
(if (pick)
(let not-a-loop ()
(if (pick)
(let also-would-be-loop ()
(if (pick)
(if (pick)
(also-would-be-loop)
(would-be-loop #t))
null))
(if (pick)
(list (not-a-loop))
null)))
(would-be-loop v))))
(define (go)
(f (let ([l '(#t #t #t #f #t #f #f)])
(lambda ()
(begin0
(car l)
(set! l (cdr l))))))))
(test '() (dynamic-require ''regression-test-for-loop-detection 'go))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

13
racket/src/cs/schemified/schemify.scm
View File

@ -37652,10 +37652,15 @@
(let ((table_1
(call-with-values
(lambda ()
(values
id_1
(box
#f)))
(if (unbox
bx_0)
(values
id_1
(box
#f))
(values
id_1
bx_0)))
(case-lambda
((key_0
val_0)

12
racket/src/schemify/lift.rkt
View File

@ -519,8 +519,14 @@
[else
(define new-loop-if-tail
(hash-set (for/hasheq ([(id bx) (in-hash loop-if-tail)])
(values id (box #f)))
u-id (box #f)))
;; If box is set, create a new one to find out if it's
;; specifically set here. Otherwise, use existing box
;; to propagate from here to elsewhere
(if (unbox bx)
(values id (box #f))
(values id bx)))
u-id
(box #f)))
(define new-loops
(find-loops-in-tail-called rhs lifts new-loop-if-tail loops))
(cond
@ -528,7 +534,7 @@
new-loops]
[else
;; Not a loop, so any reference added in `new-loop-if-tail`
;; is also to a non-loop
;; is also a non-loop
(for/fold ([loops new-loops]) ([(id bx) (in-hash new-loop-if-tail)])
(if (unbox bx)
(hash-remove loops id)