From 482fcd6d59bb777948fe7f981cf15ce3acc64464 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 6 Oct 2019 17:49:32 -0600
Subject: [PATCH] schemify: improve known-value detection

Recognize `(let () <expr>)` and `(begin <expr>)` when inspecting
expressions.
---
 racket/src/schemify/infer-known.rkt | 115 +++++++++++++++-------------
 1 file changed, 62 insertions(+), 53 deletions(-)

diff --git a/racket/src/schemify/infer-known.rkt b/racket/src/schemify/infer-known.rkt
index cafca3ec29..8d45d01b89 100644
--- a/racket/src/schemify/infer-known.rkt
+++ b/racket/src/schemify/infer-known.rkt
@@ -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])])])))
 
 ;; ----------------------------------------