From 851fbaaa70958418be64b8367ab4e4870775f572 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 7 Aug 2017 16:00:00 -0700 Subject: [PATCH] emit less code from macro --- hyphenate/hyphenate/private/bootstrap.rkt | 98 +++++++++++++---------- 1 file changed, 54 insertions(+), 44 deletions(-) diff --git a/hyphenate/hyphenate/private/bootstrap.rkt b/hyphenate/hyphenate/private/bootstrap.rkt index 8614510b..610ca6d6 100644 --- a/hyphenate/hyphenate/private/bootstrap.rkt +++ b/hyphenate/hyphenate/private/bootstrap.rkt @@ -1,50 +1,60 @@ #lang racket/base -(require (for-syntax racket/base syntax/strip-context)) +(require (for-syntax racket/base syntax/strip-context) + txexpr/base + sugar/define + racket/contract + (only-in xml xexpr/c) + (prefix-in core: hyphenate/private/core)) + (provide build-main) +;; An exception-word is a string of word characters or hyphens. +(define (exception-word? x) + (and (string? x) (regexp-match #px"^(\\p{L}|-)+$" x) #t)) +(define (exception-words? xs) + (and (list? xs) (andmap exception-word? xs))) + +(define hyphenate/c + ((xexpr?) ((or/c char? string?) + #:exceptions exception-words? + #:min-length (or/c integer? #f) + #:omit-word (string? . -> . any/c) + #:omit-string (string? . -> . any/c) + #:omit-txexpr (txexpr? . -> . any/c) + #:min-left-length (or/c (and/c integer? positive?) #f) + #:min-right-length (or/c (and/c integer? positive?) #f)) . ->* . xexpr/c)) + +(define (make-hyphenate-function patterns exceptions) + (make-keyword-procedure + ;; put caches here so they can persist across successive invocations of the function. + ;; but remain distinct between instantiations of this module (say, us vs fr) + ;; pass them as arguments to the core:hyphenate func + (let ([word-cache exceptions] ; preload exceptions + [pattern-cache patterns]) + (λ (kws kw-args . rest) + (keyword-apply core:hyphenate kws kw-args word-cache pattern-cache rest))))) + +(define unhyphenate + (make-keyword-procedure + (λ (kws kw-args . rest) + (keyword-apply core:unhyphenate kws kw-args rest)))) + +(define unhyphenate/c + ((xexpr/c) ((or/c char? string?) + #:omit-word (string? . -> . any/c) + #:omit-string (string? . -> . any/c) + #:omit-txexpr (txexpr? . -> . any/c)) . ->* . xexpr/c)) + (define-syntax (build-main stx) (syntax-case stx () [(_ dir) - (with-syntax ([patterns-path (format "~a/patterns.rkt" (syntax->datum #'dir))] - [exceptions-path (format "~a/exceptions.rkt" (syntax->datum #'dir))]) - (replace-context - stx - #'(begin - (require txexpr/base - sugar/define - (only-in xml xexpr/c) - (prefix-in core: hyphenate/private/core) - patterns-path exceptions-path) - - (module+ safe - ;; An exception-word is a string of word characters or hyphens. - (define (exception-word? x) - (and (string? x) (regexp-match #px"^(\\p{L}|-)+$" x) #t)) - (define (exception-words? xs) - (and (list? xs) (andmap exception-word? xs)))) - - (define+provide+safe hyphenate - ((xexpr?) ((or/c char? string?) - #:exceptions exception-words? - #:min-length (or/c integer? #f) - #:omit-word (string? . -> . any/c) - #:omit-string (string? . -> . any/c) - #:omit-txexpr (txexpr? . -> . any/c) - #:min-left-length (or/c (and/c integer? positive?) #f) - #:min-right-length (or/c (and/c integer? positive?) #f)) . ->* . xexpr/c) - (make-keyword-procedure - ;; put caches here so they can persist across successive invocations of the function. - ;; but remain distinct between instantiations of this module (say, us vs fr) - ;; pass them as arguments to the core:hyphenate func - (let ([word-cache exceptions] ; preload exceptions - [pattern-cache patterns]) - (λ (kws kw-args . rest) - (keyword-apply core:hyphenate kws kw-args (list* word-cache pattern-cache rest)))))) - - (define+provide+safe unhyphenate - ((xexpr/c) ((or/c char? string?) - #:omit-word (string? . -> . any/c) - #:omit-string (string? . -> . any/c) - #:omit-txexpr (txexpr? . -> . any/c)) . ->* . xexpr/c) - (make-keyword-procedure (λ (kws kw-args . rest) - (keyword-apply core:unhyphenate kws kw-args rest)))))))])) \ No newline at end of file + (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)) + (provide+safe [unhyphenate unhyphenate/c])))])) \ No newline at end of file