[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-96-g94027fe
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-96-g94027fe |
|
Date: |
Wed, 16 Jan 2013 09:31:41 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=94027fe6ec99874b1f6d1cdf1d7f31f482ecd960
The branch, master has been updated
via 94027fe6ec99874b1f6d1cdf1d7f31f482ecd960 (commit)
via fee87b821f6ed644c77cee4b3f5a02836f3d974f (commit)
via 3ebd5786160226df4dd4bb2abf610105d156653a (commit)
via 40ebbd64c4e5a9e2d330fabf1f7176e0ed584058 (commit)
via 8022f5023e2e193e208ab96492631e635ed70bc5 (commit)
via d7e2f5e3c26756de06cd3eda0db1c84bc0cfb0c0 (commit)
via ecaa261a2006a51a510c640b544350ce895fc2f3 (commit)
via e0d140251a1385ba88abd631d62e317ffab3487f (commit)
via 680f1dee0c94ddf875b9a8f1523a1dc2b72a5b32 (commit)
via cdeb5a78269c46ba5cd45bf9e82e8226bbae6cdf (commit)
via 72287411e9cd2c43afe061d2b4f07f4f7c577268 (commit)
via 66ba3de0a630f2644ca6bc2771da098c78babf45 (commit)
via 8e97edd5d3454153a459afb108e4f7cbcdcaabc7 (commit)
via 3d19969d74dcf053b0020cfc21280d831f80456b (commit)
via f310a111de79a84d595d3323573748316deb8774 (commit)
via 5c3f2da81f9d470da24d98b2414df773a340236e (commit)
via 89c3c9ecf0477cf4547aaf1b17386d76aa9897de (commit)
via 0977b03ef1231b86f9ae518b58c6a71bae6c7fc1 (commit)
via 22d4c9d99af1d3a1e5587055b5e885d25209984b (commit)
via 172ac609c4580bb73094fffaf8abee8d727d4be1 (commit)
via 94e8517c16f75466d0e1ab8f9bcf9473dd28b15f (commit)
via bbc5564c423e8a080754f822831fdf44f3799a2c (commit)
via 0afaf59982cc4e394951871183a15ad4db390dc7 (commit)
via 97c846947d51a9b89098fee809af8c35f44ba96f (commit)
via 74393a53cf15b76e74174a6c9d4015673d4474c0 (commit)
via 44bd21ae7b5f9dc424eb5c948ba077d2200d3152 (commit)
via f3f41b92266201c883ff245631ccd8513a0de213 (commit)
via 5e16c41703fd01162075c974939c7a97c632f33c (commit)
via 00923497d2b83943e642860d15a431d65340e7c8 (commit)
via 86849e2c190745a0e5f87f88db435d4cc81e3e2f (commit)
via bff3ccd957d32f70ff5c206e68cc803acc3fd00d (commit)
via 718bc349afae39247b2c19c555acb6fc718dbae9 (commit)
via c7ed2190cfb1e4a486c1180033ca1f8dd528d9f8 (commit)
via 3be2799eaf72a8c5cb516025ca023aaa5d0bcc22 (commit)
via 5041b82067515e9bc8c5f7a7f4c28d0d0497f49b (commit)
via c5b85ecebaec334068709b369ffef8c060eb2ff1 (commit)
via 63a1336de7def675b873d9c6b0702522994f00ef (commit)
via e9722ec0aae5e2bc7fb41484cff0c35bfc24d9b4 (commit)
via 102d022f5352fee8c9efae5805f2bc7d2562769b (commit)
via 67ac87f96d0e6b9eef6224a0cc5893976a8c492a (commit)
via 7b746f409017b208382021e8b5900076d6a35108 (commit)
via 990b24b2541e375357b49a22c414776f75e5aeca (commit)
via 87c3ef2f95a0038e58c91705f79d7d71e3fc5a3c (commit)
via 09a6a7a44a34e3fa9bb2d24c07a80ac256c6011e (commit)
via 49db248111e876ae0cd3163b08d2967573a15bda (commit)
via a907bce6573608288b393cf2364702ad3506805a (commit)
via bb7ff21a7702581caac5027f51c08f962e115958 (commit)
via b5ebb8abad1e8877ead643aa4d5abae765d45787 (commit)
via 3c8963de27babbb85d6ff243645658cb0b8f0756 (commit)
via 0d2f21fc81075a1a16f3f136c25873752c60b25a (commit)
via 9ca71e7b84e8a6a732740a4a375213d0d909aa25 (commit)
via 18905baf6ed70c4213c61399229d4afce0ccc161 (commit)
via ac8a071390ffbc3b2b8d553193063254d9f83e6a (commit)
via 84cb143eb4043ae1ccd735fbc6620db328d788dd (commit)
via 8e8de46ec60ee61d0b9f6a05cb5d52f55c58dbdd (commit)
via 00e227f7799de4f338670af56cb58d42001fd5a9 (commit)
via 8b52357e88b8923b159001dc209cb01b066ec33e (commit)
via febe6dadab4e85a6d794646dc80df0cdeba7259c (commit)
via 6f6c7d15a28af03f268d2dcbbb1f7c7fb0401a6d (commit)
via 0b61da75fed6cf871a0a90d34baf77ece7238605 (commit)
via 6a297af1011a7c99a35f402fa0c155fc035b8ce6 (commit)
via b987677437159c9657aa4e780ff41e8484067ba2 (commit)
via 2a88fe3046b569fb0fdc6b773fae69124c533e88 (commit)
via fe50d7ee1aa50a7d0b2154f84f4f012da2dad9fc (commit)
via ccab173a5b94a8aafb3bf1c16117fd79aca3622b (commit)
via c9a6f4befae34fbb6e32a1dc32993e77cd50d78d (commit)
via 8b38945119b87f534945406400dcc399cbe643d4 (commit)
via bce6e5d3f28c2a0878bfc75a1611a3521d076592 (commit)
via c011c0b6ef3716807b9405398222c2841dc55ec2 (commit)
via f4576d8161cdb94e9c2ea1d43ab4a0ae29cd0879 (commit)
via add20d35be22242afef5ae8635b54fa6ef0b49c0 (commit)
via eee0877c3e6ade8f2fa243cfa696918451c67aff (commit)
from 2f0db5ee96e166b1cec6bd826b64161fa335f761 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 94027fe6ec99874b1f6d1cdf1d7f31f482ecd960
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 15:08:10 2012 -0500
Remove 'define-grammar-f'
* module/ice-9/peg.scm: don't re-export 'define-grammar-f'
* module/ice-9/peg/string-peg.scm: don't export 'define-grammar-f'
commit fee87b821f6ed644c77cee4b3f5a02836f3d974f
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 15:03:13 2012 -0500
PEG Renames
* module/ice-9/peg.scm: rename 'peg-sexp-compile' to
'compile-peg-pattern'
* module/ice-9/peg/codegen.scm: same
* module/ice-9/peg/string-peg.scm: same
* module/ice-9/peg/using-parsers.scm: same
* doc/ref/api-peg.texi: same
commit 3ebd5786160226df4dd4bb2abf610105d156653a
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 14:58:35 2012 -0500
PEG Renames
* module/ice-9/peg.scm: rename 'define-grammar' to
'define-peg-string-patterns'
* module/ice-9/peg/string-peg.scm: same
* doc/ref/api-peg.texi: same
* test-suite/tests/peg.bench: same
* test-suite/tests/peg.test: same
commit 40ebbd64c4e5a9e2d330fabf1f7176e0ed584058
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 14:54:05 2012 -0500
PEG Renames
* module/ice-9/peg.scm: rename 'define-nonterm' to 'define-peg-pattern'
* module/ice-9/peg/using-parsers.scm: same
* module/ice-9/peg/string-peg.scm: same
* test-suite/tests/peg.test: same
* doc/ref/api-peg.texi: same
commit 8022f5023e2e193e208ab96492631e635ed70bc5
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 14:47:32 2012 -0500
PEG Renames
* module/ice-9/peg.scm: rename 'peg-parse' to 'match-pattern'
* module/ice-9/peg/string-peg.scm: same
* module/ice-9/peg/using-parsers.scm: same
* doc/ref/api-peg.texi: same
* test-suite/tests/peg.test: same
* test-suite/tests/peg.bench: same
commit d7e2f5e3c26756de06cd3eda0db1c84bc0cfb0c0
Author: Noah Lavine <address@hidden>
Date: Sun Jan 22 14:35:57 2012 -0500
PEG Renames
* doc/ref/api-peg.texi: rename 'peg-match' to 'search-for-pattern'
* module/ice-9/peg.scm: same
* module/ice-9/peg/using-parsers.scm: same
* test-suite/tests/peg.test: same
commit ecaa261a2006a51a510c640b544350ce895fc2f3
Author: Noah Lavine <address@hidden>
Date: Wed Sep 21 15:46:44 2011 -0400
Document PEGs at Runtime
doc/ref/api-peg.texi: suggest a cleaner method of generating PEG parsers
at runtime.
commit e0d140251a1385ba88abd631d62e317ffab3487f
Author: Noah Lavine <address@hidden>
Date: Tue Sep 20 14:44:12 2011 -0400
Update PEG Documentation
Change the PEG documentation to use the new style of s-expression PEGs.
commit 680f1dee0c94ddf875b9a8f1523a1dc2b72a5b32
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:40:28 2011 -0400
Comments in PEG
module/ice-9/peg/string-peg.scm: add comments explaining the format of some
of the parsed PEG forms.
commit cdeb5a78269c46ba5cd45bf9e82e8226bbae6cdf
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:36:06 2011 -0400
Remove 'body' PEG
module/ice-9/peg/string-peg.scm: update S-expression generators to use the
new *, +, ?, followed-by, and not-followed-by forms.
module/ice-9/peg/codegen.scm: remove the 'body' form in the PEG s-expression
representation.
commit 72287411e9cd2c43afe061d2b4f07f4f7c577268
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:33:09 2011 -0400
Add 'not-followed-by' PEG
The PEG s-expression syntax now uses '(not-followed-by ...)' instead of
'(body ! ... 1)'.
commit 66ba3de0a630f2644ca6bc2771da098c78babf45
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:30:53 2011 -0400
Add 'followed-by' PEG
The PEG s-expression syntax now uses '(followed-by ...)' instead of
'(body & ... 1)'.
commit 8e97edd5d3454153a459afb108e4f7cbcdcaabc7
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:28:35 2011 -0400
Add '?' PEG
The PEG s-expression syntax now uses '(? ...)' instead of '(body lit ...
?)'.
commit 3d19969d74dcf053b0020cfc21280d831f80456b
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:26:56 2011 -0400
Add '+' PEG
The PEG s-expression syntax now uses '(+ ...)' instead of '(body lit ...
+)'.
commit f310a111de79a84d595d3323573748316deb8774
Author: Noah Lavine <address@hidden>
Date: Mon Sep 19 10:24:56 2011 -0400
Add '*' PEG
The s-expression representation of PEG grammars now uses a '(* ...)' form
instead of '(body lit ... *)'.
commit 5c3f2da81f9d470da24d98b2414df773a340236e
Author: Noah Lavine <address@hidden>
Date: Tue Sep 6 12:14:21 2011 -0400
Clean Up PEG Codegen
* module/ice-9/peg/codegen.scm: remove unnecessary literals in
peg-sexp-compile.
commit 89c3c9ecf0477cf4547aaf1b17386d76aa9897de
Author: Noah Lavine <address@hidden>
Date: Fri Apr 15 17:04:02 2011 -0400
Make PEG Files
* module/ice-9/peg/using-parsers.scm: remove unnecessary dependency
* module/ice-9/peg.scm: add comment about string-peg dependency
* module/Makefile.scm: add PEG files to makefile
commit 0977b03ef1231b86f9ae518b58c6a71bae6c7fc1
Author: Noah Lavine <address@hidden>
Date: Fri Apr 15 16:57:11 2011 -0400
Rearrange PEG Modules
* module/ice-9/peg.scm: move code out of here
* module/ice-9/peg/match-records.scm: remove this file
* module/ice-9/peg/using-parsers.scm: make a new module with utilities for
using parsers. It contains the code from both peg.scm and
match-records.scm
* module/ice-9/peg/string-peg.scm: update to use new module
commit 22d4c9d99af1d3a1e5587055b5e885d25209984b
Author: Noah Lavine <address@hidden>
Date: Fri Apr 1 19:45:54 2011 -0400
PEG Cache Module
* module/ice-9/peg/cache.scm: add module to hold cache logic for PEG
parsers
* module/ice-9/peg.scm: move cache logic out of here
commit 172ac609c4580bb73094fffaf8abee8d727d4be1
Author: Noah Lavine <address@hidden>
Date: Thu Mar 31 17:42:36 2011 -0400
Update String PEGs
* module/ice-9/peg/string-peg.scm: use new interface for extending PEG
syntax
* module/ice-9/peg.scm: remove peg-extended-compile
commit 94e8517c16f75466d0e1ab8f9bcf9473dd28b15f
Author: Noah Lavine <address@hidden>
Date: Thu Mar 31 17:04:06 2011 -0400
Extensible PEG Syntax
* module/ice-9/peg/codegen.scm: Make the PEG syntax extensible, and
move most of the current code generators to the new interface
* doc/ref/api-peg.texi: Document PEG extensions in the PEG Internals
section of the manual
commit bbc5564c423e8a080754f822831fdf44f3799a2c
Author: Noah Lavine <address@hidden>
Date: Mon Mar 28 15:18:27 2011 -0400
Separate PEG Concerns
* module/ice-9/peg/codegen.scm: peg-sexp-compile no longer knows about
string PEGs
* module/ice-9/peg.scm: add a new function peg-extended-compile that
calls peg-sexp-compile or peg-string-compile on its argument as
appropriate
commit 0afaf59982cc4e394951871183a15ad4db390dc7
Author: Noah Lavine <address@hidden>
Date: Mon Mar 28 15:13:35 2011 -0400
Move define-nonterm
* module/ice-9/peg/string-peg.scm: remove define-nonterm and make a simpler
macro called `define-sexp-parser' to make the PEG grammar
* module/ice-9/peg.scm: move define-nonterm macro to this file
* module/ice-9/peg/codegen.scm: move code to wrap a parser result nicely to
this file, under name `wrap-parser-for-users'
commit 97c846947d51a9b89098fee809af8c35f44ba96f
Author: Noah Lavine <address@hidden>
Date: Sun Mar 6 20:24:13 2011 -0500
Document PEG Internals
* doc/ref/api-peg.texi: add a manual section about the PEG internals.
commit 74393a53cf15b76e74174a6c9d4015673d4474c0
Author: Noah Lavine <address@hidden>
Date: Sun Mar 6 00:12:37 2011 -0500
Remove eval-when
* module/ice-9/peg.scm: remove the eval-when statement
commit 44bd21ae7b5f9dc424eb5c948ba077d2200d3152
Author: Noah Lavine <address@hidden>
Date: Sun Mar 6 00:09:16 2011 -0500
Factor PEG Structure
* modules/ice-9/peg.scm: remove the part that defines a match structure
* modules/ice-9/peg/match-record.scm: and put it here
commit f3f41b92266201c883ff245631ccd8513a0de213
Author: Noah Lavine <address@hidden>
Date: Sun Mar 6 00:02:27 2011 -0500
Factor PEG Functions
* module/ice-9/peg.scm: take out the functions for simplifying trees
* module/ice-9/peg/simplify-tree.scm: and put them here
commit 5e16c41703fd01162075c974939c7a97c632f33c
Author: Noah Lavine <address@hidden>
Date: Sat Mar 5 23:54:50 2011 -0500
Separate PEG Strings
* module/ice-9/peg.scm: remove functions dealing with PEGs as strings
* module/ice-9/peg/string-peg.scm: and put them here
commit 00923497d2b83943e642860d15a431d65340e7c8
Author: Noah Lavine <address@hidden>
Date: Sat Mar 5 22:37:11 2011 -0500
Make Macros Hygienic
* modules/ice-9/peg.scm: convert the unhygienic macros that generate code
for string PEGs to use hygiene.
commit 86849e2c190745a0e5f87f88db435d4cc81e3e2f
Author: Noah Lavine <address@hidden>
Date: Sat Mar 5 16:23:05 2011 -0500
Rename in peg.scm
* module/ice-9/peg.scm: rename peg-parse-* functions to avoid confusion
with what PEGs do.
commit bff3ccd957d32f70ff5c206e68cc803acc3fd00d
Author: Noah Lavine <address@hidden>
Date: Sat Mar 5 15:23:59 2011 -0500
Split peg.scm
* module/ice-9/peg.scm: move code generators to new module
* module/ice-9/peg/codegen.scm: new module for PEG code generators
commit 718bc349afae39247b2c19c555acb6fc718dbae9
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 22:35:22 2011 +0100
reformat and reflow api-peg.texi
* doc/ref/api-peg.texi: Reformat and reflow.
commit c7ed2190cfb1e4a486c1180033ca1f8dd528d9f8
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 21:28:49 2011 +0100
peg: remove error-val
* module/ice-9/peg.scm (error-val): Remove needless definition.
commit 3be2799eaf72a8c5cb516025ca023aaa5d0bcc22
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 21:27:36 2011 +0100
peg: refactor peg-sexp-compile to operate on syntax directly
* module/ice-9/peg.scm (cg-generic-ret): Remove unused for-syntax
argument.
(peg-sexp-compile): Take the pattern as syntax directly, and use
syntax-case to destructure it and dispatch to the code generators.
(cg-and, cg-and-int, cg-or, cg-or-int): Refactor to operate on syntax
instead of on s-expressions.
(cg-body): Likewise; though this was a larger refactor.
(define-nonterm, peg-match): Adapt to peg-sexp-compile calling
convention change.
(peg-string-compile): Likewise, and just take the grammar as a syntax
object.
commit 5041b82067515e9bc8c5f7a7f4c28d0d0497f49b
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 11:33:12 2011 +0100
peg: cg-string, cg-peg-any, cg-range: remove needless for-syntax arg
* module/ice-9/peg.scm (cg-string, cg-peg-any, cg-range): Remove
unnecessary for-syntax arg.
(peg-sexp-compile): Adapt.
commit c5b85ecebaec334068709b369ffef8c060eb2ff1
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 11:31:18 2011 +0100
peg: change some instances of "match" to "pat"
* module/ice-9/peg.scm (cg-string): Rename "match" to "pat".
(peg-sexp-compile, cg-body-test, cg-body, define-nonterm): Likewise.
commit 63a1336de7def675b873d9c6b0702522994f00ef
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 11:13:39 2011 +0100
remove cggl, cg-generic-lambda
* module/ice-9/peg.scm (cg-generic-lambda, cggl): Remove these helpers,
they are no longer needed.
(cg-generic-ret): Remove optimization for particular cg- routines, as
it's no longer needed.
commit e9722ec0aae5e2bc7fb41484cff0c35bfc24d9b4
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 11:10:17 2011 +0100
peg: more cggl / cggr excisions
* module/ice-9/peg.scm (cg-peg-any): Don't use cggr.
(cg-range): Don't use cggl or cggr.
commit 102d022f5352fee8c9efae5805f2bc7d2562769b
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 11:03:26 2011 +0100
peg: cg-string does not use cggr
* module/ice-9/peg.scm (cg-string): Don't use cggr. Interesting to see
what it actually generates.
commit 67ac87f96d0e6b9eef6224a0cc5893976a8c492a
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 10:53:18 2011 +0100
peg: cg-peg-any does not use cggl
* module/ice-9/peg.scm (cg-peg-any): Don't use cggl.
commit 7b746f409017b208382021e8b5900076d6a35108
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 10:48:22 2011 +0100
peg: cg-string without cggl
* module/ice-9/peg.scm (cg-string): Refactor to not use cggl.
commit 990b24b2541e375357b49a22c414776f75e5aeca
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 10:42:13 2011 +0100
peg: cg-string improvement
* module/ice-9/peg.scm (cg-string): Use the more efficient string= with
range args, rather than string=? and substring.
commit 87c3ef2f95a0038e58c91705f79d7d71e3fc5a3c
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 10:33:03 2011 +0100
peg: helper macro docstrings
* module/ice-9/peg.scm: Convert the helper macro comments into
docstrings.
commit 09a6a7a44a34e3fa9bb2d24c07a80ac256c6011e
Author: Andy Wingo <address@hidden>
Date: Fri Feb 18 10:19:30 2011 +0100
peg: module-ref cleanup
* module/ice-9/peg.scm (cg-generic-ret, cg-and-int, cg-body-test):
Remove a few needless @ or @@ forms.
commit 49db248111e876ae0cd3163b08d2967573a15bda
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 14:09:31 2011 +0100
peg: remove get-code debugging foo
* module/ice-9/peg.scm (define-nonterm): Don't stash the code in a
symbol property.
(get-code): Remove.
commit a907bce6573608288b393cf2364702ad3506805a
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 14:06:08 2011 +0100
peg: more syntax helper cleanup
* module/ice-9/peg.scm (single-filter, push-not-null!): Use
syntax-rules, and move outside the eval-when.
commit bb7ff21a7702581caac5027f51c08f962e115958
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 13:52:37 2011 +0100
peg: else for default cond clauses, not #t
* module/ice-9/peg.scm: Change default cases of `cond' to use `else'
instead of #t.
commit b5ebb8abad1e8877ead643aa4d5abae765d45787
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 13:49:28 2011 +0100
peg; syntax helper cleanups
* module/ice-9/peg.scm (until, single?, push!): Move outside the
eval-when. Use syntax-rules, and single? is faster now.
commit 3c8963de27babbb85d6ff243645658cb0b8f0756
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 13:41:55 2011 +0100
peg: cleanups
* module/ice-9/peg.scm (until): Rename from until-works, and be
functional (and faster).
(peg-match): Adapt.
commit 0d2f21fc81075a1a16f3f136c25873752c60b25a
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 13:38:14 2011 +0100
peg: define-module cleanup
* module/ice-9/peg.scm: Fix up define-module block.
commit 9ca71e7b84e8a6a732740a4a375213d0d909aa25
Author: Noah Lavine <address@hidden>
Date: Tue Feb 1 15:15:54 2011 -0500
peg: let cleanups
* module/ice-9/peg.scm (cg-string, cg-peg-any, cg-range): Remove some
unnecessary lets.
commit 18905baf6ed70c4213c61399229d4afce0ccc161
Author: Noah Lavine <address@hidden>
Date: Tue Feb 1 10:42:50 2011 -0500
peg: remove unhygienic safe-bind, safe-bind-f
* module/ice-9/peg.scm (safe-bind, safe-bind-f): Remove.
commit ac8a071390ffbc3b2b8d553193063254d9f83e6a
Author: Noah Lavine <address@hidden>
Date: Tue Feb 1 10:41:20 2011 -0500
peg: remove unused nonhygienic expander helpers
* module/ice-9/peg.scm (cggl, cggr): Remove, and rename the cggl-syn and
cggr-syn to take their place.
commit 84cb143eb4043ae1ccd735fbc6620db328d788dd
Author: Noah Lavine <address@hidden>
Date: Tue Feb 1 10:36:08 2011 -0500
peg: more helpers returning syntax
* module/ice-9/peg.scm (cg-body, cg-body-success, cg-body-more)
(cg-body-ret): Return syntax instead of s-expressions.
commit 8e8de46ec60ee61d0b9f6a05cb5d52f55c58dbdd
Author: Noah Lavine <address@hidden>
Date: Mon Jan 31 15:08:32 2011 -0500
peg: cg-or, cg-or-int return syntax
* module/ice-9/peg.scm (cg-or, cg-or-int): Return syntax instead of
s-expressions.
(peg-sexp-compile): Adapt.
commit 00e227f7799de4f338670af56cb58d42001fd5a9
Author: Noah Lavine <address@hidden>
Date: Mon Jan 31 15:04:59 2011 -0500
peg: hygiene in cg-and, cg-and-int
* module/ice-9/peg.scm (cg-and, cg-and-int): Use cggr-syn instead of
cggr, and also return syntax now instead of s-expressions.
commit 8b52357e88b8923b159001dc209cb01b066ec33e
Author: Noah Lavine <address@hidden>
Date: Mon Jan 31 14:58:15 2011 -0500
peg: hygiene in cg-range
* module/ice-9/peg.scm (cg-range): Use cggl-syn and cggr-syn.
commit febe6dadab4e85a6d794646dc80df0cdeba7259c
Author: Noah Lavine <address@hidden>
Date: Mon Jan 31 14:56:02 2011 -0500
peg: hygiene in cg-peg-any
* module/ice-9/peg.scm (cg-peg-any): Use cggl-syn and cggr-syn.
commit 6f6c7d15a28af03f268d2dcbbb1f7c7fb0401a6d
Author: Noah Lavine <address@hidden>
Date: Mon Jan 31 14:45:32 2011 -0500
peg: more hygiene in cg-string
* module/ice-9/peg.scm (cggl-syn, cggr-syn): New functions, equivalent
to cggl and cggr except that they operate on syntax instead of
s-expressions.
(cg-string): Use them here.
commit 0b61da75fed6cf871a0a90d34baf77ece7238605
Author: Noah Lavine <address@hidden>
Date: Sun Jan 30 16:10:07 2011 -0500
peg: lower datum->syntax in cg-range case
* module/ice-9/peg.scm (cg-range): Datum->syntax here...
(peg-sexp-compile): ...instead of here.
commit 6a297af1011a7c99a35f402fa0c155fc035b8ce6
Author: Noah Lavine <address@hidden>
Date: Sun Jan 30 16:07:34 2011 -0500
peg: lower datum->syntax in cg-peg-any case
* module/ice-9/peg.scm (cg-peg-any): Datum->syntax here...
(peg-sexp-compile): ...instead of here.
commit b987677437159c9657aa4e780ff41e8484067ba2
Author: Noah Lavine <address@hidden>
Date: Sun Jan 30 16:04:36 2011 -0500
peg: lower datum->syntax in cg-string case
* module/ice-9/peg.scm (cg-string): Return syntax instead of
s-expressions.
(peg-sexp-compile): No need for datum->string in cg-string case.
commit 2a88fe3046b569fb0fdc6b773fae69124c533e88
Author: Noah Lavine <address@hidden>
Date: Sun Jan 30 15:59:52 2011 -0500
peg: peg-sexp-compile datum->syntax refactor
* module/ice-9/peg.scm (peg-sexp-compile): Push datum->syntax call
through cond expression in peg-sexp-compile. This is a preliminary
move so that I can convert the code-generating functions into
syntax-generating functions one by one.
commit fe50d7ee1aa50a7d0b2154f84f4f012da2dad9fc
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 14:12:38 2011 -0500
peg: compilers return syntax instead of s-expressions
* module/ice-9/peg.scm (peg-sexp-compile, peg-string-compile): Return
syntax instead of s-expressions.
commit ccab173a5b94a8aafb3bf1c16117fd79aca3622b
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 14:07:49 2011 -0500
peg: beginnings of hygiene
* module/ice-9/peg.scm: Pass for-syntax argument to all of the
code-generating functions.
commit c9a6f4befae34fbb6e32a1dc32993e77cd50d78d
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 13:42:32 2011 -0500
peg: more syntax-for-non-cache-case cleanups
* module/ice-9/peg.scm (syntax-for-non-cache-case): More cleanups.
commit 8b38945119b87f534945406400dcc399cbe643d4
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 13:36:41 2011 -0500
peg: clean up syntax-for-non-cache-case
* module/ice-9/peg.scm (syntax-for-non-cache-case): Cleanups.
commit bce6e5d3f28c2a0878bfc75a1611a3521d076592
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 13:30:48 2011 -0500
peg: use quasisyntax instead of safe-bind
* module/ice-9/peg.scm (syntax-for-non-cache-case): Use quasisyntax
instead of safe-bind.
commit c011c0b6ef3716807b9405398222c2841dc55ec2
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 12:55:43 2011 -0500
peg: define-nonterm returns syntax instead of s-expression
* module/ice-9/peg.scm (define-nonterm, syntax-for-non-cache-case):
Returns syntax instead of an s-expression.
commit f4576d8161cdb94e9c2ea1d43ab4a0ae29cd0879
Author: Noah Lavine <address@hidden>
Date: Sat Jan 29 12:40:37 2011 -0500
peg: split define-nonterm into two functions for better readability.
* module/ice-9/peg.scm (define-nonterm): Split for readability.
commit add20d35be22242afef5ae8635b54fa6ef0b49c0
Author: Andy Wingo <address@hidden>
Date: Thu Feb 17 13:28:37 2011 +0100
peg: add copyright header
* module/ice-9/peg.scm: Add copyright header.
commit eee0877c3e6ade8f2fa243cfa696918451c67aff
Author: Andy Wingo <address@hidden>
Date: Wed Jan 16 10:11:15 2013 +0100
add PEG parser generator
* module/ice-9/peg.scm: New file.
* module/Makefile.am: Add to build.
* doc/ref/Makefile.am:
* doc/ref/api-peg.texi:
* doc/ref/guile.texi: Add documentation for PEG parser.
* test-suite/Makefile.am:
* test-suite/tests/peg.bench:
* test-suite/tests/peg.test: Add tests, and a benchmark.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/Makefile.am | 1 +
doc/ref/api-peg.texi | 1036 ++++++++++++++++++++++++++++++++++++
doc/ref/guile.texi | 2 +
module/Makefile.am | 6 +
module/ice-9/peg.scm | 42 ++
module/ice-9/peg/cache.scm | 45 ++
module/ice-9/peg/codegen.scm | 359 +++++++++++++
module/ice-9/peg/simplify-tree.scm | 97 ++++
module/ice-9/peg/string-peg.scm | 273 ++++++++++
module/ice-9/peg/using-parsers.scm | 116 ++++
test-suite/Makefile.am | 1 +
test-suite/tests/peg.bench | 173 ++++++
test-suite/tests/peg.test | 278 ++++++++++
13 files changed, 2429 insertions(+), 0 deletions(-)
create mode 100644 doc/ref/api-peg.texi
create mode 100644 module/ice-9/peg.scm
create mode 100644 module/ice-9/peg/cache.scm
create mode 100644 module/ice-9/peg/codegen.scm
create mode 100644 module/ice-9/peg/simplify-tree.scm
create mode 100644 module/ice-9/peg/string-peg.scm
create mode 100644 module/ice-9/peg/using-parsers.scm
create mode 100644 test-suite/tests/peg.bench
create mode 100644 test-suite/tests/peg.test
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 201ab6b..54b43cd 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -46,6 +46,7 @@ guile_TEXINFOS = preface.texi \
api-foreign.texi \
api-regex.texi \
api-lalr.texi \
+ api-peg.texi \
api-languages.texi \
api-evaluation.texi \
api-memory.texi \
diff --git a/doc/ref/api-peg.texi b/doc/ref/api-peg.texi
new file mode 100644
index 0000000..0e16aab
--- /dev/null
+++ b/doc/ref/api-peg.texi
@@ -0,0 +1,1036 @@
address@hidden -*-texinfo-*-
address@hidden This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 2006, 2010, 2011
address@hidden Free Software Foundation, Inc.
address@hidden See the file guile.texi for copying conditions.
+
address@hidden PEG Parsing
address@hidden PEG Parsing
+
+Parsing Expression Grammars (PEGs) are a way of specifying formal
+languages for text processing. They can be used either for matching
+(like regular expressions) or for building recursive descent parsers
+(like lex/yacc). Guile uses a superset of PEG syntax that allows more
+control over what information is preserved during parsing.
+
+Wikipedia has a clear and concise introduction to PEGs if you want to
+familiarize yourself with the syntax:
address@hidden://en.wikipedia.org/wiki/Parsing_expression_grammar}.
+
+The module works by compiling PEGs down to lambda expressions. These
+can either be stored in variables at compile-time by the define macros
+(@code{define-peg-pattern} and @code{define-peg-string-patterns}) or calculated
+explicitly at runtime with the compile functions
+(@code{compile-peg-pattern} and @code{peg-string-compile}).
+
+They can then be used for either parsing (@code{match-pattern}) or searching
+(@code{search-for-pattern}). For convenience, @code{search-for-pattern}
+also takes pattern literals in case you want to inline a simple search
+(people often use regular expressions this way).
+
+The rest of this documentation consists of a syntax reference, an API
+reference, and a tutorial.
+
address@hidden
+* PEG Syntax Reference::
+* PEG API Reference::
+* PEG Tutorial::
+* PEG Internals::
address@hidden menu
+
address@hidden PEG Syntax Reference
address@hidden PEG Syntax Reference
+
address@hidden Normal PEG Syntax:
+
address@hidden {PEG Pattern} sequence a b
+Parses @var{a}. If this succeeds, continues to parse @var{b} from the
+end of the text parsed as @var{a}. Succeeds if both @var{a} and
address@hidden succeed.
+
address@hidden"a b"}
+
address@hidden(and a b)}
address@hidden deftp
+
address@hidden {PEG Pattern} {ordered choice} a b
+Parses @var{a}. If this fails, backtracks and parses @var{b}.
+Succeeds if either @var{a} or @var{b} succeeds.
+
address@hidden"a/b"}
+
address@hidden(or a b)}
address@hidden deftp
+
address@hidden {PEG Pattern} {zero or more} a
+Parses @var{a} as many times in a row as it can, starting each @var{a}
+at the end of the text parsed by the previous @var{a}. Always
+succeeds.
+
address@hidden"a*"}
+
address@hidden(* a)}
address@hidden deftp
+
address@hidden {PEG Pattern} {one or more} a
+Parses @var{a} as many times in a row as it can, starting each @var{a}
+at the end of the text parsed by the previous @var{a}. Succeeds if at
+least one @var{a} was parsed.
+
address@hidden"a+"}
+
address@hidden(+ a)}
address@hidden deftp
+
address@hidden {PEG Pattern} optional a
+Tries to parse @var{a}. Succeeds if @var{a} succeeds.
+
address@hidden"a?"}
+
address@hidden(? a)}
address@hidden deftp
+
address@hidden {PEG Pattern} {followed by} a
+Makes sure it is possible to parse @var{a}, but does not actually parse
+it. Succeeds if @var{a} would succeed.
+
address@hidden"&a"}
+
address@hidden(followed-by a)}
address@hidden deftp
+
address@hidden {PEG Pattern} {not followed by} a
+Makes sure it is impossible to parse @var{a}, but does not actually
+parse it. Succeeds if @var{a} would fail.
+
address@hidden"!a"}
+
address@hidden(not-followed-by a)}
address@hidden deftp
+
address@hidden {PEG Pattern} {string literal} ``abc''
+Parses the string @var{"abc"}. Succeeds if that parsing succeeds.
+
address@hidden"'abc'"}
+
address@hidden"abc"}
address@hidden deftp
+
address@hidden {PEG Pattern} {any character}
+Parses any single character. Succeeds unless there is no more text to
+be parsed.
+
address@hidden"."}
+
address@hidden
address@hidden deftp
+
address@hidden {PEG Pattern} {character class} a b
+Alternative syntax for ``Ordered Choice @var{a} @var{b}'' if @var{a} and
address@hidden are characters.
+
address@hidden"[ab]"}
+
address@hidden(or "a" "b")}
address@hidden deftp
+
address@hidden {PEG Pattern} {range of characters} a z
+Parses any character falling between @var{a} and @var{z}.
+
address@hidden"[a-z]"}
+
address@hidden(range #\a #\z)}
address@hidden deftp
+
+Example:
+
address@hidden
+"(a !b / c &d*) 'e'+"
address@hidden example
+
+Would be:
+
address@hidden
+(and
+ (or
+ (and a (not-followed-by b))
+ (and c (followed-by (* d))))
+ (+ "e"))
address@hidden lisp
+
address@hidden Extended Syntax
+
+There is some extra syntax for S-expressions.
+
address@hidden {PEG Pattern} ignore a
+Ignore the text matching @var{a}
address@hidden deftp
+
address@hidden {PEG Pattern} capture a
+Capture the text matching @var{a}.
address@hidden deftp
+
address@hidden {PEG Pattern} peg a
+Embed the PEG pattern @var{a} using string syntax.
address@hidden deftp
+
+Example:
+
address@hidden
+"!a / 'b'"
address@hidden example
+
+Is equivalent to
+
address@hidden
+(or (peg "!a") "b")
address@hidden lisp
+
+and
+
address@hidden
+(or (not-followed-by a) "b")
address@hidden lisp
+
address@hidden PEG API Reference
address@hidden PEG API Reference
+
address@hidden Define Macros
+
+The most straightforward way to define a PEG is by using one of the
+define macros (both of these macroexpand into @code{define}
+expressions). These macros bind parsing functions to variables. These
+parsing functions may be invoked by @code{match-pattern} or
address@hidden, which return a PEG match record. Raw data can be
+retrieved from this record with the PEG match deconstructor functions.
+More complicated (and perhaps enlightening) examples can be found in the
+tutorial.
+
address@hidden {Scheme Macro} define-peg-string-patterns peg-string
+Defines all the nonterminals in the PEG @var{peg-string}. More
+precisely, @code{define-peg-string-patterns} takes a superset of PEGs. A
normal PEG
+has a @code{<-} between the nonterminal and the pattern.
address@hidden uses this symbol to determine what information it
+should propagate up the parse tree. The normal @code{<-} propagates the
+matched text up the parse tree, @code{<--} propagates the matched text
+up the parse tree tagged with the name of the nonterminal, and @code{<}
+discards that matched text and propagates nothing up the parse tree.
+Also, nonterminals may consist of any alphanumeric character or a ``-''
+character (in normal PEGs nonterminals can only be alphabetic).
+
+For example, if we:
address@hidden
+(define-peg-string-patterns
+ "as <- 'a'+
+bs <- 'b'+
+as-or-bs <- as/bs")
+(define-peg-string-patterns
+ "as-tag <-- 'a'+
+bs-tag <-- 'b'+
+as-or-bs-tag <-- as-tag/bs-tag")
address@hidden lisp
+Then:
address@hidden
+(match-pattern as-or-bs "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+(match-pattern as-or-bs-tag "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: (as-or-bs-tag (as-tag aa))>
address@hidden lisp
+
+Note that in doing this, we have bound 6 variables at the toplevel
+(@var{as}, @var{bs}, @var{as-or-bs}, @var{as-tag}, @var{bs-tag}, and
address@hidden).
address@hidden deffn
+
address@hidden {Scheme Macro} define-peg-pattern name capture-type peg-sexp
+Defines a single nonterminal @var{name}. @var{capture-type} determines
+how much information is passed up the parse tree. @var{peg-sexp} is a
+PEG in S-expression form.
+
+Possible values for capture-type:
+
address@hidden @code
address@hidden all
+passes the matched text up the parse tree tagged with the name of the
+nonterminal.
address@hidden body
+passes the matched text up the parse tree.
address@hidden none
+passes nothing up the parse tree.
address@hidden table
+
+For Example, if we:
address@hidden
+(define-peg-pattern as body (+ "a"))
+(define-peg-pattern bs body (+ "b"))
+(define-peg-pattern as-or-bs body (or as bs))
+(define-peg-pattern as-tag all (+ "a"))
+(define-peg-pattern bs-tag all (+ "b"))
+(define-peg-pattern as-or-bs-tag all (or as-tag bs-tag))
address@hidden lisp
+Then:
address@hidden
+(match-pattern as-or-bs "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+(match-pattern as-or-bs-tag "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: (as-or-bs-tag (as-tag aa))>
address@hidden lisp
+
+Note that in doing this, we have bound 6 variables at the toplevel
+(@var{as}, @var{bs}, @var{as-or-bs}, @var{as-tag}, @var{bs-tag}, and
address@hidden).
address@hidden deffn
+
address@hidden Compile Functions
+It is sometimes useful to be able to compile anonymous PEG patterns at
+runtime. These functions let you do that using either syntax.
+
address@hidden {Scheme Procedure} peg-string-compile peg-string capture-type
+Compiles the PEG pattern in @var{peg-string} propagating according to
address@hidden (capture-type can be any of the values from
address@hidden).
address@hidden deffn
+
+
address@hidden {Scheme Procedure} compile-peg-pattern peg-sexp capture-type
+Compiles the PEG pattern in @var{peg-sexp} propagating according to
address@hidden (capture-type can be any of the values from
address@hidden).
address@hidden deffn
+
+The functions return syntax objects, which can be useful if you want to
+use them in macros. If all you want is to define a new nonterminal, you
+can do the following:
+
address@hidden
+(define exp '(+ "a"))
+(define as (compile (compile-peg-pattern exp 'body)))
address@hidden lisp
+
+You can use this nonterminal with all of the regular PEG functions:
+
address@hidden
+(match-pattern as "aaaaa") @result{}
+#<peg start: 0 end: 5 string: bbbbb tree: bbbbb>
address@hidden lisp
+
address@hidden Parsing & Matching Functions
+
+For our purposes, ``parsing'' means parsing a string into a tree
+starting from the first character, while ``matching'' means searching
+through the string for a substring. In practice, the only difference
+between the two functions is that @code{match-pattern} gives up if it can't
+find a valid substring starting at index 0 and @code{search-for-pattern} keeps
+looking. They are both equally capable of ``parsing'' and ``matching''
+given those constraints.
+
address@hidden {Scheme Procedure} match-pattern nonterm string
+Parses @var{string} using the PEG stored in @var{nonterm}. If no match
+was found, @code{match-pattern} returns false. If a match was found, a PEG
+match record is returned.
+
+The @code{capture-type} argument to @code{define-peg-pattern} allows you to
+choose what information to hold on to while parsing. The options are:
+
address@hidden @code
address@hidden all
+tag the matched text with the nonterminal
address@hidden body
+just the matched text
address@hidden none
+nothing
address@hidden table
+
address@hidden
+(define-peg-pattern as all (+ "a"))
+(match-pattern as "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: (as aa)>
+
+(define-peg-pattern as body (+ "a"))
+(match-pattern as "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+
+(define-peg-pattern as none (+ "a"))
+(match-pattern as "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: ()>
+
+(define-peg-pattern bs body (+ "b"))
+(match-pattern bs "aabbcc") @result{}
+#f
address@hidden lisp
address@hidden deffn
+
address@hidden {Scheme Macro} search-for-pattern nonterm-or-peg string
+Searches through @var{string} looking for a matching subexpression.
address@hidden can either be a nonterminal or a literal PEG
+pattern. When a literal PEG pattern is provided, @code{search-for-pattern}
works
+very similarly to the regular expression searches many hackers are used
+to. If no match was found, @code{search-for-pattern} returns false. If a
match
+was found, a PEG match record is returned.
+
address@hidden
+(define-peg-pattern as body (+ "a"))
+(search-for-pattern as "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+(search-for-pattern (+ "a") "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+(search-for-pattern "'a'+" "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: aa>
+
+(define-peg-pattern as all (+ "a"))
+(search-for-pattern as "aabbcc") @result{}
+#<peg start: 0 end: 2 string: aabbcc tree: (as aa)>
+
+(define-peg-pattern bs body (+ "b"))
+(search-for-pattern bs "aabbcc") @result{}
+#<peg start: 2 end: 4 string: aabbcc tree: bb>
+(search-for-pattern (+ "b") "aabbcc") @result{}
+#<peg start: 2 end: 4 string: aabbcc tree: bb>
+(search-for-pattern "'b'+" "aabbcc") @result{}
+#<peg start: 2 end: 4 string: aabbcc tree: bb>
+
+(define-peg-pattern zs body (+ "z"))
+(search-for-pattern zs "aabbcc") @result{}
+#f
+(search-for-pattern (+ "z") "aabbcc") @result{}
+#f
+(search-for-pattern "'z'+" "aabbcc") @result{}
+#f
address@hidden lisp
address@hidden deffn
+
address@hidden PEG Match Records
+The @code{match-pattern} and @code{search-for-pattern} functions both return
PEG
+match records. Actual information can be extracted from these with the
+following functions.
+
address@hidden {Scheme Procedure} peg:string match-record
+Returns the original string that was parsed in the creation of
address@hidden
address@hidden deffn
+
address@hidden {Scheme Procedure} peg:start match-record
+Returns the index of the first parsed character in the original string
+(from @code{peg:string}). If this is the same as @code{peg:end},
+nothing was parsed.
address@hidden deffn
+
address@hidden {Scheme Procedure} peg:end match-record
+Returns one more than the index of the last parsed character in the
+original string (from @code{peg:string}). If this is the same as
address@hidden:start}, nothing was parsed.
address@hidden deffn
+
address@hidden {Scheme Procedure} peg:substring match-record
+Returns the substring parsed by @code{match-record}. This is equivalent to
address@hidden(substring (peg:string match-record) (peg:start match-record)
(peg:end
+match-record))}.
address@hidden deffn
+
address@hidden {Scheme Procedure} peg:tree match-record
+Returns the tree parsed by @code{match-record}.
address@hidden deffn
+
address@hidden {Scheme Procedure} peg-record? match-record
+Returns true if @code{match-record} is a PEG match record, or false
+otherwise.
address@hidden deffn
+
+Example:
address@hidden
+(define-peg-pattern bs all (peg "'b'+"))
+
+(search-for-pattern bs "aabbcc") @result{}
+#<peg start: 2 end: 4 string: aabbcc tree: (bs bb)>
+
+(let ((pm (search-for-pattern bs "aabbcc")))
+ `((string ,(peg:string pm))
+ (start ,(peg:start pm))
+ (end ,(peg:end pm))
+ (substring ,(peg:substring pm))
+ (tree ,(peg:tree pm))
+ (record? ,(peg-record? pm)))) @result{}
+((string "aabbcc")
+ (start 2)
+ (end 4)
+ (substring "bb")
+ (tree (bs "bb"))
+ (record? #t))
address@hidden lisp
+
address@hidden Miscellaneous
+
address@hidden {Scheme Procedure} context-flatten tst lst
+Takes a predicate @var{tst} and a list @var{lst}. Flattens @var{lst}
+until all elements are either atoms or satisfy @var{tst}. If @var{lst}
+itself satisfies @var{tst}, @code{(list lst)} is returned (this is a
+flat list whose only element satisfies @var{tst}).
+
address@hidden
+(context-flatten (lambda (x) (and (number? (car x)) (= (car x) 1))) '(2 2 (1 1
(2 2)) (2 2 (1 1)))) @result{}
+(2 2 (1 1 (2 2)) 2 2 (1 1))
+(context-flatten (lambda (x) (and (number? (car x)) (= (car x) 1))) '(1 1 (1 1
(2 2)) (2 2 (1 1)))) @result{}
+((1 1 (1 1 (2 2)) (2 2 (1 1))))
address@hidden lisp
+
+If you're wondering why this is here, take a look at the tutorial.
address@hidden deffn
+
address@hidden {Scheme Procedure} keyword-flatten terms lst
+A less general form of @code{context-flatten}. Takes a list of terminal
+atoms @code{terms} and flattens @var{lst} until all elements are either
+atoms, or lists which have an atom from @code{terms} as their first
+element.
address@hidden
+(keyword-flatten '(a b) '(c a b (a c) (b c) (c (b a) (c a)))) @result{}
+(c a b (a c) (b c) c (b a) c a)
address@hidden lisp
+
+If you're wondering why this is here, take a look at the tutorial.
address@hidden deffn
+
address@hidden PEG Tutorial
address@hidden PEG Tutorial
+
address@hidden Parsing /etc/passwd
+This example will show how to parse /etc/passwd using PEGs.
+
+First we define an example /etc/passwd file:
+
address@hidden
+(define *etc-passwd*
+ "root:x:0:0:root:/root:/bin/bash
+daemon:x:1:1:daemon:/usr/sbin:/bin/sh
+bin:x:2:2:bin:/bin:/bin/sh
+sys:x:3:3:sys:/dev:/bin/sh
+nobody:x:65534:65534:nobody:/nonexistent:/bin/sh
+messagebus:x:103:107::/var/run/dbus:/bin/false
+")
address@hidden lisp
+
+As a first pass at this, we might want to have all the entries in
+/etc/passwd in a list.
+
+Doing this with string-based PEG syntax would look like this:
address@hidden
+(define-peg-string-patterns
+ "passwd <- entry* !.
+entry <-- (! NL .)* NL*
+NL < '\n'")
address@hidden lisp
+
+A @code{passwd} file is 0 or more entries (@code{entry*}) until the end
+of the file (@code{!.} (@code{.} is any character, so @code{!.} means
+``not anything'')). We want to capture the data in the nonterminal
address@hidden, but not tag it with the name, so we use @code{<-}.
+
+An entry is a series of 0 or more characters that aren't newlines
+(@code{(! NL .)*}) followed by 0 or more newlines (@code{NL*}). We want
+to tag all the entries with @code{entry}, so we use @code{<--}.
+
+A newline is just a literal newline (@code{'\n'}). We don't want a
+bunch of newlines cluttering up the output, so we use @code{<} to throw
+away the captured data.
+
+Here is the same PEG defined using S-expressions:
address@hidden
+(define-peg-pattern passwd body (and (* entry) (not-followed-by peg-any)))
+(define-peg-pattern entry all (and (* (and (not-followed-by NL) peg-any))
+ (* NL)))
+(define-peg-pattern NL none "\n")
address@hidden lisp
+
+Obviously this is much more verbose. On the other hand, it's more
+explicit, and thus easier to build automatically. However, there are
+some tricks that make S-expressions easier to use in some cases. One is
+the @code{ignore} keyword; the string syntax has no way to say ``throw
+away this text'' except breaking it out into a separate nonterminal.
+For instance, to throw away the newlines we had to define @code{NL}. In
+the S-expression syntax, we could have simply written @code{(ignore
+"\n")}. Also, for the cases where string syntax is really much cleaner,
+the @code{peg} keyword can be used to embed string syntax in
+S-expression syntax. For instance, we could have written:
+
address@hidden
+(define-peg-pattern passwd body (peg "entry* !."))
address@hidden lisp
+
+However we define it, parsing @code{*etc-passwd*} with the @code{passwd}
+nonterminal yields the same results:
+
address@hidden
+(peg:tree (match-pattern passwd *etc-passwd*)) @result{}
+((entry "root:x:0:0:root:/root:/bin/bash")
+ (entry "daemon:x:1:1:daemon:/usr/sbin:/bin/sh")
+ (entry "bin:x:2:2:bin:/bin:/bin/sh")
+ (entry "sys:x:3:3:sys:/dev:/bin/sh")
+ (entry "nobody:x:65534:65534:nobody:/nonexistent:/bin/sh")
+ (entry "messagebus:x:103:107::/var/run/dbus:/bin/false"))
address@hidden lisp
+
+However, here is something to be wary of:
+
address@hidden
+(peg:tree (match-pattern passwd "one entry")) @result{}
+(entry "one entry")
address@hidden lisp
+
+By default, the parse trees generated by PEGs are compressed as much as
+possible without losing information. It may not look like this is what
+you want at first, but uncompressed parse trees are an enormous headache
+(there's no easy way to predict how deep particular lists will nest,
+there are empty lists littered everywhere, etc. etc.). One side-effect
+of this, however, is that sometimes the compressor is too aggressive.
+No information is discarded when @code{((entry "one entry"))} is
+compressed to @code{(entry "one entry")}, but in this particular case it
+probably isn't what we want.
+
+There are two functions for easily dealing with this:
address@hidden and @code{context-flatten}. The
address@hidden function takes a list of keywords and a list to
+flatten, then tries to coerce the list such that the first element of
+all sublists is one of the keywords. The @code{context-flatten}
+function is similar, but instead of a list of keywords it takes a
+predicate that should indicate whether a given sublist is good enough
+(refer to the API reference for more details).
+
+What we want here is @code{keyword-flatten}.
address@hidden
+(keyword-flatten '(entry) (peg:tree (match-pattern passwd *etc-passwd*)))
@result{}
+((entry "root:x:0:0:root:/root:/bin/bash")
+ (entry "daemon:x:1:1:daemon:/usr/sbin:/bin/sh")
+ (entry "bin:x:2:2:bin:/bin:/bin/sh")
+ (entry "sys:x:3:3:sys:/dev:/bin/sh")
+ (entry "nobody:x:65534:65534:nobody:/nonexistent:/bin/sh")
+ (entry "messagebus:x:103:107::/var/run/dbus:/bin/false"))
+(keyword-flatten '(entry) (peg:tree (match-pattern passwd "one entry")))
@result{}
+((entry "one entry"))
address@hidden lisp
+
+Of course, this is a somewhat contrived example. In practice we would
+probably just tag the @code{passwd} nonterminal to remove the ambiguity
+(using either the @code{all} keyword for S-expressions or the @code{<--}
+symbol for strings)..
+
address@hidden
+(define-peg-pattern tag-passwd all (peg "entry* !."))
+(peg:tree (match-pattern tag-passwd *etc-passwd*)) @result{}
+(tag-passwd
+ (entry "root:x:0:0:root:/root:/bin/bash")
+ (entry "daemon:x:1:1:daemon:/usr/sbin:/bin/sh")
+ (entry "bin:x:2:2:bin:/bin:/bin/sh")
+ (entry "sys:x:3:3:sys:/dev:/bin/sh")
+ (entry "nobody:x:65534:65534:nobody:/nonexistent:/bin/sh")
+ (entry "messagebus:x:103:107::/var/run/dbus:/bin/false"))
+(peg:tree (match-pattern tag-passwd "one entry"))
+(tag-passwd
+ (entry "one entry"))
address@hidden lisp
+
+If you're ever uncertain about the potential results of parsing
+something, remember the two absolute rules:
address@hidden
address@hidden
+No parsing information will ever be discarded.
address@hidden
+There will never be any lists with fewer than 2 elements.
address@hidden enumerate
+
+For the purposes of (1), "parsing information" means things tagged with
+the @code{any} keyword or the @code{<--} symbol. Plain strings will be
+concatenated.
+
+Let's extend this example a bit more and actually pull some useful
+information out of the passwd file:
+
address@hidden
+(define-peg-string-patterns
+ "passwd <-- entry* !.
+entry <-- login C pass C uid C gid C nameORcomment C homedir C shell NL*
+login <-- text
+pass <-- text
+uid <-- [0-9]*
+gid <-- [0-9]*
+nameORcomment <-- text
+homedir <-- path
+shell <-- path
+path <-- (SLASH pathELEMENT)*
+pathELEMENT <-- (!NL !C !'/' .)*
+text <- (!NL !C .)*
+C < ':'
+NL < '\n'
+SLASH < '/'")
address@hidden lisp
+
+This produces rather pretty parse trees:
address@hidden
+(passwd
+ (entry (login "root")
+ (pass "x")
+ (uid "0")
+ (gid "0")
+ (nameORcomment "root")
+ (homedir (path (pathELEMENT "root")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "bash"))))
+ (entry (login "daemon")
+ (pass "x")
+ (uid "1")
+ (gid "1")
+ (nameORcomment "daemon")
+ (homedir
+ (path (pathELEMENT "usr") (pathELEMENT "sbin")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "sh"))))
+ (entry (login "bin")
+ (pass "x")
+ (uid "2")
+ (gid "2")
+ (nameORcomment "bin")
+ (homedir (path (pathELEMENT "bin")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "sh"))))
+ (entry (login "sys")
+ (pass "x")
+ (uid "3")
+ (gid "3")
+ (nameORcomment "sys")
+ (homedir (path (pathELEMENT "dev")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "sh"))))
+ (entry (login "nobody")
+ (pass "x")
+ (uid "65534")
+ (gid "65534")
+ (nameORcomment "nobody")
+ (homedir (path (pathELEMENT "nonexistent")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "sh"))))
+ (entry (login "messagebus")
+ (pass "x")
+ (uid "103")
+ (gid "107")
+ nameORcomment
+ (homedir
+ (path (pathELEMENT "var")
+ (pathELEMENT "run")
+ (pathELEMENT "dbus")))
+ (shell (path (pathELEMENT "bin") (pathELEMENT "false")))))
address@hidden lisp
+
+Notice that when there's no entry in a field (e.g. @code{nameORcomment}
+for messagebus) the symbol is inserted. This is the ``don't throw away
+any information'' rule---we succesfully matched a @code{nameORcomment}
+of 0 characters (since we used @code{*} when defining it). This is
+usually what you want, because it allows you to e.g. use @code{list-ref}
+to pull out elements (since they all have known offsets).
+
+If you'd prefer not to have symbols for empty matches, you can replace
+the @code{*} with a @code{+} and add a @code{?} after the
address@hidden in @code{entry}. Then it will try to parse 1 or
+more characters, fail (inserting nothing into the parse tree), but
+continue because it didn't have to match the nameORcomment to continue.
+
+
address@hidden Embedding Arithmetic Expressions
+
+We can parse simple mathematical expressions with the following PEG:
+
address@hidden
+(define-peg-string-patterns
+ "expr <- sum
+sum <-- (product ('+' / '-') sum) / product
+product <-- (value ('*' / '/') product) / value
+value <-- number / '(' expr ')'
+number <-- [0-9]+")
address@hidden lisp
+
+Then:
address@hidden
+(peg:tree (match-pattern expr "1+1/2*3+(1+1)/2")) @result{}
+(sum (product (value (number "1")))
+ "+"
+ (sum (product
+ (value (number "1"))
+ "/"
+ (product
+ (value (number "2"))
+ "*"
+ (product (value (number "3")))))
+ "+"
+ (sum (product
+ (value "("
+ (sum (product (value (number "1")))
+ "+"
+ (sum (product (value (number "1")))))
+ ")")
+ "/"
+ (product (value (number "2")))))))
address@hidden lisp
+
+There is very little wasted effort in this PEG. The @code{number}
+nonterminal has to be tagged because otherwise the numbers might run
+together with the arithmetic expressions during the string concatenation
+stage of parse-tree compression (the parser will see ``1'' followed by
+``/'' and decide to call it ``1/''). When in doubt, tag.
+
+It is very easy to turn these parse trees into lisp expressions:
+
address@hidden
+(define (parse-sum sum left . rest)
+ (if (null? rest)
+ (apply parse-product left)
+ (list (string->symbol (car rest))
+ (apply parse-product left)
+ (apply parse-sum (cadr rest)))))
+
+(define (parse-product product left . rest)
+ (if (null? rest)
+ (apply parse-value left)
+ (list (string->symbol (car rest))
+ (apply parse-value left)
+ (apply parse-product (cadr rest)))))
+
+(define (parse-value value first . rest)
+ (if (null? rest)
+ (string->number (cadr first))
+ (apply parse-sum (car rest))))
+
+(define parse-expr parse-sum)
address@hidden lisp
+
+(Notice all these functions look very similar; for a more complicated
+PEG, it would be worth abstracting.)
+
+Then:
address@hidden
+(apply parse-expr (peg:tree (match-pattern expr "1+1/2*3+(1+1)/2"))) @result{}
+(+ 1 (+ (/ 1 (* 2 3)) (/ (+ 1 1) 2)))
address@hidden lisp
+
+But wait! The associativity is wrong! Where it says @code{(/ 1 (* 2
+3))}, it should say @code{(* (/ 1 2) 3)}.
+
+It's tempting to try replacing e.g. @code{"sum <-- (product ('+' / '-')
+sum) / product"} with @code{"sum <-- (sum ('+' / '-') product) /
+product"}, but this is a Bad Idea. PEGs don't support left recursion.
+To see why, imagine what the parser will do here. When it tries to
+parse @code{sum}, it first has to try and parse @code{sum}. But to do
+that, it first has to try and parse @code{sum}. This will continue
+until the stack gets blown off.
+
+So how does one parse left-associative binary operators with PEGs?
+Honestly, this is one of their major shortcomings. There's no
+general-purpose way of doing this, but here the repetition operators are
+a good choice:
+
address@hidden
+(use-modules (srfi srfi-1))
+
+(define-peg-string-patterns
+ "expr <- sum
+sum <-- (product ('+' / '-'))* product
+product <-- (value ('*' / '/'))* value
+value <-- number / '(' expr ')'
+number <-- [0-9]+")
+
+;; take a deep breath...
+(define (make-left-parser next-func)
+ (lambda (sum first . rest) ;; general form, comments below assume
+ ;; that we're dealing with a sum expression
+ (if (null? rest) ;; form (sum (product ...))
+ (apply next-func first)
+ (if (string? (cadr first));; form (sum ((product ...) "+") (product ...))
+ (list (string->symbol (cadr first))
+ (apply next-func (car first))
+ (apply next-func (car rest)))
+ ;; form (sum (((product ...) "+") ((product ...) "+")) (product ...))
+ (car
+ (reduce ;; walk through the list and build a left-associative tree
+ (lambda (l r)
+ (list (list (cadr r) (car r) (apply next-func (car l)))
+ (string->symbol (cadr l))))
+ 'ignore
+ (append ;; make a list of all the products
+ ;; the first one should be pre-parsed
+ (list (list (apply next-func (caar first))
+ (string->symbol (cadar first))))
+ (cdr first)
+ ;; the last one has to be added in
+ (list (append rest '("done"))))))))))
+
+(define (parse-value value first . rest)
+ (if (null? rest)
+ (string->number (cadr first))
+ (apply parse-sum (car rest))))
+(define parse-product (make-left-parser parse-value))
+(define parse-sum (make-left-parser parse-product))
+(define parse-expr parse-sum)
address@hidden lisp
+
+Then:
address@hidden
+(apply parse-expr (peg:tree (match-pattern expr "1+1/2*3+(1+1)/2"))) @result{}
+(+ (+ 1 (* (/ 1 2) 3)) (/ (+ 1 1) 2))
address@hidden lisp
+
+As you can see, this is much uglier (it could be made prettier by using
address@hidden, but the way it's written above makes it clear
+how we deal with the three ways the zero-or-more @code{*} expression can
+parse). Fortunately, most of the time we can get away with only using
+right-associativity.
+
address@hidden Simplified Functions
+
+For a more tantalizing example, consider the following grammar that
+parses (highly) simplified C functions:
+
address@hidden
+(define-peg-string-patterns
+ "cfunc <-- cSP ctype cSP cname cSP cargs cLB cSP cbody cRB
+ctype <-- cidentifier
+cname <-- cidentifier
+cargs <-- cLP (! (cSP cRP) carg cSP (cCOMMA / cRP) cSP)* cSP
+carg <-- cSP ctype cSP cname
+cbody <-- cstatement *
+cidentifier <- [a-zA-z][a-zA-Z0-9_]*
+cstatement <-- (!';'.)*cSC cSP
+cSC < ';'
+cCOMMA < ','
+cLP < '('
+cRP < ')'
+cLB < '@{'
+cRB < '@}'
+cSP < [ \t\n]*")
address@hidden lisp
+
+Then:
address@hidden
+(match-pattern cfunc "int square(int a) @{ return a*a;@}") @result{}
+(32
+ (cfunc (ctype "int")
+ (cname "square")
+ (cargs (carg (ctype "int") (cname "a")))
+ (cbody (cstatement "return a*a"))))
address@hidden lisp
+
+And:
address@hidden
+(match-pattern cfunc "int mod(int a, int b) @{ int c = a/b;return a-b*c; @}")
@result{}
+(52
+ (cfunc (ctype "int")
+ (cname "mod")
+ (cargs (carg (ctype "int") (cname "a"))
+ (carg (ctype "int") (cname "b")))
+ (cbody (cstatement "int c = a/b")
+ (cstatement "return a- b*c"))))
address@hidden lisp
+
+By wrapping all the @code{carg} nonterminals in a @code{cargs}
+nonterminal, we were able to remove any ambiguity in the parsing
+structure and avoid having to call @code{context-flatten} on the output
+of @code{match-pattern}. We used the same trick with the @code{cstatement}
+nonterminals, wrapping them in a @code{cbody} nonterminal.
+
+The whitespace nonterminal @code{cSP} used here is a (very) useful
+instantiation of a common pattern for matching syntactically irrelevant
+information. Since it's tagged with @code{<} and ends with @code{*} it
+won't clutter up the parse trees (all the empty lists will be discarded
+during the compression step) and it will never cause parsing to fail.
+
address@hidden PEG Internals
address@hidden PEG Internals
+
+A PEG parser takes a string as input and attempts to parse it as a given
+nonterminal. The key idea of the PEG implementation is that every
+nonterminal is just a function that takes a string as an argument and
+attempts to parse that string as its nonterminal. The functions always
+start from the beginning, but a parse is considered successful if there
+is material left over at the end.
+
+This makes it easy to model different PEG parsing operations. For
+instance, consider the PEG grammar @code{"ab"}, which could also be
+written @code{(and "a" "b")}. It matches the string ``ab''. Here's how
+that might be implemented in the PEG style:
+
address@hidden
+(define (match-and-a-b str)
+ (match-a str)
+ (match-b str))
address@hidden lisp
+
+As you can see, the use of functions provides an easy way to model
+sequencing. In a similar way, one could model @code{(or a b)} with
+something like the following:
+
address@hidden
+(define (match-or-a-b str)
+ (or (match-a str) (match-b str)))
address@hidden lisp
+
+Here the semantics of a PEG @code{or} expression map naturally onto
+Scheme's @code{or} operator. This function will attempt to run
address@hidden(match-a str)}, and return its result if it succeeds. Otherwise it
+will run @code{(match-b str)}.
+
+Of course, the code above wouldn't quite work. We need some way for the
+parsing functions to communicate. The actual interface used is below.
+
address@hidden Parsing Function Interface
+
+A parsing function takes three arguments - a string, the length of that
+string, and the position in that string it should start parsing at. In
+effect, the parsing functions pass around substrings in pieces - the
+first argument is a buffer of characters, and the second two give a
+range within that buffer that the parsing function should look at.
+
+Parsing functions return either #f, if they failed to match their
+nonterminal, or a list whose first element must be an integer
+representing the final position in the string they matched and whose cdr
+can be any other data the function wishes to return, or '() if it
+doesn't have any more data.
+
+The one caveat is that if the extra data it returns is a list, any
+adjacent strings in that list will be appended by @code{match-pattern}. For
+instance, if a parsing function returns @code{(13 ("a" "b" "c"))},
address@hidden will take @code{(13 ("abc"))} as its value.
+
+For example, here is a function to match ``ab'' using the actual
+interface.
+
address@hidden
+(define (match-a-b str len pos)
+ (and (<= (+ pos 2) len)
+ (string= str "ab" pos (+ pos 2))
+ (list (+ pos 2) '()))) ; we return no extra information
address@hidden lisp
+
+The above function can be used to match a string by running
address@hidden(match-pattern match-a-b "ab")}.
+
address@hidden Code Generators and Extensible Syntax
+
+PEG expressions, such as those in a @code{define-peg-pattern} form, are
+interpreted internally in two steps.
+
+First, any string PEG is expanded into an s-expression PEG by the code
+in the @code{(ice-9 peg string-peg)} module.
+
+Then, then s-expression PEG that results is compiled into a parsing
+function by the @code{(ice-9 peg codegen)} module. In particular, the
+function @code{compile-peg-pattern} is called on the s-expression. It then
+decides what to do based on the form it is passed.
+
+The PEG syntax can be expanded by providing @code{compile-peg-pattern} more
+options for what to do with its forms. The extended syntax will be
+associated with a symbol, for instance @code{my-parsing-form}, and will
+be called on all PEG expressions of the form
address@hidden
+(my-parsing-form ...)
address@hidden lisp
+
+The parsing function should take two arguments. The first will be a
+syntax object containing a list with all of the arguments to the form
+(but not the form's name), and the second will be the
address@hidden argument that is passed to @code{define-peg-pattern}.
+
+New functions can be registered by calling @code{(add-peg-compiler!
+symbol function)}, where @code{symbol} is the symbol that will indicate
+a form of this type and @code{function} is the code generating function
+described above. The function @code{add-peg-compiler!} is exported from
+the @code{(ice-9 peg codegen)} module.
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index a1b3fe6..ed820af 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -309,6 +309,7 @@ available through both Scheme and C interfaces.
* Input and Output:: Ports, reading and writing.
* Regular Expressions:: Pattern matching and substitution.
* LALR(1) Parsing:: Generating LALR(1) parsers.
+* PEG Parsing:: Parsing Expression Grammars.
* Read/Load/Eval/Compile:: Reading and evaluating Scheme code.
* Memory Management:: Memory management and garbage collection.
* Modules:: Designing reusable code libraries.
@@ -337,6 +338,7 @@ available through both Scheme and C interfaces.
@include api-io.texi
@include api-regex.texi
@include api-lalr.texi
address@hidden api-peg.texi
@include api-evaluation.texi
@include api-memory.texi
@include api-modules.texi
diff --git a/module/Makefile.am b/module/Makefile.am
index d04a118..c070014 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -218,6 +218,12 @@ ICE_9_SOURCES = \
ice-9/null.scm \
ice-9/occam-channel.scm \
ice-9/optargs.scm \
+ ice-9/peg/simplify-tree.scm \
+ ice-9/peg/codegen.scm \
+ ice-9/peg/cache.scm \
+ ice-9/peg/using-parsers.scm \
+ ice-9/peg/string-peg.scm \
+ ice-9/peg.scm \
ice-9/poe.scm \
ice-9/poll.scm \
ice-9/posix.scm \
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm
new file mode 100644
index 0000000..4e03131
--- /dev/null
+++ b/module/ice-9/peg.scm
@@ -0,0 +1,42 @@
+;;;; peg.scm --- Parsing Expression Grammar (PEG) parser generator
+;;;;
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg)
+ #:use-module (ice-9 peg codegen)
+ #:use-module (ice-9 peg string-peg)
+ ;; Note: the most important effect of using string-peg is not whatever
+ ;; functions it exports, but the fact that it adds a new handler to
+ ;; peg-sexp-compile.
+ #:use-module (ice-9 peg simplify-tree)
+ #:use-module (ice-9 peg using-parsers)
+ #:use-module (ice-9 peg cache)
+ #:re-export (define-peg-pattern
+ define-peg-string-patterns
+ match-pattern
+ search-for-pattern
+ compile-peg-pattern
+ keyword-flatten
+ context-flatten
+ peg:start
+ peg:end
+ peg:string
+ peg:tree
+ peg:substring
+ peg-record?))
+
diff --git a/module/ice-9/peg/cache.scm b/module/ice-9/peg/cache.scm
new file mode 100644
index 0000000..f45432b
--- /dev/null
+++ b/module/ice-9/peg/cache.scm
@@ -0,0 +1,45 @@
+;;;; cache.scm --- cache the results of parsing
+;;;;
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg cache)
+ #:export (cg-cached-parser))
+
+;; The results of parsing using a nonterminal are cached. Think of it like a
+;; hash with no conflict resolution. Process for deciding on the cache size
+;; wasn't very scientific; just ran the benchmarks and stopped a little after
+;; the point of diminishing returns on my box.
+(define *cache-size* 512)
+
+(define (make-cache)
+ (make-vector *cache-size* #f))
+
+;; given a syntax object which is a parser function, returns syntax
+;; which, if evaluated, will become a parser function that uses a cache.
+(define (cg-cached-parser parser)
+ #`(let ((cache (make-cache)))
+ (lambda (str strlen at)
+ (let* ((vref (vector-ref cache (modulo at *cache-size*))))
+ ;; Check to see whether the value is cached.
+ (if (and vref (eq? (car vref) str) (= (cadr vref) at))
+ (caddr vref);; If it is return it.
+ (let ((fres ;; Else calculate it and cache it.
+ (#,parser str strlen at)))
+ (vector-set! cache (modulo at *cache-size*)
+ (list str at fres))
+ fres))))))
diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm
new file mode 100644
index 0000000..d80c3e8
--- /dev/null
+++ b/module/ice-9/peg/codegen.scm
@@ -0,0 +1,359 @@
+;;;; codegen.scm --- code generation for composable parsers
+;;;;
+;;;; Copyright (C) 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg codegen)
+ #:export (compile-peg-pattern wrap-parser-for-users add-peg-compiler!)
+ #:use-module (ice-9 pretty-print)
+ #:use-module (system base pmatch))
+
+(define-syntax single?
+ (syntax-rules ()
+ "Return #t if X is a list of one element."
+ ((_ x)
+ (pmatch x
+ ((_) #t)
+ (else #f)))))
+
+(define-syntax single-filter
+ (syntax-rules ()
+ "If EXP is a list of one element, return the element. Otherwise
+return EXP."
+ ((_ exp)
+ (pmatch exp
+ ((,elt) elt)
+ (,elts elts)))))
+
+(define-syntax push-not-null!
+ (syntax-rules ()
+ "If OBJ is non-null, push it onto LST, otherwise do nothing."
+ ((_ lst obj)
+ (if (not (null? obj))
+ (push! lst obj)))))
+
+(define-syntax push!
+ (syntax-rules ()
+ "Push an object onto a list."
+ ((_ lst obj)
+ (set! lst (cons obj lst)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; CODE GENERATORS
+;; These functions generate scheme code for parsing PEGs.
+;; Conventions:
+;; accum: (all name body none)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Code we generate will have a certain return structure depending on how we're
+;; accumulating (the ACCUM variable).
+(define (cg-generic-ret accum name body-uneval at)
+ ;; name, body-uneval and at are syntax
+ #`(let ((body #,body-uneval))
+ #,(cond
+ ((and (eq? accum 'all) name)
+ #`(list #,at
+ (cond
+ ((not (list? body)) (list '#,name body))
+ ((null? body) '#,name)
+ ((symbol? (car body)) (list '#,name body))
+ (else (cons '#,name body)))))
+ ((eq? accum 'name)
+ #`(list #,at '#,name))
+ ((eq? accum 'body)
+ #`(list #,at
+ (cond
+ ((single? body) (car body))
+ (else body))))
+ ((eq? accum 'none)
+ #`(list #,at '()))
+ (else
+ (begin
+ (pretty-print `(cg-generic-ret-error ,accum ,name ,body-uneval ,at))
+ (pretty-print "Defaulting to accum of none.\n")
+ #`(list #,at '()))))))
+
+;; The short name makes the formatting below much easier to read.
+(define cggr cg-generic-ret)
+
+;; Generates code that matches a particular string.
+;; E.g.: (cg-string syntax "abc" 'body)
+(define (cg-string pat accum)
+ (let ((plen (string-length pat)))
+ #`(lambda (str len pos)
+ (let ((end (+ pos #,plen)))
+ (and (<= end len)
+ (string= str #,pat pos end)
+ #,(case accum
+ ((all) #`(list end (list 'cg-string #,pat)))
+ ((name) #`(list end 'cg-string))
+ ((body) #`(list end #,pat))
+ ((none) #`(list end '()))
+ (else (error "bad accum" accum))))))))
+
+;; Generates code for matching any character.
+;; E.g.: (cg-peg-any syntax 'body)
+(define (cg-peg-any accum)
+ #`(lambda (str len pos)
+ (and (< pos len)
+ #,(case accum
+ ((all) #`(list (1+ pos)
+ (list 'cg-peg-any (substring str pos (1+ pos)))))
+ ((name) #`(list (1+ pos) 'cg-peg-any))
+ ((body) #`(list (1+ pos) (substring str pos (1+ pos))))
+ ((none) #`(list (1+ pos) '()))
+ (else (error "bad accum" accum))))))
+
+;; Generates code for matching a range of characters between start and end.
+;; E.g.: (cg-range syntax #\a #\z 'body)
+(define (cg-range pat accum)
+ (syntax-case pat ()
+ ((start end)
+ (if (not (and (char? (syntax->datum #'start))
+ (char? (syntax->datum #'end))))
+ (error "range PEG should have characters after it; instead got"
+ #'start #'end))
+ #`(lambda (str len pos)
+ (and (< pos len)
+ (let ((c (string-ref str pos)))
+ (and (char>=? c start)
+ (char<=? c end)
+ #,(case accum
+ ((all) #`(list (1+ pos) (list 'cg-range (string c))))
+ ((name) #`(list (1+ pos) 'cg-range))
+ ((body) #`(list (1+ pos) (string c)))
+ ((none) #`(list (1+ pos) '()))
+ (else (error "bad accum" accum))))))))))
+
+;; Generate code to match a pattern and do nothing with the result
+(define (cg-ignore pat accum)
+ (syntax-case pat ()
+ ((inner)
+ (compile-peg-pattern #'inner 'none))))
+
+(define (cg-capture pat accum)
+ (syntax-case pat ()
+ ((inner)
+ (compile-peg-pattern #'inner 'body))))
+
+;; Filters the accum argument to compile-peg-pattern for buildings like string
+;; literals (since we don't want to tag them with their name if we're doing an
+;; "all" accum).
+(define (builtin-accum-filter accum)
+ (cond
+ ((eq? accum 'all) 'body)
+ ((eq? accum 'name) 'name)
+ ((eq? accum 'body) 'body)
+ ((eq? accum 'none) 'none)))
+(define baf builtin-accum-filter)
+
+;; Top-level function builder for AND. Reduces to a call to CG-AND-INT.
+(define (cg-and clauses accum)
+ #`(lambda (str len pos)
+ (let ((body '()))
+ #,(cg-and-int clauses (baf accum) #'str #'len #'pos #'body))))
+
+;; Internal function builder for AND (calls itself).
+(define (cg-and-int clauses accum str strlen at body)
+ (syntax-case clauses ()
+ (()
+ (cggr accum 'cg-and #`(reverse #,body) at))
+ ((first rest ...)
+ #`(let ((res (#,(compile-peg-pattern #'first accum) #,str #,strlen #,at)))
+ (and res
+ ;; update AT and BODY then recurse
+ (let ((newat (car res))
+ (newbody (cadr res)))
+ (set! #,at newat)
+ (push-not-null! #,body (single-filter newbody))
+ #,(cg-and-int #'(rest ...) accum str strlen at body)))))))
+
+;; Top-level function builder for OR. Reduces to a call to CG-OR-INT.
+(define (cg-or clauses accum)
+ #`(lambda (str len pos)
+ #,(cg-or-int clauses (baf accum) #'str #'len #'pos)))
+
+;; Internal function builder for OR (calls itself).
+(define (cg-or-int clauses accum str strlen at)
+ (syntax-case clauses ()
+ (()
+ #f)
+ ((first rest ...)
+ #`(or (#,(compile-peg-pattern #'first accum) #,str #,strlen #,at)
+ #,(cg-or-int #'(rest ...) accum str strlen at)))))
+
+(define (cg-* args accum)
+ (syntax-case args ()
+ ((pat)
+ #`(lambda (str strlen at)
+ (let ((body '()))
+ (let lp ((end at) (count 0))
+ (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
+ str strlen end))
+ (new-end (if match (car match) end))
+ (count (if (> new-end end) (1+ count) count)))
+ (if (> new-end end)
+ (push-not-null! body (single-filter (cadr match))))
+ (if (and (> new-end end)
+ #,#t)
+ (lp new-end count)
+ (let ((success #,#t))
+ #,#`(and success
+ #,(cggr (baf accum) 'cg-body
+ #'(reverse body) #'new-end)))))))))))
+
+(define (cg-+ args accum)
+ (syntax-case args ()
+ ((pat)
+ #`(lambda (str strlen at)
+ (let ((body '()))
+ (let lp ((end at) (count 0))
+ (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
+ str strlen end))
+ (new-end (if match (car match) end))
+ (count (if (> new-end end) (1+ count) count)))
+ (if (> new-end end)
+ (push-not-null! body (single-filter (cadr match))))
+ (if (and (> new-end end)
+ #,#t)
+ (lp new-end count)
+ (let ((success #,#'(>= count 1)))
+ #,#`(and success
+ #,(cggr (baf accum) 'cg-body
+ #'(reverse body) #'new-end)))))))))))
+
+(define (cg-? args accum)
+ (syntax-case args ()
+ ((pat)
+ #`(lambda (str strlen at)
+ (let ((body '()))
+ (let lp ((end at) (count 0))
+ (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
+ str strlen end))
+ (new-end (if match (car match) end))
+ (count (if (> new-end end) (1+ count) count)))
+ (if (> new-end end)
+ (push-not-null! body (single-filter (cadr match))))
+ (if (and (> new-end end)
+ #,#'(< count 1))
+ (lp new-end count)
+ (let ((success #,#t))
+ #,#`(and success
+ #,(cggr (baf accum) 'cg-body
+ #'(reverse body) #'new-end)))))))))))
+
+(define (cg-followed-by args accum)
+ (syntax-case args ()
+ ((pat)
+ #`(lambda (str strlen at)
+ (let ((body '()))
+ (let lp ((end at) (count 0))
+ (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
+ str strlen end))
+ (new-end (if match (car match) end))
+ (count (if (> new-end end) (1+ count) count)))
+ (if (> new-end end)
+ (push-not-null! body (single-filter (cadr match))))
+ (if (and (> new-end end)
+ #,#'(< count 1))
+ (lp new-end count)
+ (let ((success #,#'(= count 1)))
+ #,#`(and success
+ #,(cggr (baf accum) 'cg-body #''()
#'at)))))))))))
+
+(define (cg-not-followed-by args accum)
+ (syntax-case args ()
+ ((pat)
+ #`(lambda (str strlen at)
+ (let ((body '()))
+ (let lp ((end at) (count 0))
+ (let* ((match (#,(compile-peg-pattern #'pat (baf accum))
+ str strlen end))
+ (new-end (if match (car match) end))
+ (count (if (> new-end end) (1+ count) count)))
+ (if (> new-end end)
+ (push-not-null! body (single-filter (cadr match))))
+ (if (and (> new-end end)
+ #,#'(< count 1))
+ (lp new-end count)
+ (let ((success #,#'(= count 1)))
+ #,#`(if success
+ #f
+ #,(cggr (baf accum) 'cg-body #''()
#'at)))))))))))
+
+;; Association list of functions to handle different expressions as PEGs
+(define peg-compiler-alist '())
+
+(define (add-peg-compiler! symbol function)
+ (set! peg-compiler-alist
+ (assq-set! peg-compiler-alist symbol function)))
+
+(add-peg-compiler! 'range cg-range)
+(add-peg-compiler! 'ignore cg-ignore)
+(add-peg-compiler! 'capture cg-capture)
+(add-peg-compiler! 'and cg-and)
+(add-peg-compiler! 'or cg-or)
+(add-peg-compiler! '* cg-*)
+(add-peg-compiler! '+ cg-+)
+(add-peg-compiler! '? cg-?)
+(add-peg-compiler! 'followed-by cg-followed-by)
+(add-peg-compiler! 'not-followed-by cg-not-followed-by)
+
+;; Takes an arbitrary expressions and accumulation variable, then parses it.
+;; E.g.: (compile-peg-pattern syntax '(and "abc" (or "-" (range #\a #\z)))
'all)
+(define (compile-peg-pattern pat accum)
+ (syntax-case pat (peg-any)
+ (peg-any
+ (cg-peg-any (baf accum)))
+ (sym (identifier? #'sym) ;; nonterminal
+ #'sym)
+ (str (string? (syntax->datum #'str)) ;; literal string
+ (cg-string (syntax->datum #'str) (baf accum)))
+ ((name . args) (let* ((nm (syntax->datum #'name))
+ (entry (assq-ref peg-compiler-alist nm)))
+ (if entry
+ (entry #'args accum)
+ (error "Bad peg form" nm #'args
+ "Not one of" (map car peg-compiler-alist)))))))
+
+;; Packages the results of a parser
+(define (wrap-parser-for-users for-syntax parser accumsym s-syn)
+ #`(lambda (str strlen at)
+ (let ((res (#,parser str strlen at)))
+ ;; Try to match the nonterminal.
+ (if res
+ ;; If we matched, do some post-processing to figure out
+ ;; what data to propagate upward.
+ (let ((at (car res))
+ (body (cadr res)))
+ #,(cond
+ ((eq? accumsym 'name)
+ #`(list at '#,s-syn))
+ ((eq? accumsym 'all)
+ #`(list (car res)
+ (cond
+ ((not (list? body))
+ (list '#,s-syn body))
+ ((null? body) '#,s-syn)
+ ((symbol? (car body))
+ (list '#,s-syn body))
+ (else (cons '#,s-syn body)))))
+ ((eq? accumsym 'none) #`(list (car res) '()))
+ (else #`(begin res))))
+ ;; If we didn't match, just return false.
+ #f))))
diff --git a/module/ice-9/peg/simplify-tree.scm
b/module/ice-9/peg/simplify-tree.scm
new file mode 100644
index 0000000..4c781a1
--- /dev/null
+++ b/module/ice-9/peg/simplify-tree.scm
@@ -0,0 +1,97 @@
+;;;; simplify-tree.scm --- utility functions for the PEG parser
+;;;;
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg simplify-tree)
+ #:export (keyword-flatten context-flatten string-collapse)
+ #:use-module (system base pmatch))
+
+(define-syntax single?
+ (syntax-rules ()
+ "Return #t if X is a list of one element."
+ ((_ x)
+ (pmatch x
+ ((_) #t)
+ (else #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; POST-PROCESSING FUNCTIONS (TO CANONICALIZE MATCH TREES)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Is everything in LST true?
+(define (andlst lst)
+ (or (null? lst)
+ (and (car lst) (andlst (cdr lst)))))
+
+;; Is LST a list of strings?
+(define (string-list? lst)
+ (and (list? lst) (not (null? lst))
+ (andlst (map string? lst))))
+
+;; Groups all strings that are next to each other in LST. Used in
+;; STRING-COLLAPSE.
+(define (string-group lst)
+ (if (not (list? lst))
+ lst
+ (if (null? lst)
+ '()
+ (let ((next (string-group (cdr lst))))
+ (if (not (string? (car lst)))
+ (cons (car lst) next)
+ (if (and (not (null? next))
+ (list? (car next))
+ (string? (caar next)))
+ (cons (cons (car lst) (car next)) (cdr next))
+ (cons (list (car lst)) next)))))))
+
+
+;; Collapses all the string in LST.
+;; ("a" "b" (c d) "e" "f") -> ("ab" (c d) "ef")
+(define (string-collapse lst)
+ (if (list? lst)
+ (let ((res (map (lambda (x) (if (string-list? x)
+ (apply string-append x)
+ x))
+ (string-group (map string-collapse lst)))))
+ (if (single? res) (car res) res))
+ lst))
+
+;; If LST is an atom, return (list LST), else return LST.
+(define (mklst lst)
+ (if (not (list? lst)) (list lst) lst))
+
+;; Takes a list and "flattens" it, using the predicate TST to know when to stop
+;; instead of terminating on atoms (see tutorial).
+(define (context-flatten tst lst)
+ (if (or (not (list? lst)) (null? lst))
+ lst
+ (if (tst lst)
+ (list lst)
+ (apply append
+ (map (lambda (x) (mklst (context-flatten tst x)))
+ lst)))))
+
+;; Takes a list and "flattens" it, using the list of keywords KEYWORD-LST to
+;; know when to stop at (see tutorial).
+(define (keyword-flatten keyword-lst lst)
+ (context-flatten
+ (lambda (x)
+ (if (or (not (list? x)) (null? x))
+ #t
+ (member (car x) keyword-lst)))
+ lst))
diff --git a/module/ice-9/peg/string-peg.scm b/module/ice-9/peg/string-peg.scm
new file mode 100644
index 0000000..45ed14b
--- /dev/null
+++ b/module/ice-9/peg/string-peg.scm
@@ -0,0 +1,273 @@
+;;;; string-peg.scm --- representing PEG grammars as strings
+;;;;
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg string-peg)
+ #:export (peg-as-peg
+ define-peg-string-patterns
+ peg-grammar)
+ #:use-module (ice-9 peg using-parsers)
+ #:use-module (ice-9 peg codegen)
+ #:use-module (ice-9 peg simplify-tree))
+
+;; Gets the left-hand depth of a list.
+(define (depth lst)
+ (if (or (not (list? lst)) (null? lst))
+ 0
+ (+ 1 (depth (car lst)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; Parse string PEGs using sexp PEGs.
+;; See the variable PEG-AS-PEG for an easier-to-read syntax.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Grammar for PEGs in PEG grammar.
+(define peg-as-peg
+"grammar <-- (nonterminal ('<--' / '<-' / '<') sp pattern)+
+pattern <-- alternative (SLASH sp alternative)*
+alternative <-- ([!&]? sp suffix)+
+suffix <-- primary ([*+?] sp)*
+primary <-- '(' sp pattern ')' sp / '.' sp / literal / charclass / nonterminal
!'<'
+literal <-- ['] (!['] .)* ['] sp
+charclass <-- LB (!']' (CCrange / CCsingle))* RB sp
+CCrange <-- . '-' .
+CCsingle <-- .
+nonterminal <-- [a-zA-Z0-9-]+ sp
+sp < [ \t\n]*
+SLASH < '/'
+LB < '['
+RB < ']'
+")
+
+(define-syntax define-sexp-parser
+ (lambda (x)
+ (syntax-case x ()
+ ((_ sym accum pat)
+ (let* ((matchf (compile-peg-pattern #'pat (syntax->datum #'accum)))
+ (accumsym (syntax->datum #'accum))
+ (syn (wrap-parser-for-users x matchf accumsym #'sym)))
+ #`(define sym #,syn))))))
+
+(define-sexp-parser peg-grammar all
+ (+ (and peg-nonterminal (or "<--" "<-" "<") peg-sp peg-pattern)))
+(define-sexp-parser peg-pattern all
+ (and peg-alternative
+ (* (and (ignore "/") peg-sp peg-alternative))))
+(define-sexp-parser peg-alternative all
+ (+ (and (? (or "!" "&")) peg-sp peg-suffix)))
+(define-sexp-parser peg-suffix all
+ (and peg-primary (* (and (or "*" "+" "?") peg-sp))))
+(define-sexp-parser peg-primary all
+ (or (and "(" peg-sp peg-pattern ")" peg-sp)
+ (and "." peg-sp)
+ peg-literal
+ peg-charclass
+ (and peg-nonterminal (not-followed-by "<"))))
+(define-sexp-parser peg-literal all
+ (and "'" (* (and (not-followed-by "'") peg-any)) "'" peg-sp))
+(define-sexp-parser peg-charclass all
+ (and (ignore "[")
+ (* (and (not-followed-by "]")
+ (or charclass-range charclass-single)))
+ (ignore "]")
+ peg-sp))
+(define-sexp-parser charclass-range all (and peg-any "-" peg-any))
+(define-sexp-parser charclass-single all peg-any)
+(define-sexp-parser peg-nonterminal all
+ (and (+ (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9) "-")) peg-sp))
+(define-sexp-parser peg-sp none
+ (* (or " " "\t" "\n")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; PARSE STRING PEGS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Takes a string representing a PEG grammar and returns syntax that
+;; will define all of the nonterminals in the grammar with equivalent
+;; PEG s-expressions.
+(define (peg-parser str for-syntax)
+ (let ((parsed (match-pattern peg-grammar str)))
+ (if (not parsed)
+ (begin
+ ;; (display "Invalid PEG grammar!\n")
+ #f)
+ (let ((lst (peg:tree parsed)))
+ (cond
+ ((or (not (list? lst)) (null? lst))
+ lst)
+ ((eq? (car lst) 'peg-grammar)
+ #`(begin
+ #,@(map (lambda (x) (peg-nonterm->defn x for-syntax))
+ (context-flatten (lambda (lst) (<= (depth lst) 2))
+ (cdr lst))))))))))
+
+;; Macro wrapper for PEG-PARSER. Parses PEG grammars expressed as strings and
+;; defines all the appropriate nonterminals.
+(define-syntax define-peg-string-patterns
+ (lambda (x)
+ (syntax-case x ()
+ ((_ str)
+ (peg-parser (syntax->datum #'str) x)))))
+
+;; lst has format (nonterm grabber pattern), where
+;; nonterm is a symbol (the name of the nonterminal),
+;; grabber is a string (either "<", "<-" or "<--"), and
+;; pattern is the parse of a PEG pattern expressed as as string.
+(define (peg-nonterm->defn lst for-syntax)
+ (let* ((nonterm (car lst))
+ (grabber (cadr lst))
+ (pattern (caddr lst))
+ (nonterm-name (datum->syntax for-syntax
+ (string->symbol (cadr nonterm)))))
+ #`(define-peg-pattern #,nonterm-name
+ #,(cond
+ ((string=? grabber "<--") (datum->syntax for-syntax 'all))
+ ((string=? grabber "<-") (datum->syntax for-syntax 'body))
+ (else (datum->syntax for-syntax 'none)))
+ #,(compressor (peg-pattern->defn pattern for-syntax) for-syntax))))
+
+;; lst has format ('peg-pattern ...).
+;; After the context-flatten, (cdr lst) has format
+;; (('peg-alternative ...) ...), where the outer list is a collection
+;; of elements from a '/' alternative.
+(define (peg-pattern->defn lst for-syntax)
+ #`(or #,@(map (lambda (x) (peg-alternative->defn x for-syntax))
+ (context-flatten (lambda (x) (eq? (car x) 'peg-alternative))
+ (cdr lst)))))
+
+;; lst has format ('peg-alternative ...).
+;; After the context-flatten, (cdr lst) has the format
+;; (item ...), where each item has format either ("!" ...), ("&" ...),
+;; or ('peg-suffix ...).
+(define (peg-alternative->defn lst for-syntax)
+ #`(and #,@(map (lambda (x) (peg-body->defn x for-syntax))
+ (context-flatten (lambda (x) (or (string? (car x))
+ (eq? (car x) 'peg-suffix)))
+ (cdr lst)))))
+
+;; lst has the format either
+;; ("!" ('peg-suffix ...)), ("&" ('peg-suffix ...)), or
+;; ('peg-suffix ...).
+(define (peg-body->defn lst for-syntax)
+ (cond
+ ((equal? (car lst) "&")
+ #`(followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
+ ((equal? (car lst) "!")
+ #`(not-followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
+ ((eq? (car lst) 'peg-suffix)
+ (peg-suffix->defn lst for-syntax))
+ (else `(peg-parse-body-fail ,lst))))
+
+;; lst has format ('peg-suffix <peg-primary> (? (/ "*" "?" "+")))
+(define (peg-suffix->defn lst for-syntax)
+ (let ((inner-defn (peg-primary->defn (cadr lst) for-syntax)))
+ (cond
+ ((null? (cddr lst))
+ inner-defn)
+ ((equal? (caddr lst) "*")
+ #`(* #,inner-defn))
+ ((equal? (caddr lst) "?")
+ #`(? #,inner-defn))
+ ((equal? (caddr lst) "+")
+ #`(+ #,inner-defn)))))
+
+;; Parse a primary.
+(define (peg-primary->defn lst for-syntax)
+ (let ((el (cadr lst)))
+ (cond
+ ((list? el)
+ (cond
+ ((eq? (car el) 'peg-literal)
+ (peg-literal->defn el for-syntax))
+ ((eq? (car el) 'peg-charclass)
+ (peg-charclass->defn el for-syntax))
+ ((eq? (car el) 'peg-nonterminal)
+ (datum->syntax for-syntax (string->symbol (cadr el))))))
+ ((string? el)
+ (cond
+ ((equal? el "(")
+ (peg-pattern->defn (caddr lst) for-syntax))
+ ((equal? el ".")
+ (datum->syntax for-syntax 'peg-any))
+ (else (datum->syntax for-syntax
+ `(peg-parse-any unknown-string ,lst)))))
+ (else (datum->syntax for-syntax
+ `(peg-parse-any unknown-el ,lst))))))
+
+;; Trims characters off the front and end of STR.
+;; (trim-1chars "'ab'") -> "ab"
+(define (trim-1chars str) (substring str 1 (- (string-length str) 1)))
+
+;; Parses a literal.
+(define (peg-literal->defn lst for-syntax)
+ (datum->syntax for-syntax (trim-1chars (cadr lst))))
+
+;; Parses a charclass.
+(define (peg-charclass->defn lst for-syntax)
+ #`(or
+ #,@(map
+ (lambda (cc)
+ (cond
+ ((eq? (car cc) 'charclass-range)
+ #`(range #,(datum->syntax
+ for-syntax
+ (string-ref (cadr cc) 0))
+ #,(datum->syntax
+ for-syntax
+ (string-ref (cadr cc) 2))))
+ ((eq? (car cc) 'charclass-single)
+ (datum->syntax for-syntax (cadr cc)))))
+ (context-flatten
+ (lambda (x) (or (eq? (car x) 'charclass-range)
+ (eq? (car x) 'charclass-single)))
+ (cdr lst)))))
+
+;; Compresses a list to save the optimizer work.
+;; e.g. (or (and a)) -> a
+(define (compressor-core lst)
+ (if (or (not (list? lst)) (null? lst))
+ lst
+ (cond
+ ((and (or (eq? (car lst) 'or) (eq? (car lst) 'and))
+ (null? (cddr lst)))
+ (compressor-core (cadr lst)))
+ ((and (eq? (car lst) 'body)
+ (eq? (cadr lst) 'lit)
+ (eq? (cadddr lst) 1))
+ (compressor-core (caddr lst)))
+ (else (map compressor-core lst)))))
+
+(define (compressor syn for-syntax)
+ (datum->syntax for-syntax
+ (compressor-core (syntax->datum syn))))
+
+;; Builds a lambda-expressions for the pattern STR using accum.
+(define (peg-string-compile args accum)
+ (syntax-case args ()
+ ((str-stx) (string? (syntax->datum #'str-stx))
+ (let ((string (syntax->datum #'str-stx)))
+ (compile-peg-pattern
+ (compressor
+ (peg-pattern->defn
+ (peg:tree (match-pattern peg-pattern string)) #'str-stx)
+ #'str-stx)
+ (if (eq? accum 'all) 'body accum))))
+ (else (error "Bad embedded PEG string" args))))
+
+(add-peg-compiler! 'peg peg-string-compile)
+
diff --git a/module/ice-9/peg/using-parsers.scm
b/module/ice-9/peg/using-parsers.scm
new file mode 100644
index 0000000..076de29
--- /dev/null
+++ b/module/ice-9/peg/using-parsers.scm
@@ -0,0 +1,116 @@
+;;;; using-parsers.scm --- utilities to make using parsers easier
+;;;;
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library 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.
+;;;;
+;;;; This library 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 this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 peg using-parsers)
+ #:use-module (ice-9 peg simplify-tree)
+ #:use-module (ice-9 peg codegen)
+ #:use-module (ice-9 peg cache)
+ #:export (match-pattern define-peg-pattern search-for-pattern
+ prec make-prec peg:start peg:end peg:string
+ peg:tree peg:substring peg-record?))
+
+;;;
+;;; Helper Macros
+;;;
+
+(define-syntax until
+ (syntax-rules ()
+ "Evaluate TEST. If it is true, return its value. Otherwise,
+execute the STMTs and try again."
+ ((_ test stmt stmt* ...)
+ (let lp ()
+ (or test
+ (begin stmt stmt* ... (lp)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; FOR DEFINING AND USING NONTERMINALS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Parses STRING using NONTERM
+(define (match-pattern nonterm string)
+ ;; We copy the string before using it because it might have been modified
+ ;; in-place since the last time it was parsed, which would invalidate the
+ ;; cache. Guile uses copy-on-write for strings, so this is fast.
+ (let ((res (nonterm (string-copy string) (string-length string) 0)))
+ (if (not res)
+ #f
+ (make-prec 0 (car res) string (string-collapse (cadr res))))))
+
+;; Defines a new nonterminal symbol accumulating with ACCUM.
+(define-syntax define-peg-pattern
+ (lambda (x)
+ (syntax-case x ()
+ ((_ sym accum pat)
+ (let ((matchf (compile-peg-pattern #'pat (syntax->datum #'accum)))
+ (accumsym (syntax->datum #'accum)))
+ ;; CODE is the code to parse the string if the result isn't cached.
+ (let ((syn (wrap-parser-for-users x matchf accumsym #'sym)))
+ #`(define sym #,(cg-cached-parser syn))))))))
+
+(define (peg-like->peg pat)
+ (syntax-case pat ()
+ (str (string? (syntax->datum #'str)) #'(peg str))
+ (else pat)))
+
+;; Searches through STRING for something that parses to PEG-MATCHER. Think
+;; regexp search.
+(define-syntax search-for-pattern
+ (lambda (x)
+ (syntax-case x ()
+ ((_ pattern string-uncopied)
+ (let ((pmsym (syntax->datum #'pattern)))
+ (let ((matcher (compile-peg-pattern (peg-like->peg #'pattern) 'body)))
+ ;; We copy the string before using it because it might have been
+ ;; modified in-place since the last time it was parsed, which would
+ ;; invalidate the cache. Guile uses copy-on-write for strings, so
+ ;; this is fast.
+ #`(let ((string (string-copy string-uncopied))
+ (strlen (string-length string-uncopied))
+ (at 0))
+ (let ((ret (until (or (>= at strlen)
+ (#,matcher string strlen at))
+ (set! at (+ at 1)))))
+ (if (eq? ret #t) ;; (>= at strlen) succeeded
+ #f
+ (let ((end (car ret))
+ (match (cadr ret)))
+ (make-prec
+ at end string
+ (string-collapse match))))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; PMATCH STRUCTURE MUNGING
+;; Pretty self-explanatory.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define prec
+ (make-record-type "peg" '(start end string tree)))
+(define make-prec
+ (record-constructor prec '(start end string tree)))
+(define (peg:start pm)
+ (if pm ((record-accessor prec 'start) pm) #f))
+(define (peg:end pm)
+ (if pm ((record-accessor prec 'end) pm) #f))
+(define (peg:string pm)
+ (if pm ((record-accessor prec 'string) pm) #f))
+(define (peg:tree pm)
+ (if pm ((record-accessor prec 'tree) pm) #f))
+(define (peg:substring pm)
+ (if pm (substring (peg:string pm) (peg:start pm) (peg:end pm)) #f))
+(define peg-record? (record-predicate prec))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 9fba7b8..b1e90ba 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -78,6 +78,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/optargs.test \
tests/options.test \
tests/parameters.test \
+ tests/peg.test \
tests/peval.test \
tests/print.test \
tests/procprop.test \
diff --git a/test-suite/tests/peg.bench b/test-suite/tests/peg.bench
new file mode 100644
index 0000000..7baad5c
--- /dev/null
+++ b/test-suite/tests/peg.bench
@@ -0,0 +1,173 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; PEG benchmark suite (minimal right now).
+;; Parses very long equations several times; outputs the average time
+;; it took and the standard deviation of times.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(use-modules (ice-9 pretty-print))
+(use-modules (srfi srfi-1))
+(use-modules (ice-9 peg))
+(use-modules (ice-9 popen))
+
+;; Generate random equations.
+(define (gen-rand-eq len)
+ (if (= len 0)
+ (random 1000)
+ (let ((len (if (even? len) (+ len 1) len)))
+ (map (lambda (x)
+ (if (odd? x)
+ (gen-rand len 'op)
+ (gen-rand len 'number)))
+ (iota len)))))
+(define (gen-rand len type)
+ (cond ((eq? type 'number)
+ (cond
+ ((= (random 5) 0) (gen-rand-eq (floor (/ len 5))))
+ (#t (random 1000))))
+ (#t (list-ref '(+ - * /) (random 4)))))
+
+;; Generates a random equation string (len is a rough indicator of the
+;; resulting length).
+(define (gen-str len)
+ (with-output-to-string (lambda () (write (gen-rand-eq len)))))
+
+;; Generates a left-associative parser (see tutorial).
+(define (make-left-parser next-func)
+ (lambda (sum first . rest)
+ (if (null? rest)
+ (apply next-func first)
+ (if (string? (cadr first))
+ (list (string->symbol (cadr first))
+ (apply next-func (car first))
+ (apply next-func (car rest)))
+ (car
+ (reduce
+ (lambda (l r)
+ (list (list (cadr r) (car r) (apply next-func (car l)))
+ (string->symbol (cadr l))))
+ 'ignore
+ (append
+ (list (list (apply next-func (caar first))
+ (string->symbol (cadar first))))
+ (cdr first)
+ (list (append rest '("done"))))))))))
+
+;; Functions for parsing equations (see tutorial).
+(define (parse-value value first . rest)
+ (if (null? rest)
+ (string->number (cadr first))
+ (apply parse-sum (car rest))))
+(define parse-product (make-left-parser parse-value))
+(define parse-sum (make-left-parser parse-product))
+(define parse-expr parse-sum)
+(define (eq-parse str) (apply parse-expr (peg:tree (match-pattern expr str))))
+
+;; PEG for parsing equations (see tutorial).
+(define-peg-string-patterns
+ "expr <- sum
+sum <-- (product ('+' / '-'))* product
+product <-- (value ('*' / '/'))* value
+value <-- sp number sp / sp '(' expr ')' sp
+number <-- [0-9]+
+sp < [ \t\n]*")
+
+;; gets the time in seconds (with a fractional part)
+(define (canon-time)
+ (let ((pair (gettimeofday)))
+ (+ (+ (car pair) (* (cdr pair) (expt 10 -6))) 0.0)))
+
+;; Times how long it takes for FUNC to complete when called on ARGS.
+;; **SIDE EFFECT** Writes the time FUNC took to stdout.
+;; Returns the return value of FUNC.
+(define (time-func func . args)
+ (let ((start (canon-time)))
+ (let ((res (apply func args)))
+ (pretty-print `(took ,(- (canon-time) start) seconds))
+ res)))
+;; Times how long it takes for FUNC to complete when called on ARGS.
+;; Returns the time FUNC took to complete.
+(define (time-ret-func func . args)
+ (let ((start (canon-time)))
+ (let ((res (apply func args)))
+ (- (canon-time) start))))
+
+;; test string (randomly generated)
+(define tst1 "(621 - 746 * 945 - 194 * (204 * (965 - 738 + (846)) - 450 / (116
* 293 * 543) + 858 / 693 - (890 * (260) - 855) + 875 - 684 / (749 - (846) +
127) / 670) - 293 - 815 - 628 * 93 - 662 + 561 / 645 + 112 - 71 - (286 - ((324)
/ 424 + 956) / 190 + ((848) / 132 * 602) + 5 + 765 * 220 - ((801) / 191 - 299)
* 708 + 151 * 682) + (943 + 847 - 145 - 816 / 550 - 217 / 9 / 969 * 524 * 447 /
323) * 991 - 283 * 915 / 733 / 478 / (680 + 343 * 186 / 341 * ((571) * 848 -
47) - (492 + 398 * (616)) + 270 - 539 * 34 / 47 / 458) * 417 / 406 / 354 * 678
+ 524 + 40 / 282 - 792 * 570 - 305 * 14 + (248 - 678 * 8 - 53 - 215 / 677 - 665
/ 216 - 275 - 462 / 502) - 24 - 780 + (967 / (636 / 400 * 823) + 933 - 361 -
620 - 255 / 372 + 394 * 869 / 839 * 727) + (436 + 993 - 668 + 772 - 33 + 64 -
252 * 957 * 320 + 540 / (23 * 74 / (422))) + (516 / (348 * 219 * 986) * 85 *
149 * 957 * 602 / 141 / 80 / 456 / 92 / (443 * 468 * 466)) * 568 / (271 - 42 +
271 + 592 + 71 * (766 + (11) * 946) / 728 / 137 / 111 + 557 / 962) * 179 - 936
/ 821 * 101 - 206 / (267 - (11 / 906 * 290) / 722 / 98 - 987 / 989 - 470 * 833
- (720 / 34 - 280) + 638 / 940) - 889 * 84 * 630 + ((214 - 888 + (46)) / 540 +
941 * 724 / 759 * (679 / 527 - 764) * 413 + 831 / 559 - (308 / 796 / 737) /
20))")
+
+;; appends two equations (adds them together)
+(define (eq-append . eqs)
+ (if (null? eqs)
+ "0"
+ (if (null? (cdr eqs))
+ (car eqs)
+ (string-append
+ (car eqs)
+ " + "
+ (apply eq-append (cdr eqs))))))
+
+;; concatenates an equation onto itself n times using eq-append
+(define (string-n str n)
+ (if (<= n 0)
+ "0"
+ (if (= n 1)
+ str
+ (eq-append str (string-n str (- n 1))))))
+
+;; standard deviation (no bias-correction)
+;; (also called population standard deviation)
+(define (stddev . lst)
+ (let ((llen (length lst)))
+ (if (<= llen 0)
+ 0
+ (let* ((avg (/ (reduce + 0 lst) llen))
+ (mapfun (lambda (x) (real-part (expt (- x avg) 2)))))
+ (sqrt (/ (reduce + 0 (map mapfun lst)) llen))))))
+
+;; average
+(define (avg . lst)
+ (if (null? lst)
+ 0
+ (/ (reduce + 0 lst) (length lst))))
+
+(pretty-print "Parsing equations (see PEG in tutorial). Sample size of 10 for
each test.")
+(pretty-print
+ (let ((lst
+ (map
+ (lambda (ignore)
+ (reduce-right
+ append
+ 0
+ (map
+ (lambda (x)
+ (let* ((mstr (string-n tst1 x))
+ (strlen (string-length mstr)))
+ (let ((func (lambda () (begin (match-pattern expr mstr)
+ 'done))))
+ `(((string of length ,strlen first pass)
+ ,(time-ret-func func))
+ ((string of length ,strlen second pass)
+ ,(time-ret-func func))))))
+ (filter (lambda (x) (= (modulo x 25) 0)) (iota 100)))))
+ (iota 10))))
+ (let ((compacted
+ (reduce-right
+ (lambda (accum conc)
+ (map (lambda (l r) (append l (cdr r))) accum conc))
+ 0
+ lst)))
+ (map
+ (lambda (els)
+ `(,(car els)
+ (average time in seconds ,(apply avg (cdr els)))
+ (standard deviation ,(apply stddev (cdr els)))))
+ compacted))))
+
+(define (sys-calc str)
+ (let* ((pipe (open-input-pipe (string-append "echo \"" str "\" | bc -l")))
+ (str (read pipe)))
+ (close-pipe pipe)
+ str))
+(define (lisp-calc str)
+ (+ (eval (eq-parse str) (interaction-environment)) 0.0))
+
+;; (pretty-print `(,(sys-calc tst1) ,(lisp-calc tst1)))
diff --git a/test-suite/tests/peg.test b/test-suite/tests/peg.test
new file mode 100644
index 0000000..f516571
--- /dev/null
+++ b/test-suite/tests/peg.test
@@ -0,0 +1,278 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;; PEG test suite.
+;; Tests the parsing capabilities of (ice-9 peg). Could use more
+;; tests for edge cases.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (test-suite test-peg)
+ :use-module (test-suite lib)
+ :use-module (ice-9 peg)
+ :use-module (ice-9 pretty-print)
+ :use-module (srfi srfi-1))
+
+;; Doubled up for pasting into REPL.
+(use-modules (test-suite lib))
+(use-modules (ice-9 peg))
+(use-modules (ice-9 pretty-print))
+(use-modules (srfi srfi-1))
+
+;; Evaluates an expression at the toplevel. Not the prettiest
+;; solution to runtime issues ever, but m3h. Runs at toplevel so that
+;; symbols are bound globally instead of in the scope of the pass-if
+;; expression.
+(define (eeval exp)
+ (eval exp (interaction-environment)))
+(define make-prec (@@ (ice-9 peg) make-prec))
+
+;; Maps the nonterminals defined in the PEG parser written as a PEG to
+;; the nonterminals defined in the PEG parser written with
+;; S-expressions.
+(define grammar-mapping
+ '((grammar peg-grammar)
+ (pattern peg-pattern)
+ (alternative peg-alternative)
+ (suffix peg-suffix)
+ (primary peg-primary)
+ (literal peg-literal)
+ (charclass peg-charclass)
+ (CCrange charclass-range)
+ (CCsingle charclass-single)
+ (nonterminal peg-nonterminal)
+ (sp peg-sp)))
+
+;; Transforms the nonterminals defined in the PEG parser written as a PEG to
the nonterminals defined in the PEG parser written with S-expressions.
+(define (grammar-transform x)
+ (let ((res (assoc x grammar-mapping)))
+ (if res (cadr res) x)))
+
+;; Maps a function onto a tree (recurses until it finds atoms, then calls the
function on the atoms).
+(define (tree-map fn lst)
+ (if (list? lst)
+ (if (null? lst)
+ lst
+ (cons (tree-map fn (car lst))
+ (tree-map fn (cdr lst))))
+ (fn lst)))
+
+;; Tests to make sure that we can parse a PEG defining a grammar for
+;; PEGs, then uses that grammar to parse the same PEG again to make
+;; sure we get the same result (i.e. make sure our PEG grammar
+;; expressed as a PEG is equivalent to our PEG grammar expressed with
+;; S-expressions).
+(with-test-prefix "PEG Grammar"
+ (pass-if
+ "defining PEGs with PEG"
+ (and (eeval `(define-peg-string-patterns ,(@@ (ice-9 peg) peg-as-peg))) #t))
+ (pass-if
+ "equivalence of definitions"
+ (equal?
+ (peg:tree (match-pattern (@@ (ice-9 peg) peg-grammar) (@@ (ice-9 peg)
peg-as-peg)))
+ (tree-map
+ grammar-transform
+ (peg:tree (match-pattern grammar (@@ (ice-9 peg) peg-as-peg)))))))
+
+;; A grammar for pascal-style comments from Wikipedia.
+(define comment-grammar
+ "Begin <-- '(*'
+End <-- '*)'
+C <- Begin N* End
+N <- C / (!Begin !End Z)
+Z <- .")
+
+;; A short /etc/passwd file.
+(define *etc-passwd*
+ "root:x:0:0:root:/root:/bin/bash
+daemon:x:1:1:daemon:/usr/sbin:/bin/sh
+bin:x:2:2:bin:/bin:/bin/sh
+sys:x:3:3:sys:/dev:/bin/sh
+nobody:x:65534:65534:nobody:/nonexistent:/bin/sh
+messagebus:x:103:107::/var/run/dbus:/bin/false
+")
+
+;; A grammar for parsing /etc/passwd files.
+(define-peg-string-patterns
+ "passwd <-- entry* !.
+entry <-- login CO pass CO uid CO gid CO nameORcomment CO homedir CO shell NL*
+login <-- text
+pass <-- text
+uid <-- [0-9]*
+gid <-- [0-9]*
+nameORcomment <-- text
+homedir <-- path
+shell <-- path
+path <-- (SLASH pathELEMENT)*
+pathELEMENT <-- (!NL !CO !'/' .)*
+text <- (!NL !CO .)*
+CO < ':'
+NL < '\n'
+SLASH < '/'")
+
+;; Tests some actual parsing using PEGs.
+(with-test-prefix "Parsing"
+ (eeval `(define-peg-string-patterns ,comment-grammar))
+ (pass-if
+ ;; Pascal-style comment parsing
+ "simple comment"
+ (equal?
+ (match-pattern C "(*blah*)")
+ (make-prec 0 8 "(*blah*)"
+ '((Begin "(*") "blah" (End "*)")))))
+ (pass-if
+ "simple comment padded"
+ (equal?
+ (match-pattern C "(*blah*)abc")
+ (make-prec 0 8 "(*blah*)abc"
+ '((Begin "(*") "blah" (End "*)")))))
+ (pass-if
+ "nested comment"
+ (equal?
+ (match-pattern C "(*1(*2*)*)")
+ (make-prec 0 10 "(*1(*2*)*)"
+ '((Begin "(*") ("1" ((Begin "(*") "2" (End "*)"))) (End "*)")))))
+ (pass-if
+ "early termination"
+ (not (match-pattern C "(*blah")))
+ (pass-if
+ "never starts"
+ (not (match-pattern C "blah")))
+ ;; /etc/passwd parsing
+ (pass-if
+ "/etc/passwd"
+ (equal?
+ (match-pattern passwd *etc-passwd*)
+ (make-prec 0 220 *etc-passwd*
+ '(passwd (entry (login "root") (pass "x") (uid "0") (gid "0")
(nameORcomment "root") (homedir (path (pathELEMENT "root"))) (shell (path
(pathELEMENT "bin") (pathELEMENT "bash")))) (entry (login "daemon") (pass "x")
(uid "1") (gid "1") (nameORcomment "daemon") (homedir (path (pathELEMENT "usr")
(pathELEMENT "sbin"))) (shell (path (pathELEMENT "bin") (pathELEMENT "sh"))))
(entry (login "bin") (pass "x") (uid "2") (gid "2") (nameORcomment "bin")
(homedir (path (pathELEMENT "bin"))) (shell (path (pathELEMENT "bin")
(pathELEMENT "sh")))) (entry (login "sys") (pass "x") (uid "3") (gid "3")
(nameORcomment "sys") (homedir (path (pathELEMENT "dev"))) (shell (path
(pathELEMENT "bin") (pathELEMENT "sh")))) (entry (login "nobody") (pass "x")
(uid "65534") (gid "65534") (nameORcomment "nobody") (homedir (path
(pathELEMENT "nonexistent"))) (shell (path (pathELEMENT "bin") (pathELEMENT
"sh")))) (entry (login "messagebus") (pass "x") (uid "103") (gid "107")
nameORcomment (homedir (path (pathELEMENT "var") (pathELEMENT "run")
(pathELEMENT "dbus"))) (shell (path (pathELEMENT "bin") (pathELEMENT
"false")))))))))
+
+;; Tests the functions for pulling data out of PEG Match Records.
+(with-test-prefix "PEG Match Records"
+ (define-peg-pattern bs all (peg "'b'+"))
+ (pass-if
+ "basic parameter extraction"
+ (equal?
+ (let ((pm (search-for-pattern bs "aabbcc")))
+ `((string ,(peg:string pm))
+ (start ,(peg:start pm))
+ (end ,(peg:end pm))
+ (substring ,(peg:substring pm))
+ (tree ,(peg:tree pm))
+ (record? ,(peg-record? pm))))
+ '((string "aabbcc")
+ (start 2)
+ (end 4)
+ (substring "bb")
+ (tree (bs "bb"))
+ (record? #t)))))
+
+;; PEG for parsing right-associative equations.
+(define-peg-string-patterns
+ "expr <- sum
+sum <-- (product ('+' / '-') sum) / product
+product <-- (value ('*' / '/') product) / value
+value <-- number / '(' expr ')'
+number <-- [0-9]+")
+
+;; Functions to actually evaluate the equations parsed with the PEG.
+(define (parse-sum sum left . rest)
+ (if (null? rest)
+ (apply parse-product left)
+ (list (string->symbol (car rest))
+ (apply parse-product left)
+ (apply parse-sum (cadr rest)))))
+
+(define (parse-product product left . rest)
+ (if (null? rest)
+ (apply parse-value left)
+ (list (string->symbol (car rest))
+ (apply parse-value left)
+ (apply parse-product (cadr rest)))))
+
+(define (parse-value value first . rest)
+ (if (null? rest)
+ (string->number (cadr first))
+ (apply parse-sum (car rest))))
+
+(define parse-expr parse-sum)
+(define (eq-parse str) (apply parse-expr (peg:tree (match-pattern expr str))))
+
+(with-test-prefix "Parsing right-associative equations"
+ (pass-if
+ "1"
+ (equal? (eq-parse "1") 1))
+ (pass-if
+ "1+2"
+ (equal? (eq-parse "1+2") '(+ 1 2)))
+ (pass-if
+ "1+2+3"
+ (equal? (eq-parse "1+2+3") '(+ 1 (+ 2 3))))
+ (pass-if
+ "1+2*3+4"
+ (equal? (eq-parse "1+2*3+4") '(+ 1 (+ (* 2 3) 4))))
+ (pass-if
+ "1+2/3*(4+5)/6-7-8"
+ (equal? (eq-parse "1+2/3*(4+5)/6-7-8")
+ '(+ 1 (- (/ 2 (* 3 (/ (+ 4 5) 6))) (- 7 8)))))
+ (pass-if
+ "1+1/2*3+(1+1)/2"
+ (equal? (eq-parse "1+1/2*3+(1+1)/2")
+ '(+ 1 (+ (/ 1 (* 2 3)) (/ (+ 1 1) 2))))))
+
+;; PEG for parsing left-associative equations (normal ones).
+(define-peg-string-patterns
+ "expr <- sum
+sum <-- (product ('+' / '-'))* product
+product <-- (value ('*' / '/'))* value
+value <-- number / '(' expr ')'
+number <-- [0-9]+")
+
+;; Functions to actually evaluate the equations parsed with the PEG.
+(define (make-left-parser next-func)
+ (lambda (sum first . rest)
+ (if (null? rest)
+ (apply next-func first)
+ (if (string? (cadr first))
+ (list (string->symbol (cadr first))
+ (apply next-func (car first))
+ (apply next-func (car rest)))
+ (car
+ (reduce
+ (lambda (l r)
+ (list (list (cadr r) (car r) (apply next-func (car l)))
+ (string->symbol (cadr l))))
+ 'ignore
+ (append
+ (list (list (apply next-func (caar first))
+ (string->symbol (cadar first))))
+ (cdr first)
+ (list (append rest '("done"))))))))))
+
+(define (parse-value value first . rest)
+ (if (null? rest)
+ (string->number (cadr first))
+ (apply parse-sum (car rest))))
+(define parse-product (make-left-parser parse-value))
+(define parse-sum (make-left-parser parse-product))
+(define parse-expr parse-sum)
+(define (eq-parse str) (apply parse-expr (peg:tree (match-pattern expr str))))
+
+(with-test-prefix "Parsing left-associative equations"
+ (pass-if
+ "1"
+ (equal? (eq-parse "1") 1))
+ (pass-if
+ "1+2"
+ (equal? (eq-parse "1+2") '(+ 1 2)))
+ (pass-if
+ "1+2+3"
+ (equal? (eq-parse "1+2+3") '(+ (+ 1 2) 3)))
+ (pass-if
+ "1+2*3+4"
+ (equal? (eq-parse "1+2*3+4") '(+ (+ 1 (* 2 3)) 4)))
+ (pass-if
+ "1+2/3*(4+5)/6-7-8"
+ (equal? (eq-parse "1+2/3*(4+5)/6-7-8")
+ '(- (- (+ 1 (/ (* (/ 2 3) (+ 4 5)) 6)) 7) 8)))
+ (pass-if
+ "1+1/2*3+(1+1)/2"
+ (equal? (eq-parse "1+1/2*3+(1+1)/2")
+ '(+ (+ 1 (* (/ 1 2) 3)) (/ (+ 1 1) 2)))))
+
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-96-g94027fe,
Andy Wingo <=