diff --git a/hyphenate/hyphenate/private/bootstrap.rkt b/hyphenate/hyphenate/private/bootstrap.rkt index 846e2b99..a5abdd65 100644 --- a/hyphenate/hyphenate/private/bootstrap.rkt +++ b/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))))])) \ No newline at end of file + [(_ 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)))))])) \ No newline at end of file diff --git a/hyphenate/hyphenate/private/exception-prep.rkt b/hyphenate/hyphenate/private/exception-prep.rkt index 4812b6f7..7c3e8fa7 100644 --- a/hyphenate/hyphenate/private/exception-prep.rkt +++ b/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)))))))))) \ No newline at end of file + (with-syntax ([STRS (string-split (port->string in))]) + (syntax->datum + #'(module exception-prep hyphenate/private/exception-prep + STRS))))) \ No newline at end of file diff --git a/hyphenate/hyphenate/private/pattern-prep.rkt b/hyphenate/hyphenate/private/pattern-prep.rkt index 4efe7f84..e79c200d 100644 --- a/hyphenate/hyphenate/private/pattern-prep.rkt +++ b/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))))) \ No newline at end of file + STRS))))) \ No newline at end of file