Parsing

original commit: 996a0366f8c8cdacbc2dd59a5d1ffbc85964b504

collects/scriblib/bibtex.rkt

@@ -17,20 +17,21 @@
     (match (peek-char ip)
       [(? pred)
        (read-char ip)
-       (read-until pred ip)]
+       (read-while pred ip)]
       [_
        (void)]))
+  
   (define (read-until pred ip)
     (list->string
      (let loop ()
       (match (peek-char ip)
         [(? pred)
-         (cons (read-char ip) (loop))]
+         empty]
         [_
-         empty]))))
+         (cons (read-char ip) (loop))]))))
   
   (define (slurp-whitespace ip)
-    (read-while char-whitespace? ip))
+    (read-while (λ (c) (and (char? c) (char-whitespace? c))) ip))
     
   (define (read-entries ip)
     (slurp-whitespace ip)
@@ -41,35 +42,67 @@
       [#\@
        (cons (read-entry ip)
              (read-entries ip))]
+      [(? eof-object?)
+       empty]
       [c
-       (error 'read-entries "Expected % or @, got ~a" c)]))
+       (error 'read-entries "Expected % or @, got ~v" c)]))
   
   (define (read-entry ip)
-    (match (peek-string 6 0 ip)
+    (match (read-until (λ (c) (char=? c #\{)) ip)
       [(app string-downcase "string")
-       (read-string 6 ip)
-       (slurp-whitespace ip)
-       (match (read-char ip)
-         [#\{
        (slurp-whitespace ip)
+       (read-char ip)
        (define tag (read-tag ip))
-          (printf "tag ~a\n" tag)
+       (printf "string tag ~v\n" tag)
        (slurp-whitespace ip)
        (match (read-char ip)
          [#\=
           (slurp-whitespace ip)
           (define string (read-value ip))
-             (printf "string (~a,~a)\n" tag string)
+          (printf "string (~v,~v)\n" tag string)
           (slurp-whitespace ip)
           (match (read-char ip)
             [#\}
-                (cons tag string)]
+             (list 'string tag string)]
             [c
-                (error 'read-entry "Parsing string, expected }, got ~a" c)])]
+             (error 'read-entry "Parsing string, expected }, got ~v" c)])]
          [c
-             (error 'read-entry "Parsing string, expected =, got ~a" c)])]
+          (error 'read-entry "Parsing string, expected =, got ~v" c)])]
+      [(app string-downcase "comment")
+       (read-char ip)
+       (let loop ()
+         (read-until (λ (c) (or (char=? c #\{) (char=? c #\}))) ip)
+         (match (read-char ip)
+           [#\{
+            (loop) (loop)]
+           [#\}
+            (void)]))]
+      [typ
+       (read-char ip)
+       (slurp-whitespace ip)
+       (define label (read-until (λ (c) (char=? c #\,)) ip))
+       (read-char ip)
+       (printf "entry label ~v\n" label)
+       (define alist
+         (let loop ()
+           (slurp-whitespace ip)
+           (define atag (read-tag ip))
+           (slurp-whitespace ip)
+           (match (read-char ip)
+            [#\=
+             (slurp-whitespace ip)
+             (define aval (read-value ip))
+             (define e (cons atag aval))
+             (match (read-char ip)
+               [#\,
+                (cons e (loop))]
+               [#\}
+                (list e)]
                [c
-          (error 'read-entry "Parsing string, expected {, got ~a" c)])]))
+                (error 'read-entry "Parsing entry, expected , or }, got ~v" c)])]
+            [c
+             (error 'read-entry "Parsing entry, expected =, got ~v" c)])))
+       (list 'entry typ label alist)]))
   
   (define (read-tag ip)
     (slurp-whitespace ip)
@@ -80,32 +113,41 @@
     (match (peek-char ip)
       [#\{
        (read-char ip)
-       (define first-part (read-until (λ (c) (or (char=? c #\{) (char=? c #\}))) ip))
+       (let loop ()
+         (define first-part (read-until (λ (c) (or (char=? c #\{) (char=? c #\})))
+                                        ip))
          (match (peek-char ip)
            [#\{
-          (printf "Inner read: ~a\n" first-part)
+            (string-append first-part (read-value ip) (loop))]
-          (string-append first-part (read-value ip))]
            [#\}
             (read-char ip)
-          first-part])]
+            first-part]))]
+      [(? char-numeric?)
+       (read-while char-numeric? ip)]
+      [(? char-alphabetic?)
+       ; XXX string ref
+       (read-until (λ (c) (char=? c #\,)) ip)]
       [c
-       (error 'read-value "Parsing value, expected {, got ~a" c)]))
+       (error 'read-value "Parsing value, expected {, got ~v" c)]))
   
   (with-handlers
       ([exn? (λ (x)
-               (printf "~a\n" (read-string 100 ip))
+               (printf "~v\n" (read-string 100 ip))
                (raise x))])
     (read-entries ip)))
 
 (define (path->bibdb pth)
-  (printf "~a\n"
+  (define bibdb
     (with-input-from-file
         pth
       (λ ()
         (bibtex-parse (current-input-port)))))
+  (printf "~v\n" (length bibdb))
   (error 'path->bibdb pth)
   #f)
 
+(path->bibdb "/Users/jay/Dev/scm/github.jeapostrophe/work/papers/etc/all.bib")
+
 (define (generate-bib db style)
   "XXX")