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

schemify: more determinism for lifted procedures

Browse Source 
A further repair to 6f919635da.
This commit is contained in:
Matthew Flatt 2019-12-05 15:56:32 -07:00
parent 898517107f
commit d7052da691
1 changed files with 24 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -621,10 +621,17 @@
;; 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)
(define bindings (define liftables
(for/list ([(f proc) (in-hash lifts)] ;; Improve determinsism by sorting liftables:
(sort (for/list ([(f proc) (in-hash lifts)]
#:when (liftable? proc)) #:when (liftable? proc))
(let* ([new-args (liftable-frees proc)] (cons f proc))
symbol<?
#:key car))
(for/list ([f+proc (in-list liftables)])
(let* ([f (car f+proc)]
[proc (cdr f+proc)]
[new-args (liftable-frees proc)]
[frees (for/hash ([arg (in-list new-args)]) [frees (for/hash ([arg (in-list new-args)])
(values arg #t))] (values arg #t))]
[rhs (liftable-expr proc)]) [rhs (liftable-expr proc)])
@ -638,8 +645,6 @@
[body (in-list bodys)]) [body (in-list bodys)])
(let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)]) (let ([body (convert-lifted-calls-in-seq/box-mutated body args lifts frees empties)])
`[,(append new-args args) . ,body]))))])]))) `[,(append new-args args) . ,body]))))])])))
;; Improve determinsism:
(sort bindings symbol<? #:key car))
;; ---------------------------------------- ;; ----------------------------------------
;; Helpers ;; Helpers