edward

  1;;>| Utility Parsing Combinators
  2;;>
  3;;> Additional high-level combinators implemented using the aforementioned
  4;;> [basic combinators][basic section]. The provided high-level combinators,
  5;;> return more useful parser error messages then the basic ones.
  6;;>
  7;;> [basic section]: #section-basic-parsing-combinators
  8
  9;;> Parser which always fails with the given error message.
 10
 11(define (parse-fail msg)
 12  (lambda (source index sk fk)
 13    (fk source index msg)))
 14
 15;;> Bind a constant `value` to a given `parser`.
 16;;> That is, always return this value if the parser succeeds.
 17
 18(define (parse-bind value parser)
 19  (parse-map
 20    parser
 21    (lambda (x) value)))
 22
 23;;> Run a parser `f`, which *must* return a list, and convert
 24;;> its return value to a string using the `list->string` procedure.
 25
 26(define (parse-as-string parser)
 27  (parse-map
 28    parser
 29    list->string))
 30
 31;;> Parse one or more digits (i.e. `0-9`), interpret them as a
 32;;> decimal number, and return this number.
 33
 34(define parse-digits
 35  (parse-with-failure-reason
 36    (parse-map
 37      (parse-token char-set:digit)
 38      string->number)
 39    "expected digits"))
 40
 41;;> Parse an ASCII lowercase character (i.e. `a-z`).
 42
 43(define parse-lowercase
 44  (parse-with-failure-reason
 45    (parse-char char-set:lower-case)
 46    "expected lowercase character"))
 47
 48;;> Attempt parsing using the given parser `f`, if it fails return a default value `def`.
 49
 50(define (parse-default f def)
 51  (parse-map
 52    (parse-optional f)
 53    (lambda (x)
 54      (if x x def))))
 55
 56;;> Parse a newline character.
 57
 58(define parse-newline
 59  (parse-with-failure-reason
 60    (parse-char #\newline)
 61    "expected newline"))
 62
 63;;> Parse a single blank character (i.e. horizontal whitespace).
 64
 65(define parse-blank
 66  (parse-with-failure-reason
 67    (parse-char char-set:blank)
 68    "expected whitespace"))
 69
 70;;> Parse one or more blank characters.
 71
 72(define parse-blanks+
 73  (parse-with-failure-reason
 74    (parse-token char-set:blank)
 75    "expected whitespaces"))
 76
 77;;> Parse zero or more blank characters.
 78
 79(define parse-blanks
 80  (parse-optional parse-blanks+))
 81
 82;;> Invokes parser `f` between the parsers `lhs` and `rhs`.
 83
 84(define (parse-between lhs f rhs)
 85  (parse-map
 86    (parse-seq lhs f rhs)
 87    cadr))
 88
 89;;> Returns the result of parser `f` but allows preceding its input
 90;;> with a backslash character to escape it in the parsed input format.
 91
 92(define (parse-esc f)
 93  (parse-map
 94    (parse-seq
 95      (parse-char #\\)
 96      f)
 97    cadr))
 98
 99;;> Parse an `alist` mapping chars to values which should be returned for each char.
100
101(define (parse-alist alist)
102  (apply
103    parse-or
104    (map
105      (lambda (x)
106        (parse-map
107          (parse-char (car x))
108          (lambda (_)
109            (cdr x))))
110      alist)))
111
112;; Utility procedure for parsing ed(1) BRE addresses.
113
114(define (%parse-regex-lit ch end)
115  (parse-with-failure-reason
116    (parse-atomic
117      (parse-as-string
118        (parse-between
119          (parse-char ch)
120          (parse-repeat (parse-or
121                          (parse-esc (parse-char ch))
122                          (parse-char (char-set-complement (char-set ch #\newline)))))
123          end)))
124    "expected regex"))
125
126;;> Parse a regex literal which is enclosed by the character `ch`.
127
128(define (parse-regex-lit ch)
129  (%parse-regex-lit
130    ch
131    (parse-char ch)))
132
133;;> Parse a regex literal which starts with character `ch` and is
134;;> terminated by the same character or the end of line.
135
136(define (parse-regex-lit* ch)
137  (%parse-regex-lit
138    ch
139    (parse-or
140      (parse-char ch)
141      parse-end-of-line)))
142
143;;> Invoke given parser and strip trailing blanks (if any).
144
145(define (parse-strip-blanks parser)
146  (parse-map
147    (parse-seq
148      parser
149      parse-blanks)
150    car))
151
152;;> Like [parse-seq](#parse-seq) but skip blanks *before* each parser.
153
154(define (parse-blanks-seq . o)
155  (define (%parse-blanks-seq lst)
156    (parse-seq-list
157      (apply append
158             (zip (make-list
159                        (length lst)
160                        (parse-ignore parse-blanks))
161                  lst))))
162
163  (%parse-blanks-seq o))
164
165;;> Parse a single line (excluding the terminating newline character).
166
167(define parse-line
168  (parse-atomic
169    (parse-or
170      (parse-bind "" parse-newline) ;; empty line
171      (parse-map
172        (parse-seq
173          (parse-token (lambda (x) (not (char=? x #\newline))))
174          ;; XXX: parse-end-of-line does _not_ consume the end-of-file.
175          ;; This is crucial for parse-input-mode to work correctly.
176          (parse-or parse-newline parse-end-of-line))
177        car))))
178
179;;> Feed the result of the parser `ctx` to a single argument procedure `f`.
180;;> The procedure must then return a new parser which is executed
181;;> afterwards on the same index as `ctx`.
182
183(define (parse-with-context ctx f)
184  (lambda (source index sk fk)
185    (let* ((yield (lambda (r s i fk) r))
186           (value (call-with-parse ctx source index yield)))
187      (if value ;; default fk returns #f on error
188        ((f value) source index sk fk)
189        (fk source index "context parser failed")))))