From a6e2f82d21a0506a5c8e0c4270eb9a0c80f0bc8c Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 21 Aug 2015 18:20:19 -0700
Subject: [PATCH] use cached namespaces for loading

---
 cache.rkt  | 45 +++++++++++++++++++++++++++++++++++++++++++++
 render.rkt | 25 ++++++++-----------------
 2 files changed, 53 insertions(+), 17 deletions(-)

diff --git a/cache.rkt b/cache.rkt
index 7f2b997..3f3c248 100644
--- a/cache.rkt
+++ b/cache.rkt
@@ -40,11 +40,56 @@
 
 (require sugar/debug)
 
+;; set up namespace for module caching
+(module caching-module racket/base
+  (define-namespace-anchor caching-module-nsa)
+  (provide caching-module-nsa))
+(require 'caching-module)
+(define caching-module-ns (namespace-anchor->namespace caching-module-nsa))
+
+(define (load-in-namespace to-ns . module-names)
+  (for-each (λ(mn) (eval `(require ,mn) to-ns)) module-names))
+
+(define (copy-from-namespace from-ns to-ns . module-names)
+  (for-each (λ(mn) (namespace-attach-module from-ns mn to-ns)) module-names))
+
+(define cached-module-names '(xml
+                              racket/bool
+                              racket/class
+                              racket/contract 
+                              racket/draw
+                              racket/file
+                              racket/format
+                              racket/function
+                              racket/port 
+                              racket/list
+                              racket/match
+                              racket/string
+                              racket/syntax
+                              ;pollen/cache ;; causes loading cycle
+                              pollen/debug
+                              pollen/decode
+                              pollen/file
+                              pollen/include-template
+                              ;pollen/main ;; causes loading cycle
+                              pollen/reader-base
+                              ;pollen/pagetree ;; causes loading cycle
+                              pollen/rerequire
+                              pollen/tag
+                              ;pollen/template ;; causes loading cycle
+                              pollen/world
+                              pollen/project
+                              sugar
+                              txexpr))
+
+(apply load-in-namespace caching-module-ns cached-module-names)
+
 (define (path->hash path subkey)
   (dynamic-rerequire path)
   ;; new namespace forces dynamic-require to re-instantiate 'path'
   ;; otherwise it gets cached in current namespace.
   (parameterize ([current-namespace (make-base-namespace)])
+    (apply copy-from-namespace caching-module-ns (current-namespace) cached-module-names)
     (hash subkey (dynamic-require (if (eq? subkey (world:current-meta-export))
                                       `(submod ,path ,subkey) ; use metas submodule for speed
                                       path) subkey))))
diff --git a/render.rkt b/render.rkt
index c9be117..a84868e 100644
--- a/render.rkt
+++ b/render.rkt
@@ -228,20 +228,15 @@
   (define-namespace-anchor caching-module-nsa)
   (provide caching-module-nsa))
 (require 'caching-module)
+(define caching-module-ns (namespace-anchor->namespace caching-module-nsa))
 
-;; (car (current-eval-namespace-cache)) = namespace containing cached modules
-;; (cdr (current-eval-namespace-cache)) = list of cached modules
-(define current-eval-namespace-cache (make-parameter (cons (namespace-anchor->namespace caching-module-nsa) '())))
+(define (load-in-namespace to-ns . module-names)
+  (for-each (λ(mn) (eval `(require ,mn) to-ns)) module-names))
 
-(define/contract+provide (add-module-to-current-eval-cache module-name)
-  (symbol? . -> . void?)
-  (define cache-ns (car (current-eval-namespace-cache)))
-  (define cached-modules (cdr (current-eval-namespace-cache)))
-  (when (not (member module-name cached-modules))
-    (eval `(require ,module-name) cache-ns)
-    (current-eval-namespace-cache (cons cache-ns (cons module-name cached-modules)))))
+(define (copy-from-namespace from-ns to-ns . module-names)
+  (for-each (λ(mn) (namespace-attach-module from-ns mn to-ns)) module-names))
 
-(define initial-modules-to-cache '(xml
+(define cached-module-names '(xml
                                    racket/bool
                                    racket/class
                                    racket/contract 
@@ -270,16 +265,12 @@
                                    sugar
                                    txexpr))
 
-
-(for-each add-module-to-current-eval-cache initial-modules-to-cache)
-
+(apply load-in-namespace caching-module-ns cached-module-names)
 
 (define/contract (render-through-eval expr-to-eval)
   (list? . -> . (or/c string? bytes?))
-  (define cache-ns (car (current-eval-namespace-cache)))
-  (define cached-modules (cdr (current-eval-namespace-cache)))
   (parameterize ([current-namespace (make-base-namespace)]
                  [current-output-port (current-error-port)]
                  [current-pagetree (make-project-pagetree (world:current-project-root))])
-    (for-each (λ(mod-name) (namespace-attach-module cache-ns mod-name)) cached-modules)   
+    (apply copy-from-namespace caching-module-ns (current-namespace) cached-module-names)   
     (eval expr-to-eval (current-namespace))))
\ No newline at end of file