Commits

Anonymous committed 8af9827

Add memoization for link-label rule

  • Participants
  • Parent commits 5ef5e73

Comments (0)

Files changed (2)

File lowdown-impl.scm

 (define non-space-char
   (none-of* space-char new-line item))
 
-(define-syntax mutually-recursive-parser
-  (syntax-rules ()
-    ((_ body ...)
-     (lambda ()
-       (lambda (input)
-         (let-once
-          ((parser (begin body ...)))
-          (parser input)))))))
-
 (define link-title
   (sequence* ((delimiter (in #\' #\"))
               (title (-> (preceded-by
               (_ (is delimiter)))
     (result title)))
 
-(define link-label
-  (mutually-recursive-parser
+(define link-label*
+  (recursive-parser
    (enclosed-by (is #\[)
                 (sequence* ((text (-> (none-of* (in #\[ #\]) inline)
                                       (zero-or-more)))
-                            (label (maybe (link-label))))
+                            (label (maybe (link-label*))))
                   (result (if label
                               (append text (list "[") label (list "]"))
                               text)))
                 (is #\]))))
 
+(define link-label
+  (memoize (link-label*)))
+
 (define explicit-link-source-contents
-  (mutually-recursive-parser
+  (recursive-parser
    (-> (in #\( #\) #\>)
        (none-of* non-space-char)
        (one-or-more)
 
 (define explicit-link
   (sequence*
-      ((label (link-label))
+      ((label link-label)
        (_ space-new-line)
        (href (preceded-by (is #\()
                           explicit-link-source))
               (title   ,title)))))
 
 (define shortcut-reference-link
-  (sequence* ((label (-> (link-label)
+  (sequence* ((label (-> link-label
                          (followed-by (none-of (is #\:))))))
     (result `(reference-link
               (input "[" ,@label "]")
               (label . ,label)))))
 
 (define reference-link
-  (sequence* ((label (link-label))
+  (sequence* ((label link-label)
               (space space-new-line)
-              (ref   (link-label)))
+              (ref   link-label))
     (result `(reference-link
               (input "[" ,@label "]"
                      ,space
                    (result (append x (list y)))))))
 
 (define emph
-  (mutually-recursive-parser
+  (recursive-parser
    (->> (any-of (surrounded-by #\* (is #\*))
                 (surrounded-by #\_ (is #\_)))
         (node 'emphasis))))
 
 (define strong
-  (mutually-recursive-parser
+  (recursive-parser
    (->> (any-of (surrounded-by #\* (char-seq "**"))
                 (surrounded-by #\_ (char-seq "__")))
         (node 'strong))))
     (result (html-element el attrs contents))))
 
 (define html-inline-element
-  (mutually-recursive-parser
+  (recursive-parser
    (html-element-parser
     (list (char-seq "a") (char-seq "span"))
     (lambda (_ close)
 (define reference
   (sequence* ((label (preceded-by non-indent-space
                                   (none-of (char-seq "[]"))
-                                  (link-label)))
+                                  link-label))
               (_ (preceded-by (is #\:) space-new-line))
               (href (as-string (one-or-more non-space-char)))
               (title (maybe reference-title))
        (node 'item)))
 
 (define list-item-tight
-  (mutually-recursive-parser
+  (recursive-parser
    (sequence* ((_ list-item-start)
                (first-block (as-string list-block))
                (more-blocks (->> list-continuation-block
     (result items)))
 
 (define list-item-loose
-  (mutually-recursive-parser
+  (recursive-parser
    (sequence* ((_ list-item-start)
                (first-block (as-string list-block))
                (more-blocks (-> (zero-or-more list-continuation-block)
     (parameterize ((references (map ref->alist-entry refs)))
       (pre-post-order* sxml markdown-html-conversion-rules*))))
 
-(define (markdown->sxml* input)
-  (parse document input))
+(define (markdown->sxml* #!optional (input (current-input-port)) (memoize? #t))
+  (parse document input memoize: memoize?))
 
-(define (markdown->sxml input)
-  (markdown-sxml->html-sxml (markdown->sxml* input)))
+(define (markdown->sxml #!optional (input (current-input-port)) (memoize? #t))
+  (markdown-sxml->html-sxml (markdown->sxml* input memoize?)))
 
-(define (markdown->html input)
-  (-> (markdown->sxml input)
+(define (markdown->html #!optional (input (current-input-port)) (memoize? #t))
+  (-> (markdown->sxml input memoize?)
       (pre-post-order*  universal-conversion-rules*)
       (SRV:send-reply)))