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

schemify: improve known-value detection

Browse Source 
Recognize `(let () <expr>)` and `(begin <expr>)` when inspecting
expressions.
This commit is contained in:
Matthew Flatt 2019-10-06 17:49:32 -06:00
parent ca285c384d
commit 482fcd6d59
1 changed files with 62 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
racket/src/schemify/infer-known.rkt
View File

@ -22,59 +22,68 @@
#:primitives [primitives #hasheq()] ; for `optimize-inline?` mode
#:optimize-inline? [optimize-inline? #f]
#:post-schemify? [post-schemify? #f])
(cond
[(lambda? rhs)
(define-values (lam inlinable?) (extract-lambda rhs))
(define arity-mask (lambda-arity-mask lam))
(if (and inlinable?
(not post-schemify?)
(or (can-inline? lam)
(wrap-property defn 'compiler-hint:cross-module-inline)))
(let ([lam (if optimize-inline?
(optimize* lam prim-knowns primitives 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)))
(known-literal (unwrap-literal rhs))]
[(and (symbol? (unwrap rhs))
(not (hash-ref mutated (unwrap id) #f)))
(define u-rhs (unwrap rhs))
(cond
[(hash-ref prim-knowns u-rhs #f)
=> (lambda (known) (known-copy u-rhs))]
[(not (simple-mutated-state? (hash-ref mutated u-rhs #f)))
;; referenced variable is mutated, but not necessarily the target
(and defn a-known-constant)]
[(hash-ref-either knowns imports u-rhs)
=> (lambda (known)
(cond
[(known-procedure/can-inline/need-imports? known)
;; can't just return `known`, since that loses the connection to the import;
;; the `inline-clone` function specially handles an identifier as the
;; expression to inline
(known-procedure/can-inline (known-procedure-arity-mask known)
rhs)]
[(or (known-procedure/can-inline? known)
(known-literal? known))
known]
[(or (not defn)
;; can't just return `known`; like `known-procedure/can-inline/need-imports`,
;; we'd lose track of the need to potentially propagate imports
(known-copy? known))
(known-copy rhs)]
[else known]))]
[defn a-known-constant]
[else (known-copy rhs)])]
[(parameter-result? rhs prim-knowns knowns mutated)
(known-procedure 3)]
[(constructed-procedure-arity-mask rhs)
=> (lambda (m) (known-procedure m))]
[(and defn
(simple? rhs prim-knowns knowns imports mutated simples))
a-known-constant]
[else #f]))
(let loop ([rhs rhs])
(cond
[(lambda? rhs)
(define-values (lam inlinable?) (extract-lambda rhs))
(define arity-mask (lambda-arity-mask lam))
(if (and inlinable?
(not post-schemify?)
(or (can-inline? lam)
(wrap-property defn 'compiler-hint:cross-module-inline)))
(let ([lam (if optimize-inline?
(optimize* lam prim-knowns primitives 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)))
(known-literal (unwrap-literal rhs))]
[(and (symbol? (unwrap rhs))
(not (hash-ref mutated (unwrap id) #f)))
(define u-rhs (unwrap rhs))
(cond
[(hash-ref prim-knowns u-rhs #f)
=> (lambda (known) (known-copy u-rhs))]
[(not (simple-mutated-state? (hash-ref mutated u-rhs #f)))
;; referenced variable is mutated, but not necessarily the target
(and defn a-known-constant)]
[(hash-ref-either knowns imports u-rhs)
=> (lambda (known)
(cond
[(known-procedure/can-inline/need-imports? known)
;; can't just return `known`, since that loses the connection to the import;
;; the `inline-clone` function specially handles an identifier as the
;; expression to inline
(known-procedure/can-inline (known-procedure-arity-mask known)
rhs)]
[(or (known-procedure/can-inline? known)
(known-literal? known))
known]
[(or (not defn)
;; can't just return `known`; like `known-procedure/can-inline/need-imports`,
;; we'd lose track of the need to potentially propagate imports
(known-copy? known))
(known-copy rhs)]
[else known]))]
[defn a-known-constant]
[else (known-copy rhs)])]
[(parameter-result? rhs prim-knowns knowns mutated)
(known-procedure 3)]
[(constructed-procedure-arity-mask rhs)
=> (lambda (m) (known-procedure m))]
[else
(match rhs
[`(let-values () ,e)
(loop e)]
[`(begin ,e)
(loop e)]
[`,_
(cond
[(and defn
(simple? rhs prim-knowns knowns imports mutated simples))
a-known-constant]
[else #f])])])))
;; ----------------------------------------