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

schemify: remove procedure-naming lets

Browse Source 
Since procedures have names that are attached more directly by the
schemify pass, remove simple `let-values` forms wrapping procedures.
This shortcut improves the result of the lifting pass in some cases.
This commit is contained in:
Matthew Flatt 2020-02-17 07:44:10 -07:00
parent e1c1269939
commit 5412a4c5fa
1 changed files with 34 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
racket/src/schemify/schemify.rkt
View File

@ -517,31 +517,40 @@
[`(let-values () ,bodys ...)
(schemify `(begin . ,bodys) wcm-state)]
[`(let-values ([(,ids) ,rhss] ...) ,bodys ...)
(define new-knowns
(for/fold ([knowns knowns]) ([id (in-list ids)]
[rhs (in-list rhss)])
(define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode?))
(if k
(hash-set knowns (unwrap id) k)
knowns)))
(define (merely-a-copy? id)
(define u-id (unwrap id))
(define k (hash-ref new-knowns u-id #f))
(and (or (known-copy? k)
(known-literal? k))
(simple-mutated-state? (hash-ref mutated u-id #f))))
(unnest-let
(left-to-right/let (for/list ([id (in-list ids)]
#:unless (merely-a-copy? id))
id)
(for/list ([id (in-list ids)]
[rhs (in-list rhss)]
#:unless (merely-a-copy? id))
(schemify rhs 'fresh))
(for/list ([body (in-list bodys)])
(schemify/knowns new-knowns inline-fuel wcm-state body))
prim-knowns knowns imports mutated simples)
prim-knowns knowns imports mutated simples)]
(cond
[(and (pair? ids) (null? (cdr ids))
(pair? bodys) (null? (cdr bodys))
(eq? (unwrap (car ids)) (unwrap (car bodys)))
(lambda? (car rhss)))
;; Simplify by discarding the binding; assume that any
;; needed naming is already reflected in properties
(schemify (car rhss) wcm-state)]
[else
(define new-knowns
(for/fold ([knowns knowns]) ([id (in-list ids)]
[rhs (in-list rhss)])
(define k (infer-known rhs #f id knowns prim-knowns imports mutated simples unsafe-mode?))
(if k
(hash-set knowns (unwrap id) k)
knowns)))
(define (merely-a-copy? id)
(define u-id (unwrap id))
(define k (hash-ref new-knowns u-id #f))
(and (or (known-copy? k)
(known-literal? k))
(simple-mutated-state? (hash-ref mutated u-id #f))))
(unnest-let
(left-to-right/let (for/list ([id (in-list ids)]
#:unless (merely-a-copy? id))
id)
(for/list ([id (in-list ids)]
[rhs (in-list rhss)]
#:unless (merely-a-copy? id))
(schemify rhs 'fresh))
(for/list ([body (in-list bodys)])
(schemify/knowns new-knowns inline-fuel wcm-state body))
prim-knowns knowns imports mutated simples)
prim-knowns knowns imports mutated simples)])]
[`(let-values ([() (begin ,rhss ... (values))]) ,bodys ...)
`(begin ,@(schemify-body rhss 'fresh) ,@(schemify-body bodys wcm-state))]
[`(let-values ([,idss ,rhss] ...) ,bodys ...)