[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/peg b8a3736: * peg-tests.el: New file. Move tests and e
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/peg b8a3736: * peg-tests.el: New file. Move tests and examples to it |
|
Date: |
Mon, 11 Mar 2019 10:02:04 -0400 (EDT) |
branch: externals/peg
commit b8a37360d8586e25688fe17009acd222172489dd
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* peg-tests.el: New file. Move tests and examples to it
* peg.el (normalize) <replace>: Silence compiler warning.
(peg-stack): Give it a default value to silence compiler warnings.
(peg-parse-string): Fix typo caught by compiler warning.
* ChangeLog: Remove.
---
ChangeLog | 133 ------------------------
peg-tests.el | 323 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
peg.el | 308 +-------------------------------------------------------
3 files changed, 328 insertions(+), 436 deletions(-)
diff --git a/ChangeLog b/ChangeLog
deleted file mode 100644
index 949332a..0000000
--- a/ChangeLog
+++ /dev/null
@@ -1,133 +0,0 @@
-2014-10-22 Helmut Eller <address@hidden>
-
- * peg.el (merge-error): Add a method for (NOT X).
-
-2009-11-04 Helmut Eller <address@hidden>
-
- Add some error reporting. If a parse fails, move to the
- right-most position and show the alternatives for that position.
-
- Also only return a signle value: the stack. Failures are
- signalled with an error. To avoid signalling errors you can add a
- rule which matches everything but indicates failure in some other
- way e.g. by setting a global variable.
-
- * peg.el (peg-errors): New variable.
- (peg-translate-rules): Use it. Also raise errors at the
- right-most point of failure.
- (peg-translate-exp): Record failures.
- (peg-record-failure): New function.
- (peg-merge-errors): Used for error reporting.
- (peg-postprocess): Just return the stack. Errors can be indicated
- by leaving something on the stack.
- (peg-parse-string): Add a NOERROR argument. Hopefully more in
- line with string-match. Update tests accordingly.
-
-2009-03-06 Helmut Eller <address@hidden>
-
- * peg.el (peg-ex-arith): Minor cleanups.
-
-2009-03-06 Helmut Eller <address@hidden>
-
- Introduce an operator to match string literals.
-
- * peg.el (translate =): Add = operator.
- (peg-ex-split): Example use.
-
-2008-12-22 Helmut Eller <address@hidden>
-
- Fix typo.
-
-2008-12-21 Helmut Eller <address@hidden>
-
- Version 0.5 for savannah.
-
-2008-12-18 Helmut Eller <address@hidden>
-
- Remove *list op.
-
-2008-12-17 Helmut Eller <address@hidden>
-
- Bump version number to 0.4.
-
-2008-12-17 Helmut Eller <address@hidden>
-
- Add some more operators for actions.
- list: Factored out of *list. Collects all items on the stack.
- region: New. Pushes start and end.
- replaces: Replaces match.
-
-2008-12-17 Helmut Eller <address@hidden>
-
- Fix normalizer for \`: Push values in left-to-right order.
- peg-postprocess: turn positions in to markers to
- support replacement ops in the actions.
-
-2008-12-01 Helmut Eller <address@hidden>
-
- (peg-ex-lisp): Minor change to allow comments in more places.
-
-2008-12-01 Helmut Eller <address@hidden>
-
- (peg-ex-uri): Fix some stack actions so that the file: example works.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Remove dups from char sets to avoid clashes with [:CLASS:] syntax.
- There's still no way to include syntax classes in charsets. There
- really should be.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Handle ^ in charsets.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Use (declare (indent )) again. Emacs 21 compatibility is to hard
- due to broken ,@ or something.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Don't use (declare (indent 3)) because that doesn' work in Emacs 21.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Fix minor spelling error.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Fix range translator: we need to check for eob.
- Thanks to Hugo Schmitt.
-
-2008-11-28 Helmut Eller <address@hidden>
-
- Make file byte-compileable in Emacs 22.
-
-2008-11-27 Helmut Eller <address@hidden>
-
- Add mini test suite
- Restore subtring operator.
- Add translate method for <fail>.
-
-2008-11-27 Helmut Eller <address@hidden>
-
- Add *list operator.
-
-2008-11-08 Helmut Eller <address@hidden>
-
- More friendly syntax for character sets.
- For example (set A-Z 0-9 "_!-" ?%).
- [A-Z] is now the same as (set A-Z) which should look familiar.
-
- Fix bug in *-loops. We must backtrack.
-
- Add somewhat bigger examples to parse URIs and Lisp-style Sexps.
-
-2008-11-06 Helmut Eller <address@hidden>
-
- Detect infinite loops.
- Use a single peg-add-method macro for all gfs.
-
-2008-11-06 Helmut Eller <address@hidden>
-
- Add peg.el.
diff --git a/peg-tests.el b/peg-tests.el
new file mode 100644
index 0000000..8d1e1d5
--- /dev/null
+++ b/peg-tests.el
@@ -0,0 +1,323 @@
+;;; peg-tests.el --- Tests of PEG parsers -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests and examples, that used to live in peg.el wrapped inside an `eval'.
+
+;;; Code:
+
+(require 'peg)
+(require 'ert)
+
+;;; Tests:
+
+(defun peg-test ()
+ (interactive)
+ (cl-assert (peg-parse-string ((s "a")) "a" t))
+ (cl-assert (not (peg-parse-string ((s "a")) "b" t)))
+ (cl-assert (peg-parse-string ((s (not "a"))) "b" t))
+ (cl-assert (not (peg-parse-string ((s (not "a"))) "a" t)))
+ (cl-assert (peg-parse-string ((s (if "a"))) "a" t))
+ (cl-assert (not (peg-parse-string ((s (if "a"))) "b" t)))
+ (cl-assert (peg-parse-string ((s "ab")) "ab" t))
+ (cl-assert (not (peg-parse-string ((s "ab")) "ba" t)))
+ (cl-assert (not (peg-parse-string ((s "ab")) "a" t)))
+ (cl-assert (peg-parse-string ((s (range ?0 ?9))) "0" t))
+ (cl-assert (not (peg-parse-string ((s (range ?0 ?9))) "a" t)))
+ (cl-assert (peg-parse-string ((s [0-9])) "0" t))
+ (cl-assert (not (peg-parse-string ((s [0-9])) "a" t)))
+ (cl-assert (not (peg-parse-string ((s [0-9])) "" t)))
+ (cl-assert (peg-parse-string ((s (any))) "0" t))
+ (cl-assert (not (peg-parse-string ((s (any))) "" t)))
+ (cl-assert (peg-parse-string ((s (eob))) "" t))
+ (cl-assert (peg-parse-string ((s (not (eob)))) "a" t))
+ (cl-assert (peg-parse-string ((s (or "a" "b"))) "a" t))
+ (cl-assert (peg-parse-string ((s (or "a" "b"))) "b" t))
+ (cl-assert (not (peg-parse-string ((s (or "a" "b"))) "c" t)))
+ (cl-assert (peg-parse-string ((s (and "a" "b"))) "ab" t))
+ (cl-assert (peg-parse-string ((s (and "a" "b"))) "abc" t))
+ (cl-assert (not (peg-parse-string ((s (and "a" "b"))) "ba" t)))
+ (cl-assert (peg-parse-string ((s (and "a" "b" "c"))) "abc" t))
+ (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "b" t))
+ (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "ab" t))
+ (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "aaab" t))
+ (cl-assert (not (peg-parse-string ((s (* "a") "b" (eob))) "abc" t)))
+ (cl-assert (peg-parse-string ((s "")) "abc" t))
+ (cl-assert (peg-parse-string ((s "" (eob))) "" t))
+ (cl-assert (peg-parse-string ((s (opt "a") "b")) "abc" t))
+ (cl-assert (peg-parse-string ((s (opt "a") "b")) "bc" t))
+ (cl-assert (not (peg-parse-string ((s (or))) "ab" t)))
+ (cl-assert (peg-parse-string ((s (and))) "ab" t))
+ (cl-assert (peg-parse-string ((s (and))) "" t))
+ (cl-assert (peg-parse-string ((s ["^"])) "^" t))
+ (cl-assert (peg-parse-string ((s ["^a"])) "a" t))
+ (cl-assert (peg-parse-string ((s ["-"])) "-" t))
+ (cl-assert (peg-parse-string ((s ["]-"])) "]" t))
+ (cl-assert (peg-parse-string ((s ["^]"])) "^" t))
+ (cl-assert (peg-parse-string ((s [alpha])) "z" t))
+ (cl-assert (not (peg-parse-string ((s [alpha])) "0" t)))
+ (cl-assert (not (peg-parse-string ((s [alpha])) "" t)))
+ (cl-assert (not (peg-parse-string ((s ["][:alpha:]"])) "z" t)))
+ (cl-assert (peg-parse-string ((s (bob))) "" t))
+ (cl-assert (peg-parse-string ((s (bos))) "x" t))
+ (cl-assert (not (peg-parse-string ((s (bos))) " x" t)))
+ (cl-assert (peg-parse-string ((s "x" (eos))) "x" t))
+ (cl-assert (peg-parse-string ((s (syntax-class whitespace))) " " t))
+ (cl-assert (peg-parse-string ((s (= "foo"))) "foo" t))
+ (cl-assert (let ((f "foo")) (peg-parse-string ((s (= f))) "foo" t)))
+ (cl-assert (not (peg-parse-string ((s (= "foo"))) "xfoo" t)))
+ (cl-assert (equal (peg-parse-string ((s `(-- 1 2))) "") '(2 1)))
+ (cl-assert (equal (peg-parse-string ((s `(-- 1 2) `(a b -- a b))) "") '(2
1)))
+ (cl-assert (equal (peg-parse-string ((s (or (and (any) s)
+ (substring [0-9]))))
+ "ab0cd1ef2gh")
+ '("2")))
+ (cl-assert (equal (peg-parse-string ((s (list x y))
+ (x `(-- 1))
+ (y `(-- 2)))
+ "")
+ '((1 2))))
+ (cl-assert (equal (peg-parse-string ((s (list (* x)))
+ (x "x" `(-- 'x)))
+ "xxx")
+ '((x x x))))
+ (cl-assert (equal (peg-parse-string ((s (region (* x)))
+ (x "x" `(-- 'x)))
+ "xxx")
+ ;; FIXME: Since string positions start at 0, this should
+ ;; really be '(3 x x x 0) !!
+ '(4 x x x 1)))
+ (cl-assert (equal (peg-parse-string ((s (region (list (* x))))
+ (x "x" `(-- 'x 'y)))
+ "xxx")
+ '(4 (x y x y x y) 1)))
+ (cl-assert (equal (with-temp-buffer
+ (save-excursion (insert "abcdef"))
+ (list
+ (peg-parse (x "a"
+ (replace "bc" "x")
+ (replace "de" "y")
+ "f"))
+ (buffer-string)))
+ '(nil "axyf")))
+ )
+
+(peg-test)
+
+;;; Examples:
+
+;; peg-ex-recognize-int recognizes integers. An integer begins with a
+;; optional sign, then follows one or more digits. Digits are all
+;; characters from 0 to 9.
+;;
+;; Notes:
+;; 1) "" matches the empty sequence, i.e. matches without consuming
+;; input.
+;; 2) [0-9] is the character range from 0 to 9. This can also be
+;; written as (range ?0 ?9). Note that 0-9 is a symbol.
+(defun peg-ex-recognize-int ()
+ (peg-parse (number sign digit (* digit))
+ (sign (or "+" "-" ""))
+ (digit [0-9])))
+
+;; peg-ex-parse-int recognizes integers and computes the corresponding
+;; value. The grammer is the same as for `peg-ex-recognize-int'
+;; augmented with parsing actions. Unfortunaletly, the actions add
+;; quite a bit of clutter.
+;;
+;; The actions for the sign rule push -1 on the stack for a minus sign
+;; and 1 for plus or no sign.
+;;
+;; The action for the digit rule pushes the value for a single digit.
+;;
+;; The action `(a b -- (+ (* a 10) b)), takes two items from the stack
+;; and pushes the first digit times 10 added to the second digit.
+;;
+;; The action `(sign val -- (* sign val)), multiplies val with the
+;; sign (1 or -1).
+(defun peg-ex-parse-int ()
+ (peg-parse (number sign digit (* digit
+ `(a b -- (+ (* a 10) b)))
+ `(sign val -- (* sign val)))
+ (sign (or (and "+" `(-- 1))
+ (and "-" `(-- -1))
+ (and "" `(-- 1))))
+ (digit [0-9] `(-- (- (char-before) ?0)))))
+
+;; Put point after the ) and press C-x C-e
+;; (peg-ex-parse-int)-234234
+
+;; Parse arithmetic expressions and compute the result as side effect.
+(defun peg-ex-arith ()
+ (peg-parse
+ (expr _ sum eol)
+ (sum product (* (or (and "+" _ product `(a b -- (+ a b)))
+ (and "-" _ product `(a b -- (- a b))))))
+ (product value (* (or (and "*" _ value `(a b -- (* a b)))
+ (and "/" _ value `(a b -- (/ a b))))))
+ (value (or (and (substring number) `(string -- (string-to-number string)))
+ (and "(" _ sum ")" _)))
+ (number (+ [0-9]) _)
+ (_ (* [" \t"]))
+ (eol (or "\n" "\r\n" "\r"))))
+
+;; (peg-ex-arith) 1 + 2 * 3 * (4 + 5)
+;; (peg-ex-arith) 1 + 2 ^ 3 * (4 + 5) ; fails to parse
+
+;; Parse URI according to RFC 2396.
+(defun peg-ex-uri ()
+ (peg-parse
+ (URI-reference (or absoluteURI relativeURI)
+ (or (and "#" (substring fragment))
+ `(-- nil))
+ `(scheme user host port path query fragment --
+ (list :scheme scheme :user user
+ :host host :port port
+ :path path :query query
+ :fragment fragment)))
+ (absoluteURI (substring scheme) ":" (or hier-part opaque-part))
+ (hier-part ;(-- user host port path query)
+ (or net-path
+ (and `(-- nil nil nil)
+ abs-path))
+ (or (and "?" (substring query))
+ `(-- nil)))
+ (net-path "//" authority (or abs-path `(-- nil)))
+ (abs-path "/" path-segments)
+ (path-segments segment (list (* "/" segment)) `(s l -- (cons s l)))
+ (segment (substring (* pchar) (* ";" param)))
+ (param (* pchar))
+ (pchar (or unreserved escaped [":@&=+$,"]))
+ (query (* uric))
+ (fragment (* uric))
+ (relativeURI (or net-path abs-path rel-path) (opt "?" query))
+ (rel-path rel-segment (opt abs-path))
+ (rel-segment (+ unreserved escaped [";@&=+$,"]))
+ (authority (or server reg-name))
+ (server (or (and (or (and (substring userinfo) "@")
+ `(-- nil))
+ hostport)
+ `(-- nil nil nil)))
+ (userinfo (* (or unreserved escaped [";:&=+$,"])))
+ (hostport (substring host) (or (and ":" (substring port))
+ `(-- nil)))
+ (host (or hostname ipv4address))
+ (hostname (* domainlabel ".") toplabel (opt "."))
+ (domainlabel alphanum
+ (opt (* (or alphanum "-") (if alphanum))
+ alphanum))
+ (toplabel alpha
+ (* (or alphanum "-") (if alphanum))
+ alphanum)
+ (ipv4address (+ digit) "." (+ digit) "." (+ digit) "." (+ digit))
+ (port (* digit))
+ (scheme alpha (* (or alpha digit ["+-."])))
+ (reg-name (or unreserved escaped ["$,;:@&=+"]))
+ (opaque-part uric-no-slash (* uric))
+ (uric (or reserved unreserved escaped))
+ (uric-no-slash (or unreserved escaped [";?:@&=+$,"]))
+ (reserved (set ";/?:@&=+$,"))
+ (unreserved (or alphanum mark))
+ (escaped "%" hex hex)
+ (hex (or digit [A-F] [a-f]))
+ (mark (set "-_.!~*'()"))
+ (alphanum (or alpha digit))
+ (alpha (or lowalpha upalpha))
+ (lowalpha [a-z])
+ (upalpha [A-Z])
+ (digit [0-9])))
+
+;; (peg-ex-uri)http://address@hidden:8080/bar/baz.html?x=1#foo
+;; (peg-ex-uri)file:/bar/baz.html?foo=df#x
+
+;; Split STRING where SEPARATOR occurs.
+(defun peg-ex-split (string separator)
+ (peg-parse-string ((s (list (* (* sep) elt)))
+ (elt (substring (+ (not sep) (any))))
+ (sep (= separator)))
+ string))
+
+;; (peg-ex-split "-abc-cd-" "-")
+
+;; Parse a lisp style Sexp.
+;; [To keep the example short, ' and . are handled as ordinary symbol.]
+(defun peg-ex-lisp ()
+ (peg-parse
+ (sexp _ (or string list number symbol))
+ (_ (* (or [" \n\t"] comment)))
+ (comment ";" (* (not (or "\n" (eob))) (any)))
+ (string "\"" (substring (* (not "\"") (any))) "\"")
+ (number (substring (opt (set "+-")) (+ digit))
+ (if terminating)
+ `(string -- (string-to-number string)))
+ (symbol (substring (and symchar (* (not terminating) symchar)))
+ `(s -- (intern s)))
+ (symchar [a-z A-Z 0-9 "-;!#%&'*+,./:;<=>address@hidden|}~"])
+ (list "(" `(-- (cons nil nil)) `(hd -- hd hd)
+ (* sexp `(tl e -- (setcdr tl (list e)))
+ ) _ ")" `(hd _tl -- (cdr hd)))
+ (digit [0-9])
+ (terminating (or (set " \n\t();\"'") (eob)))))
+
+;; (peg-ex-lisp)
+
+;; We try to detect left recursion and report it as error.
+(defun peg-ex-left-recursion ()
+ (eval '(peg-parse (exp (or term
+ (and exp "+" exp)))
+ (term (or digit
+ (and term "*" term)))
+ (digit [0-9]))
+ t))
+
+(defun peg-ex-infinite-loop ()
+ (eval '(peg-parse (exp (* (or "x"
+ "y"
+ (action (foo))))))
+ t))
+
+;; Some efficency problems:
+
+;; Find the last digit in a string.
+;; Recursive definition with excessive stack usage.
+(defun peg-ex-last-digit (string)
+ (peg-parse-string ((s (or (and (any) s)
+ (substring [0-9]))))
+ string))
+
+;; (peg-ex-last-digit "ab0cd1ef2gh")
+;; (peg-ex-last-digit (make-string 50 ?-))
+;; (peg-ex-last-digit (make-string 1000 ?-))
+
+;; Find the last digit without recursion. Doesn't run out of stack,
+;; but probably still too inefficient for large inputs.
+(defun peg-ex-last-digit2 (string)
+ (peg-parse-string ((s `(-- nil)
+ (+ (* (not digit) (any))
+ (substring digit)
+ `(_d1 d2 -- d2)))
+ (digit [0-9]))
+ string))
+
+;; (peg-ex-last-digit2 "ab0cd1ef2gh")
+;; (peg-ex-last-digit2 (concat (make-string 500000 ?-) "8a9b"))
+;; (peg-ex-last-digit2 (make-string 500000 ?-))
+;; (peg-ex-last-digit2 (make-string 500000 ?5))
+
+(provide 'peg-tests)
+;;; peg-tests.el ends here
diff --git a/peg.el b/peg.el
index 8f238f1..7684dc2 100644
--- a/peg.el
+++ b/peg.el
@@ -375,7 +375,7 @@ Note: a PE can't \"call\" rules by name."
(stack-action (start -- (progn
(delete-region start (point))
(insert-before-markers ,replacement))))
- (stack-action (x --)))))
+ (stack-action (_ --)))))
(peg-add-method normalize quote (_form)
(error "quote is reserved for future use"))
@@ -536,7 +536,7 @@ Note: a PE can't \"call\" rules by name."
(push (cons (point) (lambda () ,form)) peg-thunks)
t))
-(defvar peg-stack)
+(defvar peg-stack nil)
(defun peg-postprocess (thunks)
"Execute \"actions\"."
(let ((peg-stack '()))
@@ -645,7 +645,8 @@ input. PATH is the list of rules that we have visited so
far."
(peg-add-method merge-error or (merged e1 e2)
(peg-merge-error e2 (peg-merge-error e1 merged)))
-(peg-add-method merge-error and (merged e1 e2)
+(peg-add-method merge-error and (merged e1 _e2)
+ ;; FIXME: Why is `e2' not used?
(peg-merge-error e1 merged))
(peg-add-method merge-error str (merged str)
@@ -694,309 +695,10 @@ resp. succeded instead of signaling an error."
,(if noerror
(let ((entry (make-symbol "entry"))
(start (caar rules)))
- `(peg-parse (entry (or (and ,start `(-- t)) ""))
+ `(peg-parse (,entry (or (and ,start `(-- t)) ""))
. ,rules))
`(peg-parse . ,rules))))
-;; We can't expand the macro at compile time, because it needs helper
-;; functions which aren't available yet. Delay the expansion to
-;; load-time (or later).
-(eval '(progn "
-(" ;<-- this stops Emacs from indenting the next form
-
-(defun peg-test ()
- (interactive)
- (cl-assert (peg-parse-string ((s "a")) "a" t))
- (cl-assert (not (peg-parse-string ((s "a")) "b" t)))
- (cl-assert (peg-parse-string ((s (not "a"))) "b" t))
- (cl-assert (not (peg-parse-string ((s (not "a"))) "a" t)))
- (cl-assert (peg-parse-string ((s (if "a"))) "a" t))
- (cl-assert (not (peg-parse-string ((s (if "a"))) "b" t)))
- (cl-assert (peg-parse-string ((s "ab")) "ab" t))
- (cl-assert (not (peg-parse-string ((s "ab")) "ba" t)))
- (cl-assert (not (peg-parse-string ((s "ab")) "a" t)))
- (cl-assert (peg-parse-string ((s (range ?0 ?9))) "0" t))
- (cl-assert (not (peg-parse-string ((s (range ?0 ?9))) "a" t)))
- (cl-assert (peg-parse-string ((s [0-9])) "0" t))
- (cl-assert (not (peg-parse-string ((s [0-9])) "a" t)))
- (cl-assert (not (peg-parse-string ((s [0-9])) "" t)))
- (cl-assert (peg-parse-string ((s (any))) "0" t))
- (cl-assert (not (peg-parse-string ((s (any))) "" t)))
- (cl-assert (peg-parse-string ((s (eob))) "" t))
- (cl-assert (peg-parse-string ((s (not (eob)))) "a" t))
- (cl-assert (peg-parse-string ((s (or "a" "b"))) "a" t))
- (cl-assert (peg-parse-string ((s (or "a" "b"))) "b" t))
- (cl-assert (not (peg-parse-string ((s (or "a" "b"))) "c" t)))
- (cl-assert (peg-parse-string ((s (and "a" "b"))) "ab" t))
- (cl-assert (peg-parse-string ((s (and "a" "b"))) "abc" t))
- (cl-assert (not (peg-parse-string ((s (and "a" "b"))) "ba" t)))
- (cl-assert (peg-parse-string ((s (and "a" "b" "c"))) "abc" t))
- (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "b" t))
- (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "ab" t))
- (cl-assert (peg-parse-string ((s (* "a") "b" (eob))) "aaab" t))
- (cl-assert (not (peg-parse-string ((s (* "a") "b" (eob))) "abc" t)))
- (cl-assert (peg-parse-string ((s "")) "abc" t))
- (cl-assert (peg-parse-string ((s "" (eob))) "" t))
- (cl-assert (peg-parse-string ((s (opt "a") "b")) "abc" t))
- (cl-assert (peg-parse-string ((s (opt "a") "b")) "bc" t))
- (cl-assert (not (peg-parse-string ((s (or))) "ab" t)))
- (cl-assert (peg-parse-string ((s (and))) "ab" t))
- (cl-assert (peg-parse-string ((s (and))) "" t))
- (cl-assert (peg-parse-string ((s ["^"])) "^" t))
- (cl-assert (peg-parse-string ((s ["^a"])) "a" t))
- (cl-assert (peg-parse-string ((s ["-"])) "-" t))
- (cl-assert (peg-parse-string ((s ["]-"])) "]" t))
- (cl-assert (peg-parse-string ((s ["^]"])) "^" t))
- (cl-assert (peg-parse-string ((s [alpha])) "z" t))
- (cl-assert (not (peg-parse-string ((s [alpha])) "0" t)))
- (cl-assert (not (peg-parse-string ((s [alpha])) "" t)))
- (cl-assert (not (peg-parse-string ((s ["][:alpha:]"])) "z" t)))
- (cl-assert (peg-parse-string ((s (bob))) "" t))
- (cl-assert (peg-parse-string ((s (bos))) "x" t))
- (cl-assert (not (peg-parse-string ((s (bos))) " x" t)))
- (cl-assert (peg-parse-string ((s "x" (eos))) "x" t))
- (cl-assert (peg-parse-string ((s (syntax-class whitespace))) " " t))
- (cl-assert (peg-parse-string ((s (= "foo"))) "foo" t))
- (cl-assert (let ((f "foo")) (peg-parse-string ((s (= f))) "foo" t)))
- (cl-assert (not (peg-parse-string ((s (= "foo"))) "xfoo" t)))
- (cl-assert (equal (peg-parse-string ((s `(-- 1 2))) "") '(2 1)))
- (cl-assert (equal (peg-parse-string ((s `(-- 1 2) `(a b -- a b))) "") '(2
1)))
- (cl-assert (equal (peg-parse-string ((s (or (and (any) s)
- (substring [0-9]))))
- "ab0cd1ef2gh")
- '("2")))
- (cl-assert (equal (peg-parse-string ((s (list x y))
- (x `(-- 1))
- (y `(-- 2)))
- "")
- '((1 2))))
- (cl-assert (equal (peg-parse-string ((s (list (* x)))
- (x "x" `(-- 'x)))
- "xxx")
- '((x x x))))
- (cl-assert (equal (peg-parse-string ((s (region (* x)))
- (x "x" `(-- 'x)))
- "xxx")
- ;; FIXME: Since string positions start at 0, this should
- ;; really be '(3 x x x 0) !!
- '(4 x x x 1)))
- (cl-assert (equal (peg-parse-string ((s (region (list (* x))))
- (x "x" `(-- 'x 'y)))
- "xxx")
- '(4 (x y x y x y) 1)))
- (cl-assert (equal (with-temp-buffer
- (save-excursion (insert "abcdef"))
- (list
- (peg-parse (x "a"
- (replace "bc" "x")
- (replace "de" "y")
- "f"))
- (buffer-string)))
- '(nil "axyf")))
- )
-
-(peg-test)
-
-;;; Examples:
-
-;; peg-ex-recognize-int recognizes integers. An integer begins with a
-;; optional sign, then follows one or more digits. Digits are all
-;; characters from 0 to 9.
-;;
-;; Notes:
-;; 1) "" matches the empty sequence, i.e. matches without consuming
-;; input.
-;; 2) [0-9] is the character range from 0 to 9. This can also be
-;; written as (range ?0 ?9). Note that 0-9 is a symbol.
-(defun peg-ex-recognize-int ()
- (peg-parse (number sign digit (* digit))
- (sign (or "+" "-" ""))
- (digit [0-9])))
-
-;; peg-ex-parse-int recognizes integers and computes the corresponding
-;; value. The grammer is the same as for `peg-ex-recognize-int'
-;; augmented with parsing actions. Unfortunaletly, the actions add
-;; quite a bit of clutter.
-;;
-;; The actions for the sign rule push -1 on the stack for a minus sign
-;; and 1 for plus or no sign.
-;;
-;; The action for the digit rule pushes the value for a single digit.
-;;
-;; The action `(a b -- (+ (* a 10) b)), takes two items from the stack
-;; and pushes the first digit times 10 added to the second digit.
-;;
-;; The action `(sign val -- (* sign val)), multiplies val with the
-;; sign (1 or -1).
-(defun peg-ex-parse-int ()
- (peg-parse (number sign digit (* digit
- `(a b -- (+ (* a 10) b)))
- `(sign val -- (* sign val)))
- (sign (or (and "+" `(-- 1))
- (and "-" `(-- -1))
- (and "" `(-- 1))))
- (digit [0-9] `(-- (- (char-before) ?0)))))
-
-;; Put point after the ) and press C-x C-e
-;; (peg-ex-parse-int)-234234
-
-;; Parse arithmetic expressions and compute the result as side effect.
-(defun peg-ex-arith ()
- (peg-parse
- (expr _ sum eol)
- (sum product (* (or (and "+" _ product `(a b -- (+ a b)))
- (and "-" _ product `(a b -- (- a b))))))
- (product value (* (or (and "*" _ value `(a b -- (* a b)))
- (and "/" _ value `(a b -- (/ a b))))))
- (value (or (and (substring number) `(string -- (string-to-number string)))
- (and "(" _ sum ")" _)))
- (number (+ [0-9]) _)
- (_ (* [" \t"]))
- (eol (or "\n" "\r\n" "\r"))))
-
-;; (peg-ex-arith) 1 + 2 * 3 * (4 + 5)
-;; (peg-ex-arith) 1 + 2 ^ 3 * (4 + 5) ; fails to parse
-
-;; Parse URI according to RFC 2396.
-(defun peg-ex-uri ()
- (peg-parse
- (URI-reference (or absoluteURI relativeURI)
- (or (and "#" (substring fragment))
- `(-- nil))
- `(scheme user host port path query fragment --
- (list :scheme scheme :user user
- :host host :port port
- :path path :query query
- :fragment fragment)))
- (absoluteURI (substring scheme) ":" (or hier-part opaque-part))
- (hier-part ;(-- user host port path query)
- (or net-path
- (and `(-- nil nil nil)
- abs-path))
- (or (and "?" (substring query))
- `(-- nil)))
- (net-path "//" authority (or abs-path `(-- nil)))
- (abs-path "/" path-segments)
- (path-segments segment (list (* "/" segment)) `(s l -- (cons s l)))
- (segment (substring (* pchar) (* ";" param)))
- (param (* pchar))
- (pchar (or unreserved escaped [":@&=+$,"]))
- (query (* uric))
- (fragment (* uric))
- (relativeURI (or net-path abs-path rel-path) (opt "?" query))
- (rel-path rel-segment (opt abs-path))
- (rel-segment (+ unreserved escaped [";@&=+$,"]))
- (authority (or server reg-name))
- (server (or (and (or (and (substring userinfo) "@")
- `(-- nil))
- hostport)
- `(-- nil nil nil)))
- (userinfo (* (or unreserved escaped [";:&=+$,"])))
- (hostport (substring host) (or (and ":" (substring port))
- `(-- nil)))
- (host (or hostname ipv4address))
- (hostname (* domainlabel ".") toplabel (opt "."))
- (domainlabel alphanum
- (opt (* (or alphanum "-") (if alphanum))
- alphanum))
- (toplabel alpha
- (* (or alphanum "-") (if alphanum))
- alphanum)
- (ipv4address (+ digit) "." (+ digit) "." (+ digit) "." (+ digit))
- (port (* digit))
- (scheme alpha (* (or alpha digit ["+-."])))
- (reg-name (or unreserved escaped ["$,;:@&=+"]))
- (opaque-part uric-no-slash (* uric))
- (uric (or reserved unreserved escaped))
- (uric-no-slash (or unreserved escaped [";?:@&=+$,"]))
- (reserved (set ";/?:@&=+$,"))
- (unreserved (or alphanum mark))
- (escaped "%" hex hex)
- (hex (or digit [A-F] [a-f]))
- (mark (set "-_.!~*'()"))
- (alphanum (or alpha digit))
- (alpha (or lowalpha upalpha))
- (lowalpha [a-z])
- (upalpha [A-Z])
- (digit [0-9])))
-
-;; (peg-ex-uri)http://address@hidden:8080/bar/baz.html?x=1#foo
-;; (peg-ex-uri)file:/bar/baz.html?foo=df#x
-
-;; Split STRING where SEPARATOR occurs.
-(defun peg-ex-split (string separator)
- (peg-parse-string ((s (list (* (* sep) elt)))
- (elt (substring (+ (not sep) (any))))
- (sep (= separator)))
- string))
-
-;; (peg-ex-split "-abc-cd-" "-")
-
-;; Parse a lisp style Sexp.
-;; [To keep the example short, ' and . are handled as ordinary symbol.]
-(defun peg-ex-lisp ()
- (peg-parse
- (sexp _ (or string list number symbol))
- (_ (* (or [" \n\t"] comment)))
- (comment ";" (* (not (or "\n" (eob))) (any)))
- (string "\"" (substring (* (not "\"") (any))) "\"")
- (number (substring (opt (set "+-")) (+ digit))
- (if terminating)
- `(string -- (string-to-number string)))
- (symbol (substring (and symchar (* (not terminating) symchar)))
- `(s -- (intern s)))
- (symchar [a-z A-Z 0-9 "-;!#%&'*+,./:;<=>address@hidden|}~"])
- (list "(" `(-- (cons nil nil)) `(hd -- hd hd)
- (* sexp `(tl e -- (setcdr tl (list e)))
- ) _ ")" `(hd tl -- (cdr hd)))
- (digit [0-9])
- (terminating (or (set " \n\t();\"'") (eob)))))
-
-;; (peg-ex-lisp)
-
-;; We try to detect left recursion and report it as error.
-(defun peg-ex-left-recursion ()
- (eval '(peg-parse (exp (or term
- (and exp "+" exp)))
- (term (or digit
- (and term "*" term)))
- (digit [0-9]))))
-
-(defun peg-ex-infinite-loop ()
- (eval '(peg-parse (exp (* (or "x"
- "y"
- (action (foo))))))))
-
-;; Some efficency problems:
-
-;; Find the last digit in a string.
-;; Recursive definition with excessive stack usage.
-(defun peg-ex-last-digit (string)
- (peg-parse-string ((s (or (and (any) s)
- (substring [0-9]))))
- string))
-
-;; (peg-ex-last-digit "ab0cd1ef2gh")
-;; (peg-ex-last-digit (make-string 50 ?-))
-;; (peg-ex-last-digit (make-string 1000 ?-))
-
-;; Find the last digit without recursion. Doesn't run out of stack,
-;; but probably still too inefficient for large inputs.
-(defun peg-ex-last-digit2 (string)
- (peg-parse-string ((s `(-- nil)
- (+ (* (not digit) (any))
- (substring digit)
- `(d1 d2 -- d2)))
- (digit [0-9]))
- string))
-
-;; (peg-ex-last-digit2 "ab0cd1ef2gh")
-;; (peg-ex-last-digit2 (concat (make-string 500000 ?-) "8a9b"))
-;; (peg-ex-last-digit2 (make-string 500000 ?-))
-;; (peg-ex-last-digit2 (make-string 500000 ?5))
-
-) t) ; end of eval-when-load
-
(provide 'peg)
;;; peg.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/peg b8a3736: * peg-tests.el: New file. Move tests and examples to it,
Stefan Monnier <=