From e509de2c6c022079a435224c58d5841001bde7b7 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 16 Jul 2012 15:32:48 -0600
Subject: [PATCH] racket/gui/init: module caching in the load handler

original commit: 5c02b1c95accdb17a13c5269e17976b6785441bd
---
 collects/mred/private/snipfile.rkt | 53 +++++++++++++++++++++++-------
 1 file changed, 41 insertions(+), 12 deletions(-)

diff --git a/collects/mred/private/snipfile.rkt b/collects/mred/private/snipfile.rkt
index 11903906..fdad5467 100644
--- a/collects/mred/private/snipfile.rkt
+++ b/collects/mred/private/snipfile.rkt
@@ -241,6 +241,29 @@
         ;; don't load the file from source or reload useless bytecode:
         (void)])))
 
+  ;; cache modules that have hash codes:
+  (define module-cache (make-hash))
+
+  (define (check-module-cache in-port check-second? normal-k)
+    (let ([header (bytes-append #"^#~"
+                                (bytes (string-length (version)))
+                                (regexp-quote (string->bytes/utf-8 (version)))
+                                #"T")])
+      (cond
+       [(regexp-match-peek header in-port)
+        (define hash-code (peek-bytes 20 (+ 2 1 (string-length (version)) 1) in-port))
+        (cond
+         [(bytes=? hash-code (make-bytes 20 0))
+          (values (normal-k) #f check-second?)]
+         [else
+          (define key (cons hash-code (current-load-relative-directory)))
+          (define m (hash-ref module-cache key #f))
+          (if m
+              (values m #f #f)
+              (values (normal-k) key check-second?))])]
+       [else
+        (values (normal-k) #f check-second?)])))
+
   (define (text-editor-load-handler filename expected-module)
     (unless (path? filename)
       (raise-type-error 'text-editor-load-handler "path" filename))
@@ -259,21 +282,27 @@
                      (jump-to-submodule
                       in-port
                       expected-module
-                      (lambda (check-second?)
+                      (lambda (orig-check-second?)
                         (with-module-reading-parameterization 
                          (lambda ()
-                           (let* ([first (read-syntax src in-port)]
-                                  [module-ized-exp (check-module-form first expected-module filename)]
-                                  [second (if check-second?
+                           (define-values (first cache-key check-second?)
+                             (check-module-cache in-port
+                                                 orig-check-second?
+                                                 (lambda () (read-syntax src in-port))))
+                           (define module-ized-exp
+                             (check-module-form first expected-module filename))
+                           (define second (if check-second?
                                               (read in-port)
-                                              eof)])
-                             (unless (eof-object? second)
-                               (raise-syntax-error
-                                'text-editor-load-handler
-                                (format "expected only a `module' declaration for `~s', but found an extra expression"
-                                        expected-module)
-                                second))
-                             (eval module-ized-exp))))))))
+                                              eof))
+                           (unless (eof-object? second)
+                             (raise-syntax-error
+                              'text-editor-load-handler
+                              (format "expected only a `module' declaration for `~s', but found an extra expression"
+                                      expected-module)
+                              second))
+                           (when cache-key
+                             (hash-set! module-cache cache-key module-ized-exp))
+                           (eval module-ized-exp)))))))
 		  (let loop ([last-time-values (list (void))])
 		    (let ([exp (read-syntax src in-port)])
 		      (if (eof-object? exp)