brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Split out passes 0 and 1 to generic parser.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-09 10:23:27 +02:00
parent 7fa9e6901c
commit 3c9f860fc6
2 changed files with 37 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/member-parser.scm
View file

@ -136,23 +136,6 @@
mr 'info mr 'info
(join (map (lambda (mk) (list mk #f)) mandatory-keys)))) (join (map (lambda (mk) (list mk #f)) mandatory-keys))))
;; Pass 1: 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)))))
;; Passes 0 and 1: Adds parsed lines to member record. ;; Passes 0 and 1: Adds parsed lines to member record.
(define (parse-member-lines mr source) (define (parse-member-lines mr source)
(let loop ((lines source) (let loop ((lines source)
@ -161,7 +144,7 @@
(line-number 1)) (line-number 1))
(if (null? lines) (if (null? lines)
(member-record-set mr #:parsed (reverse result)) (member-record-set mr #:parsed (reverse result))
(let ((parsed-line (parse-member-line (let ((parsed-line (parser-parse-line
(parser-preprocess-line (parser-preprocess-line
(car lines))))) (car lines)))))
(loop (cdr lines) (loop (cdr lines)
@ -251,23 +234,6 @@
(define (member-parser-tests!) (define (member-parser-tests!)
(run-tests (run-tests
member-parser member-parser
(test-false parse-member-line
(parse-member-line ""))
(test-eq? parse-member-line
(parse-member-line "key")
'key)
(test-equal? parse-member-line
(parse-member-line "key value")
'(key . "value"))
(test-equal? parse-member-line
(parse-member-line "key value")
'(key . "value"))
(test-equal? parse-member-line
(parse-member-line "key value and some")
'(key . "value and some"))
(test-equal? parse-member-line
(parse-member-line "key value lot of spaces")
'(key . "value lot of spaces"))
)) ))
) )

37
src/util-parser.scm
View file

@ -29,6 +29,7 @@
util-parser util-parser
( (
parser-preprocess-line parser-preprocess-line
parser-parse-line
parser-tests! parser-tests!
) )
@ -46,6 +47,23 @@
"") "")
"")) ""))
;; Pass 1: 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 (parser-parse-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)))))
;; Self-tests ;; Self-tests
(define (parser-tests!) (define (parser-tests!)
(run-tests (run-tests
@ -62,6 +80,23 @@
(test-equal? parser-preprocess-line (test-equal? parser-preprocess-line
(parser-preprocess-line "key value # spaces and comment after spaces") (parser-preprocess-line "key value # spaces and comment after spaces")
"key value") "key value")
)) (test-false parser-parse-line
(parser-parse-line ""))
(test-eq? parser-parse-line
(parser-parse-line "key")
'key)
(test-equal? parser-parse-line
(parser-parse-line "key value")
'(key . "value"))
(test-equal? parser-parse-line
(parser-parse-line "key value")
'(key . "value"))
(test-equal? parser-parse-line
(parser-parse-line "key value and some")
'(key . "value and some"))
(test-equal? parser-parse-line
(parser-parse-line "key value lot of spaces")
'(key . "value lot of spaces"))
))
) )