diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | syntax-highlight/parsers.scm | 224 |
2 files changed, 0 insertions, 225 deletions
diff --git a/Makefile.am b/Makefile.am index 965ee08..191e28c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -41,7 +41,6 @@ godir=$(libdir)/guile/2.0/ccache SOURCES = \ syntax-highlight/utils.scm \ syntax-highlight/lexers.scm \ - syntax-highlight/parsers.scm \ syntax-highlight/scheme.scm \ syntax-highlight/xml.scm \ syntax-highlight.scm diff --git a/syntax-highlight/parsers.scm b/syntax-highlight/parsers.scm deleted file mode 100644 index c631a59..0000000 --- a/syntax-highlight/parsers.scm +++ /dev/null @@ -1,224 +0,0 @@ -;;; guile-syntax-highlight --- General-purpose syntax highlighter -;;; Copyright © 2015 David Thompson <davet@gnu.org> -;;; -;;; Guile-syntax-highlight is free software; you can redistribute it -;;; and/or modify it under the terms of the GNU Lesser General Public -;;; License as published by the Free Software Foundation; either -;;; version 3 of the License, or (at your option) any later version. -;;; -;;; Guile-syntax-highlight is distributed in the hope that it will be -;;; useful, but WITHOUT ANY WARRANTY; without even the implied -;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -;;; See the GNU Lesser General Public License for more details. -;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with guile-syntax-highlight. If not, see -;;; <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Parsing utilities. -;; -;;; Code: - -(define-module (syntax-highlight parsers) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-41) - #:use-module (syntax-highlight utils) - #:export (parse-fail - parse-bind - parse-return - parse-lift - parse-map - parse-filter - parse-either - parse-both - parse-any - parse-each - parse-maybe - parse-many - parse-string - parse-char-set - parse-whitespace - parse-delimited - parse-regexp - tagged-parser)) - -;;; -;;; Parser combinators -;;; - -(define (parse-fail stream) - "Always fail to parse STREAM without consuming any of it." - (values #f stream)) - -(define (parse-bind proc parser) - (lambda (stream) - (let-values (((result stream) (parser stream))) - (if result - ((proc result) stream) - (parse-fail stream))))) - -(define (parse-return x) - "Return a parser that always yields X as the parse result." - (lambda (stream) - (values x stream))) - -(define (parse-lift proc) - "Return a procedure that wraps the result of PROC in a parser." - (lambda args - (parse-return (apply proc args)))) - -(define (parse-map proc parser) - "Return a new parser that applies PROC to result of PARSER." - (parse-bind (parse-lift proc) parser)) - -(define (parse-filter predicate parser) - "Create a new parser that succeeds when PARSER is successful and -PREDICATE is satisfied with the result." - (lambda (stream) - (let-values (((result remaining) (parser stream))) - (if (and result (predicate result)) - (values result remaining) - (parse-fail stream))))) - -(define (parse-either first second) - "Create a parser that tries to parse with FIRST or, if that fails, -parses SECOND." - (lambda (stream) - (let-values (((result remaining) (first stream))) - (if result - (values result remaining) - (second stream))))) - -(define (parse-both first second) - "Create a parser that returns a pair of the results of the parsers -FIRST and SECOND if both are successful." - (lambda (stream) - (let-values (((result1 remaining) (first stream))) - (if result1 - (let-values (((result2 remaining) (second remaining))) - (if result2 - (values (cons result1 result2) remaining) - (parse-fail stream))) - (parse-fail stream))))) - -(define (parse-any . parsers) - "Create a parser that returns the result of the first successful -parser in PARSERS. This parser fails if no parser in PARSERS -succeeds." - (fold-right parse-either parse-fail parsers)) - -(define (parse-each . parsers) - "Create a parser that builds a list of the results of PARSERS. This -parser fails without consuming any input if any parser in PARSERS -fails." - (fold-right parse-both (parse-return '()) parsers)) - -(define (parse-maybe parser) - "Create a parser that always succeeds, but tries to use PARSER. If -PARSER succeeds, its result is returned, otherwise the empty string is -returned without consuming any input." - (lambda (stream) - (let-values (((result remaining) (parser stream))) - (if result - (values result remaining) - (values "" stream))))) - -(define (parse-many parser) - "Create a parser that uses PARSER as many times as possible until it -fails and return the results of each successful parse in a list. This -parser always succeeds." - (lambda (stream) - (let loop ((stream stream) - (results '())) - (let-values (((result remaining) (parser stream))) - (if result - (loop remaining (cons result results)) - (values (reverse results) - remaining)))))) - -(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) - (values str (stream-drop (string-length str) stream)) - (parse-fail stream))))) - -(define (parse-char-set char-set) - "Create a parser that returns a string containing a contiguous -sequence of characters that belong to CHAR-SET." - (lambda (stream) - (let loop ((stream stream) - (result '())) - (define (stringify) - (if (null? result) - (parse-fail stream) - (values (list->string (reverse result)) - stream))) - - (stream-match stream - (() (stringify)) - ((head . rest) - (if (char-set-contains? char-set head) - (loop rest (cons head result)) - (stringify))))))) - -(define parse-whitespace - (parse-char-set char-set:whitespace)) - -(define* (parse-delimited str #:key (until str) (escape #\\)) - "Create a parser that parses a delimited character sequence -beginning with the string STR and ending with the string UNTIL. -Within the sequence, ESCAPE is recognized as the escape character." - (let ((parse-str (parse-string str)) - (parse-until (parse-string until))) - - (define (stringify lst stream) - (values (list->string (reverse lst)) - stream)) - - (define (parse-until-maybe stream) - (let-values (((result remaining) (parse-until stream))) - (and result remaining))) - - (lambda (stream) - (let-values (((result remaining) (parse-str stream))) - (if result - (let loop ((stream remaining) - (result (reverse (string->list str)))) - (cond - ((stream-null? stream) - (stringify result stream)) - ;; Escape character. - ((eqv? (stream-car stream) escape) - (stream-match (stream-cdr stream) - (() (stringify result stream-null)) - ((head . rest) - (loop rest (cons* head escape result))))) - ((parse-until-maybe stream) => - (lambda (remaining) - (stringify (append (reverse (string->list until)) result) - remaining))) - (else - (loop (stream-cdr stream) (cons (stream-car stream) result))))) - (parse-fail stream)))))) - -(define (parse-regexp regexp parser) - "Create a parser that succeeds if the result of PARSER is a string -that matches the string REGEXP." - (let ((rx (make-regexp regexp))) - (parse-filter (lambda (result) - (regexp-match? (regexp-exec rx result))) - parser))) - -(define (tagged-parser tag parser) - "Create a parser that wraps the result of PARSER in a two element -list whose first element is TAG." - (parse-map (cut list tag <>) parser)) |