Streamlining the new parser.

member2-parser.scm

@@ -1,123 +0,0 @@
-;;
-;; member2-parser.scm
-;;
-;; Member file parsing.
-;;
-;; ISC License
-;;
-;; Copyright 2023 Brmlab, z.s.
-;; Dominik Pantůček <dominik.pantucek@trustica.cz>
-;;
-;; Permission to use, copy, modify, and/or distribute this software
-;; for any purpose with or without fee is hereby granted, provided
-;; that the above copyright notice and this permission notice appear
-;; in all copies.
-;; 
-;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
-;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
-;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
-;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
-;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
-;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-;;
-
-(declare (unit member2-parser))
-
-(module
- member2-parser
- (
-  parse-member-file
-  member-parser-tests!
-  )
-
- (import scheme
-	 (chicken base)
-	 (chicken io)
-	 (chicken irregex)
-	 member2-record
-	 testing)
-
- ;; Removes any comments and removes any leading and trailing
- ;; whitespace.
- (define (preprocess-member-line line)
-   (irregex-replace (irregex "[ \\t]*$" 'u)
-		    (irregex-replace (irregex "^[ \\t]*" 'u)
-				     (irregex-replace (irregex "#.*$" 'u) line "")
-				     "")
-		    ""))
-
- ;; Expects line with comments and surrounding whitespace removed,
- ;; returns either #f if nothing was parsed, symbol if only one token
- ;; was there and pair of symbol and string if both key and the value
- ;; were present.
- (define (parse-member-line line)
-   (if (= (string-length line) 0)
-       #f
-       (let ((dm (irregex-search (irregex "[ \\t]" 'u) line)))
-	 (if dm
-	     (let* ((sep-idx (irregex-match-start-index dm))
-		    (key-str (substring line 0 sep-idx))
-		    (key (string->symbol key-str))
-		    (sep+val (substring line sep-idx))
-		    (val (irregex-replace (irregex "^[ \\t]*" 'u) sep+val "")))
-	       (cons key val))
-	     (string->symbol line)))))
-
- ;; Adds parsed lines to member record.
- (define (parse-member-lines mr source)
-   (let loop ((lines source)
-	      (mr (member-record-set mr #:source source))
-	      (result '())
-	      (line-number 1))
-     (if (null? lines)
-	 (member-record-set mr #:parsed (reverse result))
-	 (let ((parsed-line (parse-member-line
-			     (preprocess-member-line
-			      (car lines)))))
-	   (loop (cdr lines)
-		 (if (symbol? parsed-line)
-		     (member-record-add-highlight mr line-number "Got only key" 1 'error)
-		     mr)
-		 (if (pair? parsed-line)
-		     (cons (list (car parsed-line)
-				 (cdr parsed-line)
-				 line-number)
-			   result)
-		     result)
-		 (add1 line-number))))))
-
- ;; Loads member file source. Performs passes 0 and 1 on each line
- ;; returning parsed source. Parsed source is a list of lists
- ;; containing '(key value line-number) information. Leading and
- ;; trailing whitespace is trimmed for both keys and values.
- (define (parse-member-file mr)
-   (let* ((mrif (member-record-input-file mr))
-	  (source (read-lines mrif))
-	  (mrp (parse-member-lines mr source)))
-     mrp))
-
- (define (member-parser-tests!)
-   (run-tests
-    member-parser
-    (test-equal? preprocess-member-line
-		 (preprocess-member-line "# all comment")
-		 "")
-    (test-equal? preprocess-member-line
-		 (preprocess-member-line "   # all comment after spaces")
-		 "")
-    (test-equal? preprocess-member-line
-		 (preprocess-member-line " test  # spaces and comment after spaces")
-		 "test")
-    (test-equal? preprocess-member-line
-		 (preprocess-member-line "key value  # spaces and comment after spaces")
-		 "key value")
-    ))
-
- )
-
-(import member2-parser)
-
-(member-parser-tests!)
-(print (parse-member-file (make-member-record "joe" "members/joe" '())))