This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions

View file

@ -0,0 +1,6 @@
version: 2
updates:
- package-ecosystem: github-actions
directory: /
schedule:
interval: weekly

View file

@ -0,0 +1,54 @@
name: Deploy odoc to GitHub Pages
on:
push:
branches:
- master
permissions: read-all
concurrency:
group: deploy-odoc
cancel-in-progress: true
jobs:
deploy-odoc:
name: Deploy odoc to GitHub Pages
environment:
name: github-pages
url: ${{ steps.deployment.outputs.page_url }}
permissions:
contents: read
id-token: write
pages: write
runs-on: ubuntu-latest
steps:
- name: Checkout tree
uses: actions/checkout@v5
- name: Set-up OCaml
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: "5.2"
- name: Install dependencies
run: opam install . --deps-only --with-doc
- name: Build documentation
run: opam exec -- dune build @doc
- name: Set-up Pages
uses: actions/configure-pages@v5
- name: Upload artifact
uses: actions/upload-pages-artifact@v4
with:
path: _build/default/_doc/_html
- name: Deploy odoc to GitHub Pages
id: deployment
uses: actions/deploy-pages@v4

View file

@ -0,0 +1,32 @@
name: build
on:
- push
- pull_request
jobs:
run:
name: Build
strategy:
matrix:
os:
- macos-latest
- ubuntu-latest
# - windows-latest
ocaml-compiler:
- "4.14"
- "5.2"
include:
- os: ubuntu-24.04-arm
ocaml-compiler: "ocaml-variants.5.2.1+options,ocaml-option-tsan"
runs-on: ${{ matrix.os }}
steps:
- uses: actions/checkout@v5
- run: |
sudo apt update
sudo apt install libunwind-dev
if: ${{ matrix.os == 'ubuntu-24.04-arm' }}
- uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
- run: opam install . --deps-only --with-test
- run: opam exec -- dune build
- run: opam exec -- dune runtest

View file

@ -0,0 +1,16 @@
name: Nix
on:
- push
- pull_request
jobs:
tests:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v5
with:
submodules: true
- uses: cachix/install-nix-action@v31
with:
nix_path: nixpkgs=channel:nixos-unstable
- run: nix develop .#test -c dune runtest

16
unikernel/duniverse/ocaml-re/.gitignore vendored Normal file
View file

@ -0,0 +1,16 @@
.*.swp
_build/
*.bak
setup.data
setup.log
setup.exe
*.native
*.byte
*.docdir
.merlin
*.install
perf.data
*.old
*.ctf
*.bench.sexp
*.trace

View file

@ -0,0 +1,3 @@
version=0.26.2
profile=janestreet
ocaml-version=4.08.0

View file

@ -0,0 +1,15 @@
language: c
sudo: required
install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
script: bash -ex .travis-opam.sh
env:
global:
- PACKAGE=re
matrix:
- OCAML_VERSION=4.03
- OCAML_VERSION=4.04
- OCAML_VERSION=4.05
- OCAML_VERSION=4.06
os:
- linux
- osx

View file

@ -0,0 +1,231 @@
1.14.0 (16-Sep-2025)
--------------------
* Thread-safety with OCaml 5 (#574).
* Introduce [Re.Pcre.get_named_substring_opt]. A non raising version of
[Re.Pcre.get_named_substring] (#525)
* Introduce parsing functions in `Re.{Perl,Pcre,Emacs,Glob}` that return a
result instead of raising. (#542)
* Introduce experimental streaming API `Re.Stream`. (#456)
* Make [Re.Str] functions tail recursive (#539)
* Fix [Re.Pcre.split]. Regression introduced in 1.12 and a previous bug with
[Re.Pcre.split] (#538).
* Avoid parsing unnecessary patterns supported only by `Re.Emacs` in `Re.Str`
(#563)
1.13.1 (30-Sep-2024)
--------------------
* Fix re on jsoo (#150)
1.13.0 (30-Sep-2024)
--------------------
* Add non raising versions of all [Re.Group] functions (#414, fixes #150)
* Add support for hex and octal of the form: `\o{...}` and `\x{...}` (#403)
* Add support for octal characters using `\0dd` and `\ddd` (#402)
* Add support for `\Q...\E` quoted expressions in Pcre and Perl syntax (#401)
* Re.execp and related function raise [Invalid_argument "$function"] when [pos]
or [len] arguments are out of bounds. In 1.12.0, a regerssion was introduced
that raised [Invalid_argument _] from [String.get].
1.12.0 (29-Aug-2024)
--------------------
* Add `Re.split_delim` (#233)
* Fix handling of empty matches in splitting and substitution functions (#233)
* Add support for character classes in `Re.Posix` (#263)
1.11.0 (19-Aug-2023)
--------------------
* Add `Re.group_count` to get the number of groups in a compiled regex (#218)
* Add `Re.exec_partial_detailed` to allow resuming searches from partial inputs
(#219)
* Re-export `Re.Perl`'s `Parse_error` and `Not_supported` exceptions
in Pcre (#222)
* Add support for `DOTALL` flag in `Re.Pcre.regexp` (#225)
* Add support for named groups (#223)
* Add support for some control characters in `Re.Perl` (#227)
1.10.4 (27-Apr-2022)
--------------------
* Improve handling of word boundaries (#179)
1.10.3 (13-Sep-2021)
--------------------
* Glob: change optional argument `?backslash_escapes` to `?match_backslashes`.
The interpretation of backslashes in the glob pattern remains unchanged with
the new option, but forward slashes match backslashes when activated (#199)
1.10.2 (09-Sep-2021)
--------------------
* Fix missing aliases introduced in 1.10.1
1.10.1 (08-Sep-2021)
--------------------
* Glob: add optional argument `?backslash_escapes` to control interpretation of
backslashes (useful under Windows) (#197, #198)
* Restore accidentally deleted `*_seq` deprecated aliases.
1.10.0 (25-Aug-2021)
--------------------
* Add the `[:alpha:]` character class in `Re.Perl` (#169)
* Double asterisk (`**`) in `Re.Glob` (#172)
Like `*` but also match `/` characters when `pathname` is set.
* Double asterisk should match 0 or more directories unless in trailing
position. (#192, fixes #185)
1.9.0 (05-Apr-2019)
-------------------
* Fix regression in `Re.exec_partial` (#164)
* Mov gen related functions to `Re.Gen` and deprecate the old names (#167)
* Introduce `Re.View` that exposes the internal representation (#163)
1.8.0 (04-Aug-2018)
-------------------
* Fix index-out-of-bounds exception in Re.Perl.re (#160)
* Add seq based iterators (#170)
1.7.3 (05-Mar-2018)
-------------------
* Remove dependency on bytes package (#155)
1.7.2 (01-Mar-2018)
-------------------
* Deprecate all Re_* modules. Re_x is now available as Re.X
* Deprecate all re.x sub libraries. Those are all available as Re.X
* Make all function in Re.Str tail recursive.
1.7.1 (19-Oct-2016)
-------------------
* Fix Re_str.global_replace (#132)
1.7.0 (18-Sep-2016)
-------------------
* Fix stack overflow in Re_str.full_split
* Use correct exceptions in Re_str group functions
* Add experimental Re.witness
* Add experimental Re.Group.nb_groups
1.6.1 (20-Jun-2016)
-------------------
* Fix Re.pp (#101)
* Add Re.Group.pp (#102)
1.6.0 (30-May-2016)
-------------------
* Add Re.pp and Re.pp_re (#55)
* Fix ocamldoc syntax (#87)
1.5.0 (04-Jan-2016)
-------------------
* Add Re.exec_opt. Like exec but doesn't raise
* Add Group module. Old group accessors are deprecated.
* Add Mark module
* Improve docs of Re.repn
* Improve docs of Re_pcre
* Fix doc of Re_pcre.match
* Consolidate variants of Re.glob that takes options to modify its behavior
(?period, ?expand_braces). Old variants are deprecated.
* New option ?pathname added for Re_glob.glob. Controls how the `/` character
is matched
1.4.1 (06-Jun-2015)
-------------------
* Fix 4.00.1 compatibilty with tests.
1.4.0 (12-May-2015)
-------------------
* Add Re.{mark,marked,mark_set}. Regexps can now be "marked" to query post
execution if they matched.
1.3.2 (14-Apr-2015)
-------------------
* Fix replacing 0 length matches (#55)
1.3.1 (13-Mar-2015)
-------------------
* Rename {Cset, Automata} to {Re_cset, Re_automata}
1.3.0 (02-Feb-2015)
-------------------
* Add Re.split{,_gen,_token,_full,_full_gen}
* Add Re.replace{,_string}
* Add Re.all{,_gen}
* Add posix classes of the form [:xxx:]
* Add complement suport for posix classes
* Add Multiline and anchored flag to Re_pcre
* Add Re_pcre.full_split
1.2.2 (05-May-2014)
-------------------
* Add a Re.whole_string convenience function to only match whole strings
* Add a ?anchored parameter to functions in Re_glob to specify whole
string matching
* Document Re_glob module
* Fix compilation of submatches occurring inside a Kleen star
* Fix word boundary matching
* Fix definition of Re.xdigit
* Fix Re.exec_partial function
* Fix compilation of patterns of the shape r1r2|r1r3
* Fixed compilation of re.cmxs (Vincent Bernardoff)
* Improved matching of anchored regular expressions: stop as soon as
we know there cannot possibly be any match.
* Updated to OASIS 0.4.x (Vincent Bernardoff)
* Add the linking exception to the license
1.2.1 (07-Apr-2013)
-------------------
* Correct OASIS metadata (Christophe Troestler).
* Fix typo in Invalid_arg error message (Jeremy Yallop).
1.2.0 (15-Jan-2012)
-------------------
* Rename Pcre module to `Re_pcre` to make it more suitable for
upstream packaging (it currently conflicts with the `Pcre` package).
(Mehdi Dogguy).
1.1.0 (05-Sep-2012)
-------------------
* Add a basic Pcre wrapper around Re_perl for porting applications using that
API (Thomas Gazagnaire).
1.0.0 (01-Aug-2012)
-------------------
* Initial public release.

View file

@ -0,0 +1,523 @@
This Software is distributed under the terms of the GNU Lesser
General Public License version 2.1 (included below), or (at your
option) any later version.
As a special exception to the GNU Library General Public License, you
may link, statically or dynamically, a "work that uses the Library"
with a publicly distributed version of the Library to produce an
executable file containing portions of the Library, and distribute
that executable file under terms of your choice, without any of the
additional requirements listed in clause 6 of the GNU Library General
Public License. By "a publicly distributed version of the Library",
we mean either the unmodified Library, or a modified version of the
Library that is distributed under the conditions defined in clause 3
of the GNU Library General Public License. This exception does not
however invalidate any other reasons why the executable file might be
covered by the GNU Library General Public License.
----------------------------------------------------------------------
GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the Lesser GPL. It also counts
as the successor of the GNU Library Public License, version 2, hence
the version number 2.1.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Lesser General Public License, applies to some
specially designated software packages--typically libraries--of the
Free Software Foundation and other authors who decide to use it. You
can use it too, but we suggest you first think carefully about whether
this license or the ordinary General Public License is the better
strategy to use in any particular case, based on the explanations below.
When we speak of free software, we are referring to freedom of use,
not price. Our General Public Licenses are designed to make sure that
you have the freedom to distribute copies of free software (and charge
for this service if you wish); that you receive source code or can get
it if you want it; that you can change the software and use pieces of
it in new free programs; and that you are informed that you can do
these things.
To protect your rights, we need to make restrictions that forbid
distributors to deny you these rights or to ask you to surrender these
rights. These restrictions translate to certain responsibilities for
you if you distribute copies of the library or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link other code with the library, you must provide
complete object files to the recipients, so that they can relink them
with the library after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
We protect your rights with a two-step method: (1) we copyright the
library, and (2) we offer you this license, which gives you legal
permission to copy, distribute and/or modify the library.
To protect each distributor, we want to make it very clear that
there is no warranty for the free library. Also, if the library is
modified by someone else and passed on, the recipients should know
that what they have is not the original version, so that the original
author's reputation will not be affected by problems that might be
introduced by others.
Finally, software patents pose a constant threat to the existence of
any free program. We wish to make sure that a company cannot
effectively restrict the users of a free program by obtaining a
restrictive license from a patent holder. Therefore, we insist that
any patent license obtained for a version of the library must be
consistent with the full freedom of use specified in this license.
Most GNU software, including some libraries, is covered by the
ordinary GNU General Public License. This license, the GNU Lesser
General Public License, applies to certain designated libraries, and
is quite different from the ordinary General Public License. We use
this license for certain libraries in order to permit linking those
libraries into non-free programs.
When a program is linked with a library, whether statically or using
a shared library, the combination of the two is legally speaking a
combined work, a derivative of the original library. The ordinary
General Public License therefore permits such linking only if the
entire combination fits its criteria of freedom. The Lesser General
Public License permits more lax criteria for linking other code with
the library.
We call this license the "Lesser" General Public License because it
does Less to protect the user's freedom than the ordinary General
Public License. It also provides other free software developers Less
of an advantage over competing non-free programs. These disadvantages
are the reason we use the ordinary General Public License for many
libraries. However, the Lesser license provides advantages in certain
special circumstances.
For example, on rare occasions, there may be a special need to
encourage the widest possible use of a certain library, so that it becomes
a de-facto standard. To achieve this, non-free programs must be
allowed to use the library. A more frequent case is that a free
library does the same job as widely used non-free libraries. In this
case, there is little to gain by limiting the free library to free
software only, so we use the Lesser General Public License.
In other cases, permission to use a particular library in non-free
programs enables a greater number of people to use a large body of
free software. For example, permission to use the GNU C Library in
non-free programs enables many more people to use the whole GNU
operating system, as well as its variant, the GNU/Linux operating
system.
Although the Lesser General Public License is Less protective of the
users' freedom, it does ensure that the user of a program that is
linked with the Library has the freedom and the wherewithal to run
that program using a modified version of the Library.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, whereas the latter must
be combined with the library in order to run.
GNU LESSER GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library or other
program which contains a notice placed by the copyright holder or
other authorized party saying it may be distributed under the terms of
this Lesser General Public License (also called "this License").
Each licensee is addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control compilation
and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (1) uses at run time a
copy of the library already present on the user's computer system,
rather than copying library functions into the executable, and (2)
will operate properly with a modified version of the library, if
the user installs one, as long as the modified version is
interface-compatible with the version that the work was made with.
c) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
d) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
e) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the materials to be distributed need not include anything that is
normally distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties with
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Lesser General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the library's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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 2 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
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
<signature of Ty Coon>, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!

View file

@ -0,0 +1,19 @@
DUNE ?= dune
all:
@$(DUNE) build
test:
@$(DUNE) runtest
check:
@$(DUNE) build @runtest @check
.PHONY: check test all clean
.PHONY: release
release: ## Release on Opam
dune-release distrib --skip-build --skip-lint --skip-tests
dune-release publish distrib --verbose
dune-release opam pkg
dune-release opam submit

View file

@ -0,0 +1,77 @@
Description
===========
Re is a regular expression library for OCaml.
[![Build status](https://github.com/ocaml/ocaml-re/actions/workflows/main.yml/badge.svg)](https://github.com/ocaml/ocaml-re/actions/workflows/main.yml)
Contact
=======
This library has been written by Jerome Vouillon
(Jerome.Vouillon@pps.univ-paris-diderot.fr).
It can be downloaded from <https://github.com/ocaml/ocaml-re>
Bug reports, suggestions and contributions are welcome.
Features
========
The following styles of regular expressions are supported:
- Perl-style regular expressions (module `Re.Perl`);
- Posix extended regular expressions (module `Re.Posix`);
- Emacs-style regular expressions (module `Re.Emacs`);
- Shell-style file globbing (module `Re.Glob`).
It is also possible to build regular expressions by combining simpler regular
expressions (module `Re`).
The most notable missing features are **back-references** and
look-ahead/look-behind **assertions**.
There is also a subset of the PCRE interface available in the `Re.Pcre` module.
This makes it easier to port code from that library to Re with minimal changes.
Performances
============
The matches are performed by lazily building a DFA (deterministic
finite automaton) from the regular expression. As a consequence,
matching takes linear time in the length of the matched string.
The compilation of patterns is slower than with libraries using
back-tracking, such as PCRE. But, once a large enough part of the
DFA is built, matching is extremely fast.
Of course, for some combinations of regular expression and string, the
part of the DFA that needs to be build is so large that this point is
never reached, and matching will be slow. This is not expected to
happen often in practice, and actually a lot of expressions that
behaves badly with a backtracking implementation are very efficient
with this implementation.
The library is at the moment entirely written in OCaml. As a
consequence, regular expression matching is much slower when the
library is compiled to bytecode than when it is compiled to native
code.
Here are some timing results (Pentium III 500Mhz):
* Scanning a 1Mb string containing only `a`s, except for the last
character which is a `b`, searching for the pattern `aa?b`
(repeated 100 times):
- RE: 2.6s
- PCRE: 68s
* Regular expression example from http://www.bagley.org/~doug/shootout/ [1]
- RE: 0.43s
- PCRE: 3.68s
[1] this page is no longer up but is available via the Internet Archive
http://web.archive.org/web/20010429190941/http://www.bagley.org/~doug/shootout/bench/regexmatch/
* The large regular expression (about 2000 characters long) that
Unison uses with my preference file to decide whether a file should
be ignored or not. This expression is matched against a filename
about 20000 times.
- RE: 0.31s
- PCRE: 3.7s
However, RE is only faster than PCRE when there are more than about
300 filenames.

View file

@ -0,0 +1,81 @@
* To compile r{i,j} we need a sequence that does not match epsilon
(or a constructor around an expression telling that this expression
does not match epsilon)
* A subexpression repeated by an asterisk ( '*' ) or an interval
expression shall not match a null expression unless this is the only
match for the repetition or it is necessary to satisfy the exact or
minimum number of occurrences for the interval expression.
* There might be a typo in deriv_1/delta_1: should we generate 'TMatch
mark' or 'TMatch mark'? (neither is correct!)
POSIX:
"(a?)*" "b" ""
"(a?)*" "ab" "a"
"((a)|(b))*" "ab" -> "b" none "b"
Str
"(a?)*" "b" no submatch
"(a?)*" "ab" "a"
"((a)|(b))*" "ab" -> "b" "a" "b"
Javascript
"(a?)*" "b" no submatch
"(a?)*" "ab" "a"
"((a)|(b))*" "ab" -> "b" none "b"
PCRE
"(a?)*" "b" ""
"(a?)*" "ab" ""
"(a?)*?" "b" ""
"(a?)*?" "ab" "a"
"((a)|(b))*" "ab" -> "b" "a" "b"
Emacs
"(a?)*" "b" ""
"(a?)*" "ab" ""
"(a?)*?" "b" ""
"(a?)*?" "ab" "a"
"((a)|(b))*" "ab" -> "b" "a" "b"
r{0,0} = eps
r{i+1,j+1} = r,r{i,j}
r{0,j+1} = r,r{0,j} | eps PCRE/Emacs
r{0,j+1} = (r-eps},r{0,j} | eps JavaScript
* Rewrite sequences of sequences when possible...
High priority
=============
* Improve the Perl regular expressions parser
* Character classes (in the three regular expression parsers)
* Reduce memory usage
- More compact representation of character sequences
- Special notation for "anything but this set of characters"
(more generally, optimize the compilation of regular expressions)
* Simple optimisations
- alt containing alt
- epsilon elimination
- Seq (Seq (x,y), z) => Seq (x, Seq (y, z)) under some circumstances
(x or y has a fixed length)
...
* Test suite
Medium priority
===============
* Implement back-references
* Implement look-ahead and look-behind assertions
Low priority
============
* Optimize the main loop for processor that are not register starved
* Rewrite the main loops in C
(but keep the option to compile a pure OCaml version)
* Limit the size of the cached DFAs by removing states that have not
been used recently
* Documentation
Other ideas
===========
* It would be great to have a more generic interface (parameterized
over some abstract tokens).
* Compile checked printers parameterized over match groups (DRY for
literal subexpressions)

View file

@ -0,0 +1,222 @@
open Core
open Core_bench
let str_20_zeroes = String.make 20 '0'
let re_20_zeroes = Re.(str str_20_zeroes)
let lots_of_a's =
String.init 101 ~f:(function
| 100 -> 'b'
| _ -> 'a')
;;
let lots_o_a's_re = Re.(seq [ char 'a'; opt (char 'a'); char 'b' ])
let media_type_re =
let re = Re.Emacs.re ~case:true "[ \t]*\\([^ \t;]+\\)" in
Re.(seq [ start; re ])
;;
(* Taken from https://github.com/rgrinberg/ocaml-uri/blob/903ef1010f9808d6f3f6d9c1fe4b4eabbd76082d/lib/uri.ml*)
let uri_reference =
Re.Posix.re "^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?"
;;
let uris =
[ "https://google.com"
; "http://yahoo.com/xxx/yyy?query=param&one=two"
; "file:/random_crap"
]
;;
let benchmarks =
[ "20 zeroes", re_20_zeroes, [ str_20_zeroes ]
; "lots of a's", lots_o_a's_re, [ lots_of_a's ]
; "media type match", media_type_re, [ " foo/bar ; charset=UTF-8" ]
; "uri", uri_reference, uris
]
;;
let test ~name re f =
[ Bench.Test.create ~name (fun () -> f re)
; (let re () =
let re = lazy (re ()) in
Lazy.force re
in
Bench.Test.create ~name:(sprintf "%s (compiled)" name) (fun () -> f re))
]
;;
let exec_bench exec name (re : Re.t) cases =
Bench.Test.create_group
~name
(List.concat_map cases ~f:(fun data ->
let name =
let len = String.length data in
if len > 70
then Printf.sprintf "%s .. (%d)" (String.sub data ~pos:0 ~len:10) len
else data
in
let re () = Re.compile re in
test ~name re (fun re -> ignore (exec (re ()) data))))
;;
let exec_bench_many exec name re cases =
test
~name
(fun () -> Re.compile re)
(fun re ->
let re = re () in
List.iter cases ~f:(fun x -> ignore (exec re x)))
;;
let string_traversal =
let len = 1000 * 1000 in
let s = String.make len 'a' in
let re =
let re = Re.Pcre.re "aaaaaaaaaaaaaaaaz" in
fun () -> Re.compile re
in
test ~name:"string traversal from #210" re (fun re ->
ignore (Re.execp (re ()) s ~pos:0))
;;
let compile_clean_star =
let c = 'c' in
let s = String.make 10_000 c in
let re = Re.rep (Re.char 'c') in
let re () = Re.compile re in
test ~name:"kleene star compilation" re (fun re -> ignore (Re.execp (re ()) s))
;;
let repeated_sequence =
let s = String.init 256 ~f:Char.of_int_exn in
let re () = Re.repn (Re.str s) 50 (Some 50) |> Re.compile in
let s = List.init 50 ~f:(fun _ -> s) |> String.concat ~sep:"" in
test ~name:"repeated sequence re" re (fun re ->
let re = re () in
ignore (Re.execp re s))
;;
let split =
let s = Bytes.make 1_000 '_' in
for i = 0 to 100 do
Bytes.set s (i * 9) ' '
done;
let s = Bytes.to_string s in
let re () = Re.(rep1 space |> compile) in
test ~name:"split on whitespace" re (fun re -> ignore (Re.split_full (re ()) s))
;;
let prefixes =
let make_ext =
let chars = "abcdefghiklmnopqrstuvwxyz" in
let buf = Buffer.create 4 in
let rec loop remains =
match remains with
| 0 -> Buffer.contents buf
| _ ->
let char = remains mod String.length chars in
Buffer.add_char buf chars.[char];
loop (remains / String.length chars)
in
fun n ->
Buffer.clear buf;
loop n
in
let n_extensions = 100 in
let n_base = 20 in
let base = String.make n_base 'x' ^ "." in
let extensions = List.init n_extensions ~f:make_ext in
let re () =
(* This regular expression can be heavily optimized by computing the shared prefix *)
List.init 100 ~f:(fun i ->
let ext = make_ext i in
let open Re in
seq [ rep1 any; char '.'; str ext ])
|> Re.alt
|> Re.compile
in
let extensions = Array.of_list extensions in
test ~name:"shared prefixes" re (fun re ->
let re = re () in
for i = 0 to Array.length extensions - 1 do
let extension = extensions.(i) in
let str = base ^ extension in
ignore (Re.execp re str)
done)
;;
let benchmarks =
let benches =
List.map benchmarks ~f:(fun (name, re, cases) ->
Bench.Test.create_group
~name
[ exec_bench Re.exec "exec" re cases
; exec_bench Re.execp "execp" re cases
; exec_bench Re.exec_opt "exec_opt" re cases
])
in
let http_benches =
let open Http.Export in
let manual =
[ request, "no group"; request_g, "group" ]
|> List.concat_map ~f:(fun (re, name) ->
let re () = Re.compile re in
test ~name re (fun re ->
let re = re () in
Http.read_all 0 re Http.requests))
|> Bench.Test.create_group ~name:"manual"
in
let many =
[ test
~name:"execp no group"
(fun () -> Re.compile requests)
(fun re -> ignore (Re.execp (re ()) Http.requests))
; test
~name:"all_gen"
(fun () -> Re.compile requests_g)
(fun re -> Http.requests |> Re.all (re ()))
]
|> List.concat
|> Bench.Test.create_group ~name:"auto"
in
Bench.Test.create_group ~name:"http" [ manual; many ]
in
benches
@ [ [ exec_bench_many Re.execp "execp"; exec_bench_many Re.exec_opt "exec_opt" ]
|> List.concat_map ~f:(fun f -> f Tex.ignore_re Tex.ignore_filesnames)
|> Bench.Test.create_group ~name:"tex gitignore"
]
@ [ http_benches ]
@ string_traversal
@ compile_clean_star
@ Memory.benchmarks
@ repeated_sequence
@ split
@ prefixes
;;
let () =
let benchmarks =
match Sys.getenv "RE_BENCH_FILTER" with
| None -> benchmarks
| Some only ->
let only = String.split ~on:',' only in
let filtered =
List.filter benchmarks ~f:(fun bench ->
let name = Bench.Test.name bench in
List.mem only name ~equal:String.equal)
in
(match filtered with
| _ :: _ -> filtered
| [] ->
print_endline "No benchmarks to run. Your options are:";
List.iter benchmarks ~f:(fun bench ->
let name = Bench.Test.name bench in
Printf.printf "- %s\n" name);
exit 1)
in
Memtrace.trace_if_requested ();
Command_unix.run (Bench.make_command benchmarks)
;;

View file

@ -0,0 +1,182 @@
open Core
module Both = struct
type 'a t =
{ lhs : 'a
; rhs : 'a
}
end
module Value = struct
type t =
| Int of int
| Float of float
let of_string s =
try Int (Int.of_string s) with
| _ -> Float (Float.of_string s)
;;
let rec percent_delta x y =
match x, y with
| Int x, Int y ->
let delta = y - x in
let open Float in
Float (100. * Float.of_int delta / Float.of_int x)
| Float x, Float y -> Float Float.(100. * (y - x) / x)
| Float x, Int y -> percent_delta (Float x) (Float (Float.of_int y))
| Int x, Float y -> percent_delta (Float (Float.of_int x)) (Float y)
;;
let to_csv t =
match t with
| Float f -> Float.to_string_hum f
| Int x -> Int.to_string_hum x
;;
let compare x y =
match x, y with
| Float x, Float y -> Float.compare x y
| Int x, Int y -> Int.compare x y
| _, _ -> assert false
;;
end
type 'a bench =
{ name : string
; time_per_run_nanos : 'a
; major_words_per_run : 'a
; promoted_words_per_run : 'a
; minor_words_per_run : 'a
}
let of_sexp (sexp : Sexp.t) =
match sexp with
| Atom _ -> failwith "expected list"
| List fields ->
let kv (sexp : Sexp.t) =
match sexp with
| List [ Atom k; Atom v ] -> Some (k, v)
| _ -> None
in
let fields = List.filter_map fields ~f:kv in
let field name =
List.find_map_exn fields ~f:(fun (k, v) ->
if String.equal k name then Some v else None)
in
let name = field "full_benchmark_name" in
let time_per_run_nanos = Value.of_string (field "time_per_run_nanos") in
let major_words_per_run = Value.of_string (field "major_words_per_run") in
let promoted_words_per_run = Value.of_string (field "promoted_words_per_run") in
let minor_words_per_run = Value.of_string (field "minor_words_per_run") in
{ name
; time_per_run_nanos
; major_words_per_run
; promoted_words_per_run
; minor_words_per_run
}
;;
let parse_all s =
match Sexp.of_string s with
| Atom _ -> failwith "list expected"
| List benches ->
List.map benches ~f:of_sexp
|> String.Map.of_list_with_key_exn ~get_key:(fun v -> v.name)
;;
let merge_one
{ name
; time_per_run_nanos
; major_words_per_run
; promoted_words_per_run
; minor_words_per_run
}
b
=
assert (String.equal name b.name);
{ b with
time_per_run_nanos = { Both.lhs = time_per_run_nanos; rhs = b.time_per_run_nanos }
; major_words_per_run = { Both.lhs = major_words_per_run; rhs = b.major_words_per_run }
; promoted_words_per_run =
{ Both.lhs = promoted_words_per_run; rhs = b.promoted_words_per_run }
; minor_words_per_run = { Both.lhs = minor_words_per_run; rhs = b.minor_words_per_run }
}
;;
let merge lhs rhs =
Map.merge lhs rhs ~f:(fun ~key:_ v ->
match v with
| `Left _ -> None
| `Right _ -> None
| `Both (lhs, rhs) -> Some (merge_one lhs rhs))
;;
let run ~prev ~next =
let report =
let prev = Stdio.In_channel.read_all prev |> parse_all in
let next = Stdio.In_channel.read_all next |> parse_all in
merge prev next
in
let records =
let headers =
[ "name"
; "time_per_run_nanos"
; "delta (%)"
; "major_words_per_run"
; "delta (%)"
; "promoted_words_per_run"
; "delta (%)"
; "minor_words_per_run"
; "delta (%)"
]
in
let values =
Map.to_alist report
|> List.map ~f:snd
|> List.map
~f:
(fun
({ name
; time_per_run_nanos
; major_words_per_run
; promoted_words_per_run
; minor_words_per_run
} :
Value.t Both.t bench)
->
let time_delta =
Value.percent_delta time_per_run_nanos.lhs time_per_run_nanos.rhs
in
let make_delta { Both.lhs; rhs } =
let delta = Value.percent_delta lhs rhs in
[ Value.to_csv lhs; Value.to_csv delta ]
in
( time_delta
, name
:: List.concat
[ make_delta time_per_run_nanos
; make_delta major_words_per_run
; make_delta promoted_words_per_run
; make_delta minor_words_per_run
] ))
|> List.sort ~compare:(fun (x, _) (y, _) -> Value.compare x y)
|> List.map ~f:snd
in
headers :: values
in
let chan = Csv.to_channel Stdio.stdout in
Csv.output_all chan records
;;
let command =
let open Command.Param in
let open Command.Param.Applicative_infix in
Command.basic
~summary:"compare two runs"
(let prev = flag "prev" (required string) ~doc:"sexp file" in
let next = flag "next" (required string) ~doc:"sexp file" in
Command.Param.return (fun prev next () -> run ~prev ~next) <*> prev <*> next)
;;
let () = Command_unix.run command

View file

@ -0,0 +1,35 @@
(env
(dev
(flags
(:standard -w -58))))
(executables
(enabled_if
(not %{env:CI=false}))
(libraries
re
core
base
stdio
threads
core_bench
core_unix.command_unix
memtrace)
(modules :standard \ compare)
(names benchmark))
(executable
(enabled_if
(not %{env:CI=false}))
(name compare)
(modules compare)
(libraries
core
csv
base
core_unix
core_unix.command_unix
core_unix.filename_unix
spawn
stdio
sexplib))

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,494 @@
GET / HTTP/1.1
Host: www.reddit.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /reddit.v_EZwRzV-Ns.css HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /reddit-init.en-us.O1zuMqOOQvY.js HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /reddit.en-us.31yAfSoTsfo.js HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /kill.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /icon.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /favicon.ico HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /AMZM4CWd6zstSC8y.jpg HTTP/1.1
Host: b.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /jz1d5Nm0w97-YyNm.jpg HTTP/1.1
Host: b.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /aWGO99I6yOcNUKXB.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /rZ_rD5TjrJM0E9Aj.css HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /tmsPwagFzyTvrGRx.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /KYgUaLvXCK3TCEJx.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /81pzxT5x2ozuEaxX.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /MFqCUiUVPO5V8t6x.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /TFpYTiAO5aEowokv.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /eMWMpmm9APNeNqcF.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /S-IpsJrOKuaK9GZ8.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /3V6dj9PDsNnheDXn.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /wQ3-VmNXhv8sg4SJ.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ixd1C1njpczEWC22.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /nGsQj15VyOHMwmq8.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /zT4yQmDxQLbIxK1b.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /L5e1HcZLv1iu4nrG.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /WJFFPxD8X4JO_lIG.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /hVMVTDdjuY3bQox5.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /rnWf8CjBcyPQs5y_.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /gZJL1jNylKbGV4d-.jpg HTTP/1.1
Host: d.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /aNd2zNRLXiMnKUFh.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /droparrowgray.gif HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /sprite-reddit.an0Lnf61Ap4.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /ga.js HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
If-Modified-Since: Tue, 29 Oct 2013 19:33:51 GMT
GET /reddit/ads.html?sr=-reddit.com&bust2 HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /pixel/of_destiny.png?v=hOlmDALJCWWdjzfBV4ZxJPmrdCLWB%2Ftq7Z%2Ffp4Q%2FxXbVPPREuMJMVGzKraTuhhNWxCCwi6yFEZg%3D&r=783333388 HTTP/1.1
Host: pixel.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /UNcO-h_QcS9PD-Gn.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://e.thumbs.redditmedia.com/rZ_rD5TjrJM0E9Aj.css
GET /welcome-lines.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /welcome-upvote.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /__utm.gif?utmwv=5.5.1&utms=1&utmn=720496082&utmhn=www.reddit.com&utme=8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512705&utmac=UA-12131688-1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=qR~ HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ImnpOQhbXUPkwceN.png HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ajax/libs/jquery/1.7.1/jquery.min.js HTTP/1.1
Host: ajax.googleapis.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /__utm.gif?utmwv=5.5.1&utms=2&utmn=1493472678&utmhn=www.reddit.com&utmt=event&utme=5(AdBlock*enabled*false)(0)8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512708&utmac=UA-12131688-1&utmni=1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=6R~ HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ados.js?q=43 HTTP/1.1
Host: secure.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /fetch-trackers?callback=jQuery111005268222517967478_1400862512407&ids%5B%5D=t3_25jzeq-t8_k2ii&_=1400862512408 HTTP/1.1
Host: tracker.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ados?t=1400862512892&request={%22Placements%22:[{%22A%22:5146,%22S%22:24950,%22D%22:%22main%22,%22AT%22:5},{%22A%22:5146,%22S%22:24950,%22D%22:%22sponsorship%22,%22AT%22:8}],%22Keywords%22:%22-reddit.com%22,%22Referrer%22:%22http%3A%2F%2Fwww.reddit.com%2F%22,%22IsAsync%22:true,%22WriteResults%22:true} HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /pixel/of_doom.png?id=t3_25jzeq-t8_k2ii&hash=da31d967485cdbd459ce1e9a5dde279fef7fc381&r=1738649500 HTTP/1.1
Host: pixel.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /Extensions/adFeedback.js HTTP/1.1
Host: static.adzrk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /Extensions/adFeedback.css HTTP/1.1
Host: static.adzrk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /reddit/ads-load.html?bust2 HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /Advertisers/a774d7d6148046efa89403a8db635a81.jpg HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo1LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxNSwiZGkiOiI4NmI2Y2UzYWM5NDM0MjhkOTk2ZTg4MjYwZDE5ZTE1YyIsImRtIjoxLCJmYyI6NDE2MTI4LCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ1fQ&s=lwlbFf2Uywt7zVBFRj_qXXu7msY HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966
GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9994987&PluID=0&ord=1400862593644&rtu=-1 HTTP/1.1
Host: bs.serving-sys.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /Advertisers/63cfd0044ffd49c0a71a6626f7a1d8f0.jpg HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9962555&PluID=0&ord=1400862593645&rtu=-1 HTTP/1.1
Host: bs.serving-sys.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
Cookie: S_9994987=6754579095859875029; A4=01fmFvgRnI09SF00000; u2=d1263d39-874b-4a89-86cd-a2ab0860ed4e3Zl040
GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo4LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxOCwiZGkiOiI3OTdlZjU3OWQ5NjE0ODdiODYyMGMyMGJkOTE4YzNiMSIsImRtIjoxLCJmYyI6NDE2MTMxLCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ2fQ&s=OjzxzXAgQksbdQOHNm-bjZcnZPA HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966
GET /subscribe?host_int=1042356184&ns_map=571794054_374233948806,464381511_13349283399&user_id=245722467&nid=1399334269710011966&ts=1400862514 HTTP/1.1
Host: notify8.dropbox.com
Accept-Encoding: identity
Connection: keep-alive
X-Dropbox-Locale: en_US
User-Agent: DropboxDesktopClient/2.7.54 (Macintosh; 10.8; ('i32',); en_US)

View file

@ -0,0 +1,40 @@
open Re
let space = rep blank
let crlf = str "\r\n"
let token = rep1 @@ compl [ rg '\000' '\031'; set "\127)(<>@,;:\\/[]?={}" ]
let meth = token
let version =
let digits = rep1 digit in
let decimal = seq [ digits; opt (seq [ char '.'; digits ]) ] in
seq [ str "HTTP/"; decimal ]
;;
let uri = rep1 (compl [ char '\n' ])
let request_line = [ space; group meth; space; group uri; group version; space ] |> seq
let header =
let key = group (rep1 (Re.compl [ char ':' ])) in
let value = group (rep1 (Re.compl [ char '\n' ])) in
seq [ space; key; space; char ':'; space; value; space; crlf ]
;;
let request' = seq [ request_line; crlf; rep header; crlf ]
module Export = struct
let request = request'
let request_g = request' |> no_group
let requests = request' |> rep1
let requests_g = request' |> no_group |> rep1
end
let requests = Stdio.In_channel.read_all "benchmarks/http-requests.txt"
let rec read_all pos re reqs =
if pos < String.length reqs
then (
let g = Re.exec ~pos re reqs in
let _, pos = Re.Group.offset g 0 in
read_all (pos + 1) re reqs)
;;

View file

@ -0,0 +1,31 @@
open Core
(* This set of benchmarks is designed for testing re's memory usage rather than
speed. *)
module Bench = Core_bench.Bench
let size = 1_000
(* a pathological re that will consume a bunch of memory *)
let re () =
let open Re in
compile @@ seq [ rep (set "01"); char '1'; repn (set "01") size (Some size) ]
;;
(* Another pathological case that is a simplified version of the above *)
let re2 () =
let open Re in
seq [ rep (set "01"); char '1'; repn (set "01") size (Some size); char 'x' ] |> compile
;;
let str = "01" ^ String.make size '1'
let benchmarks =
[ "memory 1", re; "memory 2", re2 ]
|> ListLabels.map ~f:(fun (name, re) ->
Bench.Test.create_indexed ~name ~args:[ 10; 20; 40; 80; 100; size ] (fun len ->
Staged.stage (fun () ->
let re = re () in
let len = Int.min (String.length str) len in
ignore (Re.execp ~pos:0 ~len re str))))
;;

View file

@ -0,0 +1 @@
val benchmarks : Core_bench.Bench.Test.t list

View file

@ -0,0 +1,194 @@
## Core latex/pdflatex auxiliary files:
*.aux
*.lof
*.log
*.lot
*.fls
*.out
*.toc
*.fmt
*.fot
*.cb
*.cb2
## Intermediate documents:
*.dvi
*-converted-to.*
# these rules might exclude image files for figures etc.
# *.ps
# *.eps
# *.pdf
## Generated if empty string is given at "Please type another file name for output:"
.pdf
## Bibliography auxiliary files (bibtex/biblatex/biber):
*.bbl
*.bcf
*.blg
*-blx.aux
*-blx.bib
*.brf
*.run.xml
## Build tool auxiliary files:
*.fdb_latexmk
*.synctex
*.synctex(busy)
*.synctex.gz
*.synctex.gz(busy)
*.pdfsync
## Auxiliary and intermediate files from other packages:
# algorithms
*.alg
*.loa
# achemso
acs-*.bib
# amsthm
*.thm
# beamer
*.nav
*.snm
*.vrb
# cprotect
*.cpt
# fixme
*.lox
#(r)(e)ledmac/(r)(e)ledpar
*.end
*.?end
*.[1-9]
*.[1-9][0-9]
*.[1-9][0-9][0-9]
*.[1-9]R
*.[1-9][0-9]R
*.[1-9][0-9][0-9]R
*.eledsec[1-9]
*.eledsec[1-9]R
*.eledsec[1-9][0-9]
*.eledsec[1-9][0-9]R
*.eledsec[1-9][0-9][0-9]
*.eledsec[1-9][0-9][0-9]R
# glossaries
*.acn
*.acr
*.glg
*.glo
*.gls
*.glsdefs
# gnuplottex
*-gnuplottex-*
# gregoriotex
*.gaux
*.gtex
# hyperref
*.brf
# knitr
*-concordance.tex
# TODO Comment the next line if you want to keep your tikz graphics files
*.tikz
*-tikzDictionary
# listings
*.lol
# makeidx
*.idx
*.ilg
*.ind
*.ist
# minitoc
*.maf
*.mlf
*.mlt
*.mtc
*.mtc[0-9]
*.mtc[1-9][0-9]
# minted
_minted*
*.pyg
# morewrites
*.mw
# mylatexformat
*.fmt
# nomencl
*.nlo
# sagetex
*.sagetex.sage
*.sagetex.py
*.sagetex.scmd
# scrwfile
*.wrt
# sympy
*.sout
*.sympy
sympy-plots-for-*.tex/
# pdfcomment
*.upa
*.upb
# pythontex
*.pytxcode
pythontex-files-*/
# thmtools
*.loe
# TikZ & PGF
*.dpth
*.md5
*.auxlock
# todonotes
*.tdo
# easy-todo
*.lod
# xindy
*.xdy
# xypic precompiled matrices
*.xyc
# endfloat
*.ttt
*.fff
# Latexian
TSWLatexianTemp*
## Editors:
# WinEdt
*.bak
*.sav
# Texpad
.texpadtmp
# Kile
*.backup
# KBibTeX
*~[0-9]*

View file

@ -0,0 +1,17 @@
open Core
let ignore_re =
Stdio.In_channel.read_lines "benchmarks/tex.gitignore"
|> List.map ~f:(fun s ->
match Base.String.lsplit2 s ~on:'#' with
| Some (pattern, _comment) -> pattern
| None -> s)
|> List.filter_map ~f:(fun s ->
match Base.String.strip s with
| "" -> None
| s -> Some s)
|> List.map ~f:Re.Glob.glob
|> Re.alt
;;
let ignore_filesnames = Stdio.In_channel.read_lines "benchmarks/files"

View file

@ -0,0 +1,52 @@
(env
(_
(flags
(:standard -w -53))))
(library
(name re_str)
(public_name re.str)
(wrapped false)
(modules re_str)
(synopsis "Deprecated. Use Re.Str")
(libraries re))
(library
(name re_pcre)
(public_name re.pcre)
(wrapped false)
(modules re_pcre)
(synopsis "Deprecated. Use Re.Pcre")
(libraries re))
(library
(name re_perl)
(public_name re.perl)
(wrapped false)
(modules re_perl)
(synopsis "Deprecated. Use Re.Perl")
(libraries re))
(library
(name re_posix)
(public_name re.posix)
(wrapped false)
(modules re_posix)
(synopsis "Deprecated. Use Re.Posix")
(libraries re))
(library
(name re_emacs)
(public_name re.emacs)
(wrapped false)
(modules re_emacs)
(synopsis "Deprecated. Use Re.Emacs")
(libraries re))
(library
(name re_glob)
(public_name re.glob)
(wrapped false)
(modules re_glob)
(synopsis "Deprecated. Use Re.Glob")
(libraries re))

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Emacs"]
include Re.Emacs

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Glob"]
include Re.Glob

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Pcre"]
include Re.Pcre

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Perl"]
include Re.Perl

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Posix"]
include Re.Posix

View file

@ -0,0 +1,3 @@
[@@@deprecated "Use Re.Str"]
include Re.Str

View file

@ -0,0 +1,4 @@
(env
(_
(flags
(:standard -w -50))))

View file

@ -0,0 +1,35 @@
(lang dune 3.15)
(name re)
(generate_opam_files true)
(implicit_transitive_deps false)
(license "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception")
(maintainers "Rudi Grinberg <me@rgrinberg.com>")
(authors
"Jerome Vouillon"
"Thomas Gazagnaire"
"Anil Madhavapeddy"
"Rudi Grinberg"
"Gabriel Radanne")
(source (github ocaml/ocaml-re))
(package
(name re)
(synopsis "RE is a regular expression library for OCaml")
(depends
(ocaml (>= 4.12.0))
(ppx_expect :with-test)
(ounit2 :with-test)
(js_of_ocaml :with-test))
(description "
Pure OCaml regular expressions with:
* Perl-style regular expressions (module Re.Perl)
* Posix extended regular expressions (module Re.Posix)
* Emacs-style regular expressions (module Re.Emacs)
* Shell-style file globbing (module Re.Glob)
* Compatibility layer for OCaml's built-in Str module (module Re.Str)
"))

79
unikernel/duniverse/ocaml-re/flake.lock generated Normal file
View file

@ -0,0 +1,79 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"inputs": {
"nixpkgs": "nixpkgs_2"
},
"locked": {
"lastModified": 1752953760,
"narHash": "sha256-HEskLVQGF48brLMmo3Dhb9rdm0D0mCG4ymPJcZylmgc=",
"owner": "nix-ocaml",
"repo": "nix-overlays",
"rev": "324e1583c2104ebee89ebb8872b0ee9231fb568c",
"type": "github"
},
"original": {
"owner": "nix-ocaml",
"repo": "nix-overlays",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1752385071,
"narHash": "sha256-lj4vD716tbbWtDzGITJGfPPIRU54H5uynlnALJHyhOk=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e2e7b4a2013f5f73eb85956aa28e9655e5d9601a",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e2e7b4a2013f5f73eb85956aa28e9655e5d9601a",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

View file

@ -0,0 +1,85 @@
{
description = "ocaml-re flake";
inputs.flake-utils.url = "github:numtide/flake-utils";
inputs.nixpkgs.url = "github:nix-ocaml/nix-overlays";
outputs = { self, nixpkgs, flake-utils }:
flake-utils.lib.eachDefaultSystem (system:
let
extraBuildInputs = pkgs:
with pkgs.ocamlPackages; [
core_bench
memtrace
];
checkInputs = pkgs:
with pkgs.ocamlPackages; [
ounit
js_of_ocaml
ppx_expect
pkgs.nodejs-slim
];
devInputs = pkgs:
with pkgs.ocamlPackages; [
ocaml-lsp
pkgs.ocamlformat_0_26_2
csv
pkgs.tabview
];
makePackages = pkgs: rec {
default = re;
re = pkgs.ocamlPackages.buildDunePackage {
pname = "re";
version = "n/a";
src = ./.;
duneVersion = "3";
propagatedBuildInputs = with pkgs.ocamlPackages; [ seq ];
# Other check deps depend on re itself
checkInputs = with pkgs.ocamlPackages; [ ounit ];
doCheck = true;
};
};
ocamlVersionOverlay =
(ocaml: self: super: { ocamlPackages = ocaml super.ocaml-ng; });
framePointers = ocaml: ocaml.override { framePointerSupport = true; };
framePointersOverlay = self: super: {
ocamlPackages = super.ocamlPackages.overrideScope
(oself: osuper: { ocaml = framePointers osuper.ocaml; });
};
makeNixpkgs = ocaml:
nixpkgs.legacyPackages.${system}.appendOverlays
[ (ocamlVersionOverlay ocaml) ];
in rec {
devShells.test = let
pkgs = makeNixpkgs (ocaml: ocaml.ocamlPackages_5_2);
packages = makePackages pkgs;
in pkgs.mkShell {
inputsFrom = pkgs.lib.attrValues packages;
buildInputs = extraBuildInputs pkgs ++ checkInputs pkgs;
};
devShells.default = let
pkgs = makeNixpkgs (ocaml: ocaml.ocamlPackages_5_2);
packages = makePackages pkgs;
in pkgs.mkShell {
inputsFrom = pkgs.lib.attrValues packages;
buildInputs = extraBuildInputs pkgs ++ devInputs pkgs
++ checkInputs pkgs;
};
devShells.fp = let
pkgs = (makeNixpkgs (ocaml: ocaml.ocamlPackages_5_2)).appendOverlays
[ framePointersOverlay ];
packages = makePackages pkgs;
in pkgs.mkShell {
inputsFrom = pkgs.lib.attrValues packages;
buildInputs = extraBuildInputs pkgs ++ devInputs pkgs;
};
devShells.memtrace = let
pkgs = makeNixpkgs (ocaml: ocaml.ocamlPackages_4_14);
packages = makePackages pkgs;
in pkgs.mkShell {
inputsFrom = pkgs.lib.attrValues packages;
buildInputs = extraBuildInputs pkgs
++ [ pkgs.ocamlPackages.memtrace_viewer ];
};
});
}

View file

@ -0,0 +1,444 @@
open Import
type ('a, _) ast =
| Alternative : 'a list -> ('a, [> `Uncased ]) ast
| No_case : 'a -> ('a, [> `Cased ]) ast
| Case : 'a -> ('a, [> `Cased ]) ast
let dyn_of_ast f =
let open Dyn in
function
| Alternative xs -> variant "Alternative" (List.map xs ~f)
| No_case a -> variant "No_case" [ f a ]
| Case a -> variant "Case" [ f a ]
;;
let empty_alternative : ('a, 'b) ast = Alternative []
let equal_ast (type a) eq (x : (a, [ `Uncased ]) ast) (y : (a, [ `Uncased ]) ast) =
match x, y with
| Alternative a, Alternative b -> List.equal ~eq a b
;;
let pp_ast (type a b) f fmt (ast : (a, b) ast) =
let open Fmt in
let var s re = sexp fmt s f re in
match ast with
| Alternative alt -> sexp fmt "Alternative" (list f) alt
| Case c -> var "Case" c
| No_case c -> var "No_case" c
;;
type cset =
| Cset of Cset.t
| Intersection of cset list
| Complement of cset list
| Difference of cset * cset
| Cast of (cset, [ `Cased | `Uncased ]) ast
let rec dyn_of_cset =
let open Dyn in
function
| Cset cset -> variant "Cset" [ Cset.to_dyn cset ]
| Intersection xs -> variant "Intersection" (List.map xs ~f:dyn_of_cset)
| Complement xs -> variant "Complement" (List.map xs ~f:dyn_of_cset)
| Difference (x, y) -> variant "Difference" [ dyn_of_cset x; dyn_of_cset y ]
| Cast c -> variant "Cast" [ dyn_of_ast dyn_of_cset c ]
;;
type ('a, 'case) gen =
| Set of 'a
| Ast of (('a, 'case) gen, 'case) ast
| Sequence of ('a, 'case) gen list
| Repeat of ('a, 'case) gen * int * int option
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| End_of_str
| Last_end_of_line
| Start
| Stop
| Group of string option * ('a, 'case) gen
| No_group of ('a, 'case) gen
| Nest of ('a, 'case) gen
| Pmark of Pmark.t * ('a, 'case) gen
| Sem of Automata.Sem.t * ('a, 'case) gen
| Sem_greedy of Automata.Rep_kind.t * ('a, 'case) gen
let rec dyn_of_gen f =
let open Dyn in
function
| Set a -> variant "Set" [ f a ]
| Ast ast -> variant "Ast" [ dyn_of_ast (dyn_of_gen f) ast ]
| Sequence xs -> variant "Sequence" (List.map xs ~f:(dyn_of_gen f))
| Repeat (gen, min, max) ->
let base =
match max with
| None -> []
| Some x -> [ int x ]
in
variant "Repeat" (dyn_of_gen f gen :: int min :: base)
| Beg_of_line -> enum "Beg_of_line"
| End_of_line -> enum "End_of_line"
| Beg_of_word -> enum "Beg_of_word"
| End_of_word -> enum "End_of_word"
| Not_bound -> enum "Not_bound"
| Beg_of_str -> enum "Beg_of_str"
| End_of_str -> enum "End_of_str"
| Last_end_of_line -> enum "Last_end_of_line"
| Start -> enum "Start"
| Stop -> enum "Stop"
| Group (name, t) ->
let args =
let args = [ dyn_of_gen f t ] in
match name with
| None -> args
| Some name -> string name :: args
in
variant "Group" args
| No_group x -> variant "No_group" [ dyn_of_gen f x ]
| Nest x -> variant "Nest" [ dyn_of_gen f x ]
| Pmark (pmark, t) -> variant "Pmark" [ Pmark.to_dyn pmark; dyn_of_gen f t ]
| Sem (sem, t) -> variant "Sem" [ Automata.Sem.to_dyn sem; dyn_of_gen f t ]
| Sem_greedy (rep, t) ->
variant "Sem_greedy" [ Automata.Rep_kind.to_dyn rep; dyn_of_gen f t ]
;;
let rec pp_gen pp_cset fmt t =
let open Format in
let open Fmt in
let pp = pp_gen pp_cset in
let var s re = sexp fmt s pp re in
let seq s rel = sexp fmt s (list pp) rel in
match t with
| Set cset -> pp_cset fmt cset
| Sequence sq -> seq "Sequence" sq
| Repeat (re, start, stop) ->
let pp' fmt () = fprintf fmt "%a@ %d%a" pp re start optint stop in
sexp fmt "Repeat" pp' ()
| Beg_of_line -> str fmt "Beg_of_line"
| End_of_line -> str fmt "End_of_line"
| Beg_of_word -> str fmt "Beg_of_word"
| End_of_word -> str fmt "End_of_word"
| Not_bound -> str fmt "Not_bound"
| Beg_of_str -> str fmt "Beg_of_str"
| End_of_str -> str fmt "End_of_str"
| Last_end_of_line -> str fmt "Last_end_of_line"
| Start -> str fmt "Start"
| Stop -> str fmt "Stop"
| Group (None, c) -> var "Group" c
| Group (Some n, c) -> sexp fmt "Named_group" (pair str pp) (n, c)
| Nest c -> var "Nest" c
| Pmark (m, r) -> sexp fmt "Pmark" (pair Pmark.pp pp) (m, r)
| Ast a -> pp_ast pp fmt a
| Sem (sem, a) -> sexp fmt "Sem" (pair Automata.Sem.pp pp) (sem, a)
| Sem_greedy (k, re) -> sexp fmt "Sem_greedy" (pair Automata.Rep_kind.pp pp) (k, re)
| No_group c -> var "No_group" c
;;
let rec pp_cset fmt cset =
let open Fmt in
let seq s rel = sexp fmt s (list pp_cset) rel in
match cset with
| Cast s -> pp_ast pp_cset fmt s
| Cset s -> sexp fmt "Set" Cset.pp s
| Intersection c -> seq "Intersection" c
| Complement c -> seq "Complement" c
| Difference (a, b) -> sexp fmt "Difference" (pair pp_cset pp_cset) (a, b)
;;
let rec equal cset x1 x2 =
match x1, x2 with
| Set s1, Set s2 -> cset s1 s2
| Sequence l1, Sequence l2 -> List.equal ~eq:(equal cset) l1 l2
| Repeat (x1', i1, j1), Repeat (x2', i2, j2) ->
Int.equal i1 i2 && Option.equal Int.equal j1 j2 && equal cset x1' x2'
| Beg_of_line, Beg_of_line
| End_of_line, End_of_line
| Beg_of_word, Beg_of_word
| End_of_word, End_of_word
| Not_bound, Not_bound
| Beg_of_str, Beg_of_str
| End_of_str, End_of_str
| Last_end_of_line, Last_end_of_line
| Start, Start
| Stop, Stop -> true
| Group _, Group _ ->
(* Do not merge groups! *)
false
| Pmark (m1, r1), Pmark (m2, r2) -> Pmark.equal m1 m2 && equal cset r1 r2
| Nest x, Nest y -> equal cset x y
| Ast x, Ast y -> equal_ast (equal cset) x y
| Sem (sem, a), Sem (sem', a') -> Poly.equal sem sem' && equal cset a a'
| Sem_greedy (rep, a), Sem_greedy (rep', a') -> Poly.equal rep rep' && equal cset a a'
| _ -> false
;;
type t = (cset, [ `Cased | `Uncased ]) gen
type no_case = (Cset.t, [ `Uncased ]) gen
let to_dyn = dyn_of_gen dyn_of_cset
let pp = pp_gen pp_cset
let cset cset = Set (Cset cset)
let rec handle_case_cset ign_case = function
| Cset s -> if ign_case then Cset.case_insens s else s
| Cast (Alternative l) -> List.map ~f:(handle_case_cset ign_case) l |> Cset.union_all
| Complement l ->
List.map ~f:(handle_case_cset ign_case) l |> Cset.union_all |> Cset.diff Cset.cany
| Difference (r, r') ->
Cset.inter
(handle_case_cset ign_case r)
(Cset.diff Cset.cany (handle_case_cset ign_case r'))
| Intersection l -> List.map ~f:(handle_case_cset ign_case) l |> Cset.intersect_all
| Cast (No_case a) -> handle_case_cset true a
| Cast (Case a) -> handle_case_cset false a
;;
let rec handle_case ign_case : t -> (Cset.t, [ `Uncased ]) gen = function
| Set s -> Set (handle_case_cset ign_case s)
| Sequence l -> Sequence (List.map ~f:(handle_case ign_case) l)
| Ast (Alternative l) ->
let l = List.map ~f:(handle_case ign_case) l in
Ast (Alternative l)
| Repeat (r, i, j) -> Repeat (handle_case ign_case r, i, j)
| ( Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| End_of_str
| Last_end_of_line
| Start
| Stop ) as r -> r
| Sem (k, r) -> Sem (k, handle_case ign_case r)
| Sem_greedy (k, r) -> Sem_greedy (k, handle_case ign_case r)
| Group (n, r) -> Group (n, handle_case ign_case r)
| No_group r -> No_group (handle_case ign_case r)
| Nest r -> Nest (handle_case ign_case r)
| Ast (Case r) -> handle_case false r
| Ast (No_case r) -> handle_case true r
| Pmark (i, r) -> Pmark (i, handle_case ign_case r)
;;
module Export = struct
type nonrec t = t
let pp = pp
let seq = function
| [ r ] -> r
| l -> Sequence l
;;
let char =
let f = Dense_map.make ~size:256 ~f:(fun i -> cset (Cset.csingle (Char.chr i))) in
fun c -> f (Char.code c)
;;
let any = cset Cset.cany
let str s : t =
let l = ref [] in
for i = String.length s - 1 downto 0 do
l := char s.[i] :: !l
done;
seq !l
;;
let as_set_elems elems =
match
List.map elems ~f:(function
| Set e -> e
| _ -> raise_notrace Exit)
with
| exception Exit -> None
| e -> Some e
;;
let empty : t = Ast empty_alternative
let alt (elems : t list) : t =
match elems with
| [] -> empty
| [ x ] -> x
| _ ->
(match as_set_elems elems with
| None -> Ast (Alternative elems)
| Some elems -> Set (Cast (Alternative elems)))
;;
let epsilon = seq []
let repn r i j =
if i < 0 then invalid_arg "Re.repn";
match j, i with
| Some j, _ when j < i -> invalid_arg "Re.repn"
| Some 0, 0 -> epsilon
| Some 1, 1 -> r
| _ -> Repeat (r, i, j)
;;
let rep r = repn r 0 None
let rep1 r = repn r 1 None
let opt r = repn r 0 (Some 1)
let bol = Beg_of_line
let eol = End_of_line
let bow = Beg_of_word
let eow = End_of_word
let word r = seq [ bow; r; eow ]
let not_boundary = Not_bound
let bos = Beg_of_str
let eos = End_of_str
let whole_string r = seq [ bos; r; eos ]
let leol = Last_end_of_line
let start = Start
let stop = Stop
type 'b f = { f : 'a. 'a -> ('a, 'b) ast }
let make_set f t =
match t with
| Set x -> Set (Cast (f.f x))
| _ -> Ast (f.f t)
;;
let preserve_set f t =
match t with
| Set _ -> t
| _ -> f t
;;
let longest = preserve_set (fun t -> Sem (`Longest, t))
let shortest = preserve_set (fun t -> Sem (`Shortest, t))
let first = preserve_set (fun t -> Sem (`First, t))
let greedy = preserve_set (fun t -> Sem_greedy (`Greedy, t))
let non_greedy = preserve_set (fun t -> Sem_greedy (`Non_greedy, t))
let group ?name r = Group (name, r)
let no_group = preserve_set (fun t -> No_group t)
let nest r = Nest r
let set str = cset (Cset.set str)
let mark r =
let i = Pmark.gen () in
i, Pmark (i, r)
;;
(**** Character sets ****)
let as_set_or_error name elems =
match as_set_elems elems with
| None -> invalid_arg name
| Some s -> s
;;
let inter elems = Set (Intersection (as_set_or_error "Re.inter" elems))
let compl elems = Set (Complement (as_set_or_error "Re.compl" elems))
let diff r r' =
match r, r' with
| Set r, Set r' -> Set (Difference (r, r'))
| _, _ -> invalid_arg "Re.diff"
;;
let case =
let f = { f = (fun r -> Case r) } in
fun t -> make_set f t
;;
let no_case =
let f = { f = (fun r -> No_case r) } in
fun t -> make_set f t
;;
let witness t =
let rec witness (t : no_case) =
match t with
| Set c -> String.make 1 (Cset.to_char (Cset.pick c))
| Sequence xs -> String.concat "" (List.map ~f:witness xs)
| Ast (Alternative (x :: _)) -> witness x
| Ast (Alternative []) -> assert false
| Repeat (r, from, _to) ->
let w = witness r in
let b = Buffer.create (String.length w * from) in
for _i = 1 to from do
Buffer.add_string b w
done;
Buffer.contents b
| No_group r -> witness r
| Sem_greedy (_, r) | Sem (_, r) | Nest r | Pmark (_, r) | Group (_, r) -> witness r
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| Last_end_of_line
| Start
| Stop
| End_of_str -> ""
in
witness (handle_case false t)
;;
end
open Export
let rec merge_sequences = function
| [] -> []
| Ast (Alternative l') :: r -> merge_sequences (l' @ r)
| Sequence (x :: y) :: r ->
(match merge_sequences r with
| Sequence (x' :: y') :: r' when equal Cset.equal x x' ->
Sequence [ x; Ast (Alternative [ seq y; seq y' ]) ] :: r'
| r' -> Sequence (x :: y) :: r')
| x :: r -> x :: merge_sequences r
;;
(*XXX Use a better algorithm allowing non-contiguous regions? *)
let colorize color_map (regexp : no_case) =
let lnl = ref false in
let rec colorize regexp =
match (regexp : no_case) with
| Set s -> Color_map.split color_map s
| Sequence l -> List.iter ~f:colorize l
| Ast (Alternative l) -> List.iter ~f:colorize l
| Repeat (r, _, _) -> colorize r
| Beg_of_line | End_of_line -> Color_map.split color_map Cset.nl
| Beg_of_word | End_of_word | Not_bound -> Color_map.split color_map Cset.cword
| Beg_of_str | End_of_str | Start | Stop -> ()
| Last_end_of_line -> lnl := true
| No_group r | Group (_, r) | Nest r | Pmark (_, r) -> colorize r
| Sem (_, r) | Sem_greedy (_, r) -> colorize r
in
colorize regexp;
!lnl
;;
let rec anchored_ast : (t, _) ast -> bool = function
| Alternative als -> List.for_all ~f:anchored als
| No_case r | Case r -> anchored r
and anchored : t -> bool = function
| Ast a -> anchored_ast a
| Sequence l -> List.exists ~f:anchored l
| Repeat (r, i, _) -> i > 0 && anchored r
| No_group r | Sem (_, r) | Sem_greedy (_, r) | Group (_, r) | Nest r | Pmark (_, r) ->
anchored r
| Set _
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| End_of_str
| Last_end_of_line
| Stop -> false
| Beg_of_str | Start -> true
;;
let t_of_cset x = Set x

View file

@ -0,0 +1,91 @@
type ('a, _) ast = private
| Alternative : 'a list -> ('a, [> `Uncased ]) ast
| No_case : 'a -> ('a, [> `Cased ]) ast
| Case : 'a -> ('a, [> `Cased ]) ast
type cset = private
| Cset of Cset.t
| Intersection of cset list
| Complement of cset list
| Difference of cset * cset
| Cast of (cset, [ `Cased | `Uncased ]) ast
type ('a, 'case) gen = private
| Set of 'a
| Ast of (('a, 'case) gen, 'case) ast
| Sequence of ('a, 'case) gen list
| Repeat of ('a, 'case) gen * int * int option
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| End_of_str
| Last_end_of_line
| Start
| Stop
| Group of string option * ('a, 'case) gen
| No_group of ('a, 'case) gen
| Nest of ('a, 'case) gen
| Pmark of Pmark.t * ('a, 'case) gen
| Sem of Automata.Sem.t * ('a, 'case) gen
| Sem_greedy of Automata.Rep_kind.t * ('a, 'case) gen
type t = (cset, [ `Cased | `Uncased ]) gen
type no_case = (Cset.t, [ `Uncased ]) gen
val to_dyn : t -> Dyn.t
val pp : t Fmt.t
val merge_sequences : (Cset.t, [ `Uncased ]) gen list -> (Cset.t, [ `Uncased ]) gen list
val handle_case : bool -> t -> (Cset.t, [ `Uncased ]) gen
val anchored : t -> bool
val colorize : Color_map.t -> (Cset.t, [ `Uncased ]) gen -> bool
module Export : sig
type nonrec t = t
val empty : t
val epsilon : t
val str : string -> t
val no_case : t -> t
val case : t -> t
val diff : t -> t -> t
val compl : t list -> t
val repn : t -> int -> int option -> t
val inter : t list -> t
val char : char -> t
val any : t
val set : string -> t
val mark : t -> Pmark.t * t
val nest : t -> t
val no_group : t -> t
val whole_string : t -> t
val leol : t
val longest : t -> t
val greedy : t -> t
val non_greedy : t -> t
val stop : t
val not_boundary : t
val group : ?name:string -> t -> t
val word : t -> t
val first : t -> t
val bos : t
val bow : t
val eow : t
val eos : t
val bol : t
val start : t
val eol : t
val opt : t -> t
val rep : t -> t
val rep1 : t -> t
val alt : t list -> t
val shortest : t -> t
val seq : t list -> t
val pp : t Fmt.t
val witness : t -> string
end
val cset : Cset.t -> t
val t_of_cset : cset -> t

View file

@ -0,0 +1,781 @@
open Import
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
let hash_combine h accu = (accu * 65599) + h
module Ids : sig
module Id : sig
type t
val equal : t -> t -> bool
val zero : t
val hash : t -> int
val pp : t Fmt.t
module Hash_set : sig
type id := t
type t
val create : unit -> t
val mem : t -> id -> bool
val add : t -> id -> unit
val clear : t -> unit
end
end
type t
val create : unit -> t
val next : t -> Id.t
end = struct
module Id = struct
type t = int
module Hash_set = Hash_set
let equal = Int.equal
let zero = 0
let hash x = x
let pp = Fmt.int
end
type t = int ref
let create () = ref 0
let next t =
incr t;
!t
;;
end
module Id = Ids.Id
module Sem = struct
type t =
[ `Longest
| `Shortest
| `First
]
let to_string = function
| `Shortest -> "short"
| `Longest -> "long"
| `First -> "first"
;;
let to_dyn t = Dyn.enum (to_string t)
let equal = Poly.equal
let pp ch k = Format.pp_print_string ch (to_string k)
end
module Rep_kind = struct
type t =
[ `Greedy
| `Non_greedy
]
let to_string = function
| `Greedy -> "Greedy"
| `Non_greedy -> "Non_greedy"
;;
let to_dyn t = Dyn.enum (to_string t)
let pp fmt t = Format.pp_print_string fmt (to_string t)
end
module Mark : sig
type t = private int
val compare : t -> t -> int
val equal : t -> t -> bool
val pp : t Fmt.t
val to_dyn : t -> Dyn.t
val start : t
val prev : t -> t
val next : t -> t
val next2 : t -> t
val group_count : t -> int
val outside_range : t -> start_inclusive:t -> stop_inclusive:t -> bool
end = struct
type t = int
let equal = Int.equal
let compare = Int.compare
let pp = Format.pp_print_int
let to_dyn = Dyn.int
let start = 0
let prev x = pred x
let next x = succ x
let next2 x = x + 2
let group_count x = x / 2
let outside_range t ~start_inclusive ~stop_inclusive =
t < start_inclusive || t > stop_inclusive
;;
end
module Idx : sig
type t = private int
val pp : t Fmt.t
val to_dyn : t -> Dyn.t
val to_int : t -> int
val unknown : t
val initial : t
val used : t -> bool
val make : int -> t
val equal : t -> t -> bool
end = struct
type t = int
let to_dyn = Dyn.int
let to_int x = x
let pp = Format.pp_print_int
let used t = t >= 0
let make x = x
let equal = Int.equal
let unknown = -1
let initial = 0
end
module Expr = struct
type t =
{ id : Id.t
; def : def
}
and def =
| Cst of Cset.t
| Alt of t list
| Seq of Sem.t * t * t
| Eps
| Rep of Rep_kind.t * Sem.t * t
| Mark of Mark.t
| Erase of Mark.t * Mark.t
| Before of Category.t
| After of Category.t
| Pmark of Pmark.t
let wrap_sem sem sem' v =
let open Dyn in
let name = Sem.to_string sem' in
match sem with
| Some sem when Sem.equal sem sem' -> v
| None | Some _ ->
(match v with
| List v -> variant name v
| _ -> variant name [ v ])
;;
let rec seq_as_list sem = function
| Eps -> []
| Cst cs -> [ Cst cs ]
| Seq (sem', x, y) ->
if Sem.equal sem sem'
then x.def :: seq_as_list sem y.def
else raise_notrace Not_found
| _ -> raise_notrace Not_found
;;
let seq_as_list sem t =
match seq_as_list sem t with
| exception Not_found -> None
| s -> Some s
;;
let rec dyn_of_def sem =
let open Dyn in
function
| Cst cset -> Cset.to_dyn cset
| Alt alt -> variant "Alt" (List.map ~f:(to_dyn sem) alt)
| Seq (sem', x, y) ->
let to_dyn = to_dyn (Some sem') in
let x =
match seq_as_list sem' y.def with
| None -> variant "Seq" [ to_dyn x; to_dyn y ]
| Some y -> variant "Seq" (to_dyn x :: List.map y ~f:(dyn_of_def sem))
in
wrap_sem sem sem' x
| Eps -> Enum "Eps"
| Rep (_, sem', t) -> wrap_sem sem sem' (variant "Rep" [ to_dyn (Some sem') t ])
| Mark m -> variant "Mark" [ Mark.to_dyn m ]
| Pmark m -> variant "Pmark" [ Pmark.to_dyn m ]
| Erase (x, y) -> variant "Erase" [ Mark.to_dyn x; Mark.to_dyn y ]
| Before c -> variant "Before" [ Category.to_dyn c ]
| After c -> variant "After" [ Category.to_dyn c ]
and to_dyn sem { id = _; def } = dyn_of_def sem def
let rec pp_with_sem sem ch e =
let open Fmt in
match e.def with
| Cst l -> sexp ch "cst" Cset.pp l
| Alt l -> sexp ch "alt" (list (pp_with_sem sem)) l
| Seq (k, e, e') ->
sexp ch "seq" (triple Sem.pp (pp_with_sem sem) (pp_with_sem sem)) (k, e, e')
| Eps -> str ch "eps"
| Rep (_rk, k, e) -> sexp ch "rep" (pair Sem.pp (pp_with_sem (Some k))) (k, e)
| Mark i -> sexp ch "mark" Mark.pp i
| Pmark i -> sexp ch "pmark" Pmark.pp i
| Erase (b, e) -> sexp ch "erase" (pair Mark.pp Mark.pp) (b, e)
| Before c -> sexp ch "before" Category.pp c
| After c -> sexp ch "after" Category.pp c
;;
let pp = pp_with_sem None
let eps_expr = { id = Id.zero; def = Eps }
let mk ids def = { id = Ids.next ids; def }
let empty ids = mk ids (Alt [])
let cst ids s = if Cset.is_empty s then empty ids else mk ids (Cst s)
let eps ids = mk ids Eps
let rep ids kind sem x = mk ids (Rep (kind, sem, x))
let mark ids m = mk ids (Mark m)
let pmark ids i = mk ids (Pmark i)
let erase ids m m' = mk ids (Erase (m, m'))
let before ids c = mk ids (Before c)
let after ids c = mk ids (After c)
let alt ids = function
| [] -> empty ids
| [ c ] -> c
| l -> mk ids (Alt l)
;;
let seq ids (kind : Sem.t) x y =
match x.def, y.def with
| Alt [], _ -> x
| _, Alt [] -> y
| Eps, _ -> y
| _, Eps when Sem.equal kind `First -> x
| _ -> mk ids (Seq (kind, x, y))
;;
let is_eps expr =
match expr.def with
| Eps -> true
| _ -> false
;;
let rec rename ids x =
match x.def with
| Cst _ | Eps | Mark _ | Pmark _ | Erase _ | Before _ | After _ -> mk ids x.def
| Alt l -> mk ids (Alt (List.map ~f:(rename ids) l))
| Seq (k, y, z) -> mk ids (Seq (k, rename ids y, rename ids z))
| Rep (g, k, y) -> mk ids (Rep (g, k, rename ids y))
;;
end
type expr = Expr.t
include Expr
module Marks = struct
type t =
{ marks : (Mark.t * Idx.t) list
; pmarks : Pmark.Set.t
}
let to_dyn { marks; pmarks } : Dyn.t =
let open Dyn in
record
[ ( "marks"
, List.map marks ~f:(fun (m, idx) -> pair (Mark.to_dyn m) (Idx.to_dyn idx))
|> list )
; "pmarks", Pmark.Set.to_list pmarks |> List.map ~f:Pmark.to_dyn |> list
]
;;
let equal { marks; pmarks } t =
List.equal
~eq:(fun (x, y) (x', y') -> Mark.equal x x' && Idx.equal y y')
marks
t.marks
&& Pmark.Set.equal pmarks t.pmarks
;;
let empty = { marks = []; pmarks = Pmark.Set.empty }
let hash_marks_offset =
let f acc ((a : Mark.t), (i : Idx.t)) =
hash_combine (a :> int) (hash_combine (i :> int) acc)
in
fun l init -> List.fold_left l ~init ~f
;;
let hash m accu = hash_marks_offset m.marks (hash_combine (Hashtbl.hash m.pmarks) accu)
let marks_set_idx =
let rec marks_set_idx idx marks =
match marks with
| [] -> []
| (a, idx') :: rem ->
if Idx.equal idx' Idx.unknown then (a, idx) :: marks_set_idx idx rem else marks
in
fun marks idx -> { marks with marks = marks_set_idx idx marks.marks }
;;
let filter t (b : Mark.t) (e : Mark.t) =
{ t with
marks =
List.filter t.marks ~f:(fun ((i : Mark.t), _) ->
Mark.outside_range i ~start_inclusive:b ~stop_inclusive:e)
}
;;
let set_mark t (i : Mark.t) =
{ t with marks = (i, Idx.unknown) :: List.remove_assq i t.marks }
;;
let set_pmark t i = { t with pmarks = Pmark.Set.add i t.pmarks }
let pp fmt { marks; pmarks } =
Format.pp_open_box fmt 1;
(match marks with
| [] -> ()
| _ :: _ ->
Format.fprintf
fmt
"@[<2>marks@ %a@]"
(Format.pp_print_list (fun fmt (a, i) ->
Format.fprintf fmt "%a-%a" Mark.pp a Idx.pp i))
marks);
(match Pmark.Set.to_list pmarks with
| [] -> ()
| pmarks ->
Format.fprintf fmt "@[<2>pmarks %a@]" (Format.pp_print_list Pmark.pp) pmarks);
Format.pp_close_box fmt ()
;;
end
module Status = struct
type t =
| Failed
| Match of Mark_infos.t * Pmark.Set.t
| Running
end
module Desc : sig
type t
val pp : t Fmt.t
module E : sig
type nonrec t = private
| TSeq of Sem.t * t * Expr.t
| TExp of Marks.t * Expr.t
| TMatch of Marks.t
end
val to_dyn : t -> Dyn.t
val fold_right : t -> init:'acc -> f:(E.t -> 'acc -> 'acc) -> 'acc
val tseq : Sem.t -> t -> Expr.t -> t -> t
val initial : Expr.t -> t
val empty : t
val set_idx : Idx.t -> t -> t
val hash : t -> int -> int
val equal : t -> t -> bool
val status : t -> Status.t
val first_match : t -> Marks.t option
val remove_matches : t -> t
val split_at_match : t -> t * t
val add_match : t -> Marks.t -> t
val add_eps : t -> Marks.t -> t
val add_expr : t -> E.t -> t
val iter_marks : t -> f:(Marks.t -> unit) -> unit
val remove_duplicates : Id.Hash_set.t -> t -> Expr.t -> t
end = struct
module E = struct
type t =
| TSeq of Sem.t * t list * Expr.t
| TExp of Marks.t * Expr.t
| TMatch of Marks.t
let rec equal_list l1 l2 = List.equal ~eq:equal l1 l2
and equal x y =
match x, y with
| TSeq (_, l1, e1), TSeq (_, l2, e2) -> Id.equal e1.id e2.id && equal_list l1 l2
| TExp (marks1, e1), TExp (marks2, e2) ->
Id.equal e1.id e2.id && Marks.equal marks1 marks2
| TMatch marks1, TMatch marks2 -> Marks.equal marks1 marks2
| _, _ -> false
;;
let rec hash (t : t) accu =
match t with
| TSeq (_, l, e) ->
hash_combine 0x172a1bce (hash_combine (Id.hash e.id) (hash_list l accu))
| TExp (marks, e) ->
hash_combine 0x2b4c0d77 (hash_combine (Id.hash e.id) (Marks.hash marks accu))
| TMatch marks -> hash_combine 0x1c205ad5 (Marks.hash marks accu)
and hash_list =
let f acc x = hash x acc in
fun l init -> List.fold_left l ~init ~f
;;
end
type t = E.t list
let rec to_dyn sem t = Dyn.list (List.map ~f:(dyn_of_e sem) t)
and dyn_of_e sem =
let open Dyn in
function
| E.TSeq (sem', x, y) ->
wrap_sem
sem
sem'
(variant "TSeq" [ to_dyn (Some sem') x; Expr.to_dyn (Some sem') y ])
| TExp (marks, e) ->
let e =
let base = [ Expr.to_dyn sem e ] in
if Marks.(equal empty marks) then base else Marks.to_dyn marks :: base
in
variant "TExp" e
| TMatch m -> variant "TMarks" [ Marks.to_dyn m ]
;;
let to_dyn t = to_dyn None t
open E
let equal = E.equal_list
let hash = E.hash_list
let tseq' kind x y =
match x with
| [] -> []
| [ TExp (marks, { def = Eps; _ }) ] -> [ TExp (marks, y) ]
| _ -> [ TSeq (kind, x, y) ]
;;
let tseq kind x y rem = tseq' kind x y @ rem
let rec fold_right t ~init ~f =
match t with
| [] -> init
| x :: xs -> f x (fold_right xs ~init ~f)
;;
let rec iter_marks t ~f =
List.iter t ~f:(fun (e : E.t) ->
match e with
| TSeq (_, l, _) -> iter_marks l ~f
| TExp (marks, _) | TMatch marks -> f marks)
;;
let rec print_state_rec ch e (y : Expr.t) =
match e with
| TMatch marks -> Format.fprintf ch "@[<2>(TMatch@ %a)@]" Marks.pp marks
| TSeq (sem, l', x) ->
Format.fprintf ch "@[<2>(TSeq@ %a@ " Sem.pp sem;
print_state_lst ch l' x;
Format.fprintf ch "@ %a)@]" Expr.pp x
| TExp (marks, { def = Eps; _ }) ->
Format.fprintf ch "@[<2>(TExp@ %a@ (%a)@ (eps))@]" Id.pp y.id Marks.pp marks
| TExp (marks, x) ->
Format.fprintf ch "@[<2>(TExp@ %a@ (%a)@ %a)@]" Id.pp x.id Marks.pp marks Expr.pp x
and print_state_lst ch l y =
match l with
| [] -> Format.fprintf ch "()"
| e :: rem ->
print_state_rec ch e y;
List.iter rem ~f:(fun e ->
Format.fprintf ch "@ | ";
print_state_rec ch e y)
;;
let pp ch t = print_state_lst ch [ t ] { id = Id.zero; def = Eps }
let rec first_match = function
| [] -> None
| TMatch marks :: _ -> Some marks
| _ :: r -> first_match r
;;
let remove_matches t =
List.filter t ~f:(function
| TMatch _ -> false
| _ -> true)
;;
let split_at_match =
let rec split_at_match_rec l = function
| [] -> assert false
| TMatch _ :: r -> List.rev l, remove_matches r
| x :: r -> split_at_match_rec (x :: l) r
in
fun l -> split_at_match_rec [] l
;;
let status : _ -> Status.t = function
| [] -> Failed
| TMatch m :: _ -> Match (Mark_infos.make (m.marks :> (int * int) list), m.pmarks)
| _ -> Running
;;
let set_idx =
let rec f idx = function
| TMatch marks -> TMatch (Marks.marks_set_idx marks idx)
| TSeq (kind, l, x) -> TSeq (kind, set_idx idx l, x)
| TExp (marks, x) -> TExp (Marks.marks_set_idx marks idx, x)
and set_idx idx xs = List.map xs ~f:(f idx) in
set_idx
;;
let[@ocaml.warning "-32"] pp fmt t =
Format.fprintf fmt "[%a]" (Format.pp_print_list ~pp_sep:(Fmt.lit "; ") pp) t
;;
let empty = []
let initial expr = [ TExp (Marks.empty, expr) ]
let add_match t marks = TMatch marks :: t
let add_eps t marks = TExp (marks, eps_expr) :: t
let add_expr t expr = expr :: t
let remove_duplicates =
let rec loop seen l y =
match l with
| [] -> []
| (TMatch _ as x) :: _ ->
(* Truncate after first match *)
[ x ]
| TSeq (kind, l, x) :: r ->
let l = loop seen l x in
let r = loop seen r y in
tseq kind l x r
| (TExp (_marks, { def = Eps; _ }) as e) :: r ->
if Id.Hash_set.mem seen y.id
then loop seen r y
else (
Id.Hash_set.add seen y.id;
e :: loop seen r y)
| (TExp (_marks, x) as e) :: r ->
if Id.Hash_set.mem seen x.id
then loop seen r y
else (
Id.Hash_set.add seen x.id;
e :: loop seen r y)
in
fun seen l y ->
Id.Hash_set.clear seen;
loop seen l y
;;
end
module E = Desc.E
module State = struct
type t =
{ idx : Idx.t
; category : Category.t
; desc : Desc.t
; mutable status : Status.t option
; hash : int
}
(* Thread-safety: We use double-checked locking to access field
[status] in function [status] below. *)
let pp fmt t = Desc.pp fmt t.desc
let[@inline] idx t = t.idx
let to_dyn t = Desc.to_dyn t.desc
let dummy =
{ idx = Idx.unknown
; category = Category.dummy
; desc = Desc.empty
; status = None
; hash = -1
}
;;
let hash idx cat desc =
Desc.hash desc (hash_combine idx (hash_combine (Category.to_int cat) 0))
land 0x3FFFFFFF
;;
let mk idx cat desc =
{ idx; category = cat; desc; status = None; hash = hash (idx :> int) cat desc }
;;
let create cat e = mk Idx.initial cat (Desc.initial e)
let equal { idx; category; desc; status = _; hash } t =
Int.equal hash t.hash
&& Idx.equal idx t.idx
&& Category.equal category t.category
&& Desc.equal desc t.desc
;;
(* To be called when the mutex has already been acquired *)
let status_no_mutex s =
match s.status with
| Some s -> s
| None ->
let st = Desc.status s.desc in
s.status <- Some st;
st
;;
let status m s =
match s.status with
| Some s -> s
| None ->
Mutex.lock m;
let st = status_no_mutex s in
Mutex.unlock m;
st
;;
module Table = Hashtbl.Make (struct
type nonrec t = t
let equal = equal
let hash t = t.hash
end)
end
(**** Find a free index ****)
module Working_area = struct
type t =
{ mutable ids : Bit_vector.t
; seen : Id.Hash_set.t
; index_count : int Atomic.t
}
let create () =
{ ids = Bit_vector.create_zero 1
; seen = Id.Hash_set.create ()
; index_count = Atomic.make 0
}
;;
let index_count w = Atomic.get w.index_count
let mark_used_indices tbl =
Desc.iter_marks ~f:(fun marks ->
List.iter marks.marks ~f:(fun (_, i) ->
if Idx.used i then Bit_vector.set tbl (i :> int) true))
;;
let rec find_free tbl idx len =
if idx = len || not (Bit_vector.get tbl idx) then idx else find_free tbl (idx + 1) len
;;
let free_index t l =
Bit_vector.reset_zero t.ids;
mark_used_indices t.ids l;
let len = Bit_vector.length t.ids in
let idx = find_free t.ids 0 len in
if idx = len
then (
t.ids <- Bit_vector.create_zero (2 * len);
(* This function is only called when the mutex is locked. So we
are sure that this is always coherent with the length of
[t.ids]. *)
Atomic.set t.index_count (2 * len));
Idx.make idx
;;
end
(**** Computation of the next state ****)
type ctx =
{ c : Cset.c
; prev_cat : Category.t
; next_cat : Category.t
}
let rec delta_expr ({ c; _ } as ctx) marks (x : Expr.t) rem =
(*Format.eprintf "%d@." x.id;*)
match x.def with
| Cst s -> if Cset.mem c s then Desc.add_eps rem marks else rem
| Alt l -> delta_alt ctx marks l rem
| Seq (kind, y, z) ->
let y = delta_expr ctx marks y Desc.empty in
delta_seq ctx kind y z rem
| Rep (rep_kind, kind, y) -> delta_rep ctx marks x rep_kind kind y rem
| Eps -> Desc.add_match rem marks
| Mark i -> Desc.add_match rem (Marks.set_mark marks i)
| Pmark i -> Desc.add_match rem (Marks.set_pmark marks i)
| Erase (b, e) -> Desc.add_match rem (Marks.filter marks b e)
| Before cat ->
if Category.intersect ctx.next_cat cat then Desc.add_match rem marks else rem
| After cat ->
if Category.intersect ctx.prev_cat cat then Desc.add_match rem marks else rem
and delta_rep ctx marks x rep_kind kind y rem =
let y, marks' =
let y = delta_expr ctx marks y Desc.empty in
match Desc.first_match y with
| None -> y, marks
| Some marks -> Desc.remove_matches y, marks
in
match rep_kind with
| `Greedy -> Desc.tseq kind y x (Desc.add_match rem marks')
| `Non_greedy -> Desc.add_match (Desc.tseq kind y x rem) marks
and delta_alt ctx marks l rem = List.fold_right l ~init:rem ~f:(delta_expr ctx marks)
and delta_seq ctx (kind : Sem.t) y z rem =
match Desc.first_match y with
| None -> Desc.tseq kind y z rem
| Some marks ->
(match kind with
| `Longest -> Desc.tseq kind (Desc.remove_matches y) z (delta_expr ctx marks z rem)
| `Shortest -> delta_expr ctx marks z (Desc.tseq kind (Desc.remove_matches y) z rem)
| `First ->
let y, y' = Desc.split_at_match y in
Desc.tseq kind y z (delta_expr ctx marks z (Desc.tseq kind y' z rem)))
;;
let rec delta_e ctx marks (x : E.t) rem =
match x with
| TSeq (kind, y, z) ->
let y = delta_desc ctx marks y Desc.empty in
delta_seq ctx kind y z rem
| TExp (marks, e) -> delta_expr ctx marks e rem
| TMatch _ -> Desc.add_expr rem x
and delta_desc ctx marks (l : Desc.t) rem =
Desc.fold_right l ~init:rem ~f:(fun y acc -> delta_e ctx marks y acc)
;;
let delta (tbl_ref : Working_area.t) next_cat char (st : State.t) =
let expr =
let prev_cat = st.category in
let ctx = { c = char; next_cat; prev_cat } in
Desc.remove_duplicates
tbl_ref.seen
(delta_desc ctx Marks.empty st.desc Desc.empty)
Expr.eps_expr
in
let idx = Working_area.free_index tbl_ref expr in
let expr = Desc.set_idx idx expr in
State.mk idx next_cat expr
;;

View file

@ -0,0 +1,123 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(* Regular expressions *)
module Mark : sig
type t [@@immediate]
val compare : t -> t -> int
val start : t
val prev : t -> t
val next : t -> t
val next2 : t -> t
val group_count : t -> int
end
module Sem : sig
type t =
[ `Longest
| `Shortest
| `First
]
val to_dyn : t -> Dyn.t
val pp : t Fmt.t
end
module Rep_kind : sig
type t =
[ `Greedy
| `Non_greedy
]
val to_dyn : t -> Dyn.t
val pp : t Fmt.t
end
type expr
val is_eps : expr -> bool
val pp : expr Fmt.t
module Ids : sig
type t
val create : unit -> t
end
val cst : Ids.t -> Cset.t -> expr
val empty : Ids.t -> expr
val alt : Ids.t -> expr list -> expr
val seq : Ids.t -> Sem.t -> expr -> expr -> expr
val eps : Ids.t -> expr
val rep : Ids.t -> Rep_kind.t -> Sem.t -> expr -> expr
val mark : Ids.t -> Mark.t -> expr
val pmark : Ids.t -> Pmark.t -> expr
val erase : Ids.t -> Mark.t -> Mark.t -> expr
val before : Ids.t -> Category.t -> expr
val after : Ids.t -> Category.t -> expr
val rename : Ids.t -> expr -> expr
(****)
(* States of the automata *)
module Idx : sig
type t
val to_int : t -> int
end
module Status : sig
type t =
| Failed
| Match of Mark_infos.t * Pmark.Set.t
| Running
end
module State : sig
type t
val pp : t Fmt.t
val dummy : t
val create : Category.t -> expr -> t
val idx : t -> Idx.t
val status_no_mutex : t -> Status.t
val status : Mutex.t -> t -> Status.t
val to_dyn : t -> Dyn.t
module Table : Hashtbl.S with type key = t
end
(****)
(* Computation of the states following a given state *)
module Working_area : sig
type t
val create : unit -> t
val index_count : t -> int
end
val delta : Working_area.t -> Category.t -> Cset.c -> State.t -> State.t

View file

@ -0,0 +1,48 @@
type t =
{ len : int
; bits : Bytes.t
}
let byte s i = Char.code (Bytes.unsafe_get s i)
let set_byte s i x = Bytes.unsafe_set s i (Char.chr x)
let length t = t.len
let unsafe_set v n b =
let i = n lsr 3 in
let c = byte v.bits i in
let mask = 1 lsl (n land 7) in
set_byte v.bits i (if b then c lor mask else c land lnot mask)
;;
let set v n b =
if n < 0 || n >= v.len then invalid_arg "Bit_vector.set";
unsafe_set v n b
;;
let unsafe_get v n =
let i = n lsr 3 in
byte v.bits i land (1 lsl (n land 7)) > 0
;;
let get v n =
if n < 0 || n >= v.len then invalid_arg "Bit_vector.get";
unsafe_get v n
;;
let reset_zero t = Bytes.fill t.bits 0 (Bytes.length t.bits) '\000'
let create_zero len =
let bits =
let r = len land 7 in
let q = len lsr 3 in
let len = if r = 0 then q else q + 1 in
Bytes.make len '\000'
in
{ len; bits }
;;
let pp fmt { len; bits } =
let len fmt () = Fmt.sexp fmt "len" Fmt.int len in
let bits fmt () = Fmt.sexp fmt "bits" Fmt.bytes bits in
Format.fprintf fmt "%a@.%a@." len () bits ()
;;

View file

@ -0,0 +1,8 @@
type t
val length : t -> int
val set : t -> int -> bool -> unit
val create_zero : int -> t
val get : t -> int -> bool
val reset_zero : t -> unit
val pp : t Fmt.t

View file

@ -0,0 +1,29 @@
type t = int
let equal (x : int) (y : int) = x = y
let compare (x : int) (y : int) = compare x y
let to_int x = x
let pp = Format.pp_print_int
let intersect x y = x land y <> 0
let ( ++ ) x y = x lor y
let dummy = -1
let inexistant = 1
let letter = 2
let not_letter = 4
let newline = 8
let lastnewline = 16
let search_boundary = 32
let to_dyn = Dyn.int
let from_char = function
(* Should match [cword] definition *)
| 'a' .. 'z'
| 'A' .. 'Z'
| '0' .. '9'
| '_' | '\170' | '\181' | '\186'
| '\192' .. '\214'
| '\216' .. '\246'
| '\248' .. '\255' -> letter
| '\n' -> not_letter ++ newline
| _ -> not_letter
;;

View file

@ -0,0 +1,22 @@
(** Categories represent the various kinds of characters that can be tested
by look-ahead and look-behind operations.
This is more restricted than Cset, but faster. *)
type t [@@immediate]
val ( ++ ) : t -> t -> t
val from_char : char -> t
val dummy : t
val inexistant : t
val letter : t
val not_letter : t
val newline : t
val lastnewline : t
val search_boundary : t
val to_int : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
val intersect : t -> t -> bool
val pp : t Fmt.t
val to_dyn : t -> Dyn.t

View file

@ -0,0 +1,56 @@
(* In reality, this can really be represented as a bool array.
The representation is best thought of as a list of all chars along with a
flag:
(a, 0), (b, 1), (c, 0), (d, 0), ...
characters belonging to the same color are represented by sequnces of
characters with the flag set to 0.
*)
type t = Bytes.t
module Repr = struct
type t = string
let repr t color = t.[Cset.to_int color]
let length = String.length
end
module Table = struct
type t = string
let get_char t c = t.[Cset.to_int c]
let get t c = Cset.of_char (String.unsafe_get t (Char.code c))
let translate_colors (cm : t) cset =
Cset.fold_right cset ~init:Cset.empty ~f:(fun i j l ->
let start = get_char cm i in
let stop = get_char cm j in
Cset.union (Cset.cseq start stop) l)
;;
end
let make () = Bytes.make 257 '\000'
let flatten cm =
let c = Bytes.create 256 in
let color_repr = Bytes.create 256 in
let v = ref 0 in
Bytes.set c 0 '\000';
Bytes.set color_repr 0 '\000';
for i = 1 to 255 do
if Bytes.get cm i <> '\000' then incr v;
Bytes.set c i (Char.chr !v);
Bytes.set color_repr !v (Char.chr i)
done;
Bytes.unsafe_to_string c, Bytes.sub_string color_repr 0 (!v + 1)
;;
(* mark all the endpoints of the intervals of the char set with the 1 byte *)
let split t set =
Cset.iter set ~f:(fun i j ->
Bytes.set t (Cset.to_int i) '\001';
Bytes.set t (Cset.to_int j + 1) '\001')
;;

View file

@ -0,0 +1,27 @@
(* Color maps exists to provide an optimization for the regex engine. The fact
that some characters are entirely equivalent for some regexes means that we
can use them interchangeably.
A color map assigns a color to every character in our character set. Any two
characters with the same color will be treated equivalently by the automaton.
*)
type t
module Repr : sig
type t
val repr : t -> Cset.c -> char
val length : t -> int
end
module Table : sig
type t
val get_char : t -> Cset.c -> char
val get : t -> char -> Cset.c
val translate_colors : t -> Cset.t -> Cset.t
end
val make : unit -> t
val flatten : t -> Table.t * Repr.t
val split : t -> Cset.t -> unit

View file

@ -0,0 +1,835 @@
open Import
let rec iter n f v = if Int.equal n 0 then v else iter (n - 1) f (f v)
module Idx : sig
type t [@@immediate]
val unknown : t
val make_break : Automata.Idx.t -> t
val of_idx : Automata.Idx.t -> t
val is_idx : t -> bool
val is_break : t -> bool
val is_unknown : t -> bool
val idx : t -> int
val break_idx : t -> int
end = struct
type t = int
let unknown = -2
let break = -3
let of_idx (x : Automata.Idx.t) = Automata.Idx.to_int x [@@inline always]
let is_idx t = t >= 0 [@@inline always]
let is_break x = x <= break [@@inline always]
let is_unknown x = x = unknown [@@inline always]
let idx t = t [@@inline always]
let make_break (idx : Automata.Idx.t) = -5 - Automata.Idx.to_int idx [@@inline always]
let break_idx t = (t + 5) * -1 [@@inline always]
end
type match_info =
| Match of Group.t
| Failed
| Running of { no_match_starts_before : int }
type state_info =
{ idx : Idx.t
; (* Index of the current position in the position table.
Not yet computed transitions point to a dummy state where
[idx] is set to [unknown];
If [idx] is set to [break] for states that either always
succeed or always fail. *)
mutable final : (Category.t * (Automata.Idx.t * Automata.Status.t)) list
; (* Mapping from the category of the next character to
- the index where the next position should be saved
- possibly, the list of marks (and the corresponding indices)
corresponding to the best match *)
desc : Automata.State.t (* Description of this state of the automata *)
}
(* Thread-safety: we use double-checked locking to access field [final]. *)
(* A state [t] is a pair composed of some information about the
state [state_info] and a transition table [t array], indexed by
color. For performance reason, to avoid an indirection, we manually
unbox the transition table: we allocate a single array, with the
state information at index 0, followed by the transitions. *)
module State : sig
type t
val make : ncol:int -> state_info -> t
val make_break : state_info -> t
val get_info : t -> state_info
val follow_transition : t -> color:Cset.c -> t
val set_transition : t -> color:Cset.c -> t -> unit
val is_unknown_transition : t -> color:Cset.c -> bool
end = struct
type t = Table of t array [@@unboxed]
(* Thread-safety:
We store the state information at index 0. For other elements
of the transition table, which are lazily computed, we use
double-checked locking. *)
let get_info (Table st) : state_info = Obj.magic (Array.unsafe_get st 0)
[@@inline always]
;;
let set_info (Table st) (info : state_info) = st.(0) <- Obj.magic info
let follow_transition (Table st) ~color = Array.unsafe_get st (1 + Cset.to_int color)
[@@inline always]
;;
let set_transition (Table st) ~color st' = st.(1 + Cset.to_int color) <- st'
let is_unknown_transition st ~color =
let st' = follow_transition st ~color in
let info = get_info st' in
Idx.is_unknown info.idx
;;
let dummy (info : state_info) = Table [| Obj.magic info |]
let unknown_state = dummy { idx = Idx.unknown; final = []; desc = Automata.State.dummy }
let make ~ncol state =
let st = Table (Array.make (ncol + 1) unknown_state) in
set_info st state;
st
;;
let make_break state = Table [| Obj.magic state |]
end
(* Automata (compiled regular expression) *)
type re =
{ initial : Automata.expr
; (* The whole regular expression *)
mutable initial_states : (Category.t * State.t) list
; (* Initial states, indexed by initial category *)
colors : Color_map.Table.t
; (* Color table *)
color_repr : Color_map.Repr.t
; (* Table from colors to one character of this color *)
ncolor : int
; (* Number of colors. *)
lnl : Cset.c
; (* Color of the last newline. [Cset.null_char] if unnecessary *)
tbl : Automata.Working_area.t
; (* Temporary table used to compute the first available index
when computing a new state *)
states : State.t Automata.State.Table.t
; (* States of the deterministic automata *)
group_names : (string * int) list
; (* Named groups in the regular expression *)
group_count : int
; (* Number of groups in the regular expression *)
mutex : Mutex.t
}
(* Thread-safety:
We use double-checked locking to access field [initial_states]. The
state table [states] and the working area [tbl] are only accessed
with the mutex [mutex] locked.
The working area is shared between all threads. This might be
inefficient if many threads are updating the automaton. It seems
complicated to manage a working area per domain and per regular
expression. So, if this becomes an issue, it might just be simpler
to allocate a fresh working area whenever needed.
*)
let pp_re ch re = Automata.pp ch re.initial
let group_count re = re.group_count
let group_names re = re.group_names
module Positions = struct
(* Information used during matching *)
type t =
{ mutable positions : int array
; (* Array of mark positions
The mark are off by one for performance reasons *)
mutable length : int
}
let empty = { positions = [||]; length = 0 }
let length t = t.length
let unsafe_set t idx pos = Array.unsafe_set t.positions idx pos
let rec resize idx t =
t.length <- 2 * t.length;
if idx >= t.length
then resize idx t
else (
let pos = t.positions in
t.positions <- Array.make t.length 0;
Array.blit pos 0 t.positions 0 (Array.length pos))
;;
let set t idx pos =
if idx >= length t then resize idx t;
unsafe_set t idx pos
;;
let all t = t.positions
let first t = t.positions.(0)
let make ~groups re =
if groups
then (
(* We initialize this table with a reasonable size. The required
size may change when the automaton gets updated. So we are
always checking whether it is large enough before modifying it. *)
let length = Automata.Working_area.index_count re.tbl + 1 in
{ positions = Array.make length 0; length })
else empty
;;
end
(****)
let category re ~color =
if Cset.equal_c color Cset.null_char
then Category.inexistant (* Special category for the last newline *)
else if Cset.equal_c color re.lnl
then Category.(lastnewline ++ newline ++ not_letter)
else Category.from_char (Color_map.Repr.repr re.color_repr color)
;;
(****)
let find_state re desc =
try Automata.State.Table.find re.states desc with
| Not_found ->
let st =
let break_state =
match Automata.State.status_no_mutex desc with
| Running -> false
| Failed | Match _ -> true
in
let st =
{ idx =
(let idx = Automata.State.idx desc in
if break_state then Idx.make_break idx else Idx.of_idx idx)
; final = []
; desc
}
in
if break_state then State.make_break st else State.make ~ncol:re.ncolor st
in
Automata.State.Table.add re.states desc st;
st
;;
(**** Match with marks ****)
let delta re cat ~color st = Automata.delta re.tbl cat color st.desc
let validate re (s : string) ~pos st =
let color = Color_map.Table.get re.colors s.[pos] in
Mutex.lock re.mutex;
if State.is_unknown_transition st ~color
then (
let st' =
let desc' =
let cat = category re ~color in
delta re cat ~color (State.get_info st)
in
find_state re desc'
in
State.set_transition st ~color st');
Mutex.unlock re.mutex
;;
let next colors st s pos =
State.follow_transition st ~color:(Color_map.Table.get colors (String.unsafe_get s pos))
;;
let rec loop re ~colors ~positions s ~pos ~last st0 st =
if pos < last
then (
let st' = next colors st s pos in
let idx = (State.get_info st').idx in
if Idx.is_idx idx
then
if Idx.idx idx < Positions.length positions
then (
Positions.unsafe_set positions (Idx.idx idx) pos;
loop re ~colors ~positions s ~pos:(pos + 1) ~last st' st')
else (
(* Resize position array *)
Positions.set positions (Idx.idx idx) pos;
loop re ~colors ~positions s ~pos:(pos + 1) ~last st' st')
else if Idx.is_break idx
then (
Positions.set positions (Idx.break_idx idx) pos;
st')
else (
(* Unknown *)
validate re s ~pos st0;
loop re ~colors ~positions s ~pos ~last st0 st0))
else st
;;
let rec loop_no_mark re ~colors s ~pos ~last st0 st =
if pos < last
then (
let st' = next colors st s pos in
let idx = (State.get_info st').idx in
if Idx.is_idx idx
then loop_no_mark re ~colors s ~pos:(pos + 1) ~last st' st'
else if Idx.is_break idx
then st'
else (
(* Unknown *)
validate re s ~pos st0;
loop_no_mark re ~colors s ~pos ~last st0 st0))
else st
;;
let final re st cat =
try List.assq cat st.final with
| Not_found ->
Mutex.lock re.mutex;
let res =
try List.assq cat st.final with
| Not_found ->
let st' = delta re cat ~color:Cset.null_char st in
let res = Automata.State.idx st', Automata.State.status_no_mutex st' in
st.final <- (cat, res) :: st.final;
res
in
Mutex.unlock re.mutex;
res
;;
let find_initial_state re cat =
try List.assq cat re.initial_states with
| Not_found ->
Mutex.lock re.mutex;
let res =
try List.assq cat re.initial_states with
| Not_found ->
let st = find_state re (Automata.State.create cat re.initial) in
re.initial_states <- (cat, st) :: re.initial_states;
st
in
Mutex.unlock re.mutex;
res
;;
let get_color re (s : string) pos =
if pos < 0
then Cset.null_char
else (
let slen = String.length s in
if pos >= slen
then Cset.null_char
else if pos = slen - 1
&& (not (Cset.equal_c re.lnl Cset.null_char))
&& Char.equal (String.unsafe_get s pos) '\n'
then (* Special case for the last newline *)
re.lnl
else Color_map.Table.get re.colors (String.unsafe_get s pos))
;;
let rec handle_last_newline re positions ~pos st ~groups =
let st' = State.follow_transition st ~color:re.lnl in
let info = State.get_info st' in
if Idx.is_idx info.idx
then (
if groups then Positions.set positions (Idx.idx info.idx) pos;
st')
else if Idx.is_break info.idx
then (
if groups then Positions.set positions (Idx.break_idx info.idx) pos;
st')
else (
(* Unknown *)
let color = re.lnl in
Mutex.lock re.mutex;
if State.is_unknown_transition st ~color
then (
let st' =
let desc =
let cat = category re ~color in
let real_c = Color_map.Table.get re.colors '\n' in
delta re cat ~color:real_c (State.get_info st)
in
find_state re desc
in
State.set_transition st ~color st');
Mutex.unlock re.mutex;
handle_last_newline re positions ~pos st ~groups)
;;
let rec scan_str re positions (s : string) initial_state ~last ~pos ~groups =
if last = String.length s
&& (not (Cset.equal_c re.lnl Cset.null_char))
&& last > pos
&& Char.equal (String.get s (last - 1)) '\n'
then (
let last = last - 1 in
let st = scan_str re positions ~pos s initial_state ~last ~groups in
if Idx.is_break (State.get_info st).idx
then st
else handle_last_newline re positions ~pos:last st ~groups)
else if groups
then loop re ~colors:re.colors ~positions s ~pos ~last initial_state initial_state
else loop_no_mark re ~colors:re.colors s ~pos ~last initial_state initial_state
;;
(* This function adds a final boundary check on the input.
This is useful to indicate that the output failed because
of insufficient input, or to verify that the output actually
matches for regex that have boundary conditions with respect
to the input string.
*)
let final_boundary_check re positions ~last ~slen s state_info ~groups =
let idx, res =
let final_cat =
Category.(
search_boundary
++ if last = slen then inexistant else category re ~color:(get_color re s last))
in
final re state_info final_cat
in
(match groups, res with
| true, Match _ -> Positions.set positions (Automata.Idx.to_int idx) last
| _ -> ());
res
;;
let make_match_str re positions ~len ~groups ~partial s ~pos =
let slen = String.length s in
let last = if len = -1 then slen else pos + len in
let st =
let initial_state =
let initial_cat =
Category.(
search_boundary
++ if pos = 0 then inexistant else category re ~color:(get_color re s (pos - 1)))
in
find_initial_state re initial_cat
in
scan_str re positions s initial_state ~pos ~last ~groups
in
let state_info = State.get_info st in
if Idx.is_break state_info.idx || (partial && not groups)
then Automata.State.status re.mutex state_info.desc
else if partial && groups
then (
match Automata.State.status re.mutex state_info.desc with
| (Match _ | Failed) as status -> status
| Running ->
(* This could be because it's still not fully matched, or it
could be that because we need to run special end of input
checks. *)
(match final_boundary_check re positions ~last ~slen s state_info ~groups with
| Match _ as status -> status
| Failed | Running ->
(* A failure here just means that we need more data, i.e.
it's a partial match. *)
Running))
else final_boundary_check re positions ~last ~slen s state_info ~groups
;;
module Stream = struct
type nonrec t =
{ state : State.t
; re : re
}
type 'a feed =
| Ok of 'a
| No_match
let create re =
let category = Category.(search_boundary ++ inexistant) in
let state = find_initial_state re category in
{ state; re }
;;
let feed t s ~pos ~len =
(* TODO bound checks? *)
let last = pos + len in
let state = loop_no_mark t.re ~colors:t.re.colors s ~last ~pos t.state t.state in
let info = State.get_info state in
if Idx.is_break info.idx
&&
match Automata.State.status t.re.mutex info.desc with
| Failed -> true
| Match _ | Running -> false
then No_match
else Ok { t with state }
;;
let finalize t s ~pos ~len =
(* TODO bound checks? *)
let last = pos + len in
let state = scan_str t.re Positions.empty s t.state ~last ~pos ~groups:false in
let info = State.get_info state in
match
let _idx, res =
let final_cat = Category.(search_boundary ++ inexistant) in
final t.re info final_cat
in
res
with
| Running | Failed -> false
| Match _ -> true
;;
module Group = struct
type nonrec t =
{ t : t
; positions : Positions.t
; slices : Slice.L.t
; abs_pos : int
; first_match_pos : int
}
let no_match_starts_before t = t.first_match_pos
let create t =
{ t
; positions = Positions.make ~groups:true t.re
; slices = []
; abs_pos = 0
; first_match_pos = 0
}
;;
module Match = struct
type t =
{ pmarks : Pmark.Set.t
; slices : Slice.L.t
; marks : Mark_infos.t
; positions : int array
; start_pos : int
}
let test_mark t mark = Pmark.Set.mem mark t.pmarks
let get t i =
Mark_infos.offset t.marks i
|> Option.map (fun (start, stop) ->
let start = t.positions.(start) - t.start_pos in
let stop = t.positions.(stop) - t.start_pos in
Slice.L.get_substring t.slices ~start ~stop)
;;
let make ~start_pos ~pmarks ~slices ~marks ~positions =
let positions = Positions.all positions in
{ pmarks; slices; positions; marks; start_pos }
;;
end
let rec loop re ~abs_pos ~colors ~positions s ~pos ~last st0 st =
if pos < last
then (
let st' = next colors st s pos in
let idx = (State.get_info st').idx in
if Idx.is_idx idx
then
if Idx.idx idx < Positions.length positions
then (
Positions.unsafe_set positions (Idx.idx idx) (abs_pos + pos);
loop re ~abs_pos ~colors ~positions s ~pos:(pos + 1) ~last st' st')
else (
(* Resize position array *)
Positions.set positions (Idx.idx idx) (abs_pos + pos);
loop re ~abs_pos ~colors ~positions s ~pos:(pos + 1) ~last st' st')
else if Idx.is_break idx
then (
Positions.set positions (Idx.break_idx idx) (abs_pos + pos);
st')
else (
(* Unknown *)
validate re s ~pos st0;
loop re ~abs_pos ~colors ~positions s ~pos ~last st0 st0))
else st
;;
let feed ({ t; positions; slices; abs_pos; first_match_pos = _ } as tt) s ~pos ~len =
let state =
(* TODO bound checks? *)
let last = pos + len in
loop t.re ~abs_pos ~colors:t.re.colors s ~positions ~last ~pos t.state t.state
in
let info = State.get_info state in
if Idx.is_break info.idx
&&
match Automata.State.status t.re.mutex info.desc with
| Failed -> true
| Match _ | Running -> false
then No_match
else (
let t = { t with state } in
let slices = { Slice.s; pos; len } :: slices in
let first_match_pos = Positions.first positions in
let slices = Slice.L.drop_rev slices (first_match_pos - tt.first_match_pos) in
let abs_pos = abs_pos + len in
Ok { tt with t; slices; abs_pos; first_match_pos })
;;
let finalize
({ t; positions; slices; abs_pos; first_match_pos = _ } as tt)
s
~pos
~len
: Match.t feed
=
(* TODO bound checks? *)
let last = pos + len in
let info =
let state =
loop t.re ~abs_pos ~colors:t.re.colors s ~positions ~last ~pos t.state t.state
in
State.get_info state
in
match
match Automata.State.status t.re.mutex info.desc with
| (Match _ | Failed) as s -> s
| Running ->
let idx, res =
let final_cat = Category.(search_boundary ++ inexistant) in
final t.re info final_cat
in
(match res with
| Running | Failed -> ()
| Match _ -> Positions.set positions (Automata.Idx.to_int idx) (abs_pos + last));
res
with
| Running | Failed -> No_match
| Match (marks, pmarks) ->
let first_match_position = Positions.first positions in
let slices =
let slices =
let slices = { Slice.s; pos; len } :: slices in
Slice.L.drop_rev slices (first_match_position - tt.first_match_pos)
in
List.rev slices
in
Ok (Match.make ~start_pos:first_match_position ~pmarks ~marks ~slices ~positions)
;;
end
end
let match_str_no_bounds ~groups ~partial re s ~pos ~len =
let positions = Positions.make ~groups re in
match make_match_str re positions ~len ~groups ~partial s ~pos with
| Match (marks, pmarks) ->
Match
(Group.create s marks pmarks ~gpos:(Positions.all positions) ~gcount:re.group_count)
| Failed -> Failed
| Running ->
let no_match_starts_before = if groups then Positions.first positions else 0 in
Running { no_match_starts_before }
;;
let match_str_p re s ~pos ~len =
if pos < 0 || len < -1 || pos + len > String.length s
then invalid_arg "Re.exec: out of bounds";
match make_match_str re Positions.empty ~len ~groups:false ~partial:false s ~pos with
| Match _ -> true
| _ -> false
;;
let match_str ~groups ~partial re s ~pos ~len =
if pos < 0 || len < -1 || pos + len > String.length s
then invalid_arg "Re.exec: out of bounds";
match_str_no_bounds ~groups ~partial re s ~pos ~len
;;
let mk_re ~initial ~colors ~color_repr ~ncolor ~lnl ~group_names ~group_count =
{ initial
; initial_states = []
; colors
; color_repr
; ncolor
; lnl
; tbl = Automata.Working_area.create ()
; states = Automata.State.Table.create 97
; group_names
; group_count
; mutex = Mutex.create ()
}
;;
(**** Compilation ****)
module A = Automata
let enforce_kind ids kind kind' cr =
match kind, kind' with
| `First, `First -> cr
| `First, k -> A.seq ids k cr (A.eps ids)
| _ -> cr
;;
type context =
{ ids : A.Ids.t
; kind : A.Sem.t
; ign_group : bool
; greedy : A.Rep_kind.t
; pos : A.Mark.t ref
; names : (string * int) list ref
; cache : Cset.t Cset.CSetMap.t ref
; colors : Color_map.Table.t
}
let trans_set cache (cm : Color_map.Table.t) s =
match Cset.one_char s with
| Some i -> Cset.csingle (Color_map.Table.get_char cm i)
| None ->
let v = Cset.hash s, s in
(try Cset.CSetMap.find v !cache with
| Not_found ->
let l = Color_map.Table.translate_colors cm s in
cache := Cset.CSetMap.add v l !cache;
l)
;;
let make_repeater ids cr kind greedy =
match greedy with
| `Greedy -> fun rem -> A.alt ids [ A.seq ids kind (A.rename ids cr) rem; A.eps ids ]
| `Non_greedy ->
fun rem -> A.alt ids [ A.eps ids; A.seq ids kind (A.rename ids cr) rem ]
;;
(* XXX should probably compute a category mask *)
let rec translate
({ ids; kind; ign_group; greedy; pos; names; cache; colors } as ctx)
(ast : Ast.no_case)
=
match ast with
| Set s -> A.cst ids (trans_set cache colors s), kind
| Sequence l -> trans_seq ctx l, kind
| Ast (Alternative l) ->
(match Ast.merge_sequences l with
| [ r' ] ->
let cr, kind' = translate ctx r' in
enforce_kind ids kind kind' cr, kind
| merged_sequences ->
( A.alt
ids
(List.map merged_sequences ~f:(fun r' ->
let cr, kind' = translate ctx r' in
enforce_kind ids kind kind' cr))
, kind ))
| Repeat (r', i, j) ->
let cr, kind' = translate ctx r' in
let rem =
match j with
| None -> A.rep ids greedy kind' cr
| Some j ->
let f = make_repeater ids cr kind' greedy in
iter (j - i) f (A.eps ids)
in
iter i (fun rem -> A.seq ids kind' (A.rename ids cr) rem) rem, kind
| Beg_of_line -> A.after ids Category.(inexistant ++ newline), kind
| End_of_line -> A.before ids Category.(inexistant ++ newline), kind
| Beg_of_word ->
( A.seq
ids
`First
(A.after ids Category.(inexistant ++ not_letter))
(A.before ids Category.letter)
, kind )
| End_of_word ->
( A.seq
ids
`First
(A.after ids Category.letter)
(A.before ids Category.(inexistant ++ not_letter))
, kind )
| Not_bound ->
( A.alt
ids
[ A.seq ids `First (A.after ids Category.letter) (A.before ids Category.letter)
; (let cat = Category.(inexistant ++ not_letter) in
A.seq ids `First (A.after ids cat) (A.before ids cat))
]
, kind )
| Beg_of_str -> A.after ids Category.inexistant, kind
| End_of_str -> A.before ids Category.inexistant, kind
| Last_end_of_line -> A.before ids Category.(inexistant ++ lastnewline), kind
| Start -> A.after ids Category.search_boundary, kind
| Stop -> A.before ids Category.search_boundary, kind
| Sem (kind', r') ->
let cr, kind'' = translate { ctx with kind = kind' } r' in
enforce_kind ids kind' kind'' cr, kind'
| Sem_greedy (greedy', r') -> translate { ctx with greedy = greedy' } r'
| Group (n, r') ->
if ign_group
then translate ctx r'
else (
let p = !pos in
let () =
match n with
| Some name -> names := (name, A.Mark.group_count p) :: !names
| None -> ()
in
pos := A.Mark.next2 !pos;
let cr, kind' = translate ctx r' in
( A.seq ids `First (A.mark ids p) (A.seq ids `First cr (A.mark ids (A.Mark.next p)))
, kind' ))
| No_group r' -> translate { ctx with ign_group = true } r'
| Nest r' ->
let b = !pos in
let cr, kind' = translate ctx r' in
let e = A.Mark.prev !pos in
if A.Mark.compare e b = -1
then cr, kind'
else A.seq ids `First (A.erase ids b e) cr, kind'
| Pmark (i, r') ->
let cr, kind' = translate ctx r' in
A.seq ids `First (A.pmark ids i) cr, kind'
and trans_seq ({ ids; kind; _ } as ctx) = function
| [] -> A.eps ids
| [ r ] ->
let cr', kind' = translate ctx r in
enforce_kind ids kind kind' cr'
| r :: rem ->
let cr', kind' = translate ctx r in
let cr'' = trans_seq ctx rem in
if A.is_eps cr'' then cr' else if A.is_eps cr' then cr'' else A.seq ids kind' cr' cr''
;;
let compile_1 regexp =
let regexp = Ast.handle_case false regexp in
let color_map = Color_map.make () in
let need_lnl = Ast.colorize color_map regexp in
let colors, color_repr = Color_map.flatten color_map in
let ncolor = Color_map.Repr.length color_repr in
let lnl = if need_lnl then Cset.of_int ncolor else Cset.null_char in
let ncolor = if need_lnl then ncolor + 1 else ncolor in
let ctx =
{ ids = A.Ids.create ()
; kind = `First
; ign_group = false
; greedy = `Greedy
; pos = ref A.Mark.start
; names = ref []
; cache = ref Cset.CSetMap.empty
; colors
}
in
let r, kind = translate ctx regexp in
let r = enforce_kind ctx.ids `First kind r in
(*Format.eprintf "<%d %d>@." !ids ncol;*)
mk_re
~initial:r
~colors
~color_repr
~ncolor
~lnl
~group_names:(List.rev !(ctx.names))
~group_count:(A.Mark.group_count !(ctx.pos))
;;
let compile r =
let open Ast.Export in
compile_1 (if Ast.anchored r then group r else seq [ shortest (rep any); group r ])
;;

View file

@ -0,0 +1,59 @@
type re
module Stream : sig
type t
type 'a feed =
| Ok of 'a
| No_match
val create : re -> t
val feed : t -> string -> pos:int -> len:int -> t feed
val finalize : t -> string -> pos:int -> len:int -> bool
module Group : sig
type stream := t
type t
module Match : sig
type t
val get : t -> int -> string option
val test_mark : t -> Pmark.t -> bool
end
val create : stream -> t
val feed : t -> string -> pos:int -> len:int -> t feed
val finalize : t -> string -> pos:int -> len:int -> Match.t feed
val no_match_starts_before : t -> int
end
end
type match_info =
| Match of Group.t
| Failed
| Running of { no_match_starts_before : int }
val match_str_no_bounds
: groups:bool
-> partial:bool
-> re
-> string
-> pos:int
-> len:int
-> match_info
val match_str
: groups:bool
-> partial:bool
-> re
-> string
-> pos:int
-> len:int
-> match_info
val match_str_p : re -> string -> pos:int -> len:int -> bool
val compile : Ast.t -> re
val group_count : re -> int
val group_names : re -> (string * int) list
val pp_re : re Fmt.t

View file

@ -0,0 +1,173 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
open Import
include struct
let cset = Ast.cset
let rg c c' = cset (Cset.cseq c c')
let notnl = cset Cset.notnl
let lower = cset Cset.lower
let upper = cset Cset.upper
let alpha = cset Cset.alpha
let digit = cset Cset.cdigit
let alnum = cset Cset.alnum
let wordc = cset Cset.wordc
let ascii = cset Cset.ascii
let blank = cset Cset.blank
let cntrl = cset Cset.cntrl
let graph = cset Cset.graph
let print = cset Cset.print
let punct = cset Cset.punct
let space = cset Cset.space
let xdigit = cset Cset.xdigit
end
include Ast.Export
let exec_internal ?(pos = 0) ?(len = -1) ~partial ~groups re s =
Compile.match_str ~groups ~partial re s ~pos ~len
;;
let exec ?pos ?len re s =
match exec_internal ?pos ?len ~groups:true ~partial:false re s with
| Match substr -> substr
| _ -> raise Not_found
;;
let exec_opt ?pos ?len re s =
match exec_internal ?pos ?len ~groups:true ~partial:false re s with
| Match substr -> Some substr
| _ -> None
;;
let execp ?(pos = 0) ?(len = -1) re s = Compile.match_str_p ~pos ~len re s
let exec_partial ?pos ?len re s =
match exec_internal ~groups:false ~partial:true ?pos ?len re s with
| Match _ -> `Full
| Running _ -> `Partial
| Failed -> `Mismatch
;;
let exec_partial_detailed ?pos ?len re s =
match exec_internal ~groups:true ~partial:true ?pos ?len re s with
| Match group -> `Full group
| Running { no_match_starts_before } -> `Partial no_match_starts_before
| Failed -> `Mismatch
;;
module Mark = struct
type t = Pmark.t
let test (g : Group.t) p = Pmark.Set.mem p (Group.pmarks g)
let all (g : Group.t) = Group.pmarks g
module Set = Pmark.Set
let equal = Pmark.equal
let compare = Pmark.compare
end
type split_token =
[ `Text of string
| `Delim of Group.t
]
module Gen = struct
type 'a gen = unit -> 'a option
let gen_of_seq (s : 'a Seq.t) : 'a gen =
let r = ref s in
fun () ->
match !r () with
| Seq.Nil -> None
| Seq.Cons (x, tl) ->
r := tl;
Some x
;;
let split ?pos ?len re s : _ gen = Search.split ?pos ?len re s |> gen_of_seq
let split_full ?pos ?len re s : _ gen = Search.split_full ?pos ?len re s |> gen_of_seq
let all ?pos ?len re s = Search.all ?pos ?len re s |> gen_of_seq
let matches ?pos ?len re s = Search.matches ?pos ?len re s |> gen_of_seq
end
module Group = Group
(** {2 Deprecated functions} *)
let split_full_seq = Search.split_full
let split_seq = Search.split
let matches_seq = Search.matches
let all_seq = Search.all
type 'a gen = 'a Gen.gen
let all_gen = Gen.all
let matches_gen = Gen.matches
let split_gen = Gen.split
let split_full_gen = Gen.split_full
type substrings = Group.t
let get = Group.get
let get_ofs = Group.offset
let get_all = Group.all
let get_all_ofs = Group.all_offset
let test = Group.test
type markid = Mark.t
let marked = Mark.test
let mark_set = Mark.all
type groups = Group.t
module List = struct
let list_of_seq (s : 'a Seq.t) : 'a list =
Seq.fold_left (fun l x -> x :: l) [] s |> List.rev
;;
let all ?pos ?len re s = Search.all ?pos ?len re s |> list_of_seq
let matches ?pos ?len re s = Search.matches ?pos ?len re s |> list_of_seq
let split_full ?pos ?len re s = Search.split_full ?pos ?len re s |> list_of_seq
let split ?pos ?len re s = Search.split ?pos ?len re s |> list_of_seq
let split_delim ?pos ?len re s = Search.split_delim ?pos ?len re s |> list_of_seq
end
include List
include struct
open Compile
type nonrec re = re
let compile = compile
let pp_re = pp_re
let print_re = pp_re
let group_names = group_names
let group_count = group_count
end
module Seq = Search
module Stream = Compile.Stream

View file

@ -0,0 +1,813 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(** Module [Re]: code for creating and using regular expressions,
independently of regular expression syntax. *)
(** Regular expression *)
type t = Ast.t
(** Compiled regular expression *)
type re = Compile.re
(** Manipulate matching groups. *)
module Group : sig
(** Information about groups in a match. As is conventional, every
match implicitly has a group 0 that covers the whole match, and
explicit groups are numbered from 1. *)
type t = Group.t
(** Raise [Not_found] if the group did not match *)
val get : t -> int -> string
(** Similar to {!get}, but returns an option instead of using an exception. *)
val get_opt : t -> int -> string option
(** Raise [Not_found] if the group did not match *)
val offset : t -> int -> int * int
(** Similar to {!offset}, but returns an option instead of using an exception. *)
val offset_opt : t -> int -> (int * int) option
(** Return the start of the match. Raise [Not_found] if the group did not match. *)
val start : t -> int -> int
(** Similar to {!start_opt}, but returns an option instead of using an exception. *)
val start_opt : t -> int -> int option
(** Return the end of the match. Raise [Not_found] if the group did not match. *)
val stop : t -> int -> int
(** Similar to {!stop_opt}, but returns an option instead of using an exception. *)
val stop_opt : t -> int -> int option
(** Return the empty string for each group which did not match *)
val all : t -> string array
(** Return [(-1,-1)] for each group which did not match *)
val all_offset : t -> (int * int) array
(** Test whether a group matched *)
val test : t -> int -> bool
(** Returns the total number of groups defined - matched or not.
This function is experimental. *)
val nb_groups : t -> int
val pp : Format.formatter -> t -> unit
end
type groups = Group.t [@@ocaml.deprecated "Use Group.t"]
(** {2 Compilation and execution of a regular expression} *)
(** Compile a regular expression into an executable version that can be
used to match strings, e.g. with {!exec}. *)
val compile : t -> re
(** Return the number of capture groups (including the one
corresponding to the entire regexp). *)
val group_count : re -> int
(** Return named capture groups with their index. *)
val group_names : re -> (string * int) list
(** [exec re str] searches [str] for a match of the compiled expression [re],
and returns the matched groups if any.
More specifically, when a match exists, [exec] returns a match that
starts at the earliest position possible. If multiple such matches are
possible, the one specified by the match semantics described below is
returned.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "//"; rep print ]);;
val regex : re = <abstr>
# Re.exec regex "// a C comment";;
- : Re.Group.t = <abstr>
# Re.exec regex "# a C comment?";;
Exception: Not_found
# Re.exec ~pos:1 regex "// a C comment";;
Exception: Not_found
]}
@param pos optional beginning of the string (default 0)
@param len
length of the substring of [str] that can be matched (default [-1],
meaning to the end of the string)
@raise Not_found if the regular expression can't be found in [str] *)
val exec
: ?pos:int (** Default: 0 *)
-> ?len:int (** Default: -1 (until end of string) *)
-> re
-> string
-> Group.t
(** Similar to {!exec}, but returns an option instead of using an exception.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "//"; rep print ]);;
val regex : re = <abstr>
# Re.exec_opt regex "// a C comment";;
- : Re.Group.t option = Some <abstr>
# Re.exec_opt regex "# a C comment?";;
- : Re.Group.t option = None
# Re.exec_opt ~pos:1 regex "// a C comment";;
- : Re.Group.t option = None
]} *)
val exec_opt
: ?pos:int (** Default: 0 *)
-> ?len:int (** Default: -1 (until end of string) *)
-> re
-> string
-> Group.t option
(** Similar to {!exec}, but returns [true] if the expression matches,
and [false] if it doesn't. This function is more efficient than
calling {!exec} or {!exec_opt} and ignoring the returned group.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "//"; rep print ]);;
val regex : re = <abstr>
# Re.execp regex "// a C comment";;
- : bool = true
# Re.execp ~pos:1 regex "// a C comment";;
- : bool = false
]} *)
val execp
: ?pos:int (** Default: 0 *)
-> ?len:int (** Default: -1 (until end of string) *)
-> re
-> string
-> bool
(** More detailed version of {!execp}. [`Full] is equivalent to [true],
while [`Mismatch] and [`Partial] are equivalent to [false], but [`Partial]
indicates the input string could be extended to create a match.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [bos; str "// a C comment"]);;
val regex : re = <abstr>
# Re.exec_partial regex "// a C comment here.";;
- : [ `Full | `Mismatch | `Partial ] = `Full
# Re.exec_partial regex "// a C comment";;
- : [ `Full | `Mismatch | `Partial ] = `Partial
# Re.exec_partial regex "//";;
- : [ `Full | `Mismatch | `Partial ] = `Partial
# Re.exec_partial regex "# a C comment?";;
- : [ `Full | `Mismatch | `Partial ] = `Mismatch
]} *)
val exec_partial
: ?pos:int (** Default: 0 *)
-> ?len:int (** Default: -1 (until end of string) *)
-> re
-> string
-> [ `Full | `Partial | `Mismatch ]
(** More detailed version of {!exec_opt}. [`Full group] is equivalent to [Some group],
while [`Mismatch] and [`Partial _] are equivalent to [None], but [`Partial position]
indicates that the input string could be extended to create a match, and no match could
start in the input string before the given position.
This could be used to not have to search the entirety of the input if more
becomes available, and use the given position as the [?pos] argument. *)
val exec_partial_detailed
: ?pos:int (** Default: 0 *)
-> ?len:int (** Default: -1 (until end of string) *)
-> re
-> string
-> [ `Full of Group.t | `Partial of int | `Mismatch ]
(** Marks *)
module Mark : sig
(** Mark id *)
type t = Pmark.t
(** Tell if a mark was matched. *)
val test : Group.t -> t -> bool
module Set : Set.S with type elt = t
(** Return all the mark matched. *)
val all : Group.t -> Set.t
val equal : t -> t -> bool
val compare : t -> t -> int
end
(** {2 High Level Operations} *)
type split_token =
[ `Text of string (** Text between delimiters *)
| `Delim of Group.t (** Delimiter *)
]
(** Repeatedly calls {!exec} on the given string, starting at given position and
length.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
val regex : re = <abstr>
# Re.all regex "my head, my shoulders, my knees, my toes ...";;
- : Re.Group.t list = [<abstr>; <abstr>; <abstr>; <abstr>]
# Re.all regex "My head, My shoulders, My knees, My toes ...";;
- : Re.Group.t list = []
]} *)
val all : ?pos:int -> ?len:int -> re -> string -> Group.t list
type 'a gen = unit -> 'a option
(** @deprecated Use {!module-Seq.all} instead. *)
val all_gen : ?pos:int -> ?len:int -> re -> string -> Group.t gen
[@@ocaml.deprecated "Use Seq.all"]
(** @deprecated Use {!module-Seq.all} instead. *)
val all_seq : ?pos:int -> ?len:int -> re -> string -> Group.t Seq.t
[@@ocaml.deprecated "Use Seq.all"]
(** Same as {!all}, but extracts the matched substring rather than returning
the whole group. This basically iterates over matched strings.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
val regex : re = <abstr>
# Re.matches regex "my head, my shoulders, my knees, my toes ...";;
- : string list = ["my head"; "my shoulders"; "my knees"; "my toes"]
# Re.matches regex "My head, My shoulders, My knees, My toes ...";;
- : string list = []
# Re.matches regex "my my my my head my 1 toe my ...";;
- : string list = ["my my"; "my my"]
# Re.matches ~pos:2 regex "my my my my head my +1 toe my ...";;
- : string list = ["my my"; "my head"]
]} *)
val matches : ?pos:int -> ?len:int -> re -> string -> string list
(** @deprecated Use {!module-Seq.matches} instead. *)
val matches_gen : ?pos:int -> ?len:int -> re -> string -> string gen
[@@ocaml.deprecated "Use Seq.matches"]
(** @deprecated Use {!module-Seq.matches} instead. *)
val matches_seq : ?pos:int -> ?len:int -> re -> string -> string Seq.t
[@@ocaml.deprecated "Use Seq.matches"]
(** [split re s] splits [s] into chunks separated by [re]. It yields
the chunks themselves, not the separator. An occurence of the
separator at the beginning or the end of the string is ignoring.
{5 Examples:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.split regex "Re,Ocaml,Jerome Vouillon";;
- : string list = ["Re"; "Ocaml"; "Jerome Vouillon"]
# Re.split regex "No commas in this sentence.";;
- : string list = ["No commas in this sentence."]
# Re.split regex ",1,2,";;
- : string list = ["1"; "2"]
# Re.split ~pos:3 regex "1,2,3,4. Commas go brrr.";;
- : string list = ["3"; "4. Commas go brrr."]
]}
{6 Zero-length patterns:}
Be careful when using [split] with zero-length patterns like [eol], [bow],
and [eow]. Because they don't have any width, they will still be present in
the result. (Note the position of the [\n] and space characters in the
output.)
{[
# Re.split (Re.compile Re.eol) "a\nb";;
- : string list = ["a"; "\nb"]
# Re.split (Re.compile Re.bow) "a b";;
- : string list = ["a "; "b"]
# Re.split (Re.compile Re.eow) "a b";;
- : string list = ["a"; " b"]
]}
Compare this to the behavior of splitting on the char itself. (Note that
the delimiters are not present in the output.)
{[
# Re.split (Re.compile (Re.char '\n')) "a\nb";;
- : string list = ["a"; "b"]
# Re.split (Re.compile (Re.char ' ')) "a b";;
- : string list = ["a"; "b"]
]} *)
val split : ?pos:int -> ?len:int -> re -> string -> string list
(** [split_delim re s] splits [s] into chunks separated by [re]. It
yields the chunks themselves, not the separator. Occurences of the
separator at the beginning or the end of the string will produce
empty chunks.
{5 Examples:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.split regex "Re,Ocaml,Jerome Vouillon";;
- : string list = ["Re"; "Ocaml"; "Jerome Vouillon"]
# Re.split regex "No commas in this sentence.";;
- : string list = ["No commas in this sentence."]
# Re.split regex ",1,2,";;
- : string list = [""; "1"; "2"; ""]
# Re.split ~pos:3 regex "1,2,3,4. Commas go brrr.";;
- : string list = ["3"; "4. Commas go brrr."]
]}
{6 Zero-length patterns:}
Be careful when using [split_delim] with zero-length patterns like [eol],
[bow], and [eow]. Because they don't have any width, they will still be
present in the result. (Note the position of the [\n] and space characters
in the output.)
{[
# Re.split_delim (Re.compile Re.eol) "a\nb";;
- : string list = ["a"; "\nb"; ""]
# Re.split_delim (Re.compile Re.bow) "a b";;
- : string list = [""; "a "; "b"]
# Re.split_delim (Re.compile Re.eow) "a b";;
- : string list = ["a"; " b"; ""]
]}
Compare this to the behavior of splitting on the char itself. (Note that
the delimiters are not present in the output.)
{[
# Re.split_delim (Re.compile (Re.char '\n')) "a\nb";;
- : string list = ["a"; "b"]
# Re.split_delim (Re.compile (Re.char ' ')) "a b";;
- : string list = ["a"; "b"]
]} *)
val split_delim : ?pos:int -> ?len:int -> re -> string -> string list
(** @deprecated Use {!module-Seq.split} instead. *)
val split_gen : ?pos:int -> ?len:int -> re -> string -> string gen
[@@ocaml.deprecated "Use Seq.split"]
(** @deprecated Use {!module-Seq.split} instead. *)
val split_seq : ?pos:int -> ?len:int -> re -> string -> string Seq.t
[@@ocaml.deprecated "Use Seq.split"]
(** [split re s] splits [s] into chunks separated by [re]. It yields the chunks
along with the separators. For instance this can be used with a
whitespace-matching re such as ["[\t ]+"].
{5 Examples:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.split_full regex "Re,Ocaml,Jerome Vouillon";;
- : Re.split_token list =
[`Text "Re"; `Delim <abstr>; `Text "Ocaml"; `Delim <abstr>;
`Text "Jerome Vouillon"]
# Re.split_full regex "No commas in this sentence.";;
- : Re.split_token list = [`Text "No commas in this sentence."]
# Re.split_full ~pos:3 regex "1,2,3,4. Commas go brrr.";;
- : Re.split_token list =
[`Delim <abstr>; `Text "3"; `Delim <abstr>; `Text "4. Commas go brrr."]
]} *)
val split_full : ?pos:int -> ?len:int -> re -> string -> split_token list
(** @deprecated Use {!module-Seq.split_full} instead. *)
val split_full_gen : ?pos:int -> ?len:int -> re -> string -> split_token gen
[@@ocaml.deprecated "Use Seq.split_full"]
(** @deprecated Use {!module-Seq.split_full} instead. *)
val split_full_seq : ?pos:int -> ?len:int -> re -> string -> split_token Seq.t
[@@ocaml.deprecated "Use Seq.split_full"]
module Seq : sig
(** Same as {!module-Re.val-all} but returns an iterator.
{5 Examples:}
{[
# let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
val regex : re = <abstr>
# Re.Seq.all regex "my head, my shoulders, my knees, my toes ...";;
- : Re.Group.t Seq.t = <fun>
]}
@since 1.10.0 *)
val all : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> Group.t Seq.t
(** Same as {!module-Re.val-matches}, but returns an iterator.
{5 Example:}
{[
# let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
val regex : re = <abstr>
# Re.Seq.matches regex "my head, my shoulders, my knees, my toes ...";;
- : string Seq.t = <fun>
]}
@since 1.10.0 *)
val matches : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
(** Same as {!module-Re.val-split} but returns an iterator.
{5 Example:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.Seq.split regex "Re,Ocaml,Jerome Vouillon";;
- : string Seq.t = <fun>
]}
@since 1.10.0 *)
val split : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
(** Same as {!module-Re.val-split_delim} but returns an iterator.
{5 Example:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.Seq.split regex "Re,Ocaml,Jerome Vouillon";;
- : string Seq.t = <fun>
]}
@since 1.11.1 *)
val split_delim : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
(** Same as {!module-Re.val-split_full} but returns an iterator.
{5 Example:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.Seq.split_full regex "Re,Ocaml,Jerome Vouillon";;
- : Re.split_token Seq.t = <fun>
]}
@since 1.10.0 *)
val split_full
: ?pos:int (** Default: 0 *)
-> ?len:int
-> re
-> string
-> split_token Seq.t
end
(** {2 String expressions (literal match)} *)
val str : string -> t
val char : char -> t
(** {2 Basic operations on regular expressions} *)
(** Alternative.
[alt []] is equivalent to {!empty}.
By default, the leftmost match is preferred (see match semantics below). *)
val alt : t list -> t
(** Sequence *)
val seq : t list -> t
(** Match nothing *)
val empty : t
(** Empty word *)
val epsilon : t
(** 0 or more matches *)
val rep : t -> t
(** 1 or more matches *)
val rep1 : t -> t
(** [repn re i j] matches [re] at least [i] times
and at most [j] times, bounds included.
[j = None] means no upper bound. *)
val repn : t -> int -> int option -> t
(** 0 or 1 matches *)
val opt : t -> t
(** {2 String, line, word}
We define a word as a sequence of latin1 letters, digits and underscore. *)
(** Beginning of line *)
val bol : t
(** End of line *)
val eol : t
(** Beginning of word *)
val bow : t
(** End of word *)
val eow : t
(** Beginning of string. This differs from {!start} because it matches
the beginning of the input string even when using [~pos] arguments:
{[
let b = execp (compile (seq [ bos; str "a" ])) "aa" ~pos:1 in
assert (not b)
]} *)
val bos : t
(** End of string. This is different from {!stop} in the way described
in {!bos}. *)
val eos : t
(** Last end of line or end of string *)
val leol : t
(** Initial position. This differs from {!bos} because it takes into
account the [~pos] arguments:
{[
let b = execp (compile (seq [ start; str "a" ])) "aa" ~pos:1 in
assert b
]} *)
val start : t
(** Final position. This is different from {!eos} in the way described
in {!start}. *)
val stop : t
(** Word *)
val word : t -> t
(** Not at a word boundary *)
val not_boundary : t
(** Only matches the whole string, i.e. [fun t -> seq [ bos; t; eos ]]. *)
val whole_string : t -> t
(** {2 Match semantics}
A regular expression frequently matches a string in multiple ways. For
instance [exec (compile (opt (str "a"))) "ab"] can match "" or "a". Match
semantic can be modified with the functions below, allowing one to choose
which of these is preferable.
By default, the leftmost branch of alternations is preferred, and repetitions
are greedy.
Note that the existence of matches cannot be changed by specifying match
semantics. [seq [ bos; str "a"; non_greedy (opt (str "b")); eos ]] will
match when applied to "ab". However if [seq [ bos; str "a"; non_greedy (opt
(str "b")) ]] is applied to "ab", it will match "a" rather than "ab".
Also note that multiple match semantics can conflict. In this case, the one
executed earlier takes precedence. For instance, any match of [shortest (seq
[ bos; group (rep (str "a")); group (rep (str "a")); eos ])] will always have
an empty first group. Conversely, if we use [longest] instead of [shortest],
the second group will always be empty. *)
(** Longest match semantics. That is, matches will match as many bytes as
possible. If multiple choices match the maximum amount of bytes, the one
respecting the inner match semantics is preferred. *)
val longest : t -> t
(** Same as {!longest}, but matching the least number of bytes. *)
val shortest : t -> t
(** First match semantics for alternations (not repetitions). That is, matches
will prefer the leftmost branch of the alternation that matches the text. *)
val first : t -> t
(** Greedy matches for repetitions ({!opt}, {!rep}, {!rep1}, {!repn}): they will
match as many times as possible. *)
val greedy : t -> t
(** Non-greedy matches for repetitions ({!opt}, {!rep}, {!rep1}, {!repn}): they
will match as few times as possible. *)
val non_greedy : t -> t
(** {2 Groups (or submatches)} *)
(** Delimit a group. The group is considered as matching if it is used at least
once (it may be used multiple times if is nested inside {!rep} for
instance). If it is used multiple times, the last match is what gets
captured. *)
val group : ?name:string -> t -> t
(** Remove all groups *)
val no_group : t -> t
(** When matching against [nest e], only the group matching in the
last match of e will be considered as matching.
For instance:
{[
let re = compile (rep1 (nest (alt [ group (str "a"); str "b" ]))) in
let group = Re.exec re "ab" in
assert (Group.get_opt group 1 = None);
(* same thing but without [nest] *)
let re = compile (rep1 (alt [ group (str "a"); str "b" ])) in
let group = Re.exec re "ab" in
assert (Group.get_opt group 1 = Some "a")
]} *)
val nest : t -> t
(** Mark a regexp. the markid can then be used to know if this regexp was used. *)
val mark : t -> Mark.t * t
(** {2 Character sets} *)
(** Any character of the string *)
val set : string -> t
(** Character ranges *)
val rg : char -> char -> t
(** Intersection of character sets *)
val inter : t list -> t
(** Difference of character sets *)
val diff : t -> t -> t
(** Complement of union *)
val compl : t list -> t
(** {2 Predefined character sets} *)
(** Any character *)
val any : t
(** Any character but a newline *)
val notnl : t
val alnum : t
val wordc : t
val alpha : t
val ascii : t
val blank : t
val cntrl : t
val digit : t
val graph : t
val lower : t
val print : t
val punct : t
val space : t
val upper : t
val xdigit : t
(** {2 Case modifiers} *)
(** Case sensitive matching. Note that this works on latin1, not ascii and not
utf8. *)
val case : t -> t
(** Case insensitive matching. Note that this works on latin1, not ascii and not
utf8. *)
val no_case : t -> t
(****)
(** {2 Internal debugging} *)
val pp : Format.formatter -> t -> unit
val pp_re : Format.formatter -> re -> unit
(** Alias for {!pp_re}. Deprecated *)
val print_re : Format.formatter -> re -> unit
(** {2 Experimental functions} *)
(** [witness r] generates a string [s] such that [execp (compile r) s] is true.
Be warned that this function is buggy because it ignores zero-width
assertions like beginning of words. As a result it can generate incorrect
results. *)
val witness : t -> string
(** {2 Deprecated functions} *)
(** Alias for {!Group.t}. Deprecated *)
type substrings = Group.t [@@ocaml.deprecated "Use Group.t"]
(** Same as {!Group.get}. Deprecated *)
val get : Group.t -> int -> string
[@@ocaml.deprecated "Use Group.get"]
(** Same as {!Group.offset}. Deprecated *)
val get_ofs : Group.t -> int -> int * int
[@@ocaml.deprecated "Use Group.offset"]
(** Same as {!Group.all}. Deprecated *)
val get_all : Group.t -> string array
[@@ocaml.deprecated "Use Group.all"]
(** Same as {!Group.all_offset}. Deprecated *)
val get_all_ofs : Group.t -> (int * int) array
[@@ocaml.deprecated "Use Group.all_offset"]
(** Same as {!Group.test}. Deprecated *)
val test : Group.t -> int -> bool
[@@ocaml.deprecated "Use Group.test"]
(** Alias for {!Mark.t}. Deprecated *)
type markid = Mark.t [@@ocaml.deprecated "Use Mark."]
(** Same as {!Mark.test}. Deprecated *)
val marked : Group.t -> Mark.t -> bool
[@@ocaml.deprecated "Use Mark.test"]
(** Same as {!Mark.all}. Deprecated *)
val mark_set : Group.t -> Mark.Set.t
[@@ocaml.deprecated "Use Mark.all"]
module Stream : sig
(** An experimental for matching a regular expression by feeding individual
string chunks.
This module is not covered by semver's stability guarantee. *)
type t
type 'a feed =
| Ok of 'a
| No_match
val create : re -> t
val feed : t -> string -> pos:int -> len:int -> t feed
(** [finalize s ~pos ~len] feed [s] from [pos] to [len] and return whether
the regular expression matched. *)
val finalize : t -> string -> pos:int -> len:int -> bool
module Group : sig
(** Match a string against a regular expression with capture groups *)
type stream := t
type t
module Match : sig
type t
val get : t -> int -> string option
val test_mark : t -> Pmark.t -> bool
end
val create : stream -> t
val feed : t -> string -> pos:int -> len:int -> t feed
val finalize : t -> string -> pos:int -> len:int -> Match.t feed
end
end

View file

@ -0,0 +1,250 @@
module List = struct end
open Import
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
type c = int
let equal_c = Int.equal
let to_int x = x
let of_int x = x
let to_char t = Char.chr t
let of_char c = Char.code c
let null_char = -1
type t = (c * c) list
let compare_pair (x, y) (x', y') =
match Int.compare x x' with
| 0 -> Int.compare y y'
| x -> x
;;
let equal_pair (x, y) (x', y') = Int.equal x x' && Int.equal y y'
let equal x y = List.equal ~eq:equal_pair x y
let compare x y = List.compare ~cmp:compare_pair x y
let rec union l l' =
match l, l' with
| _, [] -> l
| [], _ -> l'
| (c1, c2) :: r, (c1', c2') :: r' ->
if c2 + 1 < c1'
then (c1, c2) :: union r l'
else if c2' + 1 < c1
then (c1', c2') :: union l r'
else if c2 < c2'
then union r ((min c1 c1', c2') :: r')
else union ((min c1 c1', c2) :: r) r'
;;
let rec inter l l' =
match l, l' with
| _, [] -> []
| [], _ -> []
| (c1, c2) :: r, (c1', c2') :: r' ->
if c2 < c1'
then inter r l'
else if c2' < c1
then inter l r'
else if c2 < c2'
then (max c1 c1', c2) :: inter r l'
else (max c1 c1', c2') :: inter l r'
;;
let rec diff l l' =
match l, l' with
| _, [] -> l
| [], _ -> []
| (c1, c2) :: r, (c1', c2') :: r' ->
if c2 < c1'
then (c1, c2) :: diff r l'
else if c2' < c1
then diff l r'
else (
let r'' = if c2' < c2 then (c2' + 1, c2) :: r else r in
if c1 < c1' then (c1, c1' - 1) :: diff r'' r' else diff r'' r')
;;
let single =
let single c = [ c, c ] in
Dense_map.make (* an extra color for lnl *) ~size:257 ~f:single
;;
let csingle i = single (Char.code i)
let add c l = union (single c) l
let seq c c' = if c <= c' then [ c, c' ] else [ c', c ]
let rec offset o l =
match l with
| [] -> []
| (c1, c2) :: r -> (c1 + o, c2 + o) :: offset o r
;;
let empty : t = []
let cany = [ 0, 255 ]
let union_all ts = List.fold_left ~init:empty ~f:union ts
let intersect_all ts = List.fold_left ~init:cany ~f:inter ts
let rec mem (c : int) s =
match s with
| [] -> false
| (c1, c2) :: rem -> if c <= c2 then c >= c1 else mem c rem
;;
(****)
let rec hash_rec = function
| [] -> 0
| (i, j) :: r -> i + (13 * j) + (257 * hash_rec r)
;;
let hash l = hash_rec l land 0x3FFFFFFF
(****)
let print_one ch (c1, c2) =
if Int.equal c1 c2 then Format.fprintf ch "%d" c1 else Format.fprintf ch "%d-%d" c1 c2
;;
let pp ts = Fmt.list ~pp_sep:(Fmt.lit ", ") print_one ts
let to_dyn t =
let open Dyn in
match t with
| [ (x, y) ] when Int.equal x y -> int x
| _ -> List.map t ~f:(fun (x, y) -> pair (int x) (int y)) |> list
;;
let rec iter t ~f =
match t with
| [] -> ()
| (x, y) :: xs ->
f x y;
iter xs ~f
;;
let one_char = function
| [ (i, j) ] when Int.equal i j -> Some i
| _ -> None
;;
module CSetMap = Map.Make (struct
type t = int * (int * int) list
let compare (i, u) (j, v) =
let c = Int.compare i j in
if c <> 0 then c else compare u v
;;
end)
let fold_right t ~init ~f = List.fold_right ~f:(fun (x, y) acc -> f x y acc) t ~init
let is_empty = function
| [] -> true
| _ -> false
;;
let rec prepend s x l =
match s, l with
| [], _ -> l
| _r, [] -> []
| (_c, c') :: r, ([ (d, _d') ], _x') :: _r' when c' < d -> prepend r x l
| (c, c') :: r, ([ (d, d') ], x') :: r' ->
if c <= d
then
if c' < d'
then ([ d, c' ], x @ x') :: prepend r x (([ c' + 1, d' ], x') :: r')
else ([ d, d' ], x @ x') :: prepend s x r'
else if c > d'
then ([ d, d' ], x') :: prepend s x r'
else ([ d, c - 1 ], x') :: prepend s x (([ c, d' ], x') :: r')
| _ -> assert false
;;
let pick = function
| [] -> invalid_arg "Re_cset.pick"
| (x, _) :: _ -> x
;;
let cseq c c' = seq (of_char c) (of_char c')
let rg = cseq
let char = csingle
let upper = union_all [ cseq 'A' 'Z'; cseq '\192' '\214'; cseq '\216' '\222' ]
let clower = offset 32 upper
let cdigit = cseq '0' '9'
let ascii = cseq '\000' '\127'
let cadd c s = add (of_char c) s
let space = add (of_char ' ') (cseq '\009' '\013')
let xdigit = union_all [ cdigit; cseq 'a' 'f'; cseq 'A' 'F' ]
let calpha =
List.fold_right
~f:cadd
[ '\170'; '\181'; '\186'; '\223'; '\255' ]
~init:(union clower upper)
;;
let calnum = union calpha cdigit
let case_insens s =
union_all [ s; offset 32 (inter s upper); offset (-32) (inter s clower) ]
;;
let cword = cadd '_' calnum
let notnl = diff cany (csingle '\n')
let nl = csingle '\n'
let set str =
let s = ref empty in
for i = 0 to String.length str - 1 do
s := union (csingle str.[i]) !s
done;
!s
;;
let blank = set "\t "
(* CR-someday rgrinberg: this [lower] doesn't match [clower] *)
let lower = union_all [ rg 'a' 'z'; char '\181'; rg '\223' '\246'; rg '\248' '\255' ]
let alpha = union_all [ lower; upper; char '\170'; char '\186' ]
let alnum = union_all [ alpha; cdigit ]
let wordc = union_all [ alnum; char '_' ]
let cntrl = union_all [ rg '\000' '\031'; rg '\127' '\159' ]
let graph = union_all [ rg '\033' '\126'; rg '\160' '\255' ]
let print = union_all [ rg '\032' '\126'; rg '\160' '\255' ]
let punct =
union_all
[ rg '\033' '\047'
; rg '\058' '\064'
; rg '\091' '\096'
; rg '\123' '\126'
; rg '\160' '\169'
; rg '\171' '\180'
; rg '\182' '\185'
; rg '\187' '\191'
; char '\215'
; char '\247'
]
;;

View file

@ -0,0 +1,84 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(* Character sets, represented as sorted list of intervals *)
type c [@@immediate]
val equal_c : c -> c -> bool
val to_int : c -> int
val of_int : int -> c
val to_char : c -> char
val of_char : char -> c
type t
(** special characters which isn't present in any set (not even in [cany]) *)
val null_char : c
val equal : t -> t -> bool
val iter : t -> f:(c -> c -> unit) -> unit
val union : t -> t -> t
val union_all : t list -> t
val intersect_all : t list -> t
val inter : t -> t -> t
val diff : t -> t -> t
val empty : t
val single : c -> t
val add : c -> t -> t
val mem : c -> t -> bool
val case_insens : t -> t
val cdigit : t
val calpha : t
val cword : t
val notnl : t
val ascii : t
val nl : t
val cseq : char -> char -> t
val set : string -> t
val blank : t
val space : t
val xdigit : t
val lower : t
val upper : t
val alpha : t
val alnum : t
val wordc : t
val cntrl : t
val graph : t
val print : t
val punct : t
val pp : t Fmt.t
val one_char : t -> c option
val fold_right : t -> init:'acc -> f:(c -> c -> 'acc -> 'acc) -> 'acc
val hash : t -> int
val compare : t -> t -> int
module CSetMap : Map.S with type key = int * t
val cany : t
val csingle : char -> t
val is_empty : t -> bool
val prepend : t -> 'a list -> (t * 'a list) list -> (t * 'a list) list
val pick : t -> c
val offset : int -> t -> t
val to_dyn : t -> Dyn.t

View file

@ -0,0 +1,4 @@
let make ~size ~f =
let cache = Array.init size f in
fun i -> cache.(i)
;;

View file

@ -0,0 +1 @@
val make : size:int -> f:(int -> 'a) -> int -> 'a

View file

@ -0,0 +1,9 @@
(library
(name re)
(synopsis "Pure OCaml regular expression library")
(public_name re))
(copy_files#
(enabled_if
(< %{ocaml_version} 5))
(files fake/*))

View file

@ -0,0 +1,26 @@
type t =
| Int of int
| Tuple of t list
| Enum of string
| String of string
| List of t list
| Variant of string * t list
| Record of (string * t) list
let variant x y = Variant (x, y)
let list x = List x
let int x = Int x
let pair x y = Tuple [ x; y ]
let record fields = Record fields
let enum x = Enum x
let string s = String s
let result ok err = function
| Ok s -> variant "Ok" [ ok s ]
| Error e -> variant "Error" [ err e ]
;;
let option f = function
| None -> enum "None"
| Some s -> variant "Some" [ f s ]
;;

View file

@ -0,0 +1,145 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
module Re = Core
exception Parse_error
exception Not_supported
let by_code f c c' =
let c = Char.code c in
let c' = Char.code c' in
Char.chr (f c c')
;;
let parse ~emacs_only s =
let buf = Parse_buffer.create s in
let accept = Parse_buffer.accept buf in
let eos () = Parse_buffer.eos buf in
let test2 = Parse_buffer.test2 buf in
let get () = Parse_buffer.get buf in
let rec regexp () = regexp' [ branch () ]
and regexp' left =
if Parse_buffer.accept_s buf {|\||}
then regexp' (branch () :: left)
else Re.alt (List.rev left)
and branch () = branch' []
and branch' left =
if eos () || test2 '\\' '|' || test2 '\\' ')'
then Re.seq (List.rev left)
else branch' (piece () :: left)
and piece () =
let r = atom () in
if accept '*'
then Re.rep r
else if accept '+'
then Re.rep1 r
else if accept '?'
then Re.opt r
else r
and atom () =
if accept '.'
then Re.notnl
else if accept '^'
then Re.bol
else if accept '$'
then Re.eol
else if accept '['
then if accept '^' then Re.compl (bracket []) else Re.alt (bracket [])
else if accept '\\'
then
if accept '('
then (
let r = regexp () in
if not (Parse_buffer.accept_s buf {|\)|}) then raise Parse_error;
Re.group r)
else if emacs_only && accept '`'
then Re.bos
else if emacs_only && accept '\''
then Re.eos
else if accept '='
then Re.start
else if accept 'b'
then Re.alt [ Re.bow; Re.eow ]
else if emacs_only && accept 'B'
then Re.not_boundary
else if emacs_only && accept '<'
then Re.bow
else if emacs_only && accept '>'
then Re.eow
else if accept 'w'
then Re.alt [ Re.alnum; Re.char '_' ]
else if accept 'W'
then Re.compl [ Re.alnum; Re.char '_' ]
else (
if eos () then raise Parse_error;
match get () with
| ('*' | '+' | '?' | '[' | ']' | '.' | '^' | '$' | '\\') as c -> Re.char c
| '0' .. '9' -> raise Not_supported
| c -> if emacs_only then raise Parse_error else Re.char c)
else (
if eos () then raise Parse_error;
match get () with
| '*' | '+' | '?' -> raise Parse_error
| c -> Re.char c)
and bracket s =
if s <> [] && accept ']'
then s
else (
let c = char () in
if accept '-'
then
if accept ']'
then Re.char c :: Re.char '-' :: s
else (
let c' = char () in
let c' = by_code Int.max c c' in
bracket (Re.rg c c' :: s))
else bracket (Re.char c :: s))
and char () =
if eos () then raise Parse_error;
get ()
in
let res = regexp () in
if not (eos ()) then raise Parse_error;
res
;;
let re ?(case = true) s =
let r = parse s ~emacs_only:true in
if case then r else Re.no_case r
;;
let re_no_emacs ~case s =
let r = parse s ~emacs_only:false in
if case then r else Re.no_case r
;;
let re_result ?case s =
match re ?case s with
| s -> Ok s
| exception Not_supported -> Error `Not_supported
| exception Parse_error -> Error `Parse_error
;;
let compile = Re.compile
let compile_pat ?(case = true) s = compile (re ~case s)

View file

@ -0,0 +1,41 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(** Emacs-style regular expressions *)
exception Parse_error
(** Errors that can be raised during the parsing of the regular expression *)
exception Not_supported
(** Parsing of an Emacs-style regular expression *)
val re : ?case:bool -> string -> Core.t
val re_result : ?case:bool -> string -> (Core.t, [ `Not_supported | `Parse_error ]) result
(** Regular expression compilation *)
val compile : Core.t -> Core.re
(** Same as [Core.compile] *)
val compile_pat : ?case:bool -> string -> Core.re
val re_no_emacs : case:bool -> string -> Core.t

View file

@ -0,0 +1,5 @@
module DLS = struct
let new_key f = ref (f())
let set x y = x := y
let get x = !x
end

View file

@ -0,0 +1,26 @@
(*
RE - A regular expression library
Copyright (C) 2025 Jerome Vouillon
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, with
linking exception; either version 2.1 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
*)
type t = unit
let create _ = ()
let lock _ = ()
let unlock _ = ()

View file

@ -0,0 +1,51 @@
(** Very small tooling for format printers. *)
include Format
type 'a t = Format.formatter -> 'a -> unit
let list = pp_print_list
let array ?pp_sep f fmt arr = list ?pp_sep f fmt (Array.to_list arr)
let str = pp_print_string
let sexp fmt s pp x = fprintf fmt "@[<3>(%s@ %a)@]" s pp x
let bytes fmt t = Format.fprintf fmt "%S" (Bytes.to_string t)
let pair pp1 pp2 fmt (v1, v2) =
pp1 fmt v1;
pp_print_space fmt ();
pp2 fmt v2
;;
let triple pp1 pp2 pp3 fmt (v1, v2, v3) =
pp1 fmt v1;
pp_print_space fmt ();
pp2 fmt v2;
pp_print_space fmt ();
pp3 fmt v3
;;
let opt f fmt x =
match x with
| None -> pp_print_string fmt "<None>"
| Some x -> fprintf fmt "%a" f x
;;
let int = pp_print_int
let optint fmt = function
| None -> ()
| Some i -> fprintf fmt "@ %d" i
;;
let char fmt c = Format.fprintf fmt "%c" c
let bool = Format.pp_print_bool
let lit s fmt () = pp_print_string fmt s
let to_to_string pp x =
let b = Buffer.create 16 in
let fmt = Format.formatter_of_buffer b in
pp fmt x;
Buffer.contents b
;;
let quoted_string fmt s = Format.fprintf fmt "%S" s

View file

@ -0,0 +1,18 @@
type formatter := Format.formatter
type 'a t = formatter -> 'a -> unit
val sexp : formatter -> string -> 'a t -> 'a -> unit
val str : string t
val optint : int option t
val opt : 'a t -> 'a option t
val char : char t
val bool : bool t
val int : int t
val pair : 'a t -> 'b t -> ('a * 'b) t
val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
val list : ?pp_sep:unit t -> 'a t -> 'a list t
val bytes : Bytes.t t
val array : ?pp_sep:unit t -> 'a t -> 'a array t
val lit : string -> unit t
val to_to_string : 'a t -> 'a -> string
val quoted_string : string t

View file

@ -0,0 +1,337 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
module Re = Core
exception Parse_error = Parse_buffer.Parse_error
type enclosed =
| Char of char
| Range of char * char
type piece =
| Exactly of char
| Any_of of enclosed list
| Any_but of enclosed list
| One
| Many
| ManyMany
type t = piece list
let of_string ~double_asterisk s : t =
let buf = Parse_buffer.create s in
let eos () = Parse_buffer.eos buf in
let read c = Parse_buffer.accept buf c in
let char () =
ignore (read '\\' : bool);
if eos () then raise Parse_error;
Parse_buffer.get buf
in
let enclosed () : enclosed list =
let rec loop s =
(* This returns the list in reverse order, but order isn't important
anyway *)
if s <> [] && read ']'
then s
else (
let c = char () in
if not (read '-')
then loop (Char c :: s)
else if read ']'
then Char c :: Char '-' :: s
else (
let c' = char () in
loop (Range (c, c') :: s)))
in
loop []
in
let piece acc =
if double_asterisk && Parse_buffer.accept_s buf "/**"
then ManyMany :: (if eos () then Exactly '/' :: acc else acc)
else if read '*'
then (if double_asterisk && read '*' then ManyMany else Many) :: acc
else if read '?'
then One :: acc
else if not (read '[')
then Exactly (char ()) :: acc
else if read '^' || read '!'
then Any_but (enclosed ()) :: acc
else Any_of (enclosed ()) :: acc
in
let rec loop pieces = if eos () then List.rev pieces else loop (piece pieces) in
loop []
;;
let mul l l' = List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l)
let explode str =
let l = String.length str in
let rec expl inner s i acc beg =
if i >= l
then (
if inner then raise Parse_error;
mul beg [ String.sub str s (i - s) ], i)
else (
match str.[i] with
| '\\' -> expl inner s (i + 2) acc beg
| '{' ->
let t, i' = expl true (i + 1) (i + 1) [] [ "" ] in
expl inner i' i' acc (mul beg (mul [ String.sub str s (i - s) ] t))
| ',' when inner ->
expl inner (i + 1) (i + 1) (mul beg [ String.sub str s (i - s) ] @ acc) [ "" ]
| '}' when inner -> mul beg [ String.sub str s (i - s) ] @ acc, i + 1
| _ -> expl inner s (i + 1) acc beg)
in
List.rev (fst (expl false 0 0 [] [ "" ]))
;;
module State = struct
type t =
{ re_pieces : Re.t list (* last piece at head of list. *)
; remaining : piece list (* last piece at tail of list. *)
; am_at_start_of_pattern : bool (* true at start of pattern *)
; am_at_start_of_component : bool
(* true at start of pattern or immediately
after '/' *)
; pathname : bool
; match_backslashes : bool
; period : bool
}
let create ~period ~pathname ~match_backslashes remaining =
{ re_pieces = []
; am_at_start_of_pattern = true
; am_at_start_of_component = true
; pathname
; match_backslashes
; period
; remaining
}
;;
let explicit_period t =
t.period && (t.am_at_start_of_pattern || (t.am_at_start_of_component && t.pathname))
;;
let explicit_slash t = t.pathname
let slashes t = if t.match_backslashes then [ '/'; '\\' ] else [ '/' ]
let append ?(am_at_start_of_component = false) t piece =
{ t with
re_pieces = piece :: t.re_pieces
; am_at_start_of_pattern = false
; am_at_start_of_component
}
;;
let to_re t = Re.seq (List.rev t.re_pieces)
let next t =
match t.remaining with
| [] -> None
| piece :: remaining -> Some (piece, { t with remaining })
;;
end
let one ~explicit_slash ~slashes ~explicit_period =
Re.compl
(List.concat
[ (if explicit_slash then List.map Re.char slashes else [])
; (if explicit_period then [ Re.char '.' ] else [])
])
;;
let enclosed enclosed =
match enclosed with
| Char c -> Re.char c
| Range (low, high) -> Re.rg low high
;;
let enclosed_set ~explicit_slash ~slashes ~explicit_period kind set =
let set = List.map enclosed set in
let enclosure =
match kind with
| `Any_of -> Re.alt set
| `Any_but -> Re.compl set
in
Re.inter [ enclosure; one ~explicit_slash ~slashes ~explicit_period ]
;;
let exactly state c =
let slashes = State.slashes state in
let am_at_start_of_component = List.mem c slashes in
let chars = if am_at_start_of_component then slashes else [ c ] in
State.append state (Re.alt (List.map Re.char chars)) ~am_at_start_of_component
;;
let many_many state =
let explicit_period = state.State.period && state.State.pathname in
let first_explicit_period = State.explicit_period state in
let slashes = State.slashes state in
let match_component ~explicit_period =
Re.seq
[ one ~explicit_slash:true ~slashes ~explicit_period
; Re.rep (one ~explicit_slash:true ~slashes ~explicit_period:false)
]
in
(* We must match components individually when [period] flag is set,
making sure to not match ["foo/.bar"]. *)
State.append
state
(Re.seq
[ Re.opt (match_component ~explicit_period:first_explicit_period)
; Re.rep
(Re.seq
[ Re.alt (List.map Re.char slashes)
; Re.opt (match_component ~explicit_period)
])
])
;;
let many (state : State.t) =
let explicit_slash = State.explicit_slash state in
let explicit_period = State.explicit_period state in
let slashes = State.slashes state in
(* Whether we must explicitly match period depends on the surrounding
characters, but slashes are easy to explicit match. This conditional
splits out some simple cases. *)
if not explicit_period
then State.append state (Re.rep (one ~explicit_slash ~slashes ~explicit_period))
else if not explicit_slash
then
(* In this state, we explicitly match periods only at the very beginning *)
State.append
state
(Re.opt
(Re.seq
[ one ~explicit_slash:false ~slashes ~explicit_period
; Re.rep (one ~explicit_slash:false ~slashes ~explicit_period:false)
]))
else (
let not_empty =
Re.seq
[ one ~explicit_slash:true ~slashes ~explicit_period:true
; Re.rep (one ~explicit_slash:true ~slashes ~explicit_period:false)
]
in
(* [maybe_empty] is the default translation of Many, except in some special
cases. *)
let maybe_empty = Re.opt not_empty in
let enclosed_set state kind set =
State.append
state
(Re.alt
[ enclosed_set kind set ~explicit_slash:true ~slashes ~explicit_period:true
; Re.seq
[ not_empty
; (* Since [not_empty] matched, subsequent dots are not leading. *)
enclosed_set
kind
set
~explicit_slash:true
~slashes
~explicit_period:false
]
])
in
let rec lookahead state =
match State.next state with
| None -> State.append state maybe_empty
(* glob ** === glob * . *)
| Some (Many, state) -> lookahead state
| Some (Exactly c, state) ->
let state = State.append state (if c = '.' then not_empty else maybe_empty) in
exactly state c
(* glob *? === glob ?* *)
| Some (One, state) -> State.append state not_empty
| Some (Any_of enclosed, state) -> enclosed_set state `Any_of enclosed
| Some (Any_but enclosed, state) -> enclosed_set state `Any_but enclosed
(* * then ** === ** *)
| Some (ManyMany, state) -> many_many state
in
lookahead state)
;;
let piece state piece =
let explicit_slash = State.explicit_slash state in
let explicit_period = State.explicit_period state in
let slashes = State.slashes state in
match piece with
| One -> State.append state (one ~explicit_slash ~slashes ~explicit_period)
| Many -> many state
| Any_of enclosed ->
State.append
state
(enclosed_set `Any_of ~explicit_slash ~slashes ~explicit_period enclosed)
| Any_but enclosed ->
State.append
state
(enclosed_set `Any_but ~explicit_slash ~slashes ~explicit_period enclosed)
| Exactly c -> exactly state c
| ManyMany -> many_many state
;;
let glob ~pathname ~match_backslashes ~period glob =
let rec loop state =
match State.next state with
| None -> State.to_re state
| Some (p, state) -> loop (piece state p)
in
loop (State.create ~pathname ~match_backslashes ~period glob)
;;
let glob
?(anchored = false)
?(pathname = true)
?(match_backslashes = false)
?(period = true)
?(expand_braces = false)
?(double_asterisk = true)
s
=
let to_re s =
let re = glob ~pathname ~match_backslashes ~period (of_string ~double_asterisk s) in
if anchored then Re.whole_string re else re
in
if expand_braces then Re.alt (List.map to_re (explode s)) else to_re s
;;
let glob_result
?anchored
?pathname
?match_backslashes
?period
?expand_braces
?double_asterisk
s
=
match
glob ?anchored ?pathname ?match_backslashes ?period ?expand_braces ?double_asterisk s
with
| re -> Ok re
| exception Parse_error -> Error `Parse_error
;;
let glob' ?anchored period s = glob ?anchored ~period s
let globx ?anchored s = glob ?anchored ~expand_braces:true s
let globx' ?anchored period s = glob ?anchored ~expand_braces:true ~period s

View file

@ -0,0 +1,95 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(** Shell-style regular expressions *)
exception Parse_error
(** Implements the semantics of shells patterns. The returned regular
expression is unanchored by default.
Character '*' matches any sequence of characters and character
'?' matches a single character.
A sequence '[...]' matches any one of the enclosed characters.
A sequence '[^...]' or '[!...]' matches any character *but* the enclosed characters.
A backslash escapes the following character. The last character of the string cannot
be a backslash.
[anchored] controls whether the regular expression will only match entire
strings. Defaults to false.
[pathname]: If this flag is set, match a slash in string only with a slash in pattern
and not by an asterisk ('*') or a question mark ('?') metacharacter, nor by a bracket
expression ('[]') containing a slash. Defaults to true.
[match_backslashes]: If this flag is set, a forward slash will also match a
backslash (useful when globbing Windows paths). Note that a backslash in the
pattern will continue to escape the following character. Defaults to
[false].
[period]: If this flag is set, a leading period in string has to be matched exactly by
a period in pattern. A period is considered to be leading if it is the first
character in string, or if both [pathname] is set and the period immediately follows a
slash. Defaults to true.
If [expand_braces] is true, braced sets will expand into multiple globs,
e.g. a\{x,y\}b\{1,2\} matches axb1, axb2, ayb1, ayb2. As specified for bash, brace
expansion is purely textual and can be nested. Defaults to false.
[double_asterisk]: If this flag is set, double asterisks ('**') will match slash
characters, even if [pathname] is set. The [period] flag still applies. Default to
true. *)
val glob
: ?anchored:bool
-> ?pathname:bool
-> ?match_backslashes:bool
-> ?period:bool
-> ?expand_braces:bool
-> ?double_asterisk:bool
-> string
-> Core.t
val glob_result
: ?anchored:bool
-> ?pathname:bool
-> ?match_backslashes:bool
-> ?period:bool
-> ?expand_braces:bool
-> ?double_asterisk:bool
-> string
-> (Core.t, [ `Parse_error ]) result
(** Same, but allows to choose whether dots at the beginning of a
file name need to be explicitly matched (true) or not (false)
@deprecated Use [glob ~period]. *)
val glob' : ?anchored:bool -> bool -> string -> Core.t
(** This version of [glob] also recognizes the pattern \{..,..\}
@deprecated Prefer [glob ~expand_braces:true]. *)
val globx : ?anchored:bool -> string -> Core.t
(** This version of [glob'] also recognizes the pattern \{..,..\}
@deprecated Prefer [glob ~expand_braces:true ~period]. *)
val globx' : ?anchored:bool -> bool -> string -> Core.t

View file

@ -0,0 +1,103 @@
(* Result of a successful match. *)
type t =
{ (* Input string. Matched strings are substrings of s *)
s : string
(* Mapping from group indices to positions in gpos. group i has positions 2*i
- 1, 2*i + 1 in gpos. If the group wasn't matched, then its corresponding
values in marks will be -1,-1 *)
; marks : Mark_infos.t
; (* Marks positions. i.e. those marks created with Re.marks *)
pmarks : Pmark.Set.t
; (* Group positions. Adjacent elements are (start, stop) of group match.
indexed by the values in marks. So group i in an re would be the substring:
start = t.gpos.(marks.(2*i)) - 1
stop = t.gpos.(marks.(2*i + 1)) - 1 *)
gpos : int array
; (* Number of groups the regular expression contains. Matched or not *)
gcount : int
}
let create s ~gcount ~gpos marks pmarks = { s; gcount; gpos; marks; pmarks }
module Offset = struct
type t = int
let absent = -1
let is_present t = t >= 0
let get_no_check t = t
end
let start_offset t i =
let i = Mark_infos.start_offset t.marks i in
if Mark_infos.Offset.is_present i
then t.gpos.(Mark_infos.Offset.get_no_check i)
else Offset.absent
;;
let stop_offset t i =
let i = Mark_infos.stop_offset t.marks i in
if Mark_infos.Offset.is_present i
then t.gpos.(Mark_infos.Offset.get_no_check i)
else Offset.absent
;;
let offset_opt t i =
Mark_infos.offset t.marks i
|> Option.map (fun (start, stop) -> t.gpos.(start), t.gpos.(stop))
;;
let or_not_found = function
| None -> raise Not_found
| Some s -> s
;;
let offset t i = offset_opt t i |> or_not_found
let get_opt t i =
offset_opt t i |> Option.map (fun (p1, p2) -> String.sub t.s p1 (p2 - p1))
;;
let pmarks t = t.pmarks
let get t i = get_opt t i |> or_not_found
let start_opt subs i = offset_opt subs i |> Option.map fst
let start subs i = start_opt subs i |> or_not_found
let stop_opt subs i = offset_opt subs i |> Option.map snd
let stop subs i = stop_opt subs i |> or_not_found
let test t i = Mark_infos.test t.marks i
let get_opt t i = if test t i then Some (get t i) else None
let dummy_offset = -1, -1
let all_offset t =
let res = Array.make t.gcount dummy_offset in
Mark_infos.iteri t.marks ~f:(fun i start stop ->
let p1 = t.gpos.(start) in
let p2 = t.gpos.(stop) in
res.(i) <- p1, p2);
res
;;
let dummy_string = ""
let all t =
let res = Array.make t.gcount dummy_string in
Mark_infos.iteri t.marks ~f:(fun i start stop ->
let p1 = t.gpos.(start) in
let p2 = t.gpos.(stop) in
res.(i) <- String.sub t.s p1 (p2 - p1));
res
;;
let pp fmt t =
let matches =
let offsets = all_offset t in
let strs = all t in
Array.to_list (Array.init (Array.length strs) (fun i -> strs.(i), offsets.(i)))
in
let open Format in
let open Fmt in
let pp_match fmt (str, (start, stop)) = fprintf fmt "@[(%s (%d %d))@]" str start stop in
sexp fmt "Group" (list pp_match) matches
;;
let nb_groups t = t.gcount

View file

@ -0,0 +1,54 @@
(** Information about groups in a match. *)
(** Result of a successful match. *)
type t
val create : string -> gcount:int -> gpos:int array -> Mark_infos.t -> Pmark.Set.t -> t
(** Raise [Not_found] if the group did not match *)
val get : t -> int -> string
(** Similar to {!get}, but returns an option instead of using an exception. *)
val get_opt : t -> int -> string option
(** Raise [Not_found] if the group did not match *)
val offset : t -> int -> int * int
val offset_opt : t -> int -> (int * int) option
(** Return the start of the match. Raise [Not_found] if the group did not match. *)
val start : t -> int -> int
val start_opt : t -> int -> int option
(** Return the end of the match. Raise [Not_found] if the group did not match. *)
val stop : t -> int -> int
val stop_opt : t -> int -> int option
(** Return the empty string for each group which did not match *)
val all : t -> string array
(** Return [(-1,-1)] for each group which did not match *)
val all_offset : t -> (int * int) array
(** Test whether a group matched *)
val test : t -> int -> bool
val pmarks : t -> Pmark.Set.t
(** Returns the total number of groups defined - matched or not.
This function is experimental. *)
val nb_groups : t -> int
val pp : t Fmt.t
module Offset : sig
type t
val is_present : t -> bool
val get_no_check : t -> int
end
val start_offset : t -> int -> Offset.t
val stop_offset : t -> int -> Offset.t

View file

@ -0,0 +1,155 @@
open Import
module Array = struct
type nonrec t = Bytes.t
let words = 8
let[@inline] length t = Bytes.length t / words
let[@inline] unsafe_get t i = Int64.to_int (Bytes.get_int64_ne t (i * words))
let[@inline] unsafe_set t i x = Bytes.set_int64_ne t (i * words) (Int64.of_int x)
let[@inline] make len x =
let t = Bytes.create (len * words) in
for i = 0 to length t - 1 do
unsafe_set t i x
done;
t
;;
let[@inline] make_absent len = Bytes.make (len * words) '\255'
let clear t = Bytes.fill t 0 (Bytes.length t) '\255'
let fold_left t ~init ~f =
let init = ref init in
for i = 0 to length t - 1 do
init := f !init (unsafe_get t i)
done;
!init
;;
end
(* A specialized hash table that makes the following trade-offs:
- Open addresing. Bucketing is quite memory intensive and dune is already
a memory hog.
- No boxing for empty slots. We make use of the fact that id's are never
negative to achieve this.
- No saving of the hash. Recomputing the hash for id's is a no-op.
*)
type nonrec table =
{ mutable table : Array.t
; mutable size : int
}
type t = table Option.t ref
let init t =
if Option.is_none !t then t := Option.some { size = 0; table = Array.make 0 (-1) };
Option.get !t
;;
let[@inline] should_grow t =
let slots = Array.length t.table in
slots = 0 || (t.size > 0 && slots / t.size < 2)
;;
let absent = -1
let () =
let x = Array.make_absent 1 in
assert (Array.unsafe_get x 0 = absent)
;;
let create () = ref None
let[@inline] index_of_offset slots index i =
let i = index + !i in
if i >= slots then i - slots else i
;;
let clear t =
match !t with
| None -> ()
| Some t ->
t.size <- 0;
Array.clear t.table
;;
let add t x =
let hash = Int.hash x in
let slots = Array.length t.table in
let index = hash land (slots - 1) in
let inserting = ref true in
let i = ref 0 in
while !inserting do
let idx = index_of_offset slots index i in
let elem = Array.unsafe_get t.table idx in
if elem = absent
then (
Array.unsafe_set t.table idx x;
inserting := false)
else incr i
done;
t.size <- t.size + 1
;;
let resize t =
let old_table = t.table in
let slots = Array.length old_table in
let table = Array.make_absent (if slots = 0 then 1 else slots lsl 1) in
t.table <- table;
for i = 0 to slots - 1 do
let elem = Array.unsafe_get old_table i in
if elem <> absent then add t elem
done
;;
let add t x =
let t = init t in
if should_grow t then resize t;
add t x
;;
let[@inline] is_empty t =
let t = !t in
if Option.is_none t
then true
else (
let t = Option.get t in
t.size = 0)
;;
let mem t x =
let t = !t in
if Option.is_none t || (Option.get t).size = 0
then false
else (
let t = Option.get t in
let hash = Int.hash x in
let slots = Array.length t.table in
let index = hash land (slots - 1) in
let i = ref 0 in
let found = ref false in
while (not !found) && !i < slots do
let idx = index_of_offset slots index i in
let elem = Array.unsafe_get t.table idx in
if Int.equal elem x
then found := true
else if Int.equal elem absent
then i := slots
else incr i
done;
!found)
;;
let pp fmt t =
let { table; size } = init t in
let table =
Array.fold_left table ~init:[] ~f:(fun acc i -> if i = absent then acc else i :: acc)
|> List.rev
|> Stdlib.Array.of_list
in
let table fmt () = Fmt.sexp fmt "table" Fmt.(array int) table in
let size fmt () = Fmt.sexp fmt "size" Fmt.int size in
Format.fprintf fmt "%a@.%a@." table () size ()
;;

View file

@ -0,0 +1,8 @@
type t
val create : unit -> t
val is_empty : t -> bool
val add : t -> int -> unit
val mem : t -> int -> bool
val clear : t -> unit
val pp : t Fmt.t

View file

@ -0,0 +1,24 @@
module List = Stdlib.ListLabels
module Poly = struct
let equal = ( = )
let compare = compare
end
module Phys_equal = struct
let equal = ( == )
end
let ( = ) = Int.equal
let ( == ) = [ `Use_phys_equal ]
let ( < ) (x : int) (y : int) = x < y
let ( > ) (x : int) (y : int) = x > y
let min = Int.min
let max = Int.max
let compare = Int.compare
module Int = struct
let[@warning "-32"] hash (x : int) = Hashtbl.hash x
include Stdlib.Int
end

View file

@ -0,0 +1,55 @@
open Import
type t = int array
let make marks =
let len = 1 + List.fold_left ~f:(fun ma (i, _) -> max ma i) ~init:(-1) marks in
let t = Array.make len (-1) in
let set (i, v) = t.(i) <- v in
List.iter ~f:set marks;
t
;;
let test t i = if 2 * i >= Array.length t then false else t.(2 * i) <> -1
module Offset = struct
type t = int
let is_present t = t >= 0
let get_no_check t = t
end
let start_offset t i =
let start_i = 2 * i in
if start_i + 1 >= Array.length t then -1 else t.(start_i)
;;
let stop_offset t i =
let stop_i = (2 * i) + 1 in
if stop_i >= Array.length t then -1 else t.(stop_i)
;;
let offset t i =
let start_i = 2 * i in
let stop_i = start_i + 1 in
if stop_i >= Array.length t
then None
else (
let start = t.(start_i) in
if start = -1
then None
else (
let stop = t.(stop_i) in
Some (start, stop)))
;;
let iteri t ~f =
for i = 0 to (Array.length t / 2) - 1 do
let idx = 2 * i in
let start = t.(idx) in
if start <> -1
then (
let stop = t.(idx + 1) in
f i start stop)
done
;;

View file

@ -0,0 +1,17 @@
(** store mark information for groups in an array *)
type t
val make : (int * int) list -> t
val offset : t -> int -> (int * int) option
val test : t -> int -> bool
val iteri : t -> f:(int -> int -> int -> unit) -> unit
module Offset : sig
type t
val is_present : t -> bool
val get_no_check : t -> int
end
val start_offset : t -> int -> Offset.t
val stop_offset : t -> int -> Offset.t

View file

@ -0,0 +1,67 @@
type t =
{ str : string
; mutable pos : int
}
exception Parse_error
let create str = { str; pos = 0 }
let unget t = t.pos <- t.pos - 1
let junk t = t.pos <- t.pos + 1
let eos t = t.pos = String.length t.str
let test t c = (not (eos t)) && t.str.[t.pos] = c
let test2 t c c' =
t.pos + 1 < String.length t.str && t.str.[t.pos] = c && t.str.[t.pos + 1] = c'
;;
let accept t c =
let r = test t c in
if r then t.pos <- t.pos + 1;
r
;;
let get t =
let r = t.str.[t.pos] in
t.pos <- t.pos + 1;
r
;;
let accept_s t s' =
let len = String.length s' in
try
for j = 0 to len - 1 do
(* CR-someday rgrinberg: stop relying on bound checks *)
try if s'.[j] <> t.str.[t.pos + j] then raise_notrace Exit with
| _ -> raise_notrace Exit
done;
t.pos <- t.pos + len;
true
with
| Exit -> false
;;
let rec integer' t i =
if eos t
then Some i
else (
match get t with
| '0' .. '9' as d ->
let i' = (10 * i) + (Char.code d - Char.code '0') in
if i' < i then raise Parse_error;
integer' t i'
| _ ->
unget t;
Some i)
;;
let integer t =
if eos t
then None
else (
match get t with
| '0' .. '9' as d -> integer' t (Char.code d - Char.code '0')
| _ ->
unget t;
None)
;;

View file

@ -0,0 +1,14 @@
type t
exception Parse_error
val create : string -> t
val junk : t -> unit
val unget : t -> unit
val eos : t -> bool
val test : t -> char -> bool
val test2 : t -> char -> char -> bool
val get : t -> char
val accept : t -> char -> bool
val accept_s : t -> string -> bool
val integer : t -> int option

View file

@ -0,0 +1,179 @@
module Re = Core
exception Parse_error = Perl.Parse_error
exception Not_supported = Perl.Not_supported
type regexp = Re.re
type flag =
[ `CASELESS
| `MULTILINE
| `ANCHORED
| `DOTALL
]
type split_result =
| Text of string
| Delim of string
| Group of int * string
| NoGroup
type groups = Core.Group.t
let re ?(flags = []) pat =
let opts =
List.map
(function
| `CASELESS -> `Caseless
| `MULTILINE -> `Multiline
| `ANCHORED -> `Anchored
| `DOTALL -> `Dotall)
flags
in
Perl.re ~opts pat
;;
let re_result ?flags s =
match re ?flags s with
| s -> Ok s
| exception Not_supported -> Error `Not_supported
| exception Parse_error -> Error `Parse_error
;;
let regexp ?flags pat = Re.compile (re ?flags pat)
let extract ~rex s = Re.Group.all (Re.exec rex s)
let exec ~rex ?pos s = Re.exec rex ?pos s
let names rex = Re.group_names rex |> List.map fst |> Array.of_list
let get_named_substring_opt rex name s =
let rec loop = function
| [] -> None
| (n, i) :: rem when n = name ->
(match Re.Group.get_opt s i with
| None -> loop rem
| Some _ as s -> s)
| _ :: rem -> loop rem
in
loop (Re.group_names rex)
;;
let get_substring_ofs s i = Re.Group.offset s i
let pmatch ~rex s = Re.execp rex s
let substitute ~rex ~subst str =
let b = Buffer.create 1024 in
let rec loop pos on_match =
if Re.execp ~pos rex str
then (
let ss = Re.exec ~pos rex str in
let start, fin = Re.Group.offset ss 0 in
if on_match && start = pos && start = fin
then (
if (* Empty match following a match *)
pos < String.length str
then (
Buffer.add_char b str.[pos];
loop (pos + 1) false))
else (
let pat = Re.Group.get ss 0 in
Buffer.add_substring b str pos (start - pos);
Buffer.add_string b (subst pat);
if start = fin
then (
if (* Manually advance by one after an empty match *)
fin < String.length str
then (
Buffer.add_char b str.[fin];
loop (fin + 1) false))
else loop fin true))
else Buffer.add_substring b str pos (String.length str - pos)
in
loop 0 false;
Buffer.contents b
;;
let split ~rex s =
let rec split accu start =
if start = String.length s
then accu
else (
match
let g = Re.exec rex s ~pos:start in
if Group.stop g 0 = start then Re.exec rex s ~pos:(start + 1) else g
with
| exception Not_found -> String.sub s start (String.length s - start) :: accu
| g ->
let next = Group.stop g 0 in
split (String.sub s start (Group.start g 0 - start) :: accu) next)
in
match Re.exec rex s ~pos:0 with
| g ->
List.rev
(if Group.start g 0 = 0
then split [] (Group.stop g 0)
else split [ String.sub s 0 (Group.start g 0) ] (Group.stop g 0))
| exception Not_found -> if s = "" then [] else [ s ]
;;
(* From PCRE *)
let string_unsafe_sub s ofs len =
let r = Bytes.create len in
Bytes.unsafe_blit s ofs r 0 len;
Bytes.unsafe_to_string r
;;
let quote s =
let len = String.length s in
let buf = Bytes.create (len lsl 1) in
let pos = ref 0 in
for i = 0 to len - 1 do
match String.unsafe_get s i with
| ('\\' | '^' | '$' | '.' | '[' | '|' | '(' | ')' | '?' | '*' | '+' | '{') as c ->
Bytes.unsafe_set buf !pos '\\';
incr pos;
Bytes.unsafe_set buf !pos c;
incr pos
| c ->
Bytes.unsafe_set buf !pos c;
incr pos
done;
string_unsafe_sub buf 0 !pos
;;
let full_split ?(max = 0) ~rex s =
if String.length s = 0
then []
else if max = 1
then [ Text s ]
else (
let results = Re.split_full rex s in
let matches =
List.map
(function
| `Text s -> [ Text s ]
| `Delim d ->
let matches = Re.Group.all_offset d in
let delim = Re.Group.get d 0 in
Delim delim
::
(let l = ref [] in
for i = 1 to Array.length matches - 1 do
l
:= (if matches.(i) = (-1, -1) then NoGroup else Group (i, Re.Group.get d i))
:: !l
done;
List.rev !l))
results
in
List.concat matches)
;;
type substrings = Group.t
let get_substring s i = Re.Group.get s i
let get_named_substring rex name s =
match get_named_substring_opt rex name s with
| None -> raise Not_found
| Some s -> s
;;

View file

@ -0,0 +1,67 @@
(** NOTE: Only a subset of the PCRE spec is supported *)
exception Parse_error
exception Not_supported
type regexp = Core.re
type flag =
[ `CASELESS
| `MULTILINE
| `ANCHORED
| `DOTALL
]
type groups = Core.Group.t
(** Result of a {!Pcre.full_split} *)
type split_result =
| Text of string (** Text part of splitted string *)
| Delim of string (** Delimiter part of splitted string *)
| Group of int * string (** Subgroup of matched delimiter (subgroup_nr, subgroup_str) *)
| NoGroup (** Unmatched subgroup *)
(** [re ~flags s] creates the regexp [s] using the pcre syntax. *)
val re : ?flags:flag list -> string -> Core.t
val re_result
: ?flags:flag list
-> string
-> (Core.t, [ `Not_supported | `Parse_error ]) result
(** [re ~flags s] compiles the regexp [s] using the pcre syntax. *)
val regexp : ?flags:flag list -> string -> regexp
(** [extract ~rex s] executes [rex] on [s] and returns the matching groups. *)
val extract : rex:regexp -> string -> string array
(** Equivalent to {!Core.exec}. *)
val exec : rex:regexp -> ?pos:int -> string -> groups
(** Equivalent to {!Core.Group.get}. *)
val get_substring : groups -> int -> string
(** Return the names of named groups. *)
val names : regexp -> string array
(** Return the first matched named group, or raise [Not_found]. Prefer to use
the non-raising version [get_named_substring_opt] *)
val get_named_substring : regexp -> string -> groups -> string
(** Return the first matched named group, or raise [Not_found]. *)
val get_named_substring_opt : regexp -> string -> groups -> string option
(** Equivalent to {!Core.Group.offset}. *)
val get_substring_ofs : groups -> int -> int * int
(** Equivalent to {!Core.execp}. *)
val pmatch : rex:regexp -> string -> bool
val substitute : rex:Core.re -> subst:(string -> string) -> string -> string
val full_split : ?max:int -> rex:regexp -> string -> split_result list
val split : rex:regexp -> string -> string list
val quote : string -> string
(** {2 Deprecated} *)
type substrings = Group.t

View file

@ -0,0 +1,360 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
module Re = Core
exception Parse_error = Parse_buffer.Parse_error
exception Not_supported
let acc_digits =
let rec loop base digits acc i =
match digits with
| [] -> acc
| d :: digits ->
let acc = acc + (d * i) in
let i = i * i in
loop base digits acc i
in
fun ~base ~digits -> loop base digits 0 1
;;
let char_of_int x =
match char_of_int x with
| x -> x
| exception _ -> raise Parse_error
;;
type elem =
| Char of char
| Set of Ast.t
let char_b = Char '\008'
let char_newline = Char '\n'
let char_cr = Char '\r'
let char_tab = Char '\t'
let word_char = [ Re.alnum; Re.char '_' ]
let word = Set (Re.alt word_char)
let not_word = Set (Re.alt word_char)
let space = Set Re.space
let not_space = Set (Re.compl [ Re.space ])
let digit = Set Re.digit
let not_digit = Set (Re.compl [ Re.digit ])
let parse ~multiline ~dollar_endonly ~dotall ~ungreedy s =
let buf = Parse_buffer.create s in
let accept = Parse_buffer.accept buf in
let eos () = Parse_buffer.eos buf in
let test c = Parse_buffer.test buf c in
let unget () = Parse_buffer.unget buf in
let get () = Parse_buffer.get buf in
let greedy_mod r =
let gr = accept '?' in
let gr = if ungreedy then not gr else gr in
if gr then Re.non_greedy r else Re.greedy r
in
let rec regexp () = regexp' [ branch () ]
and regexp' left =
if accept '|' then regexp' (branch () :: left) else Re.alt (List.rev left)
and branch () = branch' []
and branch' left =
if eos () || test '|' || test ')'
then Re.seq (List.rev left)
else branch' (piece () :: left)
and in_brace ~f ~init =
match accept '{' with
| false -> None
| true ->
let rec loop acc =
if accept '}'
then acc
else (
let acc = f acc in
loop acc)
in
Some (loop init)
and piece () =
let r = atom () in
if accept '*'
then greedy_mod (Re.rep r)
else if accept '+'
then greedy_mod (Re.rep1 r)
else if accept '?'
then greedy_mod (Re.opt r)
else if accept '{'
then (
match Parse_buffer.integer buf with
| Some i ->
let j = if accept ',' then Parse_buffer.integer buf else Some i in
if not (accept '}') then raise Parse_error;
(match j with
| Some j when j < i -> raise Parse_error
| _ -> ());
greedy_mod (Re.repn r i j)
| None ->
unget ();
r)
else r
and atom () =
if accept '.'
then if dotall then Re.any else Re.notnl
else if accept '('
then
if accept '?'
then
if accept ':'
then (
let r = regexp () in
if not (accept ')') then raise Parse_error;
r)
else if accept '#'
then comment ()
else if accept '<'
then (
let name = name () in
let r = regexp () in
if not (accept ')') then raise Parse_error;
Re.group ~name r)
else raise Parse_error
else (
let r = regexp () in
if not (accept ')') then raise Parse_error;
Re.group r)
else if accept '^'
then if multiline then Re.bol else Re.bos
else if accept '$'
then if multiline then Re.eol else if dollar_endonly then Re.leol else Re.eos
else if accept '['
then if accept '^' then Re.compl (bracket []) else Re.alt (bracket [])
else if accept '\\'
then (
(* XXX
- Back-references
- \cx (control-x), \ddd
*)
if eos () then raise Parse_error;
match get () with
| 'w' -> Re.alt [ Re.alnum; Re.char '_' ]
| 'W' -> Re.compl [ Re.alnum; Re.char '_' ]
| 's' -> Re.space
| 'S' -> Re.compl [ Re.space ]
| 'd' -> Re.digit
| 'D' -> Re.compl [ Re.digit ]
| 'b' -> Re.alt [ Re.bow; Re.eow ]
| 'B' -> Re.not_boundary
| 'A' -> Re.bos
| 'Z' -> Re.leol
| 'z' -> Re.eos
| 'G' -> Re.start
| 'e' -> Re.char '\x1b'
| 'f' -> Re.char '\x0c'
| 'n' -> Re.char '\n'
| 'r' -> Re.char '\r'
| 't' -> Re.char '\t'
| 'Q' -> quote (Buffer.create 12)
| 'E' -> raise Parse_error
| 'x' ->
let c1, c2 =
match in_brace ~init:[] ~f:(fun acc -> hexdigit () :: acc) with
| Some [ c1; c2 ] -> c1, c2
| Some [ c2 ] -> 0, c2
| Some _ -> raise Parse_error
| None ->
let c1 = hexdigit () in
let c2 = hexdigit () in
c1, c2
in
let code = (c1 * 16) + c2 in
Re.char (char_of_int code)
| 'o' ->
(match
in_brace ~init:[] ~f:(fun acc ->
match maybe_octaldigit () with
| None -> raise Parse_error
| Some p -> p :: acc)
with
| None -> raise Parse_error
| Some digits -> Re.char (char_of_int (acc_digits ~base:8 ~digits)))
| 'a' .. 'z' | 'A' .. 'Z' -> raise Parse_error
| '0' .. '7' as n1 ->
let n2 = maybe_octaldigit () in
let n3 = maybe_octaldigit () in
(match n2, n3 with
| Some n2, Some n3 ->
let n1 = Char.code n1 - Char.code '0' in
Re.char (char_of_int ((n1 * (8 * 8)) + (n2 * 8) + n3))
| _, _ -> raise Not_supported)
| '8' .. '9' -> raise Not_supported
| c -> Re.char c)
else (
if eos () then raise Parse_error;
match get () with
| '*' | '+' | '?' | '{' | '\\' -> raise Parse_error
| c -> Re.char c)
and quote buf =
if accept '\\'
then (
if eos () then raise Parse_error;
match get () with
| 'E' -> Re.str (Buffer.contents buf)
| c ->
Buffer.add_char buf '\\';
Buffer.add_char buf c;
quote buf)
else (
if eos () then raise Parse_error;
Buffer.add_char buf (get ());
quote buf)
and hexdigit () =
if eos () then raise Parse_error;
match get () with
| '0' .. '9' as d -> Char.code d - Char.code '0'
| 'a' .. 'f' as d -> Char.code d - Char.code 'a' + 10
| 'A' .. 'F' as d -> Char.code d - Char.code 'A' + 10
| _ -> raise Parse_error
and maybe_octaldigit () =
if eos ()
then None
else (
match get () with
| '0' .. '7' as d -> Some (Char.code d - Char.code '0')
| _ -> None)
and name () =
if eos ()
then raise Parse_error
else (
match get () with
| ('_' | 'a' .. 'z' | 'A' .. 'Z') as c ->
let b = Buffer.create 32 in
Buffer.add_char b c;
name' b
| _ -> raise Parse_error)
and name' b =
if eos ()
then raise Parse_error
else (
match get () with
| ('_' | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9') as c ->
Buffer.add_char b c;
name' b
| '>' -> Buffer.contents b
| _ -> raise Parse_error)
and bracket s =
if s <> [] && accept ']'
then s
else (
match char () with
| Set st -> bracket (st :: s)
| Char c ->
if accept '-'
then
if accept ']'
then Re.char c :: Re.char '-' :: s
else
bracket
(match char () with
| Char c' -> Re.rg c c' :: s
| Set st' -> Re.char c :: Re.char '-' :: st' :: s)
else bracket (Re.char c :: s))
and char () =
if eos () then raise Parse_error;
let c = get () in
if c = '['
then (
if accept '=' then raise Not_supported;
match Posix_class.parse buf with
| Some set -> Set set
| None ->
if accept '.'
then (
if eos () then raise Parse_error;
let c = get () in
if not (accept '.') then raise Not_supported;
if not (accept ']') then raise Parse_error;
Char c)
else Char c)
else if c = '\\'
then (
if eos () then raise Parse_error;
let c = get () in
(* XXX
\127, ...
*)
match c with
| 'b' -> char_b
| 'n' -> char_newline (*XXX*)
| 'r' -> char_cr (*XXX*)
| 't' -> char_tab (*XXX*)
| 'w' -> word
| 'W' -> not_word
| 's' -> space
| 'S' -> not_space
| 'd' -> digit
| 'D' -> not_digit
| 'a' .. 'z' | 'A' .. 'Z' -> raise Parse_error
| '0' .. '9' -> raise Not_supported
| _ -> Char c)
else Char c
and comment () =
if eos () then raise Parse_error;
if accept ')'
then Re.epsilon
else (
Parse_buffer.junk buf;
comment ())
in
let res = regexp () in
if not (eos ()) then raise Parse_error;
res
;;
type opt =
[ `Ungreedy
| `Dotall
| `Dollar_endonly
| `Multiline
| `Anchored
| `Caseless
]
let re ?(opts = []) s =
let r =
parse
~multiline:(List.memq `Multiline opts)
~dollar_endonly:(List.memq `Dollar_endonly opts)
~dotall:(List.memq `Dotall opts)
~ungreedy:(List.memq `Ungreedy opts)
s
in
let r = if List.memq `Anchored opts then Re.seq [ Re.start; r ] else r in
let r = if List.memq `Caseless opts then Re.no_case r else r in
r
;;
let compile = Re.compile
let compile_pat ?(opts = []) s = compile (re ~opts s)
let re_result ?opts s =
match re ?opts s with
| s -> Ok s
| exception Not_supported -> Error `Not_supported
| exception Parse_error -> Error `Parse_error
;;

View file

@ -0,0 +1,51 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(** Perl-style regular expressions *)
exception Parse_error
(** Errors that can be raised during the parsing of the regular expression *)
exception Not_supported
type opt =
[ `Ungreedy
| `Dotall
| `Dollar_endonly
| `Multiline
| `Anchored
| `Caseless
]
(** Parsing of a Perl-style regular expression *)
val re : ?opts:opt list -> string -> Core.t
val re_result
: ?opts:opt list
-> string
-> (Core.t, [ `Not_supported | `Parse_error ]) result
(** (Same as [Re.compile]) *)
val compile : Core.t -> Core.re
(** Regular expression compilation *)
val compile_pat : ?opts:opt list -> string -> Core.re

View file

@ -0,0 +1,24 @@
module Pmark = struct
type t = int
let equal (x : int) (y : int) = x = y
let compare (x : int) (y : int) = compare x y
let r = Atomic.make 1
let gen () = Atomic.fetch_and_add r 1
let pp = Format.pp_print_int
end
include Pmark
module Set = struct
module Set = Set.Make (Pmark)
let[@warning "-32"] to_list x =
let open Set in
to_seq x |> List.of_seq
;;
include Set
end
let to_dyn = Dyn.int

View file

@ -0,0 +1,13 @@
type t = private int
val equal : t -> t -> bool
val compare : t -> t -> int
val gen : unit -> t
val pp : t Fmt.t
val to_dyn : t -> Dyn.t
module Set : sig
include Set.S with type elt = t
val to_list : t -> elt list
end

View file

@ -0,0 +1,163 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(*
What we could (should?) do:
- a* ==> longest ((shortest (no_group a)* ), a | ()) (!!!)
- abc understood as (ab)c
- "((a?)|b)" against "ab" should not bind the first subpattern to anything
Note that it should be possible to handle "(((ab)c)d)e" efficiently
*)
module Re = Core
exception Parse_error = Parse_buffer.Parse_error
exception Not_supported
let parse newline s =
let buf = Parse_buffer.create s in
let accept = Parse_buffer.accept buf in
let eos () = Parse_buffer.eos buf in
let test c = Parse_buffer.test buf c in
let unget () = Parse_buffer.unget buf in
let get () = Parse_buffer.get buf in
let rec regexp () = regexp' [ branch () ]
and regexp' left =
if accept '|' then regexp' (branch () :: left) else Re.alt (List.rev left)
and branch () = branch' []
and branch' left =
if eos () || test '|' || test ')'
then Re.seq (List.rev left)
else branch' (piece () :: left)
and piece () =
let r = atom () in
if accept '*'
then Re.rep (Re.nest r)
else if accept '+'
then Re.rep1 (Re.nest r)
else if accept '?'
then Re.opt r
else if accept '{'
then (
match Parse_buffer.integer buf with
| Some i ->
let j = if accept ',' then Parse_buffer.integer buf else Some i in
if not (accept '}') then raise Parse_error;
(match j with
| Some j when j < i -> raise Parse_error
| _ -> ());
Re.repn (Re.nest r) i j
| None ->
unget ();
r)
else r
and atom () =
if accept '.'
then if newline then Re.notnl else Re.any
else if accept '('
then (
let r = regexp () in
if not (accept ')') then raise Parse_error;
Re.group r)
else if accept '^'
then if newline then Re.bol else Re.bos
else if accept '$'
then if newline then Re.eol else Re.eos
else if accept '['
then
if accept '^'
then Re.diff (Re.compl (bracket [])) (Re.char '\n')
else Re.alt (bracket [])
else if accept '\\'
then (
if eos () then raise Parse_error;
match get () with
| ('|' | '(' | ')' | '*' | '+' | '?' | '[' | '.' | '^' | '$' | '{' | '\\') as c ->
Re.char c
| _ -> raise Parse_error)
else (
if eos () then raise Parse_error;
match get () with
| '*' | '+' | '?' | '{' | '\\' -> raise Parse_error
| c -> Re.char c)
and bracket s =
if s <> [] && accept ']'
then s
else (
match char () with
| `Set st -> bracket (st :: s)
| `Char c ->
if accept '-'
then
if accept ']'
then Re.char c :: Re.char '-' :: s
else
bracket
(match char () with
| `Char c' -> Re.rg c c' :: s
| `Set st' -> Re.char c :: Re.char '-' :: st' :: s)
else bracket (Re.char c :: s))
and char () =
if eos () then raise Parse_error;
let c = get () in
if c = '['
then (
match Posix_class.parse buf with
| Some set -> `Set set
| None ->
if accept '.'
then (
if eos () then raise Parse_error;
let c = get () in
if not (accept '.') then raise Not_supported;
if not (accept ']') then raise Parse_error;
`Char c)
else `Char c)
else `Char c
in
let res = regexp () in
if not (eos ()) then raise Parse_error;
res
;;
type opt =
[ `ICase
| `NoSub
| `Newline
]
let re ?(opts = []) s =
let r = parse (List.memq `Newline opts) s in
let r = if List.memq `ICase opts then Re.no_case r else r in
let r = if List.memq `NoSub opts then Re.no_group r else r in
r
;;
let re_result ?opts s =
match re ?opts s with
| s -> Ok s
| exception Not_supported -> Error `Not_supported
| exception Parse_error -> Error `Parse_error
;;
let compile re = Re.compile (Re.longest re)
let compile_pat ?(opts = []) s = compile (re ~opts s)

View file

@ -0,0 +1,107 @@
(*
RE - A regular expression library
Copyright (C) 2001 Jerome Vouillon
email: Jerome.Vouillon@pps.jussieu.fr
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, with
linking exception; either version 2.1 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
*)
(** References:
- {{:http://www.opengroup.org/onlinepubs/007908799/xbd/re.html} re}
- {{:http://www.opengroup.org/onlinepubs/007908799/xsh/regcomp.html} regcomp}
Example of how to use this module (to parse some IRC logs):
{[
type msg =
{ time : string
; author : string
; content : string
}
let re = Core.compile (Re_posix.re "([^:].*:[^:]*:[^:]{2})<.([^>]+)> (.+)$")
(* parse a line *)
let match_line line =
try
let substrings = Core.exec re line in
let groups = Core.get_all substrings in
(* groups can be obtained directly by index within [substrings] *)
Some { time = groups.(1); author = groups.(2); content = groups.(3) }
with
| Not_found -> None (* regex didn't match *)
;;
]} *)
(* XXX Character classes *)
exception Parse_error
(** Errors that can be raised during the parsing of the regular expression *)
exception Not_supported
type opt =
[ `ICase
| `NoSub
| `Newline
]
(** Parsing of a Posix extended regular expression *)
val re : ?opts:opt list -> string -> Core.t
val re_result
: ?opts:opt list
-> string
-> (Core.t, [ `Not_supported | `Parse_error ]) result
(** [compile r] is defined as [Core.compile (Core.longest r)] *)
val compile : Core.t -> Core.re
(** [compile_pat ?opts regex] compiles the Posix extended regular expression [regexp] *)
val compile_pat : ?opts:opt list -> string -> Core.re
(*
Deviation from the standard / ambiguities in the standard
---------------------------------------------------------
We tested the behavior of the Linux library (glibc) and the Solaris
library.
(1) An expression [efg] should be parsed as [(ef)g].
All implementations parse it as [e(fg)].
(2) When matching the pattern "((a)|b)*" against the string "ab",
the sub-expression "((a)|b)" should match "b", and the
sub-expression "(a)" should not match anything.
In both implementation, the sub-expression "(a)" matches "a".
(3) When matching the pattern "(aa?)*" against the string "aaa", it is
not clear whether the final match of the sub-expression "(aa?)" is
the last "a" (all matches of the sub-expression are successively
maximized), or "aa" (the final match is maximized).
Both implementations implements the first case.
(4) When matching the pattern "((a?)|b)*" against the string "ab",
the sub-expression "((a?)|b)" should match the empty string at the
end of the string (it is better to match the empty string than to
match nothing).
In both implementations, this sub-expression matches "b".
(Strangely, in the Linux implementation, the sub-expression "(a?)"
correctly matches the empty string at the end of the string)
This library behaves the same way as the other libraries for all
points, except for (2) and (4) where it follows the standard.
The behavior of this library in theses four cases may change in future
releases.
*)

View file

@ -0,0 +1,53 @@
module Re = Core
let of_name = function
| "alpha" -> Re.alpha
| "alnum" -> Re.alnum
| "ascii" -> Re.ascii
| "blank" -> Re.blank
| "cntrl" -> Re.cntrl
| "digit" -> Re.digit
| "lower" -> Re.lower
| "print" -> Re.print
| "space" -> Re.space
| "upper" -> Re.upper
| "word" -> Re.wordc
| "punct" -> Re.punct
| "graph" -> Re.graph
| "xdigit" -> Re.xdigit
| class_ -> invalid_arg ("Invalid pcre class: " ^ class_)
;;
let names =
[ "alpha"
; "alnum"
; "ascii"
; "blank"
; "cntrl"
; "digit"
; "lower"
; "print"
; "space"
; "upper"
; "word"
; "punct"
; "graph"
; "xdigit"
]
;;
let parse buf =
let accept = Parse_buffer.accept buf in
let accept_s = Parse_buffer.accept_s buf in
match accept ':' with
| false -> None
| true ->
let compl = accept '^' in
let cls =
try List.find accept_s names with
| Not_found -> raise Parse_buffer.Parse_error
in
if not (accept_s ":]") then raise Parse_buffer.Parse_error;
let posix_class = of_name cls in
Some (if compl then Re.compl [ posix_class ] else posix_class)
;;

View file

@ -0,0 +1,3 @@
val names : string list
val of_name : string -> Core.t
val parse : Parse_buffer.t -> Core.t option

View file

@ -0,0 +1,9 @@
include Core
include Replace
module View = View
module Emacs = Emacs
module Glob = Glob
module Perl = Perl
module Pcre = Pcre
module Posix = Posix
module Str = Str

View file

@ -0,0 +1,53 @@
let replace ?(pos = 0) ?len ?(all = true) re ~f s =
if pos < 0 then invalid_arg "Re.replace";
let limit =
match len with
| None -> String.length s
| Some l ->
if l < 0 || pos + l > String.length s then invalid_arg "Re.replace";
pos + l
in
(* buffer into which we write the result *)
let buf = Buffer.create (String.length s) in
(* iterate on matched substrings. *)
let rec iter pos on_match =
if pos <= limit
then (
match
Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
with
| Match substr ->
let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
if pos = p1 && p1 = p2 && on_match
then (
(* if we matched an empty string right after a match,
we must manually advance by 1 *)
if p2 < limit then Buffer.add_char buf s.[p2];
iter (p2 + 1) false)
else (
(* add string between previous match and current match *)
Buffer.add_substring buf s pos (p1 - pos);
(* what should we replace the matched group with? *)
let replacing = f substr in
Buffer.add_string buf replacing;
if all
then
(* if we matched an empty string, we must manually advance by 1 *)
iter
(if p1 = p2
then (
(* a non char could be past the end of string. e.g. $ *)
if p2 < limit then Buffer.add_char buf s.[p2];
p2 + 1)
else p2)
(p1 <> p2)
else Buffer.add_substring buf s p2 (limit - p2))
| Running _ -> ()
| Failed -> Buffer.add_substring buf s pos (limit - pos))
in
iter pos false;
Buffer.contents buf
;;
let replace_string ?pos ?len ?all re ~by s = replace ?pos ?len ?all re s ~f:(fun _ -> by)

View file

@ -0,0 +1,35 @@
(** [replace ~all re ~f s] iterates on [s], and replaces every occurrence
of [re] with [f substring] where [substring] is the current match.
If [all = false], then only the first occurrence of [re] is replaced. *)
val replace
: ?pos:int (** Default: 0 *)
-> ?len:int
-> ?all:bool (** Default: true. Otherwise only replace first occurrence *)
-> Compile.re (** matched groups *)
-> f:(Group.t -> string) (** how to replace *)
-> string (** string to replace in *)
-> string
(** [replace_string ~all re ~by s] iterates on [s], and replaces every
occurrence of [re] with [by]. If [all = false], then only the first
occurrence of [re] is replaced.
{5 Examples:}
{[
# let regex = Re.compile (Re.char ',');;
val regex : re = <abstr>
# Re.replace_string regex ~by:";" "[1,2,3,4,5,6,7]";;
- : string = "[1;2;3;4;5;6;7]"
# Re.replace_string regex ~all:false ~by:";" "[1,2,3,4,5,6,7]";;
- : string = "[1;2,3,4,5,6,7]"
]} *)
val replace_string
: ?pos:int (** Default: 0 *)
-> ?len:int
-> ?all:bool (** Default: true. Otherwise only replace first occurrence *)
-> Compile.re (** matched groups *)
-> by:string (** replacement string *)
-> string (** string to replace in *)
-> string

View file

@ -0,0 +1,114 @@
let all ?(pos = 0) ?len re s : _ Seq.t =
if pos < 0 then invalid_arg "Re.all";
(* index of the first position we do not consider.
!pos < limit is an invariant *)
let limit =
match len with
| None -> String.length s
| Some l ->
if l < 0 || pos + l > String.length s then invalid_arg "Re.all";
pos + l
in
(* iterate on matches. When a match is found, search for the next
one just after its end *)
let rec aux pos on_match () =
if pos > limit
then Seq.Nil (* no more matches *)
else (
match
Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
with
| Match substr ->
let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
if on_match && p1 = pos && p1 = p2
then (* skip empty match right after a match *)
aux (pos + 1) false ()
else (
let pos = if p1 = p2 then p2 + 1 else p2 in
Seq.Cons (substr, aux pos (p1 <> p2)))
| Running _ | Failed -> Seq.Nil)
in
aux pos false
;;
let matches ?pos ?len re s : _ Seq.t =
all ?pos ?len re s |> Seq.map (fun sub -> Group.get sub 0)
;;
let split_full ?(pos = 0) ?len re s : _ Seq.t =
if pos < 0 then invalid_arg "Re.split";
let limit =
match len with
| None -> String.length s
| Some l ->
if l < 0 || pos + l > String.length s then invalid_arg "Re.split";
pos + l
in
(* i: start of delimited string
pos: first position after last match of [re]
limit: first index we ignore (!pos < limit is an invariant) *)
let pos0 = pos in
let rec aux state i pos () =
match state with
| `Idle when pos > limit ->
(* We had an empty match at the end of the string *)
assert (i = limit);
Seq.Nil
| `Idle ->
(match
Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
with
| Match substr ->
let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
let pos = if p1 = p2 then p2 + 1 else p2 in
let old_i = i in
let i = p2 in
if old_i = p1 && p1 = p2 && p1 > pos0
then (* Skip empty match right after a delimiter *)
aux state i pos ()
else if p1 > pos0
then (
(* string does not start by a delimiter *)
let text = String.sub s old_i (p1 - old_i) in
let state = `Yield (`Delim substr) in
Seq.Cons (`Text text, aux state i pos))
else Seq.Cons (`Delim substr, aux state i pos)
| Running _ -> Seq.Nil
| Failed ->
if i < limit
then (
let text = String.sub s i (limit - i) in
(* yield last string *)
Seq.Cons (`Text text, aux state limit pos))
else Seq.Nil)
| `Yield x -> Seq.Cons (x, aux `Idle i pos)
in
aux `Idle pos pos
;;
let split ?pos ?len re s : _ Seq.t =
let seq = split_full ?pos ?len re s in
let rec filter seq () =
match seq () with
| Seq.Nil -> Seq.Nil
| Seq.Cons (`Delim _, tl) -> filter tl ()
| Seq.Cons (`Text s, tl) -> Seq.Cons (s, filter tl)
in
filter seq
;;
let split_delim ?pos ?len re s : _ Seq.t =
let seq = split_full ?pos ?len re s in
let rec filter ~delim seq () =
match seq () with
| Seq.Nil -> if delim then Seq.Cons ("", fun () -> Seq.Nil) else Seq.Nil
| Seq.Cons (`Delim _, tl) ->
if delim
then Seq.Cons ("", fun () -> filter ~delim:true tl ())
else filter ~delim:true tl ()
| Seq.Cons (`Text s, tl) -> Seq.Cons (s, filter ~delim:false tl)
in
filter ~delim:true seq
;;

View file

@ -0,0 +1,70 @@
open Import
type t =
{ s : string
; pos : int
; len : int
}
module L = struct
type nonrec t = t list
let get_substring slices ~start ~stop =
if stop = start
then ""
else (
let slices =
let rec drop slices remains =
if remains = 0
then slices
else (
match slices with
| [] -> assert false
| ({ s = _; pos; len } as slice) :: xs ->
let remains' = remains - len in
if remains' >= 0
then drop xs remains'
else (
let pos = pos + remains in
let len = len - remains in
{ slice with pos; len } :: xs))
in
drop slices start
in
let buf = Buffer.create (stop - start) in
let rec take slices remains =
if remains > 0
then (
match slices with
| [] -> assert false
| { s; pos; len } :: xs ->
let remains' = remains - len in
if remains' > 0
then (
Buffer.add_substring buf s pos len;
take xs remains')
else Buffer.add_substring buf s pos remains)
in
take slices (stop - start);
Buffer.contents buf)
;;
let rec drop t remains =
if remains = 0
then t
else (
match t with
| [] -> []
| ({ s = _; pos; len } as slice) :: t ->
if remains >= len
then drop t (remains - len)
else (
let delta = len - remains in
{ slice with pos = pos + delta; len = len - delta } :: t))
;;
let drop_rev t remains =
(* TODO Use a proper functional queue *)
if remains = 0 then t else List.rev (drop (List.rev t) remains)
;;
end

View file

@ -0,0 +1,12 @@
type t =
{ s : string
; pos : int
; len : int
}
module L : sig
type nonrec t = t list
val get_substring : t -> start:int -> stop:int -> string
val drop_rev : t -> int -> t
end

View file

@ -0,0 +1,299 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* linking exception. *)
(* *)
(***********************************************************************)
(* Modified by Jerome.Vouillon@pps.jussieu.fr for integration in RE *)
(* $Id: re_str.ml,v 1.3 2002/07/03 15:47:54 vouillon Exp $ *)
module Ast = Ast.Export
include struct
open Core
let exec = exec
let exec_partial = exec_partial
end
type regexp =
{ mtch : Compile.re Lazy.t
; srch : Compile.re Lazy.t
}
let compile_regexp s c =
let re = Emacs.re_no_emacs ~case:(not c) s in
{ mtch = lazy (Compile.compile (Ast.seq [ Ast.start; re ]))
; srch = lazy (Compile.compile re)
}
;;
let state = Domain.DLS.new_key (fun () -> None)
let string_match re s p =
match exec ~pos:p (Lazy.force re.mtch) s with
| res ->
Domain.DLS.set state (Some res);
true
| exception Not_found ->
Domain.DLS.set state None;
false
;;
let string_partial_match re s p =
match exec_partial ~pos:p (Lazy.force re.mtch) s with
| `Full -> string_match re s p
| `Partial -> true
| `Mismatch -> false
;;
let search_forward re s p =
match exec ~pos:p (Lazy.force re.srch) s with
| res ->
Domain.DLS.set state (Some res);
fst (Group.offset res 0)
| exception Not_found ->
Domain.DLS.set state None;
raise Not_found
;;
let rec search_backward re s p =
match exec ~pos:p (Lazy.force re.mtch) s with
| res ->
Domain.DLS.set state (Some res);
p
| exception Not_found ->
Domain.DLS.set state None;
if p = 0 then raise Not_found else search_backward re s (p - 1)
;;
let valid_group n =
n >= 0
&& n < 10
&&
match Domain.DLS.get state with
| None -> false
| Some m -> n < Group.nb_groups m
;;
let offset_group i =
match Domain.DLS.get state with
| Some m -> Group.offset m i
| None -> raise Not_found
;;
let group_len i =
match offset_group i with
| b, e -> e - b
| exception Not_found -> 0
;;
let rec repl_length repl p q len =
if p < len
then
if repl.[p] <> '\\'
then repl_length repl (p + 1) (q + 1) len
else (
let p = p + 1 in
if p = len then failwith "Str.replace: illegal backslash sequence";
let q =
match repl.[p] with
| '\\' -> q + 1
| '0' .. '9' as c -> q + group_len (Char.code c - Char.code '0')
| _ -> q + 2
in
repl_length repl (p + 1) q len)
else q
;;
let rec replace orig repl p res q len =
if p < len
then (
let c = repl.[p] in
if c <> '\\'
then (
Bytes.set res q c;
replace orig repl (p + 1) res (q + 1) len)
else (
match repl.[p + 1] with
| '\\' ->
Bytes.set res q '\\';
replace orig repl (p + 2) res (q + 1) len
| '0' .. '9' as c ->
let d =
let group = Char.code c - Char.code '0' in
match offset_group group with
| exception Not_found -> 0
| b, e ->
let d = e - b in
if d > 0 then String.blit orig b res q d;
d
in
replace orig repl (p + 2) res (q + d) len
| c ->
Bytes.set res q '\\';
Bytes.set res (q + 1) c;
replace orig repl (p + 2) res (q + 2) len))
;;
let replacement_text repl orig =
let len = String.length repl in
let res = Bytes.create (repl_length repl 0 0 len) in
replace orig repl 0 res 0 (String.length repl);
Bytes.unsafe_to_string res
;;
let quote s =
let len = String.length s in
let buf = Buffer.create (2 * len) in
for i = 0 to len - 1 do
match s.[i] with
| ('[' | ']' | '*' | '.' | '\\' | '?' | '+' | '^' | '$') as c ->
Buffer.add_char buf '\\';
Buffer.add_char buf c
| c -> Buffer.add_char buf c
done;
Buffer.contents buf
;;
let string_before s n = String.sub s 0 n
let string_after s n = String.sub s n (String.length s - n)
let first_chars s n = String.sub s 0 n
let last_chars s n = String.sub s (String.length s - n) n
let regexp e = compile_regexp e false
let regexp_case_fold e = compile_regexp e true
let regexp_string s = compile_regexp (quote s) false
let regexp_string_case_fold s = compile_regexp (quote s) true
let group_beginning n =
if not (valid_group n) then invalid_arg "Str.group_beginning";
let pos = fst (offset_group n) in
if pos = -1 then raise Not_found else pos
;;
let group_end n =
if not (valid_group n) then invalid_arg "Str.group_end";
let pos = snd (offset_group n) in
if pos = -1 then raise Not_found else pos
;;
let matched_group n txt =
let b, e = offset_group n in
String.sub txt b (e - b)
;;
let replace_matched repl matched = replacement_text repl matched
let match_beginning () = group_beginning 0
and match_end () = group_end 0
and matched_string txt = matched_group 0 txt
let substitute_first expr repl_fun text =
try
let pos = search_forward expr text 0 in
String.concat
""
[ string_before text pos; repl_fun text; string_after text (match_end ()) ]
with
| Not_found -> text
;;
let global_substitute expr repl_fun text =
let rec replace accu start last_was_empty =
let startpos = if last_was_empty then start + 1 else start in
if startpos > String.length text
then string_after text start :: accu
else (
match search_forward expr text startpos with
| pos ->
let end_pos = match_end () in
let repl_text = repl_fun text in
replace
(repl_text :: String.sub text start (pos - start) :: accu)
end_pos
(end_pos = pos)
| exception Not_found -> string_after text start :: accu)
in
String.concat "" (List.rev (replace [] 0 false))
;;
let global_replace expr repl text = global_substitute expr (replacement_text repl) text
and replace_first expr repl text = substitute_first expr (replacement_text repl) text
let search_forward_progress re s p =
let pos = search_forward re s p in
if match_end () > p
then pos
else if p < String.length s
then search_forward re s (p + 1)
else raise Not_found
;;
let bounded_split expr text num =
let start = if string_match expr text 0 then match_end () else 0 in
let rec split accu start n =
if start >= String.length text
then accu
else if n = 1
then string_after text start :: accu
else (
match search_forward_progress expr text start with
| pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
| exception Not_found -> string_after text start :: accu)
in
List.rev (split [] start num)
;;
let split expr text = bounded_split expr text 0
let bounded_split_delim expr text num =
let rec split accu start n =
if start > String.length text
then accu
else if n = 1
then string_after text start :: accu
else (
match search_forward_progress expr text start with
| pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
| exception Not_found -> string_after text start :: accu)
in
if text = "" then [] else List.rev (split [] 0 num)
;;
let split_delim expr text = bounded_split_delim expr text 0
type split_result =
| Text of string
| Delim of string
let bounded_full_split expr text num =
let rec split accu start n =
if start >= String.length text
then accu
else if n = 1
then Text (string_after text start) :: accu
else (
match search_forward_progress expr text start with
| pos ->
let s = matched_string text in
if pos > start
then
split
(Delim s :: Text (String.sub text start (pos - start)) :: accu)
(match_end ())
(n - 1)
else split (Delim s :: accu) (match_end ()) (n - 1)
| exception Not_found -> Text (string_after text start) :: accu)
in
List.rev (split [] 0 num)
;;
let full_split expr text = bounded_full_split expr text 0

View file

@ -0,0 +1,220 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* linking exception. *)
(* *)
(***********************************************************************)
(* $Id: re_str.mli,v 1.1 2002/01/16 14:16:04 vouillon Exp $ *)
(** Module [Str]: regular expressions and high-level string processing *)
(** {2 Regular expressions} *)
(** The type of compiled regular expressions. *)
type regexp
(** Compile a regular expression. The syntax for regular expressions
is the same as in Gnu Emacs. The special characters are
[$^.*+?[]]. The following constructs are recognized:
- [. ] matches any character except newline
- [* ] (postfix) matches the previous expression zero, one or
several times
- [+ ] (postfix) matches the previous expression one or
several times
- [? ] (postfix) matches the previous expression once or
not at all
- [[..] ] character set; ranges are denoted with [-], as in [[a-z]];
an initial [^], as in [[^0-9]], complements the set
- [^ ] matches at beginning of line
- [$ ] matches at end of line
- [\| ] (infix) alternative between two expressions
- [\(..\)] grouping and naming of the enclosed expression
- [\1 ] the text matched by the first [\(...\)] expression
([\2] for the second expression, etc)
- [\b ] matches word boundaries
- [\ ] quotes special characters. *)
val regexp : string -> regexp
(** Same as [regexp], but the compiled expression will match text
in a case-insensitive way: uppercase and lowercase letters will
be considered equivalent. *)
val regexp_case_fold : string -> regexp
(** [Str.quote s] returns a regexp string that matches exactly
[s] and nothing else. *)
val quote : string -> string
(** [Str.regexp_string s] returns a regular expression
that matches exactly [s] and nothing else. *)
val regexp_string : string -> regexp
(** [Str.regexp_string_case_fold] is similar to [Str.regexp_string], but the regexp
matches in a case-insensitive way. *)
val regexp_string_case_fold : string -> regexp
(** {2 String matching and searching} *)
(** [string_match r s start] tests whether the characters in [s]
starting at position [start] match the regular expression [r].
The first character of a string has position [0], as usual. *)
val string_match : regexp -> string -> int -> bool
(** [search_forward r s start] searches the string [s] for a substring
matching the regular expression [r]. The search starts at position
[start] and proceeds towards the end of the string.
Return the position of the first character of the matched
substring, or raise [Not_found] if no substring matches. *)
val search_forward : regexp -> string -> int -> int
(** Same as [search_forward], but the search proceeds towards the
beginning of the string. *)
val search_backward : regexp -> string -> int -> int
(** Similar to [string_match], but succeeds whenever the argument
string is a prefix of a string that matches. This includes
the case of a true complete match. *)
val string_partial_match : regexp -> string -> int -> bool
(** [matched_string s] returns the substring of [s] that was matched
by the latest [string_match], [search_forward] or [search_backward].
The user must make sure that the parameter [s] is the same string
that was passed to the matching or searching function. *)
val matched_string : string -> string
(** [match_beginning ()] returns the position of the first character
of the substring that was matched by [string_match],
[search_forward] or [search_backward]. *)
val match_beginning : unit -> int
(** [match_end ()] returns the position of the character following the
last character of the substring that was matched by [string_match],
[search_forward] or [search_backward]. *)
val match_end : unit -> int
(** [matched_group n s] returns the substring of [s] that was matched
by the [n]th group [\(...\)] of the regular expression during
the latest [string_match], [search_forward] or [search_backward].
The user must make sure that the parameter [s] is the same string
that was passed to the matching or searching function.
[matched_group n s] raises [Not_found] if the [n]th group
of the regular expression was not matched. This can happen
with groups inside alternatives [\|], options [?]
or repetitions [*]. For instance, the empty string will match
[\(a\)*], but [matched_group 1 ""] will raise [Not_found]
because the first group itself was not matched. *)
val matched_group : int -> string -> string
(** [group_beginning n] returns the position of the first character
of the substring that was matched by the [n]th group of the regular expression.
Raises [Not_found] if the [n]th group of the regular expression was not matched. *)
val group_beginning : int -> int
(** [group_end n] returns the position of the character following
the last character of the matched substring.
Raises [Not_found] if the [n]th group of the regular expression was not matched. *)
val group_end : int -> int
(** {2 Replacement} *)
(** [global_replace regexp templ s] returns a string identical to [s],
except that all substrings of [s] that match [regexp] have been
replaced by [templ]. The replacement template [templ] can contain
[\1], [\2], etc; these sequences will be replaced by the text
matched by the corresponding group in the regular expression.
[\0] stands for the text matched by the whole regular expression. *)
val global_replace : regexp -> string -> string -> string
(** Same as [global_replace], except that only the first substring
matching the regular expression is replaced. *)
val replace_first : regexp -> string -> string -> string
(** [global_substitute regexp subst s] returns a string identical
to [s], except that all substrings of [s] that match [regexp]
have been replaced by the result of function [subst]. The
function [subst] is called once for each matching substring,
and receives [s] (the whole text) as argument. *)
val global_substitute : regexp -> (string -> string) -> string -> string
(** Same as [global_substitute], except that only the first substring
matching the regular expression is replaced. *)
val substitute_first : regexp -> (string -> string) -> string -> string
(** [replace_matched repl s] returns the replacement text [repl]
in which [\1], [\2], etc. have been replaced by the text
matched by the corresponding groups in the most recent matching
operation. [s] must be the same string that was matched during
this matching operation. *)
val replace_matched : string -> string -> string
(** {2 Splitting} *)
(** [split r s] splits [s] into substrings, taking as delimiters
the substrings that match [r], and returns the list of substrings.
For instance, [split (regexp "[ \t]+") s] splits [s] into
blank-separated words. An occurrence of the delimiter at the
beginning and at the end of the string is ignored. *)
val split : regexp -> string -> string list
(** Same as [split], but splits into at most [n] substrings,
where [n] is the extra integer parameter. *)
val bounded_split : regexp -> string -> int -> string list
(** Same as [split], but occurrences of the delimiter at the beginning
and at the end of the string are recognized and returned as empty strings
in the result.
For instance, [split_delim (regexp " ") " abc "] returns [[""; "abc"; ""]],
while [split] with the same arguments returns [["abc"]]. *)
val split_delim : regexp -> string -> string list
(** Same as [bounded_split] and [split_delim], but occurrences of
the delimiter at the beginning and at the end of the string are recognized
and returned as empty strings in the result.
For instance, [split_delim (regexp " ") " abc "] returns [[""; "abc"; ""]],
while [split] with the same arguments returns [["abc"]]. *)
val bounded_split_delim : regexp -> string -> int -> string list
type split_result =
| Text of string
| Delim of string
(** Same as [split_delim], but returns the delimiters
as well as the substrings contained between delimiters.
The former are tagged [Delim] in the result list;
the latter are tagged [Text].
For instance, [full_split (regexp "[{}]") "{ab}"] returns
[[Delim "{"; Text "ab"; Delim "}"]]. *)
val full_split : regexp -> string -> split_result list
(** Same as [split_delim] and [bounded_split_delim], but returns
the delimiters as well as the substrings contained between delimiters.
The former are tagged [Delim] in the result list;
the latter are tagged [Text].
For instance, [full_split (regexp "[{}]") "{ab}"] returns
[[Delim "{"; Text "ab"; Delim "}"]]. *)
val bounded_full_split : regexp -> string -> int -> split_result list
(** {2 Extracting substrings} *)
(** [string_before s n] returns the substring of all characters of [s]
that precede position [n] (excluding the character at
position [n]). *)
val string_before : string -> int -> string
(** [string_after s n] returns the substring of all characters of [s]
that follow position [n] (including the character at
position [n]). *)
val string_after : string -> int -> string
(** [first_chars s n] returns the first [n] characters of [s].
This is the same function as [string_before]. *)
val first_chars : string -> int -> string
(** [last_chars s n] returns the last [n] characters of [s]. *)
val last_chars : string -> int -> string

View file

@ -0,0 +1,90 @@
open Import
module Cset = struct
include Cset
module Range = struct
type t =
{ first : Char.t
; last : Char.t
}
let first t = t.first
let last t = t.last
end
let view t =
fold_right t ~init:[] ~f:(fun first last acc ->
let range = { Range.first = Cset.to_char first; last = Cset.to_char last } in
range :: acc)
;;
end
module Sem = Automata.Sem
module Rep_kind = Automata.Rep_kind
type t =
| Set of Cset.t
| Sequence of Ast.t list
| Alternative of Ast.t list
| Repeat of Ast.t * int * int option
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| End_of_str
| Last_end_of_line
| Start
| Stop
| Sem of Automata.Sem.t * Ast.t
| Sem_greedy of Automata.Rep_kind.t * Ast.t
| Group of string option * Ast.t
| No_group of Ast.t
| Nest of Ast.t
| Case of Ast.t
| No_case of Ast.t
| Intersection of Ast.t list
| Complement of Ast.t list
| Difference of Ast.t * Ast.t
| Pmark of Pmark.t * Ast.t
let view_ast f (t : _ Ast.ast) : t =
match t with
| Alternative a -> Alternative (List.map ~f a)
| No_case a -> No_case (f a)
| Case a -> Case (f a)
;;
let view_set (cset : Ast.cset) : t =
match cset with
| Cset set -> Set set
| Intersection sets -> Intersection (List.map sets ~f:Ast.t_of_cset)
| Complement sets -> Complement (List.map sets ~f:Ast.t_of_cset)
| Difference (x, y) -> Difference (Ast.t_of_cset x, Ast.t_of_cset y)
| Cast ast -> view_ast Ast.t_of_cset ast
;;
let view : Ast.t -> t = function
| Set s -> view_set s
| Ast s -> view_ast (fun x -> x) s
| Sem (sem, a) -> Sem (sem, a)
| Sem_greedy (sem, a) -> Sem_greedy (sem, a)
| Sequence s -> Sequence s
| Repeat (t, x, y) -> Repeat (t, x, y)
| Beg_of_line -> Beg_of_line
| End_of_line -> End_of_line
| Beg_of_word -> Beg_of_word
| End_of_word -> End_of_word
| Not_bound -> Not_bound
| Beg_of_str -> Beg_of_str
| End_of_str -> End_of_str
| Last_end_of_line -> Last_end_of_line
| Start -> Start
| Stop -> Stop
| No_group a -> No_group a
| Group (name, t) -> Group (name, t)
| Nest t -> Nest t
| Pmark (pmark, t) -> Pmark (pmark, t)
;;

View file

@ -0,0 +1,58 @@
(** A view of the top-level of a regex. This type is unstable and may change *)
module Cset : sig
type t = Cset.t
module Range : sig
type t
val first : t -> Char.t
val last : t -> Char.t
end
val view : t -> Range.t list
end
module Sem : sig
type t =
[ `Longest
| `Shortest
| `First
]
end
module Rep_kind : sig
type t =
[ `Greedy
| `Non_greedy
]
end
type t =
| Set of Cset.t
| Sequence of Ast.t list
| Alternative of Ast.t list
| Repeat of Ast.t * int * int option
| Beg_of_line
| End_of_line
| Beg_of_word
| End_of_word
| Not_bound
| Beg_of_str
| End_of_str
| Last_end_of_line
| Start
| Stop
| Sem of Sem.t * Ast.t
| Sem_greedy of Rep_kind.t * Ast.t
| Group of string option * Ast.t
| No_group of Ast.t
| Nest of Ast.t
| Case of Ast.t
| No_case of Ast.t
| Intersection of Ast.t list
| Complement of Ast.t list
| Difference of Ast.t * Ast.t
| Pmark of Pmark.t * Ast.t
val view : Ast.t -> t

View file

@ -0,0 +1,9 @@
*.cmi
*.cmx
re_match
pcre_match
re_scan
pcre_scan
unison
unison2
unison3

View file

@ -0,0 +1,13 @@
(test
(name test)
(build_if
(>= %{ocaml_version} 5.0))
(action
(pipe-outputs
(setenv
TSAN_OPTIONS
suppressions=suppress.txt
(run %{test}))
(run cat)))
(deps suppress.txt)
(libraries re))

View file

@ -0,0 +1,22 @@
# Data race between Compile.State.follow_transition (inlined in Compile.next)
# and Compile.State.set_transition
race_top:^camlRe__Compile.next
# Data race within Compile.find_initial_state (read/write re.initial_states)
race_top:^camlRe__Compile.find_initial_state
# Spurious data race due to the two-step initialization in Compile.State.make
# (between Compile.State.get_info and Compile.State.set_info, both inlined)
race_top:^camlRe__Compile.loop
# Race within Automata.Desc.status and Automata.Desc.status_no_mutex
# (read/write s.status)
race_top:^camlRe__Automata.status
# Race within Compile.final
race_top:^camlRe__Compile.final
# Spurious data race due to the two-step initialization in Mark_info.make
# (between Mark_info.make and other functions in module Mark_infos)
race_top:^camlRe__Mark_infos.set

View file

@ -0,0 +1,2 @@
Sequential
Concurrent

View file

@ -0,0 +1,142 @@
module Barrier = struct
type t =
{ waiters : int Atomic.t
; size : int
; passed : int Atomic.t
}
let create n = { waiters = Atomic.make n; size = n; passed = Atomic.make 0 }
let await { waiters; size; passed } =
if Atomic.fetch_and_add passed 1 = size - 1
then (
Atomic.set passed 0;
Atomic.set waiters 0);
while Atomic.get waiters = size do
Domain.cpu_relax ()
done;
Atomic.incr waiters;
while Atomic.get waiters < size do
Domain.cpu_relax ()
done
;;
end
let shuffle_array a =
let n = Array.length a in
let a' = Array.copy a in
for i = n - 1 downto 1 do
let j = Random.int (i + 1) in
let temp = a'.(i) in
a'.(i) <- a'.(j);
a'.(j) <- temp
done;
a'
;;
let inverse_permutation p =
let n = Array.length p in
let inv = Array.make n 0 in
for i = 0 to n - 1 do
inv.(p.(i)) <- i
done;
inv
;;
let apply_permutation p a =
let n = Array.length p in
let b = Array.make n a.(0) in
for i = 0 to n - 1 do
b.(i) <- a.(p.(i))
done;
b
;;
(****)
let re1 = Re.(alt [ group (char 'a'); char 'b' ])
let re2 = Re.(seq [ re1; re1 ])
let re3 = Re.(seq [ re2; re2 ])
let re4 = Re.(seq [ re3; re3 ])
let re5 =
Re.(
alt
[ seq [ re4; re4 ]
; group (str "b")
; group (str "bb")
; group (str "bbb")
; group (str "bbbb")
])
;;
let size = 300
let strings =
Array.init size (fun _ -> String.init 30 (fun _ -> if Random.bool () then 'a' else 'b'))
;;
let execute ~short re a =
apply_permutation
(inverse_permutation a)
(Array.map
(fun i ->
try
Some
(Re.Group.all_offset
@@ Re.exec ~pos:(if short then 30 - 7 else 0) re strings.(i))
with
| Not_found -> None)
a)
;;
let compare_groups g g' = g = g'
let concurrent f f' =
let barrier = Barrier.create 2 in
let domain =
Domain.spawn
@@ fun () ->
Barrier.await barrier;
f' ()
in
Barrier.await barrier;
let res = f () in
let res' = Domain.join domain in
res, res'
;;
let sequential f f' = f (), f' ()
let test compose ~short n =
let success = ref true in
for _ = 1 to n do
let re = Re.compile re5 in
let a = shuffle_array (Array.init size Fun.id) in
let a' = shuffle_array a in
try
let groups, groups' =
compose (fun () -> execute ~short re a) (fun () -> execute ~short re a')
in
let ok = Array.for_all2 (Option.equal compare_groups) groups groups' in
success := !success && ok;
if not ok then prerr_endline "Bad group"
with
| Invalid_argument msg ->
prerr_endline ("Invalid_argument " ^ msg);
success := false
| Division_by_zero ->
prerr_endline "Division_by_zero";
success := false
done;
if not !success then exit 1
;;
let () =
prerr_endline "Sequential";
test sequential ~short:false 20;
test sequential ~short:true 10;
prerr_endline "Concurrent";
test ~short:false concurrent 750;
test ~short:true concurrent 250
;;

View file

@ -0,0 +1,4 @@
(env
(_
(flags
(:standard -w -58))))

View file

@ -0,0 +1,39 @@
(library
(name re_tests)
(libraries
re_private
;; This is because of the (implicit_transitive_deps false)
;; in dune-project
ppx_expect.config
ppx_expect.config_types
ppx_expect
ppx_expect_common
base
str
ppx_inline_test.config)
(inline_tests
(modes native js))
(preprocess
(pps ppx_expect)))
;; ppx_expect v16 depends on ppx_expect.common
(subdir
ppx_expect_common
(library
(name ppx_expect_common)
(enabled_if
(< %{ocaml_version} 5.0))
(libraries (re_export ppx_expect.common)))
(library
(name ppx_expect_common)
(enabled_if
(>= %{ocaml_version} 5.0))))
;; this hackery is needed because ppx_expect itself uses re, therefore we need to mangle
;; the library name
(subdir
private_re
(library
(name re_private))
(copy_files %{project_root}/lib/*.{ml,mli}))

View file

@ -0,0 +1,85 @@
module Re = Re_private.Re
include Re_private.Import
module Fmt = Re_private.Fmt
module Dyn = Re_private.Dyn
let printf = Printf.printf
let t re s =
let group = Re.exec_opt (Re.compile re) s in
Format.printf "%a@." (Fmt.opt Re.Group.pp) group
;;
let re_whitespace = Re.Pcre.regexp "[\t ]+"
let re_eol = Re.compile Re.eol
let re_bow = Re.compile Re.bow
let re_eow = Re.compile Re.eow
let strings = Format.printf "[%a]@." Fmt.(list ~pp_sep:(Fmt.lit "; ") Fmt.quoted_string)
let re_empty = Re.Posix.compile_pat ""
let invalid_argument f =
match f () with
| s -> ignore s
| exception Invalid_argument s -> Format.printf "Invalid_argument %S@." s
;;
let exec_partial_detailed ?pos re s =
let re = Re.compile re in
let res = Re.exec_partial_detailed ?pos re s in
match res with
| `Mismatch -> Format.printf "`Mismatch@."
| `Partial position -> Format.printf "`Partial %d@." position
| `Full groups ->
Re.Group.all_offset groups
|> Array.to_list
|> List.map ~f:(fun (a, b) ->
Printf.sprintf
"%d,%d,%s"
a
b
(match String.sub s a (b - a) with
| exception Invalid_argument _ -> "<No match>"
| s -> Printf.sprintf "%S" s))
|> String.concat ";"
|> Format.printf "`Full [|%s|]@."
;;
let or_not_found f fmt v =
match v () with
| exception Not_found -> Format.fprintf fmt "Not_found"
| s -> f fmt s
;;
let array f fmt v =
Format.fprintf fmt "[| %a |]" (Fmt.list ~pp_sep:(Fmt.lit "; ") f) (Array.to_list v)
;;
let offset fmt (x, y) = Format.fprintf fmt "(%d, %d)" x y
let test_re ?pos ?len r s =
let offsets () = Re.Group.all_offset (Re.exec ?pos ?len (Re.compile r) s) in
Format.printf "%a@." (or_not_found (array offset)) offsets
;;
let rec sexp_of_dyn (t : Re_private.Dyn.t) : Base.Sexp.t =
match t with
| Int i -> Atom (Int.to_string i)
| String s -> Atom s
| Tuple xs -> List (List.map xs ~f:sexp_of_dyn)
| Enum s -> Atom s
| List xs -> List (List.map ~f:sexp_of_dyn xs)
| Variant (name, []) -> Atom name
| Variant (name, xs) ->
let xs = List.map xs ~f:sexp_of_dyn in
(match xs with
| [] -> List []
| xs -> List (Atom name :: xs))
| Record fields ->
List
(List.filter_map fields ~f:(fun (name, v) ->
match sexp_of_dyn v with
| List [] -> None
| sexp -> Some (Base.Sexp.List [ Atom name; sexp ])))
;;
let print_dyn dyn = sexp_of_dyn dyn |> Base.Sexp.to_string_hum |> print_endline

View file

@ -0,0 +1,76 @@
open Import
let print re result =
Printf.printf
"%s: %s\n"
re
(match result with
| Ok _ -> "backward range parsed"
| Error `Parse_error -> "parse error"
| Error `Not_supported -> "not supported")
;;
let cases = [ "[1-0]"; "[5-1]"; "[6-6]"; "[z-a]"; "[b-b]" ]
let test f =
List.iter cases ~f:(fun re ->
let result = f re in
print re result)
;;
let%expect_test "perl" =
test Re.Perl.re_result;
[%expect
{|
[1-0]: backward range parsed
[5-1]: backward range parsed
[6-6]: backward range parsed
[z-a]: backward range parsed
[b-b]: backward range parsed
|}]
;;
let%expect_test "pcre" =
test Re.Pcre.re_result;
[%expect
{|
[1-0]: backward range parsed
[5-1]: backward range parsed
[6-6]: backward range parsed
[z-a]: backward range parsed
[b-b]: backward range parsed
|}]
;;
let%expect_test "posix" =
test Re.Posix.re_result;
[%expect
{|
[1-0]: backward range parsed
[5-1]: backward range parsed
[6-6]: backward range parsed
[z-a]: backward range parsed
[b-b]: backward range parsed
|}]
;;
(* CR-someday rgrinberg: is this correct? *)
let%expect_test "emacs" =
test Re.Emacs.re_result;
[%expect
{|
[1-0]: backward range parsed
[5-1]: backward range parsed
[6-6]: backward range parsed
[z-a]: backward range parsed
[b-b]: backward range parsed
|}]
;;
(* We allow backward ranges in re. We could forbid them? *)
let%expect_test "re" =
Format.printf "%a@." Re.pp (Re.rg '5' '0');
[%expect {| (Set 48-53) |}];
Format.printf "%a@." Re.pp (Re.rg '0' '5');
[%expect {| (Set 48-53) |}]
;;

View file

@ -0,0 +1,28 @@
open Import
module Ast = Re_private.Ast
let test f string =
match f string with
| Ok res -> print_dyn (Ast.to_dyn res)
| Error _ -> assert false
;;
let%expect_test "pcre" =
test Re.Pcre.re_result "(a|b|c)";
[%expect {| (Group (Set (Cast (Alternative (Cset 97) (Cset 98) (Cset 99))))) |}]
;;
let%expect_test "emacs" =
test Re.Emacs.re_result {|\(a\|b\|c\)|};
[%expect {| (Group (Set (Cast (Alternative (Cset 97) (Cset 98) (Cset 99))))) |}]
;;
let%expect_test "perl" =
test Re.Perl.re_result "(a|b|c)";
[%expect {| (Group (Set (Cast (Alternative (Cset 97) (Cset 98) (Cset 99))))) |}]
;;
let%expect_test "posix" =
test Re.Posix.re_result "(a|b|c)";
[%expect {| (Group (Set (Cast (Alternative (Cset 97) (Cset 98) (Cset 99))))) |}]
;;

Some files were not shown because too many files have changed in this diff Show more