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 ;; Create bindings for lifted functions, adding new arguments
;; as the functions are lifted ;; as the functions are lifted
(define (extract-lifted-bindings lifts empties) (define (extract-lifted-bindings lifts empties)
(for/list ([(f proc) (in-hash lifts)] (define bindings
#:when (liftable? proc)) (for/list ([(f proc) (in-hash lifts)]
(let* ([new-args (liftable-frees proc)] #:when (liftable? proc))
[frees (for/hash ([arg (in-list new-args)]) (let* ([new-args (liftable-frees proc)]
(values arg #t))] [frees (for/hash ([arg (in-list new-args)])
[rhs (liftable-expr proc)]) (values arg #t))]
`[,f ,(match rhs [rhs (liftable-expr proc)])
[`(lambda ,args . ,body) `[,f ,(match rhs
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)]) [`(lambda ,args . ,body)
(reannotate rhs `(lambda ,(append new-args args) . ,body)))] (let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
[`(case-lambda [,argss . ,bodys] ...) (reannotate rhs `(lambda ,(append new-args args) . ,body)))]
(reannotate rhs `(case-lambda [`(case-lambda [,argss . ,bodys] ...)
,@(for/list ([args (in-list argss)] (reannotate rhs `(case-lambda
[body (in-list bodys)]) ,@(for/list ([args (in-list argss)]
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)]) [body (in-list bodys)])
`[,(append new-args args) . ,body]))))])]))) (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 ;; Helpers