Commits

Anonymous committed bf5d173

Break lowdown module up into lowdown and lowdown-lolevel

Comments (0)

Files changed (4)

 
 (define document
   (zero-or-more block))
-
-(define (maybe-ref key alist)
-  (and-let* ((value (alist-ref key alist)))
-    (and (not (and (not (car value))
-                   (null? (cdr value))))
-         value)))
-
-(define (maybe-attr-ref attr attrs)
-  (let ((value (maybe-ref attr attrs)))
-    (if value
-        (list (cons attr value))
-        '())))
-
-(define (reference-element? el)
-  (and (pair? el) (eq? 'reference (car el))))
-
-(define references
-  (make-parameter #f))
-
-(define (call-with-reference attrs proc)
-  (let ((ref (-> (car (alist-ref 'ref attrs))
-                 (alist-ref (references) equal?))))
-    (if ref
-        (proc ref attrs)
-        (alist-ref 'input attrs))))
-
-(define (make-image ref #!optional attrs)
-  `(img (@ (src ,(alist-ref 'href ref))
-           (alt . ,(alist-ref 'label (or attrs ref)))
-           ,(if attrs
-                (maybe-attr-ref 'title ref)
-                `((title . ,(alist-ref 'title ref)))))))
-
-(define (make-anchor ref #!optional attrs)
-  `(a (@ (href ,(alist-ref 'href ref))
-         . ,(maybe-attr-ref 'title ref))
-      . ,(alist-ref 'label (or attrs ref))))
-
-(define markdown-html-conversion-rules*
-  `((explicit-link . ,(lambda (_ attrs)
-                        (make-anchor attrs)))
-    (reference-link . ,(lambda (_ attrs)
-                         (call-with-reference attrs make-anchor)))
-    (auto-link . ,(lambda (_ attrs)
-                    `(a (@ (href . ,(alist-ref 'href attrs)))
-                        . ,(alist-ref 'label attrs))))
-    (image . ,(lambda (_ attrs)
-                (make-image attrs)))
-    (reference-image . ,(lambda (_ attrs)
-                          (call-with-reference attrs make-image)))
-    (verbatim . ,(lambda (_ contents)
-                   `(pre (code . ,contents))))
-    (bullet-list . ,(lambda (_ items)
-                      `(ul . ,items)))
-    (ordered-list . ,(lambda (_ items)
-                       `(ol . ,items)))
-    (item . ,(lambda (_ contents)
-               `(li . ,contents)))
-    (heading . ,(lambda (_ contents)
-                  (cons (->> (number->string (car contents))
-                             (string-append "h")
-                             (string->symbol))
-                        (cdr contents))))
-    (paragraph . ,(lambda (_ contents)
-                    `(p . ,contents)))
-    (emphasis . ,(lambda (_ text)
-                   `(em . ,text)))
-    (strong . ,(lambda (_ text)
-                 `(strong . ,text)))
-    (html-element . ,(lambda (_ contents)
-                       contents))
-    (comment . ,(lambda (_ contents)
-                  (list #\< "!--" contents "--" #\> #\newline)))
-    . ,alist-conv-rules*))
-
-(define (ref->alist-entry ref)
-  (cons (car (alist-ref 'label (cdr ref)))
-        (cdr ref)))
-
-(define (markdown-sxml->html-sxml markdown-sxml)
-  (receive (refs sxml) (partition reference-element? markdown-sxml)
-    (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 input)
-  (markdown-sxml->html-sxml (markdown->sxml* input)))

lowdown-lolevel.scm

+(module lowdown-lolevel
+
+(document inline)
+
+"lowdown-impl.scm"
+
+)
 
 (markdown->sxml markdown->sxml*)
 
-"lowdown-impl.scm"
+(import chicken scheme)
+(use data-structures srfi-1 clojurian-syntax comparse
+     sxml-transforms lazy-seq lowdown-lolevel)
+
+(define (maybe-ref key alist)
+  (and-let* ((value (alist-ref key alist)))
+    (and (not (and (not (car value))
+                   (null? (cdr value))))
+         value)))
+
+(define (maybe-attr-ref attr attrs)
+  (let ((value (maybe-ref attr attrs)))
+    (if value
+        (list (cons attr value))
+        '())))
+
+(define (reference-element? el)
+  (and (pair? el) (eq? 'reference (car el))))
+
+(define references
+  (make-parameter #f))
+
+(define (call-with-reference attrs proc)
+  (let ((ref (-> (car (alist-ref 'ref attrs))
+                 (alist-ref (references) equal?))))
+    (if ref
+        (proc ref attrs)
+        (alist-ref 'input attrs))))
+
+(define (make-image ref #!optional attrs)
+  `(img (@ (src ,(alist-ref 'href ref))
+           (alt . ,(alist-ref 'label (or attrs ref)))
+           ,(if attrs
+                (maybe-attr-ref 'title ref)
+                `((title . ,(alist-ref 'title ref)))))))
+
+(define (make-anchor ref #!optional attrs)
+  `(a (@ (href ,(alist-ref 'href ref))
+         . ,(maybe-attr-ref 'title ref))
+      . ,(alist-ref 'label (or attrs ref))))
+
+(define markdown-html-conversion-rules*
+  `((explicit-link . ,(lambda (_ attrs)
+                        (make-anchor attrs)))
+    (reference-link . ,(lambda (_ attrs)
+                         (call-with-reference attrs make-anchor)))
+    (auto-link . ,(lambda (_ attrs)
+                    `(a (@ (href . ,(alist-ref 'href attrs)))
+                        . ,(alist-ref 'label attrs))))
+    (image . ,(lambda (_ attrs)
+                (make-image attrs)))
+    (reference-image . ,(lambda (_ attrs)
+                          (call-with-reference attrs make-image)))
+    (verbatim . ,(lambda (_ contents)
+                   `(pre (code . ,contents))))
+    (bullet-list . ,(lambda (_ items)
+                      `(ul . ,items)))
+    (ordered-list . ,(lambda (_ items)
+                       `(ol . ,items)))
+    (item . ,(lambda (_ contents)
+               `(li . ,contents)))
+    (heading . ,(lambda (_ contents)
+                  (cons (->> (number->string (car contents))
+                             (string-append "h")
+                             (string->symbol))
+                        (cdr contents))))
+    (paragraph . ,(lambda (_ contents)
+                    `(p . ,contents)))
+    (emphasis . ,(lambda (_ text)
+                   `(em . ,text)))
+    (strong . ,(lambda (_ text)
+                 `(strong . ,text)))
+    (html-element . ,(lambda (_ contents)
+                       contents))
+    (comment . ,(lambda (_ contents)
+                  (list #\< "!--" contents "--" #\> #\newline)))
+    (inline-note . ,(lambda (_ contents)
+                      `(span (@ (class "note")) . ,contents)))
+    . ,alist-conv-rules*))
+
+(define (ref->alist-entry ref)
+  (cons (car (alist-ref 'label (cdr ref)))
+        (cdr ref)))
+
+(define (markdown-sxml->html-sxml markdown-sxml)
+  (receive (refs sxml) (partition reference-element? markdown-sxml)
+    (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 input)
+  (markdown-sxml->html-sxml (markdown->sxml* input)))
 
 )
-(compile -d0 -O2 -J -s -X char-set-literals lowdown.scm)
-(compile -d0 -O2 -s lowdown.import.scm)
+(define info
+  '((version "0.0.1")))
+
+(define-for-syntax (lib-file name suffix)
+  (string-append name suffix))
+
+(define-syntax compile-lib
+  (ir-macro-transformer
+   (lambda (x i c)
+     (let ((name (symbol->string (strip-syntax (last x)))))
+       `(begin
+          (compile -d0 -O2 -J -s ,@(butlast (cdr x)) ,(lib-file name ".scm"))
+          (compile -d0 -O3 -s ,(lib-file name ".import.scm")))))))
+
+(compile-lib -X char-set-literals lowdown-lolevel)
+(compile-lib lowdown)
 
 (install-extension
  'lowdown
- '("lowdown.so" "lowdown.import.so")
- '((version "0.0.1")))
+ '("lowdown-lolevel.so" "lowdown-lolevel.import.so"
+   "lowdown.so" "lowdown.import.so")
+ info)