schemify: purge all gensyms
Although some of them probbably do not matter (while some certainly do), avoid various possible problems by always using a locally determinsitic replacement for `gensym`.
This commit is contained in:
Matthew Flatt
parent
d5ab0fce05
commit
898517107f
19
racket/src/schemify/gensym.rkt
Normal file
19
racket/src/schemify/gensym.rkt
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide with-deterministic-gensym
|
||||
deterministic-gensym)
|
||||
|
||||
(define gensym-counter (make-parameter #f))
|
||||
|
||||
(define-syntax-rule (with-deterministic-gensym body ...)
|
||||
(parameterize ([gensym-counter (box 0)])
|
||||
body ...))
|
||||
|
||||
(define (deterministic-gensym prefix)
|
||||
(define b (gensym-counter))
|
||||
(unless b (error 'deterministic-gensym "not in `call-with-deterministic-gensym`"))
|
||||
(set-box! b (add1 (unbox b)))
|
||||
(string->uninterned-symbol (string-append (if (string? prefix)
|
||||
prefix
|
||||
(symbol->string prefix))
|
||||
(number->string (unbox b)))))
|
||||
|
|
@ -1,4 +1,6 @@
|
|||
#lang racket/base
|
||||
(require "gensym.rkt")
|
||||
|
||||
(provide (struct-out import)
|
||||
(struct-out import-group)
|
||||
|
||||
|
|
@ -83,8 +85,8 @@
|
|||
(and (eq? ext-id (import-ext-id im))
|
||||
(import-int-id im)))
|
||||
;; `ext-id` from the group is not currently imported; add it as an import
|
||||
(let ([id (gensym ext-id)]
|
||||
[int-id (gensym ext-id)])
|
||||
(let ([id (deterministic-gensym ext-id)]
|
||||
[int-id (deterministic-gensym ext-id)])
|
||||
(define im (import grp id int-id ext-id))
|
||||
(set-import-group-imports! grp (cons im (import-group-imports grp)))
|
||||
(hash-set! imports int-id im)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
"known.rkt"
|
||||
"import.rkt"
|
||||
"export.rkt"
|
||||
"wrap-path.rkt")
|
||||
"wrap-path.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
(provide init-inline-fuel
|
||||
can-inline?
|
||||
|
|
@ -127,7 +128,7 @@
|
|||
[(wrap-null? args) base-env]
|
||||
[(wrap-pair? args)
|
||||
(define u (unwrap (wrap-car args)))
|
||||
(define g (gensym u))
|
||||
(define g (deterministic-gensym u))
|
||||
(define m (hash-ref mutated u #f))
|
||||
(when m
|
||||
(hash-set! mutated g m))
|
||||
|
|
@ -135,7 +136,7 @@
|
|||
(loop (wrap-cdr args)))]
|
||||
[else
|
||||
(define u (unwrap args))
|
||||
(cons (cons u (gensym u)) base-env)])))
|
||||
(cons (cons u (deterministic-gensym u)) base-env)])))
|
||||
(values (let loop ([args args] [env env])
|
||||
(cond
|
||||
[(wrap-null? args) '()]
|
||||
|
|
|
|||
|
|
@ -6,7 +6,8 @@
|
|||
"path-for-srcloc.rkt"
|
||||
"to-fasl.rkt"
|
||||
"interp-match.rkt"
|
||||
"interp-stack.rkt")
|
||||
"interp-stack.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
;; Interpreter for the output of "jitify". This little interpreter is
|
||||
;; useful to avoid going through a more heavyweight `eval` or
|
||||
|
|
@ -267,7 +268,7 @@
|
|||
(compile-assignment id rhs env stack-depth stk-i)]
|
||||
[`(define-values ,ids ,rhs)
|
||||
(define gen-ids (for/list ([id (in-list ids)])
|
||||
(gensym (unwrap id))))
|
||||
(deterministic-gensym (unwrap id))))
|
||||
(compile-expr `(call-with-values (lambda () ,rhs)
|
||||
(lambda ,gen-ids
|
||||
,@(if (null? ids)
|
||||
|
|
@ -424,9 +425,10 @@
|
|||
pos))
|
||||
(cond
|
||||
[(null? clears) e]
|
||||
[else (vector 'clear clears e)]))
|
||||
[else (vector 'clear (sort clears <) e)]))
|
||||
|
||||
(start linklet-e))
|
||||
(with-deterministic-gensym
|
||||
(start linklet-e)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
(require "match.rkt"
|
||||
"wrap.rkt")
|
||||
"wrap.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
;; Convert `lambda`s to make them fully closed, which is compatible
|
||||
;; with JIT compilation of the `lambda` or separate ahead-of-time
|
||||
|
|
@ -33,7 +34,7 @@
|
|||
|
||||
(struct convert-mode (sizes called? lift? no-more-conversions?))
|
||||
|
||||
(define lifts-id (gensym 'jits))
|
||||
(define lifts-id (string->uninterned-symbol "_jits"))
|
||||
|
||||
(define (jitify-schemified-linklet v
|
||||
need-extract?
|
||||
|
|
@ -55,11 +56,13 @@
|
|||
[`(self ,m ,orig-id) orig-id]
|
||||
[`(self ,m) (extract-id m id)]
|
||||
[`,_ id]))
|
||||
(define captures (hash-keys
|
||||
;; `extract-id` for different `id`s can produce the
|
||||
;; same `id`, so hash and then convert to a list
|
||||
(for/hash ([id (in-list ids)])
|
||||
(values (extract-id (hash-ref env id) id) #t))))
|
||||
(define captures (sort
|
||||
(hash-keys
|
||||
;; `extract-id` for different `id`s can produce the
|
||||
;; same `id`, so hash and then convert to a list
|
||||
(for/hash ([id (in-list ids)])
|
||||
(values (extract-id (hash-ref env id) id) #t)))
|
||||
symbol<?))
|
||||
(define jitted-proc
|
||||
(or (match (and name
|
||||
(hash-ref free-vars (unwrap name) #f)
|
||||
|
|
@ -470,7 +473,7 @@
|
|||
[new-rhs (in-list rev-new-rhss)])
|
||||
`(let (,(cond
|
||||
[(hash-ref rhs-free (unwrap id) #f)
|
||||
`[,(gensym 'ignored) (set-box! ,id ,new-rhs)]]
|
||||
`[,(deterministic-gensym "ignored") (set-box! ,id ,new-rhs)]]
|
||||
[(hash-ref mutables (unwrap id) #f)
|
||||
`[,id (box ,new-rhs)]]
|
||||
[else `[,id ,new-rhs]]))
|
||||
|
|
@ -575,7 +578,7 @@
|
|||
(define (activate-self env name)
|
||||
(cond
|
||||
[name
|
||||
(define (genself) (gensym 'self))
|
||||
(define (genself) (deterministic-gensym "self"))
|
||||
(define u (unwrap name))
|
||||
(define new-m
|
||||
(match (hash-ref env u #f)
|
||||
|
|
@ -823,8 +826,9 @@
|
|||
(body-record-sizes! body sizes))]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(top))
|
||||
|
||||
(with-deterministic-gensym
|
||||
(top)))
|
||||
|
||||
;; ============================================================
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
#lang racket/base
|
||||
(require "wrap.rkt"
|
||||
"match.rkt"
|
||||
"simple.rkt")
|
||||
"simple.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
(provide left-to-right/let
|
||||
left-to-right/let-values
|
||||
|
|
@ -104,7 +105,7 @@
|
|||
`(let ([,pending-id ,pending-non-simple])
|
||||
,(loop l accum #f #f))]
|
||||
[else
|
||||
(define g (gensym "app_"))
|
||||
(define g (deterministic-gensym "app_"))
|
||||
(loop (cdr l) (cons g accum) (car l) g)]))]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
(require "match.rkt"
|
||||
"wrap.rkt")
|
||||
"wrap.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
;; Reduces closure allocation by lifting bindings that are only used
|
||||
;; in calls that have the right number of arguments.
|
||||
|
|
@ -592,7 +593,7 @@
|
|||
(define new-rhs (convert-lifted-calls-in-expr rhs lifts frees empties))
|
||||
(cond
|
||||
[(indirected? (hash-ref lifts (unwrap id) #f))
|
||||
`[,(gensym) (unsafe-set-box*! ,id ,new-rhs)]]
|
||||
`[,(deterministic-gensym "seq") (unsafe-set-box*! ,id ,new-rhs)]]
|
||||
[else `[,id ,new-rhs]])))
|
||||
(define new-bindings
|
||||
(if (null? bindings)
|
||||
|
|
@ -751,14 +752,15 @@
|
|||
(define (lift-if-empty v lifts empties new-v)
|
||||
(cond
|
||||
[(hash-ref lifts v #f)
|
||||
(define id (gensym 'procz))
|
||||
(define id (deterministic-gensym "procz"))
|
||||
(set-box! empties (cons `[,id ,new-v] (unbox empties)))
|
||||
id]
|
||||
[else new-v]))
|
||||
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Go
|
||||
|
||||
(if (lift-in? v)
|
||||
(lift-in v)
|
||||
(with-deterministic-gensym
|
||||
(lift-in v))
|
||||
v))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@
|
|||
"ptr-ref-set.rkt"
|
||||
"literal.rkt"
|
||||
"authentic.rkt"
|
||||
"single-valued.rkt")
|
||||
"single-valued.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
(provide schemify-linklet
|
||||
schemify-body)
|
||||
|
|
@ -78,118 +79,120 @@
|
|||
(define (schemify-linklet lk serializable? datum-intern? for-jitify? allow-set!-undefined?
|
||||
unsafe-mode? enforce-constant? allow-inline? no-prompt?
|
||||
prim-knowns primitives get-import-knowns import-keys)
|
||||
(define (im-int-id id) (unwrap (if (pair? id) (cadr id) id)))
|
||||
(define (im-ext-id id) (unwrap (if (pair? id) (car id) id)))
|
||||
(define (ex-int-id id) (unwrap (if (pair? id) (car id) id)))
|
||||
(define (ex-ext-id id) (unwrap (if (pair? id) (cadr id) id)))
|
||||
;; Assume no wraps unless the level of an id or expression
|
||||
(match lk
|
||||
[`(linklet ,im-idss ,ex-ids . ,bodys)
|
||||
;; For imports, map symbols to gensymed `variable` argument names,
|
||||
;; keeping `import` records in groups:
|
||||
(define grps
|
||||
(for/list ([im-ids (in-list im-idss)]
|
||||
[index (in-naturals)])
|
||||
;; An import key from `import-keys` lets us get cross-module
|
||||
;; information on demand
|
||||
(import-group index (and import-keys (vector-ref import-keys index))
|
||||
get-import-knowns #f #f
|
||||
'())))
|
||||
;; Record import information in both the `imports` table and within
|
||||
;; the import-group record
|
||||
(define imports
|
||||
(let ([imports (make-hasheq)])
|
||||
(for ([im-ids (in-list im-idss)]
|
||||
[grp (in-list grps)])
|
||||
(set-import-group-imports!
|
||||
grp
|
||||
(for/list ([im-id (in-list im-ids)])
|
||||
(define id (im-int-id im-id))
|
||||
(define ext-id (im-ext-id im-id))
|
||||
(define int-id (gensym (symbol->string id)))
|
||||
(define im (import grp int-id id ext-id))
|
||||
(hash-set! imports id im)
|
||||
(hash-set! imports int-id im) ; useful for optimizer to look up known info late
|
||||
im)))
|
||||
imports))
|
||||
;; Inlining can add new import groups or add imports to an existing group
|
||||
(define new-grps '())
|
||||
(define add-import!
|
||||
(make-add-import! imports
|
||||
grps
|
||||
get-import-knowns
|
||||
(lambda (new-grp) (set! new-grps (cons new-grp new-grps)))))
|
||||
;; For exports, too, map symbols to gensymed `variable` argument names
|
||||
(define exports
|
||||
(for/fold ([exports (hasheq)]) ([ex-id (in-list ex-ids)])
|
||||
(define id (ex-int-id ex-id))
|
||||
(hash-set exports id (export (gensym (symbol->string id)) (ex-ext-id ex-id)))))
|
||||
;; Lift any quoted constants that can't be serialized
|
||||
(define-values (bodys/constants-lifted lifted-constants)
|
||||
(if serializable?
|
||||
(convert-for-serialize bodys #f datum-intern?)
|
||||
(values bodys null)))
|
||||
;; Collect source names for defined identifiers, to the degree that the
|
||||
;; original source name differs from the current name
|
||||
(define src-syms (get-definition-source-syms bodys))
|
||||
;; Schemify the body, collecting information about defined names:
|
||||
(define-values (new-body defn-info mutated)
|
||||
(schemify-body* bodys/constants-lifted prim-knowns primitives imports exports
|
||||
for-jitify? allow-set!-undefined? add-import! #f
|
||||
unsafe-mode? enforce-constant? allow-inline? no-prompt?))
|
||||
(define all-grps (append grps (reverse new-grps)))
|
||||
(values
|
||||
;; Build `lambda` with schemified body:
|
||||
(make-let*
|
||||
lifted-constants
|
||||
`(lambda (instance-variable-reference
|
||||
,@(for*/list ([grp (in-list all-grps)]
|
||||
[im (in-list (import-group-imports grp))])
|
||||
(import-id im))
|
||||
,@(for/list ([ex-id (in-list ex-ids)])
|
||||
(export-id (hash-ref exports (ex-int-id ex-id)))))
|
||||
,@new-body))
|
||||
;; Imports (external names), possibly extended via inlining:
|
||||
(for/list ([grp (in-list all-grps)])
|
||||
(for/list ([im (in-list (import-group-imports grp))])
|
||||
(import-ext-id im)))
|
||||
;; Exports (external names, but paired with source name if it's different):
|
||||
(for/list ([ex-id (in-list ex-ids)])
|
||||
(define sym (ex-ext-id ex-id))
|
||||
(define int-sym (ex-int-id ex-id))
|
||||
(define src-sym (hash-ref src-syms int-sym sym)) ; external name unless 'source-name
|
||||
(if (eq? sym src-sym) sym (cons sym src-sym)))
|
||||
;; Import keys --- revised if we added any import groups
|
||||
(if (null? new-grps)
|
||||
import-keys
|
||||
(for/vector #:length (length all-grps) ([grp (in-list all-grps)])
|
||||
(import-group-key grp)))
|
||||
;; Import ABI: request values for constants, `variable`s otherwise
|
||||
(for/list ([grp (in-list all-grps)])
|
||||
(define im-ready? (import-group-lookup-ready? grp))
|
||||
(for/list ([im (in-list (import-group-imports grp))])
|
||||
(and im-ready?
|
||||
(known-constant? (import-group-lookup grp (import-ext-id im))))))
|
||||
;; Convert internal to external identifiers for known-value info
|
||||
(for/fold ([knowns (hasheq)]) ([ex-id (in-list ex-ids)])
|
||||
(define id (ex-int-id ex-id))
|
||||
(define v (known-inline->export-known (hash-ref defn-info id #f)
|
||||
prim-knowns imports exports
|
||||
serializable?))
|
||||
(cond
|
||||
[(not (set!ed-mutated-state? (hash-ref mutated id #f)))
|
||||
(define ext-id (ex-ext-id ex-id))
|
||||
(hash-set knowns ext-id (or v a-known-constant))]
|
||||
[else knowns])))]))
|
||||
(with-deterministic-gensym
|
||||
(define (im-int-id id) (unwrap (if (pair? id) (cadr id) id)))
|
||||
(define (im-ext-id id) (unwrap (if (pair? id) (car id) id)))
|
||||
(define (ex-int-id id) (unwrap (if (pair? id) (car id) id)))
|
||||
(define (ex-ext-id id) (unwrap (if (pair? id) (cadr id) id)))
|
||||
;; Assume no wraps unless the level of an id or expression
|
||||
(match lk
|
||||
[`(linklet ,im-idss ,ex-ids . ,bodys)
|
||||
;; For imports, map symbols to gensymed `variable` argument names,
|
||||
;; keeping `import` records in groups:
|
||||
(define grps
|
||||
(for/list ([im-ids (in-list im-idss)]
|
||||
[index (in-naturals)])
|
||||
;; An import key from `import-keys` lets us get cross-module
|
||||
;; information on demand
|
||||
(import-group index (and import-keys (vector-ref import-keys index))
|
||||
get-import-knowns #f #f
|
||||
'())))
|
||||
;; Record import information in both the `imports` table and within
|
||||
;; the import-group record
|
||||
(define imports
|
||||
(let ([imports (make-hasheq)])
|
||||
(for ([im-ids (in-list im-idss)]
|
||||
[grp (in-list grps)])
|
||||
(set-import-group-imports!
|
||||
grp
|
||||
(for/list ([im-id (in-list im-ids)])
|
||||
(define id (im-int-id im-id))
|
||||
(define ext-id (im-ext-id im-id))
|
||||
(define int-id (deterministic-gensym id))
|
||||
(define im (import grp int-id id ext-id))
|
||||
(hash-set! imports id im)
|
||||
(hash-set! imports int-id im) ; useful for optimizer to look up known info late
|
||||
im)))
|
||||
imports))
|
||||
;; Inlining can add new import groups or add imports to an existing group
|
||||
(define new-grps '())
|
||||
(define add-import!
|
||||
(make-add-import! imports
|
||||
grps
|
||||
get-import-knowns
|
||||
(lambda (new-grp) (set! new-grps (cons new-grp new-grps)))))
|
||||
;; For exports, too, map symbols to gensymed `variable` argument names
|
||||
(define exports
|
||||
(for/fold ([exports (hasheq)]) ([ex-id (in-list ex-ids)])
|
||||
(define id (ex-int-id ex-id))
|
||||
(hash-set exports id (export (deterministic-gensym id) (ex-ext-id ex-id)))))
|
||||
;; Lift any quoted constants that can't be serialized
|
||||
(define-values (bodys/constants-lifted lifted-constants)
|
||||
(if serializable?
|
||||
(convert-for-serialize bodys #f datum-intern?)
|
||||
(values bodys null)))
|
||||
;; Collect source names for defined identifiers, to the degree that the
|
||||
;; original source name differs from the current name
|
||||
(define src-syms (get-definition-source-syms bodys))
|
||||
;; Schemify the body, collecting information about defined names:
|
||||
(define-values (new-body defn-info mutated)
|
||||
(schemify-body* bodys/constants-lifted prim-knowns primitives imports exports
|
||||
for-jitify? allow-set!-undefined? add-import! #f
|
||||
unsafe-mode? enforce-constant? allow-inline? no-prompt?))
|
||||
(define all-grps (append grps (reverse new-grps)))
|
||||
(values
|
||||
;; Build `lambda` with schemified body:
|
||||
(make-let*
|
||||
lifted-constants
|
||||
`(lambda (instance-variable-reference
|
||||
,@(for*/list ([grp (in-list all-grps)]
|
||||
[im (in-list (import-group-imports grp))])
|
||||
(import-id im))
|
||||
,@(for/list ([ex-id (in-list ex-ids)])
|
||||
(export-id (hash-ref exports (ex-int-id ex-id)))))
|
||||
,@new-body))
|
||||
;; Imports (external names), possibly extended via inlining:
|
||||
(for/list ([grp (in-list all-grps)])
|
||||
(for/list ([im (in-list (import-group-imports grp))])
|
||||
(import-ext-id im)))
|
||||
;; Exports (external names, but paired with source name if it's different):
|
||||
(for/list ([ex-id (in-list ex-ids)])
|
||||
(define sym (ex-ext-id ex-id))
|
||||
(define int-sym (ex-int-id ex-id))
|
||||
(define src-sym (hash-ref src-syms int-sym sym)) ; external name unless 'source-name
|
||||
(if (eq? sym src-sym) sym (cons sym src-sym)))
|
||||
;; Import keys --- revised if we added any import groups
|
||||
(if (null? new-grps)
|
||||
import-keys
|
||||
(for/vector #:length (length all-grps) ([grp (in-list all-grps)])
|
||||
(import-group-key grp)))
|
||||
;; Import ABI: request values for constants, `variable`s otherwise
|
||||
(for/list ([grp (in-list all-grps)])
|
||||
(define im-ready? (import-group-lookup-ready? grp))
|
||||
(for/list ([im (in-list (import-group-imports grp))])
|
||||
(and im-ready?
|
||||
(known-constant? (import-group-lookup grp (import-ext-id im))))))
|
||||
;; Convert internal to external identifiers for known-value info
|
||||
(for/fold ([knowns (hasheq)]) ([ex-id (in-list ex-ids)])
|
||||
(define id (ex-int-id ex-id))
|
||||
(define v (known-inline->export-known (hash-ref defn-info id #f)
|
||||
prim-knowns imports exports
|
||||
serializable?))
|
||||
(cond
|
||||
[(not (set!ed-mutated-state? (hash-ref mutated id #f)))
|
||||
(define ext-id (ex-ext-id ex-id))
|
||||
(hash-set knowns ext-id (or v a-known-constant))]
|
||||
[else knowns])))])))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define (schemify-body l prim-knowns primitives imports exports for-cify? unsafe-mode? no-prompt?)
|
||||
(define-values (new-body defn-info mutated)
|
||||
(schemify-body* l prim-knowns primitives imports exports
|
||||
#f #f (lambda (im ext-id index) #f)
|
||||
for-cify? unsafe-mode? #t #t no-prompt?))
|
||||
new-body)
|
||||
(with-deterministic-gensym
|
||||
(define-values (new-body defn-info mutated)
|
||||
(schemify-body* l prim-knowns primitives imports exports
|
||||
#f #f (lambda (im ext-id index) #f)
|
||||
for-cify? unsafe-mode? #t #t no-prompt?))
|
||||
new-body))
|
||||
|
||||
(define (schemify-body* l prim-knowns primitives imports exports
|
||||
for-jitify? allow-set!-undefined? add-import!
|
||||
|
|
@ -403,7 +406,7 @@
|
|||
(or (hash-ref exports int-id #f)
|
||||
(and extra-variables
|
||||
(or (hash-ref extra-variables int-id #f)
|
||||
(let ([ex (export (gensym int-id) int-id)])
|
||||
(let ([ex (export (deterministic-gensym int-id) int-id)])
|
||||
(hash-set! extra-variables int-id ex)
|
||||
ex))))))
|
||||
|
||||
|
|
@ -414,7 +417,7 @@
|
|||
`(define ,id (variable-ref/no-check ,(export-id ex))))
|
||||
|
||||
(define (make-expr-defn expr)
|
||||
`(define ,(gensym) (begin ,expr (void))))
|
||||
`(define ,(deterministic-gensym "effect") (begin ,expr (void))))
|
||||
|
||||
(define (variable-constance id knowns mutated)
|
||||
(cond
|
||||
|
|
@ -562,12 +565,12 @@
|
|||
(let ([rhs (schemify rhs 'fresh)])
|
||||
(cond
|
||||
[(null? ids)
|
||||
`([,(gensym "lr")
|
||||
`([,(deterministic-gensym "lr")
|
||||
,(make-let-values null rhs '(void) for-cify?)])]
|
||||
[(and (pair? ids) (null? (cdr ids)))
|
||||
`([,(car ids) ,rhs])]
|
||||
[else
|
||||
(define lr (gensym "lr"))
|
||||
(define lr (deterministic-gensym "lr"))
|
||||
`([,lr ,(make-let-values ids rhs `(vector . ,ids) for-cify?)]
|
||||
,@(for/list ([id (in-list ids)]
|
||||
[pos (in-naturals)])
|
||||
|
|
@ -620,7 +623,7 @@
|
|||
(cond
|
||||
[(and (too-early-mutated-state? state)
|
||||
(not for-cify?))
|
||||
(define tmp (gensym 'set))
|
||||
(define tmp (deterministic-gensym "set"))
|
||||
`(let ([,tmp ,new-rhs])
|
||||
(check-not-unsafe-undefined/assign ,id ',(too-early-mutated-state-name state int-id))
|
||||
(set! ,id ,tmp))]
|
||||
|
|
@ -733,7 +736,7 @@
|
|||
;; use `e` directly if it's ok to duplicate
|
||||
(if (simple/can-copy? e prim-knowns knowns imports mutated)
|
||||
e
|
||||
(gensym name)))
|
||||
(deterministic-gensym name)))
|
||||
(define (wrap-tmp tmp e body)
|
||||
(if (eq? tmp e)
|
||||
body
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
"wrap.rkt"
|
||||
"struct-type-info.rkt"
|
||||
"mutated-state.rkt"
|
||||
"find-definition.rkt")
|
||||
"find-definition.rkt"
|
||||
"gensym.rkt")
|
||||
|
||||
(provide struct-convert
|
||||
struct-convert-local)
|
||||
|
|
@ -53,7 +54,7 @@
|
|||
(null? (struct-type-info-rest sti))
|
||||
(not (set!ed-mutated-state? (hash-ref mutated (unwrap struct:s) #f)))))
|
||||
(define can-impersonate? (not (struct-type-info-authentic? sti)))
|
||||
(define raw-s? (if can-impersonate? (gensym (unwrap s?)) s?))
|
||||
(define raw-s? (if can-impersonate? (deterministic-gensym (unwrap s?)) s?))
|
||||
`(begin
|
||||
(define ,struct:s (make-record-type-descriptor ',(struct-type-info-name sti)
|
||||
,(schemify (struct-type-info-parent sti) knowns)
|
||||
|
|
@ -71,7 +72,7 @@
|
|||
`(mutable ,(string->symbol (format "f~a" i))))))
|
||||
,@(if (null? (struct-type-info-rest sti))
|
||||
null
|
||||
`((define ,(gensym)
|
||||
`((define ,(deterministic-gensym "effect")
|
||||
(struct-type-install-properties! ,struct:s
|
||||
',(struct-type-info-name sti)
|
||||
,(struct-type-info-immediate-field-count sti)
|
||||
|
|
@ -104,7 +105,7 @@
|
|||
null)
|
||||
,@(for/list ([acc/mut (in-list acc/muts)]
|
||||
[make-acc/mut (in-list make-acc/muts)])
|
||||
(define raw-acc/mut (if can-impersonate? (gensym (unwrap acc/mut)) acc/mut))
|
||||
(define raw-acc/mut (if can-impersonate? (deterministic-gensym (unwrap acc/mut)) acc/mut))
|
||||
(match make-acc/mut
|
||||
[`(make-struct-field-accessor ,(? (lambda (v) (wrap-eq? v -ref))) ,pos ',field-name)
|
||||
(define raw-def `(define ,raw-acc/mut
|
||||
|
|
@ -141,7 +142,7 @@
|
|||
',(struct-type-info-name sti) ',field-name)))))))
|
||||
raw-def)]
|
||||
[`,_ (error "oops")]))
|
||||
(define ,(gensym)
|
||||
(define ,(deterministic-gensym "effect")
|
||||
(begin
|
||||
(register-struct-constructor! ,make-s)
|
||||
(register-struct-predicate! ,s?)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user