summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--parser-combinators.scm113
1 files changed, 90 insertions, 23 deletions
diff --git a/parser-combinators.scm b/parser-combinators.scm
index e0522dd..1b8c960 100644
--- a/parser-combinators.scm
+++ b/parser-combinators.scm
@@ -40,6 +40,8 @@
parse-bind
parse-return
parse-lift
+ parse
+
parse-map
parse-match
parse-any
@@ -48,7 +50,14 @@
parse-one-or-more
parse-up-to
parse-maybe
- parse))
+ parse-any-char
+ parse-char
+ parse-char-set
+ parse-string))
+
+;;;
+;;; Core
+;;;
(define-record-type <parse-result>
(parse-result value stream)
@@ -96,11 +105,39 @@
(lambda args
(parse-return (apply proc args))))
+(define (string->stream str)
+ "Convert the string STR into a stream of characters."
+ (stream-map (lambda (i)
+ (string-ref str i))
+ (stream-range 0 (string-length str))))
+
+(define* (parse parser obj #:optional (fail-value #f))
+ "Parse the contents of OBJ with PARSER. OBJ may be either a string, port,
+or stream."
+ (let ((stream (match obj
+ ;; Handle strings and ports as a convenience.
+ ((? string? str) (string->stream str))
+ ((? port? port) (port->stream port))
+ ((? stream? stream) stream))))
+ (match (parser stream)
+ ((or (? parse-failure?)
+ (not (? parse-done?)))
+ fail-value)
+ (($ <parse-result> value _) value))))
+
+
+;;;
+;;; Extras
+;;;
+
(define (parse-map proc parser)
"Return a new parser that applies PROC to result of PARSER."
(parse-bind (parse-lift proc) parser))
(define-syntax-rule (parse-match parser matchers ...)
+ "Create a parser that applies pattern matching to transform the
+successful results of PARSER using MATCHERS. MATCHERS uses the (ice-9
+match) pattern matching syntax."
(parse-map (match-lambda matchers ...) parser))
(define (%parse-any . parsers)
@@ -135,9 +172,13 @@ parsers succeed."
(%parse-any (delay parser) ...))
(define-syntax-rule (parse-each parser ...)
+ "Create a sequential parser that returns a list of parse results if
+all of the input parsers succeed."
(%parse-each (delay parser) ...))
(define (parse-zero-or-more parser)
+ "Create a parser that applies PARSER as many times as it can before
+failing and returns list of the successful parse results."
(lambda (stream)
(let loop ((stream stream)
(result '()))
@@ -148,6 +189,9 @@ parsers succeed."
(loop stream (cons value result)))))))
(define (parse-one-or-more parser)
+ "Return a parser that succeeds when PARSER can be successfully
+applied at least once and returns a list of the successful parse
+results."
(lambda (stream)
(let loop ((stream stream)
(result '()))
@@ -160,40 +204,63 @@ parsers succeed."
(loop stream (cons value result)))))))
(define (parse-up-to n parser)
- "Parse using PARSER at most N times."
+ "Create a parser that applies PARSER at most N times and returns a
+list of the successful parse results."
(lambda (stream)
(let loop ((stream stream)
- (m 0))
- (if (= m n)
+ (n n))
+ (if (zero? n)
'()
(match (parser stream)
((? parse-failure?) '())
(($ <parse-result> value stream)
- (cons value (loop stream (1+ m)))))))))
+ (cons value (loop stream (1- n)))))))))
(define* (parse-maybe parser #:optional (default #f))
+ "Create a parser that returns the result of PARSER upon success, or
+DEFAULT upon failure."
(lambda (stream)
(match (parser stream)
((? parse-failure?)
(parse-result default stream))
(result result))))
-(define (string->stream str)
- "Convert the string STR into a stream of characters."
- (stream-map (lambda (i)
- (string-ref str i))
- (stream-range 0 (string-length str))))
+(define (parse-any-char stream)
+ "Parse any single character or fail if STREAM is empty."
+ (stream-match stream
+ (() %parse-failure)
+ ((head . tail)
+ (parse-result head tail))))
-(define* (parse parser obj #:optional (fail-value #f))
- "Parse the contents of OBJ with PARSER. OBJ may be either a string, port,
-or stream."
- (let ((stream (match obj
- ;; Handle strings and ports as a convenience.
- ((? string? str) (string->stream str))
- ((? port? port) (port->stream port))
- ((? stream? stream) stream))))
- (match (parser stream)
- ((or (? parse-failure?)
- (not (? parse-done?)))
- fail-value)
- (($ <parse-result> value _) value))))
+(define (parse-char c)
+ "Create a parser that succeeds when the next character in the stream
+is C."
+ (lambda (stream)
+ (stream-match stream
+ (() %parse-failure)
+ ((head . tail)
+ (if (equal? head c)
+ (parse-result head tail)
+ %parse-failure)))))
+
+(define (parse-char-set char-set)
+ "Create a parser that succeeds when the next character in the stream
+is a member of CHAR-SET."
+ (lambda (stream)
+ (stream-match stream
+ (() %parse-failure)
+ ((char . tail)
+ (if (char-set-contains? char-set char)
+ (parse-result char tail)
+ %parse-failure)))))
+
+(define stream->string (compose list->string stream->list))
+
+(define (parse-string str)
+ "Create a parser that succeeds when the front of the stream contains
+the character sequence in STR."
+ (lambda (stream)
+ (let ((input (stream->string (stream-take (string-length str) stream))))
+ (if (string=? str input)
+ (parse-result str (stream-drop (string-length str) stream))
+ %parse-failure))))