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

schmeify: improve determinism by ordering lifted procedures

Browse Source
This commit is contained in:
Matthew Flatt 2019-12-05 07:06:28 -07:00
parent 1083aa1317
commit 6f919635da
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -620,23 +620,25 @@
;; Create bindings for lifted functions, adding new arguments
;; as the functions are lifted
(define (extract-lifted-bindings lifts empties)
(for/list ([(f proc) (in-hash lifts)]
#:when (liftable? proc))
(let* ([new-args (liftable-frees proc)]
[frees (for/hash ([arg (in-list new-args)])
(values arg #t))]
[rhs (liftable-expr proc)])
`[,f ,(match rhs
[`(lambda ,args . ,body)
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
(reannotate rhs `(lambda ,(append new-args args) . ,body)))]
[`(case-lambda [,argss . ,bodys] ...)
(reannotate rhs `(case-lambda
,@(for/list ([args (in-list argss)]
[body (in-list bodys)])
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
`[,(append new-args args) . ,body]))))])])))
(define bindings
(for/list ([(f proc) (in-hash lifts)]
#:when (liftable? proc))
(let* ([new-args (liftable-frees proc)]
[frees (for/hash ([arg (in-list new-args)])
(values arg #t))]
[rhs (liftable-expr proc)])
`[,f ,(match rhs
[`(lambda ,args . ,body)
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
(reannotate rhs `(lambda ,(append new-args args) . ,body)))]
[`(case-lambda [,argss . ,bodys] ...)
(reannotate rhs `(case-lambda
,@(for/list ([args (in-list argss)]
[body (in-list bodys)])
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
`[,(append new-args args) . ,body]))))])])))
;; Improve determinsism:
(sort bindings symbol<? #:key car))
;; ----------------------------------------
;; Helpers