From 898517107fb3e01b03592c7b87347f72f493de52 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 5 Dec 2019 14:40:30 -0700 Subject: [PATCH] schemify: purge all `gensym`s 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`. --- racket/src/schemify/gensym.rkt | 19 ++ racket/src/schemify/import.rkt | 6 +- racket/src/schemify/inline.rkt | 7 +- racket/src/schemify/interpret.rkt | 10 +- racket/src/schemify/jitify.rkt | 26 +-- racket/src/schemify/left-to-right.rkt | 5 +- racket/src/schemify/lift.rkt | 12 +- racket/src/schemify/schemify.rkt | 233 +++++++++++++------------ racket/src/schemify/struct-convert.rkt | 11 +- 9 files changed, 182 insertions(+), 147 deletions(-) create mode 100644 racket/src/schemify/gensym.rkt diff --git a/racket/src/schemify/gensym.rkt b/racket/src/schemify/gensym.rkt new file mode 100644 index 0000000000..5899d7269c --- /dev/null +++ b/racket/src/schemify/gensym.rkt @@ -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))))) diff --git a/racket/src/schemify/import.rkt b/racket/src/schemify/import.rkt index fce0d0f9db..b77d596e57 100644 --- a/racket/src/schemify/import.rkt +++ b/racket/src/schemify/import.rkt @@ -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) diff --git a/racket/src/schemify/inline.rkt b/racket/src/schemify/inline.rkt index 838af3f251..3c4f221b17 100644 --- a/racket/src/schemify/inline.rkt +++ b/racket/src/schemify/inline.rkt @@ -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) '()] diff --git a/racket/src/schemify/interpret.rkt b/racket/src/schemify/interpret.rkt index 4656daf213..c190e13bc1 100644 --- a/racket/src/schemify/interpret.rkt +++ b/racket/src/schemify/interpret.rkt @@ -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))) ;; ---------------------------------------- diff --git a/racket/src/schemify/jitify.rkt b/racket/src/schemify/jitify.rkt index 068b4ce92d..92751594ea 100644 --- a/racket/src/schemify/jitify.rkt +++ b/racket/src/schemify/jitify.rkt @@ -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))) + symbolstring 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 diff --git a/racket/src/schemify/struct-convert.rkt b/racket/src/schemify/struct-convert.rkt index c27c196d95..bcb5477ac9 100644 --- a/racket/src/schemify/struct-convert.rkt +++ b/racket/src/schemify/struct-convert.rkt @@ -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?)