comments and standard fieldsHEADmaster

1 files changed, 79 insertions, 36 deletions

diff --git a/mcgoron.ris.parse.scm b/mcgoron.ris.parse.scm
index 3711a96..2bd1c42 100644
--- a/mcgoron.ris.parse.scm
+++ b/mcgoron.ris.parse.scm
@@ -17,55 +17,79 @@
 ;;; Stream destructors.
 
 (define (stream-pair=> stream)
+  ;; Destructure a stream into its car and cdr.
   (cond-values
     (when-ct (stream-pair? stream)
       (values (stream-car stream) (stream-cdr stream)))))
 
 (define (stream-predicate=> stream predicate?)
+  ;; Destructure a stream into its car and cdr if the car satisfies
+  ;; PREDICATE?
   (cond-values
     (after ((let (stream-pair=> stream) => (head stream))
             (when (predicate? head)))
       (values head stream))))
 
 (define-syntax with-stream-predicates
+  ;; Sequence stream predicates together.
+  ;; The final cdr is bound to STREAM. The resultant CAR of each test
+  ;; is bound to NAME.
   (syntax-rules ()
     ((_ stream ((predicate? name) ...) body ...)
      (after ((let (stream-predicate=> stream predicate?) => (name stream))
              ...)
        body ...))))
 
-;;; Mapping destructors.
+;;; Mapping utils.
 
-(define (mapping-ref=> mapping key)
-  (mapping-ref mapping key (lambda () (values))))
-
-(define (mapping-new-field mapping key val)
-  (mapping-set mapping key (flexvector val)))
+(define (add-to-mapping mapping name rest)
+  ;; Add REST to the flexvector mapped to NAME in MAPPING. If NAME is
+  ;; not mapped, allocate a new flexvector with REST as its first element.
+  (let ((fv (mapping-ref/default mapping name #f)))
+    (cond
+      (fv (flexvector-add-back! fv rest)
+          mapping)
+      (else (mapping-set mapping name (flexvector rest))))))
 
 ;;; Flexvector utils.
 
 (define (flexvector-update-last! fv update)
+  ;; Update the last value in FV with the result of applying UPDATE
+  ;; to the last value in FV.
   (let ((len (flexvector-length fv)))
     (flexvector-set! fv
                      (- len 1)
                      (update (flexvector-ref fv (- len 1))))))
 
+(define (append-new-line! fv rest)
+  ;; Append to the last value in FV the string REST.
+  (flexvector-update-last! fv
+                           (lambda (x)
+                             (string-append x "\n" rest))))
+
 ;;; Parsing each line.
 
-(define (prefix-char? ch)
+(define (field-char? ch)
+  ;; Check if CH is a valid RIS field char.
   (or (char-upper-case? ch) (char-numeric? ch)))
 
 (define (end=> stream)
+  ;; Check if STREAM is at the end of a line.
   (cond-values
+    ;; EOF is end of line
     (when-ct (stream-null? stream)
       stream)
+    ;; Handle CRLF
     (with-stream-predicates stream (((cut eqv? #\return <>) _)
                                     ((cut eqv? #\newline <>) _))
       stream)
+    ;; Handle LF
     (with-stream-predicates stream (((cut eqv? #\newline <>) _))
       stream)))
 
 (define (read-rest stream)
+  ;; Read the rest of the stream up to the end of a line, and return
+  ;; it as a string.
   (let ((fv (flexvector)))
     (let read-rest ((stream stream))
       (cond-thunk
@@ -77,12 +101,16 @@
           (read-rest stream))
         (else (raise (stream-error stream)))))))
 
-(define (prefix=> stream)
+(define (field=> stream)
+  ;; At the start of a line, read a field specifier, or return no
+  ;; values.
+  ;; 
+  ;; TODO: This needs to read /[A-Z0-9]{2,}  - /
   (let ((ws? (lambda (x)
                (char=? x #\space))))
     (cond-values
-      (with-stream-predicates stream ((prefix-char? char1)
-                                      (prefix-char? char2)
+      (with-stream-predicates stream ((field-char? char1)
+                                      (field-char? char2)
                                       (ws? _)
                                       (ws? _)
                                       ((cut char=? #\- <>) _)
@@ -92,48 +120,63 @@
 
 ;;; Parsing of references.
 
+(define (add/special-fields mapping name rest)
+  (let ((mapping (add-to-mapping mapping name rest)))
+    ;; If NAME is an author field, append the name to the special field
+    ;; AUTHOR.
+    (if (author-field? name)
+        (add-to-mapping mapping "AUTHOR" rest)
+        mapping)))
+
 (define (read-reference stream mapping last-name)
+  ;; Read an entire reference up to the ER field. This function starts
+  ;; at the beginning of a line.
+  ;; 
+  ;; All new fields are added to MAPPING. Repeated fields are appended
+  ;; to a flexvector that the field name maps to.
+  ;; 
+  ;; If the beginning of the line is not a field, then it is a
+  ;; continuation of the last field, specified by LAST-NAME.
+  ;; 
+  ;; Returns (VALUES STREAM MAPPING) after ER.
   (cond-thunk
-    (after ((let (prefix=> stream) => (name rest stream)))
-      (cond-thunk
-        (when-ct (equal? name "ER")
-          (values stream mapping))
-        (after ((let (mapping-ref=> mapping name) => (fv)))
-          (flexvector-add-back! fv rest)
-          (read-reference stream mapping name))
-        (else
-         (read-reference stream
-                         (mapping-new-field mapping
-                                            name
-                                            rest)
-                         name))))
+    (after ((let (field=> stream) => (name rest stream)))
+      (if (equal? name "ER")
+          (values stream mapping)
+          (let ((mapping (add/special-fields mapping name rest)))
+            (read-reference stream mapping name))))
     (when-ct (stream-null? stream)
       (values stream mapping))
     (else
      (let-values
-         (((fv) (mapping-ref mapping
-                           last-name
-                           (lambda () (error "internal error" stream))))
+         (((fv) (mapping-ref mapping last-name))
           ((rest stream) (read-rest stream)))
-       (flexvector-update-last! fv
-                                (lambda (last)
-                                  (string-append last "\n" rest)))
+       (append-new-line! rest)
        (read-reference stream mapping last-name)))))
 
-(define (read-new-reference stream mapping)
+(define (new-mapping name rest)
+  (add-to-mapping (mapping (make-default-comparator)) name rest))
+
+(define (read-new-reference stream references-fv)
+  ;; Read the start of a new reference.
+  ;; 
+  ;; If the file is at EOF, return MAPPING.
+  ;; Otherwise, read the TY field of the new reference. If there is no
+  ;; TY field, raise MALFORMED-REFERENCE-ERROR.
   (cond-thunk
     (when-ct (stream-null? stream)
-      mapping)
-    (after ((let (prefix=> stream) => (name rest stream))
+      references-fv)
+    (after ((let (field=> stream) => (name rest stream))
             (when (string=? name "TY")))
-      (let-values (((stream mapping)
+      (let-values (((stream ref-mapping)
                     (read-reference stream
-                                    (mapping-new-field mapping name rest)
+                                    (new-mapping name rest)
                                     name)))
-        (read-new-reference stream mapping)))
+        (flexvector-add-back! references-fv ref-mapping)
+        (read-new-reference stream references-fv)))
     (else (raise (malformed-reference-error stream)))))
 
 (define (ris->mapping port)
   (read-new-reference (port->stream port)
-                      (mapping (make-default-comparator))))
+                      (flexvector)))