generalize cache activities

hyphenate/hyphenate/private/bootstrap.rkt

@@ -3,6 +3,7 @@
          txexpr/base
          sugar/define
          racket/contract
+         racket/file
          (only-in xml xexpr/c)
          (prefix-in core: hyphenate/private/core))
 
@@ -45,18 +46,30 @@
               #:omit-string (string? . -> . any/c)
               #:omit-txexpr (txexpr? . -> . any/c)) . ->* . xexpr/c))
 
+(define (load-from-cache-if-possible module-path cache-path id-sym)
+  (unless (and (file-exists? cache-path)
+               (> (file-or-directory-modify-seconds cache-path)
+                  (file-or-directory-modify-seconds module-path)))
+    (write-to-file (dynamic-require module-path id-sym) cache-path #:exists 'replace))
+  (file->value cache-path))
+
 (define-syntax (build-main stx)
   (syntax-case stx () 
-    [(_ dir)
-     (with-syntax ([PATTERNS-PATH (path->string (build-path (symbol->string(syntax->datum #'dir)) "patterns.rkt"))]
-                   [EXCEPTIONS-PATH (path->string (build-path (symbol->string (syntax->datum #'dir)) "exceptions.rkt"))]
-                   [PATTERNS-ID 'patterns]
-                   [EXCEPTIONS-ID 'exceptions])
-       #'(begin
-           (require PATTERNS-PATH EXCEPTIONS-PATH)
-           (define+provide+safe hyphenate
-             hyphenate/c
-             (make-hyphenate-function PATTERNS-ID EXCEPTIONS-ID))
-           (define+provide+safe unhyphenate
-             unhyphenate/c
-             (make-unhyphenate-function))))]))
+    [(_ DIR)
+     (let ([dir (symbol->string (syntax->datum #'DIR))])
+       (with-syntax ([PATTERNS-PATH (path->string (build-path dir "patterns.rkt"))]
+                     [PATTERN-CACHE-PATH (build-path dir "compiled" "patterns-cache.rktd")]
+                     [EXCEPTIONS-PATH (path->string (build-path dir "exceptions.rkt"))]
+                     [EXCEPTIONS-CACHE-PATH (build-path dir "compiled" "exceptions-cache.rktd")]
+                     [PATTERNS-ID 'patterns]
+                     [EXCEPTIONS-ID 'exceptions])
+         #'(begin
+             (define PATTERNS-ID (load-from-cache-if-possible PATTERNS-PATH PATTERN-CACHE-PATH 'PATTERNS-ID))
+             ;; a file-cached hash is immutable, so convert it
+             (define EXCEPTIONS-ID (make-hash (hash->list (load-from-cache-if-possible EXCEPTIONS-PATH EXCEPTIONS-CACHE-PATH 'EXCEPTIONS-ID))))
+             (define+provide+safe hyphenate
+               hyphenate/c
+               (make-hyphenate-function PATTERNS-ID EXCEPTIONS-ID))
+             (define+provide+safe unhyphenate
+               unhyphenate/c
+               (make-unhyphenate-function)))))]))

hyphenate/hyphenate/private/exception-prep.rkt

@@ -1,18 +1,21 @@
 #lang racket/base
+(require racket/string racket/list hyphenate/private/core)
+(provide (rename-out [emb #%module-begin]) #%app #%datum #%top-interaction)
 
-(module reader racket/base
-  (require racket/port syntax/strip-context)
-  (provide (rename-out [exception-prep-read read]
-                       [exception-prep-read-syntax read-syntax]))
-  
-  (define (exception-prep-read in)
-    (syntax->datum (exception-prep-read-syntax #f in)))
+(define-syntax-rule (emb STRS)
+  (#%module-begin
+   (provide exceptions)
+   (define exceptions (for/hash ([str (in-list (list . STRS))])
+                        (define key+val (exception-word->word+pattern str))
+                        (values (first key+val) (second key+val))))
+   (module+ main exceptions)))
+
+(module+ reader
+  (require racket/port)
+  (provide (rename-out [exception-prep-read-syntax read-syntax]))
   
   (define (exception-prep-read-syntax src in)
-    (with-syntax ([str (port->string in)])
-      (strip-context
-       #'(module exception-prep racket/base
-           (require racket/string racket/list hyphenate/private/core)
-           (provide exceptions)
-           (define exceptions
-             (make-hash (map (λ(xs) (apply cons xs)) (map exception-word->word+pattern (string-split str))))))))))
+    (with-syntax ([STRS (string-split (port->string in))])
+      (syntax->datum
+       #'(module exception-prep hyphenate/private/exception-prep
+           STRS)))))

hyphenate/hyphenate/private/pattern-prep.rkt

@@ -2,30 +2,20 @@
 (require hyphenate/private/core racket/list racket/file)
 (provide (rename-out [pmb #%module-begin]) #%app #%datum #%top-interaction)
 
-(define-syntax-rule (pmb SRC STRS)
+(define-syntax-rule (pmb STRS)
   (#%module-begin     
    (provide patterns)
-   (define strs (list . STRS))
-   (define src SRC)
-   (define-values (dir name _) (split-path src))
-   (define pattern-cache-path (build-path dir "compiled" "pattern-cache.rktd"))
-   (unless (and (file-exists? pattern-cache-path)
-                (> (file-or-directory-modify-seconds pattern-cache-path)
-                   (file-or-directory-modify-seconds src)))
-     (define patterns (for/hasheq ([str (in-list strs)])
-                                  (define strkey+val (string->hashpair str))
-                                  (values (string->symbol (first strkey+val)) (second strkey+val))))
-     (write-to-file patterns pattern-cache-path #:exists 'replace))
-   (define patterns (file->value pattern-cache-path))))
+   (define patterns (for/hasheq ([str (in-list (list . STRS))])
+                      (define key+val (string->hashpair str))
+                      (values (string->symbol (first key+val)) (second key+val))))
+   (module+ main patterns)))
 
 (module+ reader
   (provide read-syntax)
-  
   (define (read-syntax src in)
-    (with-syntax ([SRC (path->string src)]
-                  [STRS (for/list ([line (in-lines in)]
+    (with-syntax ([STRS (for/list ([line (in-lines in)]
                                    #:when (and (positive? (string-length line)) ; omit empty
                                                (not (regexp-match #rx"^;" line)))) ; omit comments
-                                  line)])
+                          line)])
       (syntax->datum #'(module patterns hyphenate/private/pattern-prep
-                         SRC STRS)))))
+                         STRS)))))