diff options
| -rw-r--r-- | parser-combinators.scm | 113 |
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)))) |