From f7382b17c75ee4a6986ebebee34788811e26dde0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 23 Jul 2012 21:28:29 -0500
Subject: [PATCH] ad hoc optimization of `hash-ref'

Convert
 (hash-ref <hash> <key-expr> (lambda () <literal>))
to
 (hash-ref <hash> <key-expr> <literal>)
which is useful for making the `case' expansion fit
Typed Racket.
---
 collects/tests/racket/optimize.rktl | 15 +++++++++++++++
 src/racket/src/optimize.c           | 11 +++++++++++
 2 files changed, 26 insertions(+)

diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl
index 4bd46570cc..50e486183c 100644
--- a/collects/tests/racket/optimize.rktl
+++ b/collects/tests/racket/optimize.rktl
@@ -1616,6 +1616,21 @@
          (unsafe-s16vector-set! x x x)
          (unsafe-u16vector-set! x x x))))
 
+(test-comp '(lambda (x)
+              (hash-ref '#hash((x . y)) x (lambda () 10)))
+           '(lambda (x)
+              (hash-ref '#hash((x . y)) x 10)))
+(test-comp '(lambda (x)
+              (hash-ref x x (lambda () 10)))
+           '(lambda (x)
+              (hash-ref x x 10))
+           #f)
+(test-comp '(lambda (x)
+              (hash-ref '#hash((x . y)) x (lambda () add1)))
+           '(lambda (x)
+              (hash-ref '#hash((x . y)) x add1))
+           #f)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check bytecode verification of lifted functions
 
diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c
index 4bab5e73e3..8238543bd3 100644
--- a/src/racket/src/optimize.c
+++ b/src/racket/src/optimize.c
@@ -1921,6 +1921,17 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
   le = direct_apply((Scheme_Object *)app, app->args[0], app->args[app->num_args]);
   if (le) return finish_optimize_app(le, info, context, rator_flags);
 
+  /* Convert (hash-ref '#hash... key (lambda () literal))
+     to (hash-ref '#hash... key literal) */
+  if ((app->num_args == 3)
+      && SAME_OBJ(scheme_hash_ref_proc, app->args[0])
+      && SCHEME_HASHTRP(app->args[1])
+      && SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(app->args[3]))
+      && (SCHEME_TYPE(((Scheme_Closure_Data *)app->args[3])->code) > _scheme_compiled_values_types_)
+      && !SCHEME_PROCP(((Scheme_Closure_Data *)app->args[3])->code)) {
+    app->args[3] = ((Scheme_Closure_Data *)app->args[3])->code;
+  }
+
   return finish_optimize_application(app, info, context, rator_flags);
 }