From 1b716d5d32e3769ee82532fbe62979535cf65a49 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 28 Jul 2018 15:04:47 -0600 Subject: [PATCH] schemify: fix inlining issues Make `map` inline again, which involves optimizing away (variable-reference-from-unsafe? (#%variable-reference)) early enough. Fix post-schemify optimization for `procedure? by adding both forms of an import name to the `imports` table. Fix a problem with inlining operations passed to an inlined function (as reflected by the addition of `find-known+import`). --- racket/src/schemify/find-definition.rkt | 6 ++- racket/src/schemify/find-known.rkt | 23 ++++++---- racket/src/schemify/infer-known.rkt | 11 +++-- racket/src/schemify/mutated.rkt | 5 ++- racket/src/schemify/optimize.rkt | 57 ++++++++++++++++++++++++- racket/src/schemify/schemify.rkt | 57 ++++++++++++++----------- 6 files changed, 118 insertions(+), 41 deletions(-) diff --git a/racket/src/schemify/find-definition.rkt b/racket/src/schemify/find-definition.rkt index 7fbc091830..524e915e1a 100644 --- a/racket/src/schemify/find-definition.rkt +++ b/racket/src/schemify/find-definition.rkt @@ -11,14 +11,16 @@ ;; Record top-level functions and structure types, and returns ;; (values knowns struct-type-info-or-#f) -(define (find-definitions v prim-knowns knowns imports mutated optimize?) +(define (find-definitions v prim-knowns knowns imports mutated unsafe-mode? + #:optimize? optimize?) (match v [`(define-values (,id) ,orig-rhs) (define rhs (if optimize? (optimize orig-rhs prim-knowns knowns imports mutated) orig-rhs)) (values - (let ([k (infer-known rhs v #t id knowns prim-knowns imports mutated)]) + (let ([k (infer-known rhs v #t id knowns prim-knowns imports mutated unsafe-mode? + #:optimize-inline? optimize?)]) (if k (hash-set knowns (unwrap id) k) knowns)) diff --git a/racket/src/schemify/find-known.rkt b/racket/src/schemify/find-known.rkt index 01fb5fd480..df0566e730 100644 --- a/racket/src/schemify/find-known.rkt +++ b/racket/src/schemify/find-known.rkt @@ -4,16 +4,23 @@ "known.rkt" "mutated-state.rkt") -(provide find-known) +(provide find-known+import + find-known) -(define (find-known key prim-knowns knowns imports mutated) +(define (find-known+import key prim-knowns knowns imports mutated) (cond [(hash-ref prim-knowns key #f) - => (lambda (k) k)] + => (lambda (k) (values k #f))] [(hash-ref-either knowns imports key) => (lambda (k) - (and (simple-mutated-state? (hash-ref mutated key #f)) - (if (known-copy? k) - (find-known (unwrap (known-copy-id k)) prim-knowns knowns imports mutated) - k)))] - [else #f])) + (cond + [(not (simple-mutated-state? (hash-ref mutated key #f))) + (values #f #f)] + [(known-copy? k) + (find-known+import (unwrap (known-copy-id k)) prim-knowns knowns imports mutated)] + [else (values k (hash-ref imports key #f))]))] + [else (values #f #f)])) + +(define (find-known key prim-knowns knowns imports mutated) + (define-values (k im) (find-known+import key prim-knowns knowns imports mutated)) + k) diff --git a/racket/src/schemify/infer-known.rkt b/racket/src/schemify/infer-known.rkt index ae6a44377c..715d67d19b 100644 --- a/racket/src/schemify/infer-known.rkt +++ b/racket/src/schemify/infer-known.rkt @@ -7,7 +7,8 @@ "pthread-parameter.rkt" "literal.rkt" "inline.rkt" - "mutated-state.rkt") + "mutated-state.rkt" + "optimize.rkt") (provide infer-known lambda?) @@ -15,7 +16,8 @@ ;; For definitions, it's useful to infer `a-known-constant` to reflect ;; that the variable will get a value without referencing anything ;; too early. -(define (infer-known rhs defn rec? id knowns prim-knowns imports mutated) +(define (infer-known rhs defn rec? id knowns prim-knowns imports mutated unsafe-mode? + #:optimize-inline? [optimize-inline? #f]) (cond [(lambda? rhs) (define-values (lam inlinable?) (extract-lambda rhs)) @@ -23,7 +25,10 @@ (if (and inlinable? (or (can-inline? lam) (wrap-property defn 'compiler-hint:cross-module-inline))) - (known-procedure/can-inline arity-mask lam) + (let ([lam (if optimize-inline? + (optimize* lam prim-knowns knowns imports mutated unsafe-mode?) + lam)]) + (known-procedure/can-inline arity-mask lam)) (known-procedure arity-mask))] [(and (literal? rhs) (not (hash-ref mutated (unwrap id) #f))) diff --git a/racket/src/schemify/mutated.rkt b/racket/src/schemify/mutated.rkt index 22b87998b4..6895161a4a 100644 --- a/racket/src/schemify/mutated.rkt +++ b/racket/src/schemify/mutated.rkt @@ -19,7 +19,7 @@ ;; definition of an identifier, because that will abort the enclosing ;; linklet. -(define (mutated-in-body l exports prim-knowns knowns imports) +(define (mutated-in-body l exports prim-knowns knowns imports unsafe-mode?) ;; Find all `set!`ed variables, and also record all bindings ;; that might be used too early (define mutated (make-hasheq)) @@ -44,7 +44,8 @@ ;; that information is correct, because it dynamically precedes ;; the `set!` (define-values (knowns info) - (find-definitions form prim-knowns prev-knowns imports mutated #f)) + (find-definitions form prim-knowns prev-knowns imports mutated unsafe-mode? + #:optimize? #f)) (match form [`(define-values (,ids ...) ,rhs) (cond diff --git a/racket/src/schemify/optimize.rkt b/racket/src/schemify/optimize.rkt index 34475a81e1..e18a46eb42 100644 --- a/racket/src/schemify/optimize.rkt +++ b/racket/src/schemify/optimize.rkt @@ -7,7 +7,8 @@ "mutated-state.rkt" "literal.rkt") -(provide optimize) +(provide optimize + optimize*) ;; Perform shallow optimizations. The `schemify` pass calls `optimize` ;; on each schemified form, which means that subexpressions of the @@ -58,3 +59,57 @@ ;; to a different name [else v])] [else v])])) + +;; ---------------------------------------- + +;; Recursive optimization --- useful when not fused with schemify, +;; such as for an initial optimization pass on a definition of a +;; function that can be inlined (where converting away +;; `variable-reference-from-unsafe?` is particularly important) + +(define (optimize* v prim-knowns knowns imports mutated unsafe-mode?) + (define (optimize* v) + (define new-v + (reannotate + v + (match v + [`(lambda ,formal ,body ...) + `(lambda ,formal ,@(optimize*-body body))] + [`(case-lambda [,formalss ,bodys ...] ...) + `(case-lambda ,@(for/list ([formals (in-list formalss)] + [body (in-list bodys)]) + `[,formals ,@(optimize*-body body)]))] + [`(let-values . ,_) (optimize*-let v)] + [`(letrec-values . ,_) (optimize*-let v)] + [`(if ,tst ,thn ,els) + `(if ,(optimize* tst) ,(optimize* thn) ,(optimize* els))] + [`(with-continuation-mark ,key ,val ,body) + `(with-continuation-mark ,(optimize* key) ,(optimize* val) ,(optimize* body))] + [`(begin ,body ...) + `(begin ,@(optimize*-body body))] + [`(begin0 ,e ,body ...) + `(begin0 ,(optimize* e) ,@(optimize*-body body))] + [`(set! ,id ,rhs) + `(set! ,id ,(optimize* rhs))] + [`(variable-reference-from-unsafe? (#%variable-reference)) + unsafe-mode?] + [`(#%variable-reference) v] + [`(#%variable-reference ,id) v] + [`(,rator ,exps ...) + `(,(optimize* rator) ,@(optimize*-body exps))] + [`,_ v]))) + (optimize new-v prim-knowns knowns imports mutated)) + + (define (optimize*-body body) + (for/list ([v (in-wrap-list body)]) + (optimize* v))) + + (define (optimize*-let v) + (match v + [`(,let-id ([,idss ,rhss] ...) ,body ...) + `(,let-id ,(for/list ([ids (in-list idss)] + [rhs (in-list rhss)]) + `[,ids ,(optimize* rhs)]) + ,@(optimize*-body body))])) + + (optimize* v)) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 0b531c1529..d8c03bd594 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -91,8 +91,10 @@ (for/list ([im-id (in-list im-ids)]) (define id (im-int-id im-id)) (define ext-id (im-ext-id im-id)) - (define im (import grp (gensym (symbol->string id)) id ext-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 @@ -172,12 +174,13 @@ ;; Various conversion steps need information about mutated variables, ;; where "mutated" here includes visible implicit mutation, such as ;; a variable that might be used before it is defined: - (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports)) + (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports unsafe-mode?)) ;; Make another pass to gather known-binding information: (define knowns (for/fold ([knowns (hasheq)]) ([form (in-list l)]) (define-values (new-knowns info) - (find-definitions form prim-knowns knowns imports mutated #t)) + (find-definitions form prim-knowns knowns imports mutated unsafe-mode? + #:optimize? #t)) new-knowns)) ;; While schemifying, add calls to install exported values in to the ;; corresponding exported `variable` records, but delay those @@ -260,17 +263,17 @@ (define (schemify v prim-knowns knowns mutated imports exports allow-set!-undefined? add-import! for-cify? for-jitify? unsafe-mode?) (let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [v v]) - (let schemify ([v v]) + (define (schemify v) (define s-v (reannotate v (match v [`(lambda ,formals ,body ...) - `(lambda ,formals ,@(map schemify body))] + `(lambda ,formals ,@(schemify-body body))] [`(case-lambda [,formalss ,bodys ...] ...) `(case-lambda ,@(for/list ([formals (in-list formalss)] [body (in-list bodys)]) - `[,formals ,@(map schemify body)]))] + `[,formals ,@(schemify-body body)]))] [`(define-values (,struct:s ,make-s ,s? ,acc/muts ...) (let-values (((,struct: ,make ,?1 ,-ref ,-set!) ,mk)) (values ,struct:2 @@ -317,7 +320,7 @@ ,(struct-type-info-immediate-field-count sti) 0 ,(schemify (struct-type-info-parent sti)) - ,@(map schemify (struct-type-info-rest sti)))))) + ,@(schemify-body (struct-type-info-rest sti)))))) (define ,make-s ,(let ([ctr `(record-constructor (make-record-constructor-descriptor ,struct:s #f #f))]) (if (struct-type-info-pure-constructor? sti) @@ -384,7 +387,7 @@ (define new-knowns (for/fold ([knowns knowns]) ([id (in-list ids)] [rhs (in-list rhss)]) - (define k (infer-known rhs #f #f id knowns prim-knowns imports mutated)) + (define k (infer-known rhs #f #f id knowns prim-knowns imports mutated unsafe-mode?)) (if k (hash-set knowns (unwrap id) k) knowns))) @@ -403,12 +406,12 @@ (schemify/knowns new-knowns inline-fuel body)) prim-knowns knowns imports mutated)] [`(let-values ([() (begin ,rhss ... (values))]) ,bodys ...) - `(begin ,@(map schemify rhss) ,@(map schemify bodys))] + `(begin ,@(schemify-body rhss) ,@(schemify-body bodys))] [`(let-values ([,idss ,rhss] ...) ,bodys ...) (left-to-right/let-values idss (for/list ([rhs (in-list rhss)]) (schemify rhs)) - (map schemify bodys) + (schemify-body bodys) mutated for-cify?)] [`(letrec-values () ,bodys ...) @@ -422,7 +425,7 @@ (define new-knowns (for/fold ([knowns knowns]) ([id (in-list ids)] [rhs (in-list rhss)]) - (define k (infer-known rhs #f #t id knowns prim-knowns imports mutated)) + (define k (infer-known rhs #f #t id knowns prim-knowns imports mutated unsafe-mode?)) (if k (hash-set knowns (unwrap id) k) knowns))) @@ -461,7 +464,7 @@ ,@(for/list ([id (in-list ids)] [pos (in-naturals)]) `[,id (unsafe-vector*-ref ,lr ,pos)]))])))) - ,@(map schemify bodys))])] + ,@(schemify-body bodys))])] [`(if ,tst ,thn ,els) `(if ,(schemify tst) ,(schemify thn) ,(schemify els))] [`(with-continuation-mark ,key ,val ,body) @@ -469,9 +472,9 @@ [`(begin ,exp) (schemify exp)] [`(begin ,exps ...) - `(begin . ,(map schemify exps))] + `(begin . ,(schemify-body exps))] [`(begin0 ,exps ...) - `(begin0 . ,(map schemify exps))] + `(begin0 . ,(schemify-body exps))] [`(set! ,id ,rhs) (define int-id (unwrap id)) (define ex (hash-ref exports int-id #f)) @@ -570,10 +573,10 @@ (define (inline-rator) (define u-rator (unwrap rator)) (and (symbol? u-rator) - (let ([k (find-known u-rator prim-knowns knowns imports mutated)]) + (let-values ([(k im) (find-known+import u-rator prim-knowns knowns imports mutated)]) (and (known-procedure/can-inline? k) (left-left-lambda-convert - (inline-clone k (hash-ref imports u-rator #f) add-import! mutated imports) + (inline-clone k im add-import! mutated imports) (sub1 inline-fuel)))))) (define (maybe-tmp e name) ;; use `e` directly if it's ok to duplicate @@ -585,10 +588,9 @@ body `(let ([,tmp ,e]) ,body))) - (define (inline-field-access k s-rator u-rator args) + (define (inline-field-access k s-rator im args) ;; For imported accessors or for JIT mode, inline the ;; selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`. - (define im (hash-ref imports u-rator #f)) (define type-id (and (or im for-jitify?) (pair? args) (null? (cdr args)) @@ -602,8 +604,7 @@ (wrap-tmp tmp (car args) sel)] [else #f])) - (define (inline-field-mutate k s-rator u-rator args) - (define im (hash-ref imports u-rator #f)) + (define (inline-field-mutate k s-rator im args) (define type-id (and (or im for-jitify?) (pair? args) (pair? (cdr args)) @@ -624,17 +625,17 @@ (and (positive? inline-fuel) (inline-rator)) (let ([s-rator (schemify rator)] - [args (map schemify exps)] + [args (schemify-body exps)] [u-rator (unwrap rator)]) - (define k (find-known u-rator prim-knowns knowns imports mutated)) + (define-values (k im) (find-known+import u-rator prim-knowns knowns imports mutated)) (cond [(and (not for-cify?) (known-field-accessor? k) - (inline-field-access k s-rator u-rator args)) + (inline-field-access k s-rator im args)) => (lambda (e) e)] [(and (not for-cify?) (known-field-mutator? k) - (inline-field-mutate k s-rator u-rator args)) + (inline-field-mutate k s-rator im args)) => (lambda (e) e)] [else (define plain-app? (or (known-procedure? k) @@ -676,4 +677,10 @@ (schemify (known-copy-id k))] [else v]))] [else v]))]))) - (optimize s-v prim-knowns knowns imports mutated)))) + (optimize s-v prim-knowns knowns imports mutated)) + + (define (schemify-body l) + (for/list ([e (in-list l)]) + (schemify e))) + + (schemify v)))