add persistent pattern caches

hyphenate/hyphenate/fr/patterns.rkt

@@ -1,50 +1,47 @@
 #lang hyphenate/private/pattern-prep
 
-#|
 
-French hyphenation patterns
+;French hyphenation patterns
-Based on v.3.0 of the OpenOffice.org French hyphenation patterns, released under the LGPL
+;Based on v.3.0 of the OpenOffice.org French hyphenation patterns, released under the LGPL
-Downloaded from http://www.dicollecte.org/download/fr/hyph-fr-v3.0.zip
+;Downloaded from http://www.dicollecte.org/download/fr/hyph-fr-v3.0.zip
-
+;
-Original license:
+;Original license:
-___________________________________________________________________
+;___________________________________________________________________
-
+;
-  French word hyphenation patterns
+;  French word hyphenation patterns
-  Version 3.0
+;  Version 3.0
-
+;
-  Language: French (fr).
+;  Language: French (fr).
-
+;
-  License:  GNU LGPL.
+;  License:  GNU LGPL.
-
+;
-  Origin:   Based on the TeX hyphenation tables *hyph-fr.tex*,
+;  Origin:   Based on the TeX hyphenation tables *hyph-fr.tex*,
-            renamed (June 2008) from *frhyph.tex* (V2.12, 2002/12/11)
+;            renamed (June 2008) from *frhyph.tex* (V2.12, 2002/12/11)
-            for consistency with other files with hyphenation patterns
+;            for consistency with other files with hyphenation patterns
-            in hyph-utf8 package. See http://tug.org/tex-hyphen for more details.
+;            in hyph-utf8 package. See http://tug.org/tex-hyphen for more details.
-            The TeX hyphenation tables are released under the LaTeX Project
+;            The TeX hyphenation tables are released under the LaTeX Project
-            Public License (LPPL)  --  http://www.latex-project.org/lppl.txt
+;            Public License (LPPL)  --  http://www.latex-project.org/lppl.txt
-
+;
-  License:  OpenOffice.org adaptions of this package are licensed under the
+;  License:  OpenOffice.org adaptions of this package are licensed under the
-            GNU Lesser General Public License (LGPL)
+;            GNU Lesser General Public License (LGPL)
-            version 2.1 or higher  --  http://www.gnu.org/licenses/
+;            version 2.1 or higher  --  http://www.gnu.org/licenses/
-
+;
-  Authors:
+;  Authors:
-            3.0     Marc Lodewijck <mlodewijck@gmail.com>
+;            3.0     Marc Lodewijck <mlodewijck@gmail.com>
-            2.0     Paul Pichaureau <paul.pichaureau@alcandre.net>
+;            2.0     Paul Pichaureau <paul.pichaureau@alcandre.net>
-            1.0     Blaise Drayer <blaise@drayer.ch>
+;            1.0     Blaise Drayer <blaise@drayer.ch>
-
+;
-  Log:
+;  Log:
-            3.0     New revised and expanded version:
+;            3.0     New revised and expanded version:
-                      +  Conversion to UTF-8 Unicode encoding
+;                      +  Conversion to UTF-8 Unicode encoding
-                      +  Processing of hyphenated compounds
+;                      +  Processing of hyphenated compounds
-                      +  Correction of altered patterns
+;                      +  Correction of altered patterns
-            2.0     Fix for words with apostrophe
+;            2.0     Fix for words with apostrophe
-            1.0     First conversion
+;            1.0     First conversion
-
+;
-  This dictionary is based on syllable matching patterns and therefore should
+;  This dictionary is based on syllable matching patterns and therefore should
-  be usable under other variations of French.
+;  be usable under other variations of French.
-___________________________________________________________________
+;___________________________________________________________________
-
-|#
 
 2'2
 .a4

hyphenate/hyphenate/private/core.rkt

@@ -106,7 +106,7 @@
                  (for*/list ([start (in-range word-length)] 
                              [end (in-range start word-length)]
                              [substr (in-value (substring word-with-boundaries start (add1 end)))]
-                             [partial-pattern (in-value (hash-ref pattern-cache substr #f))]
+                             [partial-pattern (in-value (hash-ref pattern-cache (string->symbol substr) #f))]
                              #:when partial-pattern)
                             ;; pad out partial-pattern to full length
                             ;; (so we can compare patterns to find max value for each slot)

hyphenate/hyphenate/private/pattern-prep.rkt

@@ -1,17 +1,31 @@
 #lang racket/base
+(require hyphenate/private/core racket/list racket/file)
+(provide (rename-out [pmb #%module-begin]) #%app #%datum #%top-interaction)
 
-(module reader racket/base
+(define-syntax-rule (pmb SRC STRS)
-  (require racket/port syntax/strip-context)
+  (#%module-begin     
-  (provide (rename-out [pattern-prep-read read]
+   (provide patterns)
-                       [pattern-prep-read-syntax read-syntax]))
+   (define strs (list . STRS))
-  
+   (define src SRC)
-  (define (pattern-prep-read in)
+   (define-values (dir name _) (split-path src))
-    (syntax->datum (pattern-prep-read-syntax #f in)))
+   (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))))
+
+(module+ reader
+  (provide read-syntax)
   
-  (define (pattern-prep-read-syntax src in)
+  (define (read-syntax src in)
-    (with-syntax ([str (port->string in)])
+    (with-syntax ([SRC (path->string src)]
-      (strip-context
+                  [STRS (for/list ([line (in-lines in)]
-       #'(module pattern-prep racket/base
+                                   #:when (and (positive? (string-length line)) ; omit empty
-           (require hyphenate/private/core racket/list racket/string)
+                                               (not (regexp-match #rx"^;" line)))) ; omit comments
-           (provide patterns)
+                                  line)])
-           (define patterns (apply hash (append-map string->hashpair (string-split str)))))))))
+      (syntax->datum #'(module patterns hyphenate/private/pattern-prep
+                         SRC STRS)))))