summaryrefslogtreecommitdiff
path: root/ebus-racket/3rdparty/bzlib/parseq/example
diff options
context:
space:
mode:
Diffstat (limited to 'ebus-racket/3rdparty/bzlib/parseq/example')
-rw-r--r--ebus-racket/3rdparty/bzlib/parseq/example/calc.ss51
-rw-r--r--ebus-racket/3rdparty/bzlib/parseq/example/csv.ss42
-rw-r--r--ebus-racket/3rdparty/bzlib/parseq/example/json.ss135
-rw-r--r--ebus-racket/3rdparty/bzlib/parseq/example/regex.ss163
-rw-r--r--ebus-racket/3rdparty/bzlib/parseq/example/sql.ss138
5 files changed, 529 insertions, 0 deletions
diff --git a/ebus-racket/3rdparty/bzlib/parseq/example/calc.ss b/ebus-racket/3rdparty/bzlib/parseq/example/calc.ss
new file mode 100644
index 0000000..35ada60
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/parseq/example/calc.ss
@@ -0,0 +1,51 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PARSEQ.PLT
+;; A Parser Combinator library.
+;;
+;; Bonzai Lab, LLC. All rights reserved.
+;;
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; calc.ss - a simple arithmetic calculator
+;; yc 12/31/2009 - first version
+(require "../main.ss"
+ )
+
+;; determine the operator (currently there are no precedences)...
+(define OP (tokens op <- (char-in '(#\+ #\- #\* #\/))
+ (return (case op
+ ((#\+) +)
+ ((#\-) -)
+ ((#\*) *)
+ ((#\/) /)))))
+
+(define NUMBER (token real-number))
+
+;; expr := term op term
+(define expr (tokens lhs <- term
+ (let loop ((lhs lhs))
+ (choice (tokens opr <- OP
+ rhs <- term
+ (loop (list opr lhs rhs)))
+ (return lhs)))))
+;; term := factor op factor
+(define term (tokens lhs <- factor
+ (let loop ((lhs lhs))
+ (choice (tokens opr <- OP
+ rhs <- factor
+ (loop (list opr lhs rhs)))
+ (return lhs)))))
+
+;; factor := number | ( exp )
+(define factor (choice NUMBER (bracket #\( expr #\))))
+
+(define (calc in)
+ (define (helper exp)
+ (cond ((number? exp) exp)
+ ((pair? exp)
+ (apply (car exp)
+ (map helper (cdr exp))))))
+ (helper ((make-reader expr) in)))
+
+(provide calc)
diff --git a/ebus-racket/3rdparty/bzlib/parseq/example/csv.ss b/ebus-racket/3rdparty/bzlib/parseq/example/csv.ss
new file mode 100644
index 0000000..4fd1526
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/parseq/example/csv.ss
@@ -0,0 +1,42 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PARSEQ.PLT
+;; A Parser Combinator library.
+;;
+;; Bonzai Lab, LLC. All rights reserved.
+;;
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; csv.ss - a customizable csv reader
+;; yc 12/31/2009 - first version
+(require "../main.ss"
+ )
+
+;; creating a delimiter-based string.
+(define (delim-string delim)
+ (seq s <- (zero-many (choice (escaped-char #\\ delim)
+ (char-not-in (list delim #\return #\newline))))
+ (return (list->string s))))
+
+;; csv-string
+;; combine between quoted string and delimited string
+(define (csv-string delim)
+ (choice quoted-string (delim-string delim)))
+
+;; csv-record
+;; reads a list of csv-strings by skipping over the delimiters
+(define (csv-record delim)
+ (delimited (csv-string delim) (char= delim)))
+
+;; csv-table
+;; reads over a csv-table
+(define (csv-table delim)
+ (delimited (csv-record delim) newline))
+
+;; make-csv-reader
+;; creates a csv-reader based on the delim...
+(define (make-csv-reader delim)
+ (make-reader (csv-table delim)))
+
+;; contract
+(provide make-csv-reader)
diff --git a/ebus-racket/3rdparty/bzlib/parseq/example/json.ss b/ebus-racket/3rdparty/bzlib/parseq/example/json.ss
new file mode 100644
index 0000000..c8df746
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/parseq/example/json.ss
@@ -0,0 +1,135 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PARSEQ.PLT
+;; A Parser Combinator library.
+;;
+;; Bonzai Lab, LLC. All rights reserved.
+;;
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; json.ss - a parser for the json format
+;; yc 1/5/2010 - first version
+;; yc 7/76/2010 - updated json-string to handle single quotes.
+(require "../main.ss"
+ )
+
+(define hex-digit (seq d <- (choice digit #\a #\b #\c #\d #\e #\f
+ #\A #\B #\C #\D #\E #\F)
+ (return (case d
+ ((#\0) 0)
+ ((#\1) 1)
+ ((#\2) 2)
+ ((#\3) 3)
+ ((#\4) 4)
+ ((#\5) 5)
+ ((#\6) 6)
+ ((#\7) 7)
+ ((#\8) 8)
+ ((#\9) 9)
+ ((#\a #\A) 10)
+ ((#\b #\B) 11)
+ ((#\c #\C) 12)
+ ((#\d #\D) 13)
+ ((#\e #\E) 14)
+ ((#\f #\F) 15)))))
+
+(define (hex->char h)
+ (case h
+ ((0) #\0)
+ ((1) #\1)
+ ((2) #\2)
+ ((3) #\3)
+ ((4) #\4)
+ ((5) #\5)
+ ((6) #\6)
+ ((7) #\7)
+ ((8) #\8)
+ ((9) #\9)
+ ((10) #\a)
+ ((11) #\b)
+ ((12) #\c)
+ ((13) #\d)
+ ((14) #\e)
+ ((15) #\f)))
+
+
+(define (hexes->char hexes)
+ (integer->char (hexes->integer hexes)))
+
+(define (char->hexes c)
+ (integer->hexes (char->integer c)))
+
+(define (char->hex-chars c)
+ (map hex->char (char->hexes c)))
+
+(define (hexes->integer hexes)
+ (define (helper rest acc)
+ (cond ((null? rest) acc)
+ (else
+ (helper (cdr rest) (+ (* acc 16) (car rest))))))
+ (helper hexes 0))
+
+(define (integer->hexes i)
+ (define (helper q acc)
+ (if (= q 0)
+ acc
+ (let-values (((q r)
+ (quotient/remainder q 16)))
+ (helper q (cons r acc)))))
+ (helper i '()))
+
+(define unicode-char
+ (seq #\\ #\u
+ code <- (repeat hex-digit 4 4)
+ (return (hexes->char code))))
+
+(define (json-string/inner quote)
+ (zero-many (choice e-newline
+ e-return
+ e-tab
+ e-backslash
+ (escaped-char #\\ quote)
+ (escaped-char #\\ #\/)
+ (escaped-char #\\ #\\)
+ (escaped-char #\\ #\b #\backspace)
+ (escaped-char #\\ #\f #\page)
+ unicode-char
+ (char-not-in (list quote
+ #\newline
+ #\return
+ #\tab
+ #\\
+ #\backspace
+ #\page))
+ )))
+
+(define json-string
+ (choice (seq #\' atoms <- (json-string/inner #\') #\'
+ (return (list->string atoms)))
+ (seq #\" atoms <- (json-string/inner #\") #\"
+ (return (list->string atoms)))))
+
+(define json-array (tokens v <- (bracket/delimited #\[ json-value #\, #\])
+ (return (list->vector v))))
+
+(define json-object (tokens v <- (bracket/delimited #\{ json-pair #\, #\})
+ (return (make-immutable-hash v))))
+
+(define json-pair (tokens key <- (choice json-string
+ (seq c <- alpha
+ lst <- (zero-many alphanumeric)
+ (return (list->string (cons c lst)))))
+ #\:
+ value <- json-value
+ (return (cons key value))))
+
+(define json-literal (choice (tokens "true" (return #t))
+ (tokens "false" (return #f))
+ (tokens "null" (return '()))
+ ))
+
+(define json-value (choice json-literal json-array json-object real-number json-string))
+
+(define read-json (make-reader json-value))
+
+(provide read-json)
diff --git a/ebus-racket/3rdparty/bzlib/parseq/example/regex.ss b/ebus-racket/3rdparty/bzlib/parseq/example/regex.ss
new file mode 100644
index 0000000..299b999
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/parseq/example/regex.ss
@@ -0,0 +1,163 @@
+#lang scheme/base
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PARSEQ.PLT
+;; A Parser Combinator library.
+;;
+;; Bonzai Lab, LLC. All rights reserved.
+;;
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; regex.ss - a simple regular expression parser
+;; yc 1/1/2009 - first version
+(require "../main.ss"
+ mzlib/trace
+ )
+
+;; sof = start of file
+(define regex-sof (zero-one (char= #\^) #\$))
+
+;; eof = end of file
+(define regex-eof (zero-one (char= #\$) #\^))
+
+;; meta-chars - a list of meta characters
+(define regex-meta-chars '( #\. #\+ #\* #\? #\^ #\$ #\[ #\] #\( #\) #\{ #\} #\\))
+
+;; digit = \\d
+(define regex-digit (seq "\\d" (return digit)))
+
+;; not-digit = \\D
+(define regex-not-digit (seq "\\D" (return not-digit)))
+
+;; word = \\w
+(define regex-word (seq "\\w" (return word)))
+
+;; not-word = \\W
+(define regex-not-word (seq "\\W" (return not-word)))
+
+;; whitespace = \\s
+(define regex-whitespace (seq "\\s" (return whitespace)))
+
+;; not-whitespace = \\S
+(define regex-not-whitespace (seq "\\S" (return not-whitespace)))
+
+;; any-char = .
+(define regex-any-char (seq #\. (return any-char)))
+
+;; literal = \\d | \\D | \\w | \\W | \\s | \\S | . | \n | \r | \t | \\ | other chars
+(define regex-literal (choice regex-digit
+ regex-not-digit
+ regex-word
+ regex-not-word
+ regex-whitespace
+ regex-not-whitespace
+ regex-any-char
+ (seq v <- (choice e-newline
+ e-return
+ e-tab
+ (escaped-char #\\ any-char)
+ (char-not-in regex-meta-chars))
+ (return (char= v)))))
+
+;; atom = literal | group | choice
+(define regex-atom (choice regex-literal
+ regex-group
+ regex-choice
+ ))
+
+;; char-range = <lc>-<hc>, e.g., a-z
+(define regex-char-range (seq lc <- (char-not-in (cons #\- regex-meta-chars))
+ #\-
+ hc <- (char-not-in (cons #\- regex-meta-chars))
+ (return `(,char-between ,lc ,hc))))
+
+;; choice = [<char-range | literal>+]
+(define regex-choice (seq #\[
+ literals <- (one-many (choice regex-char-range
+ regex-literal))
+ #\]
+ (return `(,one-of* ,@literals))))
+
+;; group = (<atom>+)
+(define regex-group (seq #\(
+ chars <- (one-many regex-atom)
+ #\)
+ (return `(,sequence* ,@chars))))
+
+;; regex combinators
+;; zero-one = <atom>?
+(define regex-zero-one (seq v <- regex-atom
+ #\?
+ (return `(,zero-one ,v))))
+;; zero-many = <atom>*
+(define regex-zero-many (seq v <- regex-atom
+ #\*
+ (return `(,zero-many ,v))))
+
+;; one-many = <atom>+
+(define regex-one-many (seq v <- regex-atom
+ #\+
+ (return `(,one-many ,v))))
+
+;; range = <atom>{min,max} | <atom>{times}
+(define regex-range (seq v <- regex-atom
+ #\{
+ min <- (zero-one natural-number 0)
+ max <- (zero-one (seq #\,
+ max <- (zero-one natural-number +inf.0)
+ (return max))
+ min)
+ #\}
+ (return `(,repeat ,v ,min ,max))))
+
+;; exp = sof ? <zero-one | zero-many | one-many | range | atom>* eof ?
+(define regex-exp (seq SOF
+ sof <- regex-sof
+ atoms <- (zero-many (choice regex-zero-one
+ regex-zero-many
+ regex-one-many
+ regex-range
+ regex-atom
+ ))
+ eof <- regex-eof
+ EOF
+ (return `(,regex-parser* ,@(if (char=? sof #\^)
+ `(,SOF)
+ '())
+ ,@atoms
+ ,@(if (char=? eof #\$)
+ `(,EOF)
+ '())))))
+
+;; regex-parser
+;; convert the regexp into an useable parser, which including determining
+;; whether to allow for
+(define (regex-parser parsers)
+ (let ((regexp (sequence parsers)))
+ (if (eq? (car parsers) SOF)
+ regexp
+ (seq v <- (choice regexp
+ (seq any-char (regex-parser parsers)))
+ (return v)))))
+
+;; regex-parser*
+;; the variable arg form of regex-parser
+(define (regex-parser* parser . parsers)
+ (regex-parser (cons parser parsers)))
+
+;; make-regex-exp
+;; wrapper over regex...
+(define (make-regex-exp in)
+ (define (helper exp)
+ (cond ((list? exp) (apply (car exp) (map helper (cdr exp))))
+ (else exp)))
+ ;; (trace helper)
+ (let-values (((exp in)
+ (regex-exp (make-input in))))
+ (if (failed? exp)
+ (error 'make-regex-exp "the regular expression is invalid")
+ (lambda (in)
+ ((helper exp) (make-input in))))))
+
+(provide regex-parser
+ make-regex-exp
+ )
diff --git a/ebus-racket/3rdparty/bzlib/parseq/example/sql.ss b/ebus-racket/3rdparty/bzlib/parseq/example/sql.ss
new file mode 100644
index 0000000..3863ab1
--- /dev/null
+++ b/ebus-racket/3rdparty/bzlib/parseq/example/sql.ss
@@ -0,0 +1,138 @@
+#lang scheme
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PARSEQ.PLT
+;; A Parser Combinator library.
+;;
+;; Bonzai Lab, LLC. All rights reserved.
+;;
+;; Licensed under LGPL.
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; sql.ss - parsing the create table statement
+;; yc 1/5/2010 - first version
+(require "../main.ss"
+ mzlib/defmacro
+ (for-syntax scheme/base
+ scheme/match
+ )
+ (planet bzlib/base)
+ )
+
+(define sql-identifier
+ (seq c <- alpha
+ rest <- (zero-many word)
+ (return (string->symbol
+ (string-downcase (list->string (cons c rest)))))))
+
+(define create-table-def
+ (tokens-ci "create" "table"
+ name <- sql-identifier
+ clauses <- (bracket #\(
+ (delimited clause-def #\,)
+ #\))
+ (return (cons name clauses))))
+
+(define clause-def
+ (choice primary-key-def foreign-key-def column-def))
+
+;; making things without order would be quite a difficult combinator.
+;; basically we need to try each of the combinator, and then as we have the binding
+;; make sure it is returned in a way that can easily be identified...
+;; for example, the first
+(define (self-and-value parser)
+ (seq v <- parser
+ (return (cons parser v))))
+
+(define (one-of-each parsers defaults)
+ ;; we need to try each one, and then figure out the *rest* that weren't matched
+ ;; continue until we are either out of the stream or out of the combinator...
+ ;; at any time there is anything that none of them matches then we will be in trouble...
+ (define (each-helper parsers)
+ (one-of (map self-and-value parsers)))
+ (define (sort-helper acc parsers defaults)
+ (map (lambda (v default)
+ (if (pair? v)
+ (cdr v)
+ default))
+ (map (lambda (parser)
+ (assf (lambda (p)
+ (eq? p parser))
+ acc))
+ parsers)
+ defaults))
+ ;; if all of them failed @ the next position, then we need to offer
+ ;; default values for the remainder of the parsers!!!
+ ;; this is where it is *interesting!!!...
+ ;; in such case we want to have a chance to work on the *fail* clause...
+ ;; this is hmm....
+ (define (helper rest acc)
+ (bind (each-helper rest)
+ (lambda (v)
+ (if (succeeded? v)
+ (let ((rest (remove (car v) rest)))
+ (if (null? rest)
+ (return (sort-helper acc parsers defaults))
+ (helper rest (cons v acc))))
+ (return (sort-helper acc parsers defaults))))))
+ (helper parsers '()))
+
+(define-syntax one-of-each*
+ (syntax-rules ()
+ ((~ (parser default) ...)
+ (one-of-each (list parser ...) (list default ...)))))
+
+(define column-def
+ (tokens name <- sql-identifier
+ attrs <- (one-of-each* (type-def 'text)
+ (nullability 'null)
+ (inline-primary-key #f)
+ (inline-foreign-key #f))
+ (return (cons name attrs))))
+
+(define nullability
+ (choice (tokens-ci "null" (return 'null))
+ (tokens-ci "not" "null" (return 'not-null))))
+
+(define type-def
+ (seq type <- (choice (string-ci= "int")
+ (string-ci= "integer")
+ (string-ci= "float")
+ (string-ci= "text"))
+ (return (string->symbol type))))
+
+(define inline-primary-key
+ (tokens-ci "primary" "key" (return 'pkey)))
+;; (trace inline-primary-key)
+
+(define sql-identifiers/paren
+ (bracket #\( (delimited sql-identifier #\,) #\)))
+
+(define inline-foreign-key
+ (tokens-ci "foreign" "key"
+ (zero-one (string-ci= "references") "references")
+ table <- sql-identifier
+ (zero-one (string-ci= "on") "on")
+ columns <- sql-identifiers/paren
+ (return `(foreign-key ,table ,columns))))
+
+(define primary-key-def
+ (tokens-ci "primary" "key"
+ name <- (zero-one sql-identifier #f)
+ columns <- sql-identifiers/paren
+ (return `(primary-key ,name ,columns))))
+
+(define foreign-key-def
+ (tokens-ci "foreign" "key"
+ name <- (zero-one sql-identifier #f)
+ columns <- sql-identifiers/paren
+ (string-ci= "references")
+ table <- sql-identifier
+ (zero-one (string-ci= "on") "on")
+ fk-columns <- sql-identifiers/paren
+ (return `(foreign-key ,name ,columns ,table ,fk-columns))))
+
+;; (provide create-table-def)
+(define sql-def (choice create-table-def))
+
+(define read-sql (make-reader sql-def))
+
+(provide read-sql)