Promote accumulator lets to the outermost let

This is a bug I never hit, due to me only having accumulators that gets passed along. However,
something like vectoring or hashing should behave like (in-vector ...), which means the let binding
needs to be propagated upwards.
* goof.scm change cl-next/acc to promote let bindings for accumulators to the outermost let.
This commit is contained in:
Linus 2021-01-01 22:00:39 +01:00
parent 02fd0199ec
commit 5f96ef4fb0

View file

@ -221,7 +221,7 @@
;; We have ONE subloop! ;; We have ONE subloop!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name orig name
((lets ...) . lets-rest) (lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...)) ((accs ...) ((oldacc oldinit oldupdate) ...))
((vars ...) . vars-rest) ((vars ...) . vars-rest)
((checks ...) . checks-rest) ((checks ...) . checks-rest)
@ -229,7 +229,7 @@
(finals ...) (finals ...)
ff ul uw ub uf clauses . body) ff ul uw ub uf clauses . body)
(cl orig name (cl orig name
((lets ... new-lets ...) . lets-rest) (lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest) ((vars ... new-vars ...) . vars-rest)
((checks ... new-checks ...) . checks-rest) ((checks ... new-checks ...) . checks-rest)
@ -239,15 +239,15 @@
;; We have several subloops! ;; We have several subloops!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name orig name
((lets ...) . lets-rest) (lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...))
((vars ...) . vars-rest) ((vars ...) . vars-rest)
((checks ...) . checks-rest) ((checks ...) . checks-rest)
((refs ...) . refs-rest) ((refs ...) . refs-rest)
(finals ...) (finals ...)
ff ul uw ub uf clauses . body) ff ul uw ub uf clauses . body)
(cl orig name (cl orig name
((lets ... new-lets ...) . lets-rest) (lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest) ((vars ... new-vars ...) . vars-rest)