From caae83f445935c06cd6aef36f283a4688675278a Mon Sep 17 00:00:00 2001 From: Yves Fischer Date: Sun, 14 Aug 2016 19:25:26 +0200 Subject: refactored ebus code --- ebus-racket/3rdparty/bzlib/parseq/primitive.ss | 233 +++++++++++++++++++++++++ 1 file changed, 233 insertions(+) create mode 100644 ebus-racket/3rdparty/bzlib/parseq/primitive.ss (limited to 'ebus-racket/3rdparty/bzlib/parseq/primitive.ss') diff --git a/ebus-racket/3rdparty/bzlib/parseq/primitive.ss b/ebus-racket/3rdparty/bzlib/parseq/primitive.ss new file mode 100644 index 0000000..2fcece5 --- /dev/null +++ b/ebus-racket/3rdparty/bzlib/parseq/primitive.ss @@ -0,0 +1,233 @@ +#lang scheme/base +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PARSEQ.PLT +;; A Parser Combinator library. +;; +;; Bonzai Lab, LLC. All rights reserved. +;; +;; Licensed under LGPL. +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; primitive.ss - holds the primitive parsers... +;; yc 12/31/2009 - first version +;; yc 1/5/2010 - added literal & literal-ci +;; yc 1/18/2010 - move make-reader to reader.ss + +(require "depend.ss" + "util.ss" + "input.ss" + scheme/contract + ) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; primitive parsers + +;; return +(define (return v (size 0)) + (lambda (in) + (values v + (new-input in size)))) + +;; struct failed - represents failed parse... +(define-struct failed (pos) #:prefab) + +;; succeeded? +(define (succeeded? v) (not (failed? v))) + +;; fail - the parser that returns failed with the current port position. +(define (fail in) + (values (make-failed (input-pos in)) + in)) + +;; SOF (start-of-file) +;; returns true only when the input-pos = 0 +(define (SOF in) + ((if (= (input-pos in) 0) + (return 'sof) + fail) in)) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; item-based primitive parsers + +;; item +;; the fundamental building block +(define (item peek isa? satisfy? size) + (lambda (in) + (let ((v (peek in))) + ((if (and (isa? v) (satisfy? v)) + (return v (size v)) + fail) in)))) + +;; bytes= +;; parses if the next part of the input matches the exact bytes +(define (bytes= bytes) + (let ((size (bytes-length bytes))) + (item (peek-bytes* size) + bytes? + (lambda (b) + (bytes=? b bytes)) + (the-number size)))) + +;; string= +;; parses if the next part of the input matches the exact string +(define (string= s (comp? string=?)) + (let ((size (string-bytes/utf-8-length s))) + (item (peek-string* size) + string? + (lambda (str) + (comp? str s)) + (the-number size)))) + +(define (string-ci= s) + (string= s string-ci=?)) + +;; byte-when +;; return the next byte when satisfy matches +(define (byte-when satisfy? (isa? byte?) (size (the-number 1))) + (item peek-byte* isa? satisfy? size)) + +;; any-byte +;; return the next byte +(define any-byte (byte-when identity)) + +;; byte= +(define (byte= b) (byte-when (lambda (v) + (= b v)))) + +;; EOF +;; return if the next byte is eof +(define EOF (byte-when identity eof-object? (the-number 0))) + +;; bits= +;; matches a byte @ the bits level... (pass in the individual bits) +(define (bits= bits) + (byte-when (lambda (b) (= b (bits->byte bits))))) + +;; byte-in +(define (byte-in bytes) + (byte-when (lambda (b) (member b bytes)))) + +(define (byte-not-in bytes) + (byte-when (lambda (b) (not (member b bytes))))) + +(define (byte-between lb hb) + (byte-when (lambda (b) (<= lb b hb)))) + +(define (byte-not-between lb hb) + (byte-when (compose not (lambda (b) (<= lb b hb))))) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; character-based parsers + +;; char-when +;; the fundamental character-based parser +(define (char-when satisfy?) + (item peek-char* char? satisfy? char-utf-8-length)) + +;; any-char +;; return the next character +(define any-char (char-when identity)) + +;; char= +;; return the next character if it equals c +(define (char= c (comp? char=?) (trans identity)) + (char-when (lambda (v) (trans (comp? c v))))) + +;; char-ci= +(define (char-ci= c) (char= c char-ci=?)) + +;; char-not +;; return the next character if it is not c +(define (char-not= c (comp? char=?)) (char= c comp? not)) + +;; char-ci-not +(define (char-ci-not= c) (char-not= char-ci=?)) + +;; char-between +;; return the next character if it falls in between lc & hc +(define (char-between lc hc (comp? char<=?) (trans identity)) + (char-when (lambda (v) (trans (comp? lc v hc))))) + +;; char-ci-between +(define (char-ci-between lc hc) (char-between lc hc char-ci<=?)) + +(define (char-not-between lc hc (comp? char<=?)) + (char-between lc hc comp? not)) + +;; char-ci-not-between +(define (char-ci-not-between lc hc) (char-not-between lc hc char-ci<=?)) + +;; char-in +;; return the next character if it one of the chars +(define (char-in chars (comp? char=?) (trans identity)) + (char-when (lambda (v) + (trans (memf (lambda (c) + (comp? c v)) + chars))))) + +;; char-ci-in +(define (char-ci-in chars) (char-in chars char-ci=?)) + +;; char-not-in +;; return the next character if it is not one of the characters +(define (char-not-in chars (comp? char=?)) (char-in chars comp? not)) + +;; char-ci-not-in +(define (char-ci-not-in chars) (char-not-in chars char-ci=?)) + +;; literal +;; returns a parser based on the passed in literal +(define (literal p) + (cond ((char? p) (char= p)) + ((byte? p) (byte= p)) + ((string? p) (string= p)) + ((bytes? p) (bytes= p)) + (else p))) + +;; literal-ci +;; a ci version of literal +(define (literal-ci p) + (cond ((char? p) (char-ci= p)) + ((string? p) (string-ci= p)) + (else (literal p)))) + +(define Literal/c (or/c string? bytes? char? byte?)) + +(define Literal-Parser/c (or/c Literal/c Parser/c)) + +(provide return + (struct-out failed) + succeeded? + fail + SOF + item + bytes= + string= + string-ci= + byte-when + any-byte + byte= + EOF + bits= + byte-in + byte-not-in + byte-between + byte-not-between + char-when + any-char + char= + char-ci= + char-not= + char-ci-not= + char-between + char-ci-between + char-not-between + char-ci-not-between + char-in + char-ci-in + char-not-in + char-ci-not-in + literal + literal-ci + Literal/c + Literal-Parser/c + ) -- cgit v1.2.1