use cached namespaces for loading

pull/84/head
Matthew Butterick 9 years ago
parent 0b092f87cb
commit a6e2f82d21

@ -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))))

@ -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))))
Loading…
Cancel
Save