regex-dfa (empty) → 0.91
raw patch · 17 files changed
+2790/−0 lines, 17 filesdep +basedep +mtldep +parsecbuild-type:Customsetup-changed
Dependencies added: base, mtl, parsec, regex-base
Files
- LICENSE +518/−0
- Setup.hs +6/−0
- Text/Regex/DFA.hs +52/−0
- Text/Regex/DFA/ByteString.hs +94/−0
- Text/Regex/DFA/ByteString/EngineFPS.hs +84/−0
- Text/Regex/DFA/ByteString/Lazy.hs +94/−0
- Text/Regex/DFA/Common.hs +39/−0
- Text/Regex/DFA/Engine.hs +579/−0
- Text/Regex/DFA/EngineFPS.hs +84/−0
- Text/Regex/DFA/EngineSeq.hs +212/−0
- Text/Regex/DFA/Pattern.hs +156/−0
- Text/Regex/DFA/ReadRegex.hs +159/−0
- Text/Regex/DFA/Sequence.hs +96/−0
- Text/Regex/DFA/String.hs +95/−0
- Text/Regex/DFA/Transitions.hs +362/−0
- Text/Regex/DFA/Wrap.hs +108/−0
- regex-dfa.cabal +52/−0
+ LICENSE view
@@ -0,0 +1,518 @@+The regex-dfa module is under LGPL since Engine.hs is derived from CTK Light.+The home page of CTK is at http://www.cse.unsw.edu.au/~chak/haskell/ctk/index.html#CTKlight++ GNU LIBRARY GENERAL PUBLIC LICENSE+ ==================================+ Version 2, June 1991++ Copyright (C) 1991 Free Software Foundation, Inc.+ 675 Mass Ave, Cambridge, MA 02139, 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 library GPL. It is+ numbered 2 because it goes with version 2 of the ordinary GPL.]++ 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 Library General Public License, applies to+some specially designated Free Software Foundation software, and+to any other libraries whose authors decide to use it. You can+use it for your libraries, too.++When we speak of free software, we are referring to freedom, 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 or use pieces of it in new free programs; and that+you know you can do these things.++To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the+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 a program 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.++Our method of protecting your rights has two steps: (1)+copyright the library, and (2) offer you this license which+gives you legal permission to copy, distribute and/or modify the+library.++Also, for each distributor's protection, we want to make certain+that everyone understands that there is no warranty for this+free library. If the library is modified by someone else and+passed on, we want its recipients to know that what they have is+not the original version, so that any problems introduced by+others will not reflect on the original authors' reputations.+ +Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that companies+distributing free software will individually obtain patent+licenses, thus in effect transforming the program into+proprietary software. To prevent this, we have made it clear+that any patent must be licensed for everyone's free use or not+licensed at all.++Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License, which was designed for+utility programs. This license, the GNU Library General Public+License, applies to certain designated libraries. This license+is quite different from the ordinary one; be sure to read it in+full, and don't assume that anything in it is the same as in the+ordinary license.++The reason we have a separate public license for some libraries+is that they blur the distinction we usually make between+modifying or adding to a program and simply using it. Linking a+program with a library, without changing the library, is in some+sense simply using the library, and is analogous to running a+utility program or application program. However, in a textual+and legal sense, the linked executable is a combined work, a+derivative of the original library, and the ordinary General+Public License treats it as such.++Because of this blurred distinction, using the ordinary General+Public License for libraries did not effectively promote+software sharing, because most developers did not use the+libraries. We concluded that weaker conditions might promote+sharing better.++However, unrestricted linking of non-free programs would deprive+the users of those programs of all benefit from the free status+of the libraries themselves. This Library General Public+License is intended to permit developers of non-free programs to+use free libraries, while preserving your freedom as a user of+such programs to change the free libraries that are incorporated+in them. (We have not seen how to achieve this as regards+changes in header files, but we have achieved it as regards+changes in the actual functions of the Library.) The hope is+that this will lead to faster development of free libraries.++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,+while the latter only works together with the library.++Note that it is possible for a library to be covered by the+ordinary General Public License rather than by this special one.++ GNU LIBRARY GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++0. This License Agreement applies to any software library which+contains a notice placed by the copyright holder or other+authorized party saying it may be distributed under the terms of+this Library 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 compile+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) 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.++ c) 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.++ d) 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 source code 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 to 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 Library 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++ Appendix: 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 Library 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+ Library General Public License for more details.++ You should have received a copy of the GNU Library General Public+ License along with this library; if not, write to the Free+ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, 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!
+ Setup.hs view
@@ -0,0 +1,6 @@+#!/usr/bin/env runhaskell++-- I usually compile this with "ghc --make -o setup Setup.hs"++import Distribution.Simple(defaultMain)+main = defaultMain
+ Text/Regex/DFA.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-| +The "Text.Regex.DFA" module provides a backend for regular+expressions. To use it should be imported along with+"Text.Regex.Lazy". If you import this along with other backends, then+you should do so with qualified imports, perhaps renamed for+convenience.++The DFA engine now takes two CompOption flags: multiline and+caseSensitive. These both default to True. The multiline option+means that a dot matches everything except a newline and ^ and $ match+the after and before a newlilne. If multiline is false then a dot+matches everything and ^ and $ match only the start and end of the+input. The ExecOption is a newtype'd ().++The DFA is a limited backend that trades off features for speed. It+returns the longest full match, but does not return substring captures+or allow back-references to be used. It has been expanded and can now+handle the ^ and $ anchors. Internally it searches ['Char'] or+'ByteString', and is very suitable to quickly search either type.++The DFA backend is a derived work and under the LGPL, the details are+in "Text.Regex.DFA.Engine".+-}++module Text.Regex.DFA(getVersion_Text_Regex_DFA+ -- ** "Text.Regex.Lib.Wrap", providing 'Regex','CompOption','ExecOption','=~','=~~'+ ,module Text.Regex.DFA.Wrap+ -- ** "Text.Regex.DFA.String", instances only+ ,module Text.Regex.DFA.String+ -- ** "Text.Regex.DFA.Sequence", instance only+ ,module Text.Regex.DFA.Sequence+ -- ** "Text.Regex.DFA.ByteString", instance only+ ,module Text.Regex.DFA.ByteString+ -- ** "Text.Regex.DFA.Lazy.ByteString", instance only+ ,module Text.Regex.DFA.ByteString.Lazy+ -- ** "Text.RegexBase" re-exported+ ,module Text.Regex.Base) where++import Text.Regex.DFA.Wrap(Regex,CompOption(..),ExecOption(..),(=~),(=~~))+import Text.Regex.DFA.String()+import Text.Regex.DFA.Sequence()+import Text.Regex.DFA.ByteString()+import Text.Regex.DFA.ByteString.Lazy()+import Text.Regex.Base+import Data.Version(Version(..))++getVersion_Text_Regex_DFA :: Version+getVersion_Text_Regex_DFA =+ Version { versionBranch = [0,91]+ , versionTags = ["unstable"]+ }
+ Text/Regex/DFA/ByteString.hs view
@@ -0,0 +1,94 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-| +This modules provides 'RegexMaker' and 'RegexLike' instances for using+'ByteString' with the DFA backend. This module is usually used via+import "Text.Regex.DFA".++This exports instances of the high level API and the medium level+API of 'compile','execute', and 'regexec'.+-}+module Text.Regex.DFA.ByteString(+ Regex+ ,CompOption+ ,ExecOption+ ,compile+ ,execute+ ,regexec+ ) where++import Data.Array(listArray,Array,elems,(!))+import Text.Regex.DFA.ReadRegex(parseRegex)+import Data.ByteString.Char8(ByteString)+import qualified Data.ByteString.Char8 as B(unpack,drop)+import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..))+import Text.Regex.DFA.EngineFPS(findRegex,matchesRegex,countRegex,accept)+import Text.Regex.DFA.String() -- piggyback on RegexMaker for String+import Text.Regex.DFA.Wrap(Regex(..),CompOption,ExecOption,makeCompat)+import Text.Regex.DFA.Transitions(noLoop)+import Text.Regex.Base.Impl(polymatch,polymatchM)++unwrap :: Either String v -> v+unwrap x = case x of Left err -> error ("Text.Regex.Parsec.ByteString died: "++ err)+ Right v -> v++instance RegexContext Regex ByteString ByteString where+ match = polymatch+ matchM = polymatchM++instance RegexMaker Regex CompOption ExecOption ByteString where+ makeRegexOpts c e source = unwrap $ compile c e source+ makeRegexOptsM c e source = either fail return $ compile c e source++instance RegexLike Regex ByteString where+ matchOnce r source =+ case findRegex regex source of+ (_,Nothing) -> Nothing+ (lenBefore,Just (lenOf,_)) -> Just $+ listArray (0,0) [(lenBefore,lenOf)]+ where regex = asLexer r++ matchAll r source =+ let loop n | n `seq` False = undefined+ | otherwise =+ case findRegex regex (B.drop n source) of+ (_,Nothing) -> []+ (lenBefore,Just (0,_)) ->+ listArray (0,0) [(n+lenBefore,0)] : []+ (lenBefore,Just (lenOf,posAfter)) ->+ listArray (0,0) [(n+lenBefore,lenOf)] : loop (n+posAfter)+ in loop 0+ where regex = asLexer r++ matchTest r source = matchesRegex regex source+ where regex = asLexer r++ matchCount r source = countRegex regex source+ where regex = asLexer r++compile :: CompOption -- ^ Flags (summed together)+ -> ExecOption -- ^ Flags (summed together)+ -> ByteString -- ^ The regular expression to compile+ -> Either String Regex -- ^ Returns: the compiled regular expression+compile compOpt execOpt bs =+ case parseRegex (B.unpack bs) of+ Left err -> Left ("parseRegex for DFA failed:"++show err)+ Right (patternRead,_) ->+ let pattern = noLoop patternRead+ lexer = accept (makeCompat compOpt pattern)+ in Right (Regex pattern lexer compOpt execOpt)++execute :: Regex -- ^ Compiled regular expression+ -> ByteString -- ^ ByteString to match against+ -> Either String (Maybe (Array Int (Int,Int)))+execute r bs = Right (matchOnce r bs)++regexec :: Regex -- ^ Compiled regular expression+ -> ByteString -- ^ ByteString to match against+ -> Either String (Maybe (ByteString, ByteString, ByteString, [ByteString]))+regexec r bs =+ case matchOnceText r bs of+ Nothing -> Right (Nothing)+ Just (pre,mt,post) ->+ let main = fst (mt!0)+ rest = map fst (tail (elems mt)) -- will be []+ in Right (Just (pre,main,post,rest))
+ Text/Regex/DFA/ByteString/EngineFPS.hs view
@@ -0,0 +1,84 @@+{-|++This module is a modification of "Text.Regex.Lazy.DFAEngine" to search ByteStrings (+see <http://www.cse.unsw.edu.au/~dons/fps/>). This uses 'index' to+access the 'Word8' as a 'Char8'.++-}+module Text.Regex.DFA.ByteString.EngineFPS(findRegex,countRegex,matchesHere,matchesRegex,accept) where++import Text.Regex.DFA.Engine(peek, accept, lexAccept, lexFailure,+ Lexer(..), Cont(..),Boundary(..))+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B(null,tail,length,index)++-- This scans through the input to find the first match+findRegex :: Lexer -- ^ The regular expression to match+ -> ByteString -- ^ The input string to scan along, looking for a match+ -> (Int, Maybe (Int,Int)) -- ^ The length of the string before the match, Nothing if there was no match or Just length of the match, index of the input past the match+findRegex lexer input = + let len = fromEnum $ B.length input+ loop s i | i == len = (len,Nothing)+ | otherwise =+ let n=applyHere lexer s len (-1) i+ in if n==(-1) then loop s (succ i)+ else (i,Just (n-i,n))+ in loop input 0++-- internal. Passes in the length of the input even though it is O(1) to compute+applyHere :: Lexer -- ^ The Lexer from (accept Regexp)+ -> ByteString -- ^ The input (Data.FastPackedString.FastString)+ -> Int -- ^ A index 'end' such that (here<=end<=B.length input)+ -> Int -- ^ A value 'value' to return if there is no match, usually (-1)+ -> Int -- ^ A index 'here' (0<=here<B.length input) where to anchor the start of the match+ -> Int -- ^ Will be the index past the match or 'value'+{-# INLINE applyHere #-}+applyHere lexerIn input end valueIn hereIn =+ let final = fromEnum (B.length input)+ loop (Lexer _ action cont) value here | here `seq` value `seq` False = undefined+ | otherwise =+ let value' = if action == lexAccept then here else value+ in case cont of+ Done -> value'+ _ -> if here == end+ then value'+ else case peek cont (B.index input (toEnum here)) of+ (Lexer _ action' _ ) | action' == lexFailure -> value'+ lexer' -> loop lexer' value' (succ here)+ loop (Predicate _ p yes no) value here | here `seq` value `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (here==0) || ('\n' == B.index input (toEnum $ pred here))+ EndLine -> (here==final) || ('\n' == B.index input (toEnum here))+ BeginInput -> here==0+ EndInput -> here==final+ lexer = if t then yes else no+ in loop lexer value here+ in loop lexerIn valueIn hereIn++-- | This counts the number of matches to regex in the string, (it+-- checks each possible starting position). This should be the same+-- as ((length (splitRegex re input))-1) but more efficient+countRegex :: Lexer -> ByteString -> Int+countRegex lexer input =+ let len = fromEnum $ B.length input+ loop i n | n `seq` (i == len) = n+ | otherwise =+ if (-1) == applyHere lexer input len (-1) i+ then loop (succ i) n+ else loop (succ i) (succ n)+ in loop 0 0++-- | This checks the regex anchored at the start of the ByteString and return+-- Nothing if there is no match or (Just n) for a match of length n+matchesHere :: Lexer -> ByteString -> Maybe Int+matchesHere lexer input =+ let n=applyHere lexer input (fromEnum $ B.length input) (-1) 0+ in if n == (-1) then Nothing else Just n++matchesRegex :: Lexer -> ByteString -> Bool+matchesRegex lexer input | B.null input = False+ | otherwise =+ case applyHere lexer input (fromEnum $ B.length input) (-1) 0 of+ (-1) -> matchesRegex lexer (B.tail input)+ _ -> True
+ Text/Regex/DFA/ByteString/Lazy.hs view
@@ -0,0 +1,94 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-| +This modules provides 'RegexMaker' and 'RegexLike' instances for using+'ByteString.Lazy' with the DFA backend. This module is usually used via+import "Text.Regex.DFA".++This exports instances of the high level API and the medium level+API of 'compile','execute', and 'regexec'.+-}+module Text.Regex.DFA.ByteString.Lazy(+ Regex+ ,CompOption+ ,ExecOption+ ,compile+ ,execute+ ,regexec+ ) where++import Data.Array(listArray,Array,elems,(!))+import Text.Regex.DFA.ReadRegex(parseRegex)+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B(unpack,drop)+import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..))+import Text.Regex.DFA.ByteString.EngineFPS(findRegex,matchesRegex,countRegex,accept)+import Text.Regex.DFA.String() -- piggyback on RegexMaker for String+import Text.Regex.DFA.Wrap(Regex(..),CompOption,ExecOption,makeCompat)+import Text.Regex.DFA.Transitions(noLoop)+import Text.Regex.Base.Impl(polymatch,polymatchM)++unwrap :: Either String v -> v+unwrap x = case x of Left err -> error ("Text.Regex.Parsec.ByteString died: "++ err)+ Right v -> v++instance RegexContext Regex ByteString ByteString where+ match = polymatch+ matchM = polymatchM++instance RegexMaker Regex CompOption ExecOption ByteString where+ makeRegexOpts c e source = unwrap $ compile c e source+ makeRegexOptsM c e source = either fail return $ compile c e source++instance RegexLike Regex ByteString where+ matchOnce r source =+ case findRegex regex source of+ (_,Nothing) -> Nothing+ (lenBefore,Just (lenOf,_)) -> Just $+ listArray (0,0) [(lenBefore,lenOf)]+ where regex = asLexer r++ matchAll r source =+ let loop n | n `seq` False = undefined+ | otherwise =+ case findRegex regex (B.drop (toEnum n) source) of+ (_,Nothing) -> []+ (lenBefore,Just (0,_)) ->+ listArray (0,0) [(n+lenBefore,0)] : []+ (lenBefore,Just (lenOf,posAfter)) ->+ listArray (0,0) [(n+lenBefore,lenOf)] : loop (n+posAfter)+ in loop 0+ where regex = asLexer r++ matchTest r source = matchesRegex regex source+ where regex = asLexer r++ matchCount r source = countRegex regex source+ where regex = asLexer r++compile :: CompOption -- ^ Flags (summed together)+ -> ExecOption -- ^ Flags (summed together)+ -> ByteString -- ^ The regular expression to compile+ -> Either String Regex -- ^ Returns: the compiled regular expression+compile compOpt execOpt bs =+ case parseRegex (B.unpack bs) of+ Left err -> Left ("parseRegex for DFA failed:"++show err)+ Right (patternRead,_) ->+ let pattern = noLoop patternRead+ lexer = accept (makeCompat compOpt pattern)+ in Right (Regex pattern lexer compOpt execOpt)++execute :: Regex -- ^ Compiled regular expression+ -> ByteString -- ^ ByteString to match against+ -> Either String (Maybe (Array Int (Int,Int)))+execute r bs = Right (matchOnce r bs)++regexec :: Regex -- ^ Compiled regular expression+ -> ByteString -- ^ ByteString to match against+ -> Either String (Maybe (ByteString, ByteString, ByteString, [ByteString]))+regexec r bs =+ case matchOnceText r bs of+ Nothing -> Right (Nothing)+ Just (pre,mt,post) ->+ let main = fst (mt!0)+ rest = map fst (tail (elems mt)) -- will be []+ in Right (Just (pre,main,post,rest))
+ Text/Regex/DFA/Common.hs view
@@ -0,0 +1,39 @@+-- | Common supports the Lazy Parsec backend. It defines all the data+-- types except Pattern and exports everything but the contructors of+-- Pattern.+module Text.Regex.DFA.Common where++import Data.IntMap(IntMap)++-- | 'RegexOption' control whether the pattern is multiline or+-- case-sensitive like Text.Regex and whether to capture the subgroups+-- (\1, \2, etc).+data CompOption = CompOption {caseSensitive :: Bool,multiline :: Bool}+data ExecOption = ExecOption+{-+-- | This is a convenience value of RegexOption with multiline,+-- caseSensitive, and captureGroups all True and longestMatch False.+defaultRegexOption :: RegexOption+defaultRegexOption = RegexOption {multiline = True+ ,caseSensitive = True+ ,captureGroups = True+ ,strategy = Find_LongestMatch+ }+-}++-- | 'MatchedStrings' is an IntMap where the keys are PatternIndex+-- numbers and the values are completed substring captures.+--+-- This has now been augmented to also remember the offset and length+-- of the matched string.+type MatchedStrings = IntMap (String,(Int,Int))++type BoolMultiline = Bool+type BoolCaseSensitive = Bool+type StringInput = String+type StringBeforeMatch = String+type StringOfMatch = String+type StringAfterMatch = String+type StringSubgroups = String+type StringSubPattern = String+type AboutMatch = (StringBeforeMatch,StringOfMatch,StringAfterMatch,[StringSubgroups])
+ Text/Regex/DFA/Engine.hs view
@@ -0,0 +1,579 @@+{-++Engine-mod.hs is an attempt to add missing functionality to Engine.hs+ * ^ and $ anchor support+ * Multiline compile option to affect .+ * case sensitive compile option for characters (just downcase everything?)+ * substring matching? (libTRE papers?)++Anchors are "boundary" matchers, not character matchers. So I need to+generalize the concept of the branching. And boundaries can coincide.+So for n kinds of boundaries there are 3^n possible ways to require /+avoid / be apathetic to the boundary.++And subgroups are also boundaries.++Using predicates makes for black boxes. Need "LookBehind" nodes.++The keys to groups are these: The open groups form a lifo stack, and+only the last opened group may be closed, and each group can only be+(unused|open at pos #|closed from pos # to #).++When combining Cont with >||< you have *decision* points: either open+a group or not. *mandatory* openings are also possible.++There are many ways to arrange sub-group capture, but consider getting all possible ways:++Maintain a set of LIFO stacks++if you get an "open" command on a group not in the stack, then add it the head of the stack.+if you get an "open" command for a group on the stack then copy it's tail and make a new element of the set with the new (open pos).++if you get a "close" command on the group at the head of the stack, remove it and update the map's list for g. Hooray.+if you get a "close" command on a group not in the stack then WTF? You have to ignore it.+if you get a "close" command on a group deeper in the stack then take it's tail and make a new element of the set with new capture.++Updating the map is annoying -- we need many possible versions. Put the maps on the same stack:+Map+Map,Open+Map,Open,Map+Map,Open,Map,Open+Map,Open,Map,Open,Map++Hmmm...don't let the last element be an open command.+Map+Map,Open,Map+Map,Open,Map,Open,Map++When you open an new group, copy the previous map to the new head.+When you close the top open, update the top map, remove the top map+and open, and replace the new top map with the updated map.++Now increase the symmetry by always starting with an open command (open 0):+(Open 0, EmptyMap) will be the initial stack.++Failing captures: Consider (ac|.|..a)* against aaaa. You can parse it many ways:+Staack is [(Open 0, Empty Map)]+Open 1 Stack is [(Open 0, Empty Map),(Open 1, Empty Map)]+"a" matches, "." matches, "." matches+-, Close 1, - Stack is [(Open 0, 1=(0,1))]+-, Open 1, - Stack is [(Open 0, 1=(0,1)),(Open 1, 1=(0,1))]++Stopping here would be Close 0 (0=(0,1), 1=(0,1))++"c fails",,"." matches; "a" matches, "." matches", "." matches+-,-,-;-,Close 1,- Stack is [(Open 0, 1=(1,1))]+-,-,-;-,Open 1,- Stack is [(Open 0, 1=(1,1)),(Open 1,1=(1,1))]++Stopping here would be Close 0 (0=(0,2), 1=(1,1))++,,"a matches"; "c" fails,,"." matches; "a" matches","." matches","." matches+-,-,Close 1;-,-,-;-,Close 1,-+-,-,Open 1;-,-,-;-,Open 1,-+-}++{-|+By Chris Kuklewicz (haskell (at) list (dot) mightyreason (dot) com), 2006.++This file is licensed under the LGPL (version 2, see the LICENSE+file), because it is a derivative work. This DFAEngine takes the lazy+transition table from Manuel Chakravarty's lexer in CTK Light, but+uses it for simpler purposes. The original CTK code can be found here+<http://www.cse.unsw.edu.au/~chak/haskell/ctk/>++Don Stewart (<http://www.cse.unsw.edu.au/~dons/contact.html>) also+contributed to this code.++I want the freedom to alter the types a bit, so this is a separate+module.++The CTK and DFA code can be thought of as three parts:++1. The ability to compose Regexp combinators which will lazily assemble a DFA. This is mainly bound up in the Cont type and the internal functions that merge it (exported as '>||<').++2. The interface of how to specify "Failure" and "Success". This was bound up in LexAction holding an function and is now lexAccept/lesFailure/lexContinue.++3. The traversal engine. At each longer and longer match the last seen match is updated. Different traversals keep track of different levels of detail.++As a descendent of the regex-dna entry at+<http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=all>,+this module has contributions from Don Stewart, Alson Kemp, and Chris+Kuklewicz.++-}++module Text.Regex.DFA.Engine+ (Lexer(..),LexAction(..),Regexp,Cont(Done),Boundary(..),+ emptyOp,char,alt,altNot,allChar,+ beginLine,endLine,beginInput,endInput,+ (>|<),orRE,(+>),concatRE,quest,star,plus,failure,accept,(>||<),+ findRegex,matchesRegex,testHere,countRegex,findRegexS,+ peek,inBounds,lexFailure,lexContinue,lexAccept ) where++import Data.Array((!), assocs, accumArray, Array)+import Data.List(sort)+import Data.Map(Map)+import qualified Data.Map as M(fromAscList, toAscList, singleton,+ empty, findWithDefault)+import Data.Set(Set)+import Text.Regex.DFA.Pattern(DoPa)+import qualified Data.Set as S++-- import qualified Debug.Trace++trace :: String -> a -> a+trace _ = id++--------------------------------------------------------------------------------+-- * Types and supporting functions for the DFA (taken form CTK Light)+--------------------------------------------------------------------------------++-- | a regular expression+type Regexp = Lexer -> Lexer++-- | Need to encode, as data, the between character decision "am I at+-- this boundary?". The different types of boundary checks and their+-- outcomes are all value of Boundary. Currently only the ^ and $+-- anchors are encoded.+--+data Boundary = BeginLine | EndLine | BeginInput | EndInput + deriving (Show,Eq)++-- | tree structure used to represent the lexer table+--+-- each node in the tree corresponds to a of the lexer; the+-- associated actions are those that apply when the corresponding+-- is reached+data Lexer = Lexer (Set DoPa) !LexAction Cont+ | Predicate {rIndex :: Set DoPa+ ,whichBoundary :: Boundary+ ,atBoundary :: Lexer+ ,notAtBoundary :: Lexer}+ deriving (Show)++-- Smart construtors+mkLexer :: LexAction -> Cont -> Lexer+mkLexer a c = trace ("mkLexer " ++ show a) $ Lexer S.empty a c+mkLexerI :: DoPa -> LexAction -> Cont -> Lexer+mkLexerI i a c = trace ("mkLexerI " ++ show i) $ Lexer (S.singleton i) a c+mkLexerS :: Set DoPa -> LexAction -> Cont -> Lexer+mkLexerS si a c = trace ("mkLexerS " ++ show si) $ Lexer si a c+mkPredicateI :: DoPa -> Boundary -> Lexer -> Lexer -> Lexer+mkPredicateI i b cTrue cFalse = Predicate (S.singleton i) b cTrue cFalse+mkPredicateS :: Set DoPa -> Boundary -> Lexer -> Lexer -> Lexer+mkPredicateS si b cTrue cFalse = Predicate si b cTrue cFalse++failure :: Lexer+failure = mkLexer lexFailure Done++-- | This is interface between the DFA table and the traversal engine,+-- and is simpler than the original CTK version.+newtype LexAction = LexAction Int deriving (Eq,Ord,Show)+lexFailure,lexContinue,lexAccept :: LexAction+lexFailure = LexAction (-1)+lexContinue = LexAction 0+lexAccept = LexAction 1+-- The above allows the definition joinActions = max++-- | 'Done' or a table-like-thing to associate the next character with a Lexer+data Cont = Dense {bounds :: !BoundsNum+ ,transArray :: Array Char (Lexer)+ ,otherTrans :: Lexer}+ | Sparse {bounds :: !BoundsNum+ ,transMap :: Map Char (Lexer)+ ,otherTrans :: Lexer}+ | Done deriving (Show)++-- | estimates the number of (non-'otherTrans') elements and the+-- bounds of a DFA transition table+data BoundsNum = B !Int !Char !Char deriving (Show)++--------------------------------------------------------------------------------+-- * Regexp matching functions and combinators (taken from CTK Light)+--------------------------------------------------------------------------------++----------------------------------------+-- | Fixity declarations+----------------------------------------++infixr 4 `quest`, `star`, `plus`+infixl 3 +>+infixl 2 >|<, >||<++----------------------------------------+-- | These create Regexp+----------------------------------------++-- | Empty lexeme (noop)+emptyOp :: Regexp+{-# INLINE emptyOp #-}+emptyOp = id++beginLine :: DoPa -> Regexp+beginLine i = \l -> mkPredicateI i BeginLine l failure++endLine :: DoPa -> Regexp+endLine i = \l -> mkPredicateI i EndLine l failure++beginInput :: DoPa -> Regexp+beginInput i = \l -> mkPredicateI i BeginInput l failure++endInput :: DoPa -> Regexp+endInput i = \l -> mkPredicateI i EndInput l failure++-- | One character regexp+char :: DoPa -> Char -> Regexp+char i c = \l -> mkLexerI i lexContinue (Sparse (B 1 c c) (M.singleton c l) failure)++-- | accepts any character+allChar :: DoPa -> Regexp+allChar i =+ let bnds = B 0 maxBound minBound+ in \l -> mkLexerI i lexContinue (Sparse bnds M.empty l)++-- | accepts a list of alternative characters+-- Equiv. to `(foldr1 (>|<) . map char) cs', but much faster+alt :: DoPa -> [Char] -> Regexp+alt _ [] = \_ -> failure+alt i cs =+ let scs = sort cs+ (len,end) = lengthAndLast scs+ bnds = B len (head scs) end+ in \l -> mkLexerI i lexContinue (aggregateConts bnds [(c, l) | c <- sort cs] failure)++-- | accepts an inverted list of alternative characters+-- Equiv. to `(foldr1 (>|<) . map char) cs', but much faster+altNot :: DoPa -> [Char] -> Regexp+altNot i [] = allChar i+altNot i cs =+ let scs = sort cs+ (len,end) = lengthAndLast scs+ bnds = B len (head scs) end+ in \l -> mkLexerI i lexContinue (aggregateConts bnds [(c, failure) | c <- sort cs] l)++-- Helper function for alt and altNot to efficiently compute the bounds+lengthAndLast :: [a] -> (Int,a)+lengthAndLast = helper 1+ where helper _ [] = (0,undefined)+ helper i [x] = (i,x)+ helper i (_:xs) = let i' = succ i in seq i' $ helper i' xs++----------------------------------------+-- | These combine two Regexp's+----------------------------------------++-- | Concatenation of regexps is just concatenation of functions+-- x +> y corresponds to xy+(+>) :: Regexp -> Regexp -> Regexp+{-# INLINE (+>) #-}+(+>) = (.) ++concatRE :: [Regexp] -> Regexp+{-# INLINE concatRE #-}+concatRE [] = emptyOp+concatRE rs = foldr1 (+>) rs++-- | disjunctive combination of two regexps, corresponding to x|y.+-- +-- This will find the longest match+(>|<) :: Regexp -> Regexp -> Regexp+{-# INLINE (>|<) #-}+re1 >|< re2 = \l -> re1 l >||< re2 l++orRE :: [Regexp] -> Regexp+{-# INLINE orRE #-}+orRE [] = emptyOp+orRE rs = foldl1 (>|<) rs++-- | x `quest` y corresponds to the regular expression x?y+quest :: Regexp -> Regexp -> Regexp+{-# INLINE quest #-}+quest re1 re2 = (re1 +> re2) >|< re2++-- | x `plus` y corresponds to the regular expression x+y+plus :: Regexp -> Regexp -> Regexp+{-# INLINE plus #-}+plus re1 re2 = re1 +> (re1 `star` re2)++--+-- The definition used below can be obtained by equational reasoning from this+-- one (which is much easier to understand): +--+-- star re1 re2 = let self = (re1 +> self >|< emptyOp) in self +> re2+--+-- However, in the above, `self' is of type `Regexp s t' (ie, a functional),+-- whereas below it is of type `Lexer s t'. Thus, below we have a graphical+-- body (finite representation of an infinite structure), which doesn't grow+-- with the size of the accepted lexeme - in contrast to the definition using+-- the functional recursion.++-- | x `star` y corresponds to the regular expression x*y+-- "self" is of type Lexer+star :: Regexp -> Regexp -> Regexp+star re1 re2 = \l -> let self = re1 self >||< re2 l in self++--------------------------------------------------------------------------------+-- * Converting Regexp into Lexer and combinind lexers+--------------------------------------------------------------------------------++-- | Have a match to Regexp be consider a success+accept :: Regexp -> Lexer+{-# INLINE accept #-}+accept re = re (mkLexer lexAccept Done)++-- | disjunctive combination of two lexers (longest match, right biased)+(>||<) :: Lexer -> Lexer -> Lexer+(Lexer i a c) >||< (Lexer j a' c') = mkLexerS (S.union i j) (joinActions a a') (joinConts c c')+(Predicate i x t f) >||< (Predicate i' x' t' f') | x==x' = mkPredicateS (S.union i i') x (t >||< t') (f >||< f')+(Predicate i x t f) >||< b = mkPredicateS i x (t >||< b) (f >||< b)+a >||< (Predicate i x t f) = mkPredicateS i x (a >||< t) (a >||< f)++-- internal+joinActions :: LexAction -> LexAction -> LexAction+joinActions = max++-- internal, combine two disjunctive continuations+joinConts :: Cont -> Cont -> Cont+joinConts Done c' = c'+joinConts c Done = c+joinConts c c' = let (bn , cls , other ) = listify c+ (bn', cls', other') = listify c'+ -- note: `addsBoundsNum' can, at this point, only+ -- approx. the number of *non-overlapping* cases;+ -- however, the bounds are correct + in aggregateConts (addBoundsNum bn bn') (fuse cls other cls' other') (other >||< other')+ where -- listify converts the array or map into an ascending list+ listify :: Cont -> (BoundsNum,[(Char,Lexer)],Lexer)+ listify (Dense {bounds=n,transArray=arr,otherTrans=other}) = (n, assocs arr, other)+ listify (Sparse {bounds=n,transMap=cls, otherTrans=other}) = (n, M.toAscList cls, other)+ listify _ = undefined++-- Combine two ascending lists with defaults into a new ascending list+fuse :: [(Char,Lexer)] -> (Lexer) -> [(Char,Lexer)] -> (Lexer) -> [(Char, Lexer)]+{-# INLINE fuse #-}+fuse [] xo y _ = map (\(yc,ya) -> (yc,xo >||< ya)) y+fuse x _ [] yo = map (\(xc,xa) -> (xc,xa >||< yo)) x+fuse x@((xc,xa):xs) xo y@((yc,ya):ys) yo = + case compare xc yc of+ LT -> (xc,xa >||< yo) : fuse xs xo y yo+ EQ -> (xc,xa >||< ya) : fuse xs xo ys yo+ GT -> (yc,xo >||< ya) : fuse x xo ys yo++-- Take a new BoundsNum, a new ascending list, and new default+aggregateConts :: BoundsNum -> [(Char, Lexer)] -> Lexer -> Cont+{-# INLINE aggregateConts #-}+aggregateConts bn@(B n lc hc) cls other+ | n >= denseMin = Dense bn (accumArray (\_ new -> new) other (lc, hc) cls) other+ | otherwise = Sparse bn (M.fromAscList cls) other++-- we use the dense representation if a table has an upper bound of at+-- least this number of (non-error) elements+denseMin :: Int+denseMin = 20++-- combine two bounds. Note that n,n',newN are upper bounds on the+-- number of characters.+addBoundsNum :: BoundsNum -> BoundsNum -> BoundsNum+{-# INLINE addBoundsNum #-}+addBoundsNum (B 0 _ _ ) b = b+addBoundsNum b (B 0 _ _ ) = b+addBoundsNum (B n lc hc) (B n' lc' hc') = let newLc = min lc lc'+ newHc = max hc hc'+ newN = min (n + n') (fromEnum newHc - fromEnum newLc + 1)+ in B newN newLc newHc++--------------------------------------------------------------------------------+-- * Matching engine+--------------------------------------------------------------------------------++-- | This is the ultra-lazy matching engine. It returns the longest match.+--+-- This will not examine any more of the input than needed, checking+-- and returning a character at a time. Once a character is read that+-- leads to no possibility of future match it does not evaluate any+-- deeper.+--+-- When a match is found, the input past match is not examined at all.+--+-- In the extreme case of the input string being (error _) this will+-- still succeed if the Regexp matches only an empty string since the+-- input will not be demanded at all. The "input before matching" in+-- this case will be [] and its length is 0, and the length of the+-- match is 0, which the input at start of match and the input past+-- the match will both be (error _).+--+-- This loops over 'matchHere' to find the first match+findRegex :: Lexer -- ^ The regular expression to match+ -> String -- ^ The input string to scan along, looking for a match+ -> (String,Int,Maybe (String,Int,String)) -- ^ The input string before the match, length of the string before the match, Nothing if there was no match or Just input string at the start of the match, length of the match, input string starting just past the match+findRegex lexer input = + let loop :: Char -> String -> Int -> (String,Int,Maybe(String,Int,String))+ loop p s i = case matchHere lexer i p s of+ ((-1),_) -> let ~(rest,len,result) = loop (head s) (tail s) $! (succ i)+ in if null s then ([],i,Nothing)+ else (head s : rest,len,result)+ (n,~leftover) -> ([],i,Just (s,n,leftover))+ in loop '\n' input 0++-- | This returns (-1,[]) if there was no match+matchHere :: Lexer -- ^ (accept regexp) to match+ -> Int -- ^ Offset into original string+ -> Char -- ^ previous character+ -> String -- ^ The input string+ -> (Int, String) -- ^ The length 'n' of the prefix of input that matched (take n input), The input starting past the match (drop n input)+{-# INLINE matchHere #-}+matchHere lexerIn offsetIn prevIn inputIn = applyHere lexerIn prevIn inputIn ((-1),[]) 0+ where+ -- internal. All the matching logic and boundary logic and group logic are here.+ applyHere :: Lexer -- ^ The current lexeme+ -> Char -- ^ previous character+ -> String -- ^ Current input+ -> (Int,String) -- ^ Longest match so far+ -> Int -- ^ Number of characters in the match so far+ -> (Int,String) -- ^ Length of match and input past match+ {-# INLINE applyHere #-}+ applyHere (Lexer _ action cont) _ input lastItem here | here `seq` False = undefined+ | otherwise =+ let lastItem' = if action == lexAccept then (here,input) else lastItem+ in case seq lastItem' cont of -- seq ensures we evaluate the if predicate+ Done -> lastItem'+ _ -> case input of+ [] -> lastItem'+ (h:t) -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> lastItem'+ lexer' -> applyHere lexer' h t lastItem' (succ here)++ applyHere (Predicate _ p yes no) prev input lastItem here | here `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (prev == '\n') || (offsetIn==0 && here==0)+ EndLine -> null input || ('\n' == head input)+ BeginInput -> offsetIn==0 && here==0+ EndInput -> null input+ lexer = if t then yes else no+ in applyHere lexer prev input lastItem here++-- Do the lookup of the current character in the DFA transition table.+peek :: Cont -> Char -> Lexer+{-# INLINE peek #-}+peek (Dense bn arr other) c | c `inBounds` bn = arr ! c+ | otherwise = other+peek (Sparse bn cls other) c | c `inBounds` bn = M.findWithDefault other c cls+ | otherwise = other+peek _ _ = undefined+-- check whether a character is in the bounds+inBounds :: Char -> BoundsNum -> Bool+{-# INLINE inBounds #-}+inBounds _ (B 0 _ _ ) = False+inBounds c (B _ lc hc) = c >= lc && c <= hc++-- | This counts the number of matches to regex in the string, (it+-- checks each possible starting position). This should be the same+-- as ((length (splitRegex re input))-1) but more efficient+-- ^^^ fix+countRegex :: Lexer -> [Char] -> Int+countRegex lexer input =+ let loop p s i | seq i False = undefined+ | otherwise =+ if testHere lexer i p s+ then if null s then succ i else loop (head s) (tail s) (succ i)+ else if null s then i else loop (head s) (tail s) i+ in loop '\n' input 0++-- | This searches the input string for a match to the regex+-- There is no need to wait for the longest match, so stop at first lexAccept+matchesRegex :: Lexer -> [Char] -> Bool+matchesRegex lexer input =+ let loop p s i | i `seq` False = undefined+ | otherwise =+ if testHere lexer i p s+ then True+ else if null s then False else loop (head s) (tail s) (succ i)+ in loop '\n' input 0++-- | This checks for a match to the regex starting at the beginning of the input+-- There is no need to wait for the longest match, so stop at first lexAccept+testHere :: Lexer -- ^ current lexeme+ -> Int -- ^ Origin offset+ -> Char -- ^ previous input character+ -> [Char] -- ^ current input+ -> Bool+testHere lexerIn offsetIn prevIn inputIn = test lexerIn (offsetIn==0) prevIn inputIn+ where+ test (Lexer _ action cont) _ _ input | action == lexAccept = True+ | otherwise =+ case cont of+ Done -> False+ _ -> case input of+ [] -> False+ (h:t) -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> False+ lexer' -> test lexer' False h t++ test (Predicate _ p yes no) atFront prev input =+ let t = case p of+ BeginLine -> atFront || (prev == '\n')+ EndLine -> null input || ('\n' == head input)+ BeginInput -> atFront+ EndInput -> null input+ lexer = if t then yes else no+ in test lexer atFront prev input++-- | This is a version of findRegex that does not compute the length of the prefix+findRegexS :: Lexer -> String -> (String, Maybe (String, Int, String))+findRegexS lexer input = + let loop :: Char -> String -> Int -> (String,Maybe(String,Int,String))+ loop p s i | i `seq` False = undefined+ | otherwise =+ case matchHere lexer i p s of+ ((-1),_) -> if null s+ then ([],Nothing)+ else let ~(rest,result) = loop (head s) (tail s) (succ i)+ in (head s : rest,result)+ (n,~leftover) -> ([],Just (s,n,leftover))+ in loop '\n' input 0+{-++-- | This returns (-1,[]) if there was no match+matchHere' :: Lexer -- ^ (accept regexp) to match+ -> Int -- ^ Offset into original string+ -> Char -- ^ previous character+ -> String -- ^ The input string+ -> (Int, String) -- ^ The length 'n' of the prefix of input that matched (take n input), The input starting past the match (drop n input)+{-# INLINE matchHere' #-}+matchHere' lexerIn offsetIn prevIn inputIn = applyHere lexerIn prevIn inputIn ((-1),[]) 0+ where+ -- internal. All the matching logic and boundary logic and group logic are here.+ applyHere :: Lexer -- ^ The current lexeme+ -> Char -- ^ previous character+ -> String -- ^ Current input+ -> (Int,String) -- ^ Longest match so far+ -> Int -- ^ Number of characters in the match so far+ -> (Int,String) -- ^ Length of match and input past match+ {-# INLINE applyHere #-}+ applyHere (Lexer _ action cont) _ input lastItem here | here `seq` False = undefined+ | otherwise =+ let lastItem' = if action == lexAccept then (here,input) else lastItem+ in case seq lastItem' cont of -- seq ensures we evaluate the if predicate+ Done -> lastItem'+ _ -> case input of+ [] -> lastItem'+ (h:t) -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> lastItem'+ lexer' -> applyHere lexer' h t lastItem' (succ here)++ applyHere (Predicate _ p yes no) prev input lastItem here | here `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (prev == '\n') || (offsetIn==0 && here==0)+ EndLine -> null input || ('\n' == head input)+ BeginInput -> offsetIn==0 && here==0+ EndInput -> null input+ lexer = if t then yes else no+ in applyHere lexer prev input lastItem here++-- Sensible tracking of open and closed information+data Opened = Opened [Closed] Int (String,Int) Opened | EndOpened [Closed] deriving (Show)+data Closed = Closed [Closed] Int (String,(Int,Int)) deriving (Show)++-}
+ Text/Regex/DFA/EngineFPS.hs view
@@ -0,0 +1,84 @@+{-|++This module is a modification of "Text.Regex.Lazy.DFAEngine" to search ByteStrings (+see <http://www.cse.unsw.edu.au/~dons/fps/>). This uses 'index' to+access the 'Word8' as a 'Char8'.++-}+module Text.Regex.DFA.EngineFPS(findRegex,countRegex,matchesHere,matchesRegex,accept) where++import Text.Regex.DFA.Engine(peek, accept, lexAccept, lexFailure,+ Lexer(..), Cont(..),Boundary(..))+import Data.ByteString.Char8(ByteString)+import qualified Data.ByteString.Char8 as B(null,tail,length,index)++-- This scans through the input to find the first match+findRegex :: Lexer -- ^ The regular expression to match+ -> ByteString -- ^ The input string to scan along, looking for a match+ -> (Int, Maybe (Int,Int)) -- ^ The length of the string before the match, Nothing if there was no match or Just length of the match, index of the input past the match+findRegex lexer input = + let len = B.length input+ loop s i | i == len = (len,Nothing)+ | otherwise =+ let n=applyHere lexer s len (-1) i+ in if n==(-1) then loop s (succ i)+ else (i,Just (n-i,n))+ in loop input 0++-- internal. Passes in the length of the input even though it is O(1) to compute+applyHere :: Lexer -- ^ The Lexer from (accept Regexp)+ -> ByteString -- ^ The input (Data.FastPackedString.FastString)+ -> Int -- ^ A index 'end' such that (here<=end<=B.length input)+ -> Int -- ^ A value 'value' to return if there is no match, usually (-1)+ -> Int -- ^ A index 'here' (0<=here<B.length input) where to anchor the start of the match+ -> Int -- ^ Will be the index past the match or 'value'+{-# INLINE applyHere #-}+applyHere lexerIn input end valueIn hereIn =+ let final = (B.length input)+ loop (Lexer _ action cont) value here | here `seq` value `seq` False = undefined+ | otherwise =+ let value' = if action == lexAccept then here else value+ in case cont of+ Done -> value'+ _ -> if here == end+ then value'+ else case peek cont (B.index input here) of+ (Lexer _ action' _ ) | action' == lexFailure -> value'+ lexer' -> loop lexer' value' (succ here)+ loop (Predicate _ p yes no) value here | here `seq` value `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (here==0) || ('\n' == B.index input (pred here))+ EndLine -> (here==final) || ('\n' == B.index input here)+ BeginInput -> here==0+ EndInput -> here==final+ lexer = if t then yes else no+ in loop lexer value here+ in loop lexerIn valueIn hereIn++-- | This counts the number of matches to regex in the string, (it+-- checks each possible starting position). This should be the same+-- as ((length (splitRegex re input))-1) but more efficient+countRegex :: Lexer -> ByteString -> Int+countRegex lexer input =+ let len = B.length input+ loop i n | n `seq` (i == len) = n+ | otherwise =+ if (-1) == applyHere lexer input len (-1) i+ then loop (succ i) n+ else loop (succ i) (succ n)+ in loop 0 0++-- | This checks the regex anchored at the start of the ByteString and return+-- Nothing if there is no match or (Just n) for a match of length n+matchesHere :: Lexer -> ByteString -> Maybe Int+matchesHere lexer input =+ let n=applyHere lexer input (B.length input) (-1) 0+ in if n == (-1) then Nothing else Just n++matchesRegex :: Lexer -> ByteString -> Bool+matchesRegex lexer input | B.null input = False+ | otherwise =+ case applyHere lexer input (B.length input) (-1) 0 of+ (-1) -> matchesRegex lexer (B.tail input)+ _ -> True
+ Text/Regex/DFA/EngineSeq.hs view
@@ -0,0 +1,212 @@+{-+-}++module Text.Regex.DFA.EngineSeq(findRegex,matchesRegex,countRegex,accept,toList,findRegexS) where++import Text.Regex.DFA.Engine hiding (testHere,findRegex,matchesRegex,countRegex,findRegexS)+import Data.Sequence as S++-- import qualified Debug.Trace++-- trace :: String -> a -> a+-- trace _ = id++{-# INLINE toList #-}+toList :: S.Seq Char -> [Char]+toList s = expand (S.viewl s) where+ expand EmptyL = []+ expand (c :< cs) = c : expand (S.viewl cs)++--------------------------------------------------------------------------------+-- * Matching engine+--------------------------------------------------------------------------------++-- | This is the ultra-lazy matching engine. It returns the longest match.+--+-- This will not examine any more of the input than needed, checking+-- and returning a character at a time. Once a character is read that+-- leads to no possibility of future match it does not evaluate any+-- deeper.+--+-- When a match is found, the input past match is not examined at all.+--+-- In the extreme case of the input string being (error _) this will+-- still succeed if the Regexp matches only an empty string since the+-- input will not be demanded at all. The "input before matching" in+-- this case will be [] and its length is 0, and the length of the+-- match is 0, which the input at start of match and the input past+-- the match will both be (error _).+--+-- This loops over 'matchHere' to find the first match+findRegex :: Lexer -- ^ The regular expression to match+ -> Seq Char -- ^ The input SEq Char to scan along, looking for a match+ -> (Seq Char,Int,Maybe (Seq Char,Int,Seq Char)) -- ^ The input string before the match, length of the string before the match, Nothing if there was no match or Just input string at the start of the match, length of the match, input string starting just past the match+findRegex lexer input = + let loop :: Char -> Seq Char -> Int -> (Seq Char,Int,Maybe(Seq Char,Int,Seq Char))+ loop p s i = case matchHere lexer i p s of+ ((-1),_) -> case S.viewl s of+ EmptyL -> (S.empty,i,Nothing)+ (h :< t) -> let ~(rest,len,result) = loop h t $! (succ i)+ in (h <| rest,len,result)+ (n,~leftover) -> (S.empty,i,Just (s,n,leftover))+ in loop '\n' input 0++-- | This returns (-1,[]) if there was no match+matchHere :: Lexer -- ^ (accept regexp) to match+ -> Int -- ^ Offset into original string+ -> Char -- ^ previous character+ -> Seq Char -- ^ The input string+ -> (Int, Seq Char) -- ^ The length 'n' of the prefix of input that matched (take n input), The input starting past the match (drop n input)+{-# INLINE matchHere #-}+matchHere lexerIn offsetIn prevIn inputIn = applyHere lexerIn prevIn inputIn ((-1),S.empty) 0+ where+ -- internal. All the matching logic and boundary logic and group logic are here.+ applyHere :: Lexer -- ^ The current lexeme+ -> Char -- ^ previous character+ -> Seq Char -- ^ Current input+ -> (Int,Seq Char) -- ^ Longest match so far+ -> Int -- ^ Number of characters in the match so far+ -> (Int,Seq Char) -- ^ Length of match and input past match+ {-# INLINE applyHere #-}+ applyHere (Lexer _ action cont) _ input lastItem here | here `seq` False = undefined+ | otherwise =+ let lastItem' = if action == lexAccept then (here,input) else lastItem+ in case seq lastItem' cont of -- seq ensures we evaluate the if predicate+ Done -> lastItem'+ _ -> case S.viewl input of+ EmptyL -> lastItem'+ (h:<t) -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> lastItem'+ lexer' -> applyHere lexer' h t lastItem' (succ here)++ applyHere (Predicate _ p yes no) prev input lastItem here | here `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (prev == '\n') || (offsetIn==0 && here==0)+ EndLine -> case viewl input of+ EmptyL -> True+ (h :< _) -> '\n' == h+ BeginInput -> offsetIn==0 && here==0+ EndInput -> S.null input+ lexer = if t then yes else no+ in applyHere lexer prev input lastItem here++-- | This counts the number of matches to regex in the string, (it+-- checks each possible starting position). This should be the same+-- as ((length (splitRegex re input))-1) but more efficient+-- ^^^ fix+countRegex :: Lexer -> Seq Char -> Int+countRegex lexer input =+ let loop p s i | seq i False = undefined+ | otherwise =+ if testHere lexer i p s+ then case S.viewl s of+ EmptyL -> succ i+ h :< t -> loop h t $! succ i+ else case S.viewl s of+ EmptyL -> i+ h :< t -> loop h t $! i+ in loop '\n' input 0++-- | This searches the input string for a match to the regex+-- There is no need to wait for the longest match, so stop at first lexAccept+matchesRegex :: Lexer -> Seq Char -> Bool+matchesRegex lexer input =+ let loop p s i | i `seq` False = undefined+ | otherwise =+ if testHere lexer i p s+ then True+ else case S.viewl s of+ EmptyL -> False+ h :< t -> loop h t $! succ i+ in loop '\n' input 0++-- | This checks for a match to the regex starting at the beginning of the input+-- There is no need to wait for the longest match, so stop at first lexAccept+testHere :: Lexer -- ^ current lexeme+ -> Int -- ^ Origin offset+ -> Char -- ^ previous input character+ -> Seq Char -- ^ current input+ -> Bool+testHere lexerIn offsetIn prevIn inputIn = test lexerIn (offsetIn==0) prevIn inputIn+ where+ test (Lexer _ action cont) _ _ input | action == lexAccept = True+ | otherwise =+ case cont of+ Done -> False+ _ -> case S.viewl input of+ EmptyL -> False+ h :< t -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> False+ lexer' -> test lexer' False h t++ test (Predicate _ p yes no) atFront prev input =+ let t = case p of+ BeginLine -> atFront || (prev == '\n')+ EndLine -> case S.viewl input of+ EmptyL -> True+ h :< _ -> '\n' == h+ BeginInput -> atFront+ EndInput -> S.null input+ lexer = if t then yes else no+ in test lexer atFront prev input++-- | This is a version of findRegex that does not compute the length of the prefix+findRegexS :: Lexer -> Seq Char -> (Seq Char, Maybe (Seq Char, Int, Seq Char))+findRegexS lexer input = + let loop :: Char -> Seq Char -> Int -> (Seq Char,Maybe(Seq Char,Int,Seq Char))+ loop p s i | i `seq` False = undefined+ | otherwise =+ case matchHere lexer i p s of+ ((-1),_) -> case S.viewl s of+ EmptyL -> (S.empty,Nothing)+ h :< t -> let ~(rest,result) = loop h t $! (succ i)+ in (h <| rest,result)+ (n,~leftover) -> (S.empty,Just (s,n,leftover))+ in loop '\n' input $! 0++{-++-- | This returns (-1,[]) if there was no match+matchHere' :: Lexer -- ^ (accept regexp) to match+ -> Int -- ^ Offset into original string+ -> Char -- ^ previous character+ -> Seq Char -- ^ The input string+ -> (Int, Seq Char) -- ^ The length 'n' of the prefix of input that matched (take n input), The input starting past the match (drop n input)+{-# INLINE matchHere' #-}+matchHere' lexerIn offsetIn prevIn inputIn = applyHere lexerIn prevIn inputIn ((-1),[]) 0+ where+ -- internal. All the matching logic and boundary logic and group logic are here.+ applyHere :: Lexer -- ^ The current lexeme+ -> Char -- ^ previous character+ -> Seq Char -- ^ Current input+ -> (Int,Seq Char) -- ^ Longest match so far+ -> Int -- ^ Number of characters in the match so far+ -> (Int,Seq Char) -- ^ Length of match and input past match+ {-# INLINE applyHere #-}+ applyHere (Lexer _ action cont) _ input lastItem here | here `seq` False = undefined+ | otherwise =+ let lastItem' = if action == lexAccept then (here,input) else lastItem+ in case seq lastItem' cont of -- seq ensures we evaluate the if predicate+ Done -> lastItem'+ _ -> case input of+ [] -> lastItem'+ (h:t) -> case peek cont h of+ Lexer _ action' _ | action' == lexFailure -> lastItem'+ lexer' -> applyHere lexer' h t lastItem' (succ here)++ applyHere (Predicate _ p yes no) prev input lastItem here | here `seq` False = undefined+ | otherwise =+ let t = case p of+ BeginLine -> (prev == '\n') || (offsetIn==0 && here==0)+ EndLine -> null input || ('\n' == head input)+ BeginInput -> offsetIn==0 && here==0+ EndInput -> null input+ lexer = if t then yes else no+ in applyHere lexer prev input lastItem here++-- Sensible tracking of open and closed information+data Opened = Opened [Closed] Int (Seq Char,Int) Opened | EndOpened [Closed] deriving (Show)+data Closed = Closed [Closed] Int (Seq Char,(Int,Int)) deriving (Show)++-}
+ Text/Regex/DFA/Pattern.hs view
@@ -0,0 +1,156 @@+-- | This "Text.Regex.DFA.Pattern" module provides the 'Pattern' data+-- type and its subtypes. This 'Pattern' type is used to represent+-- the parsed form of a Regular Expression and is syntax independent.+--+-- It is possible to construct values of 'Pattern' that are invalid+-- regular expressions.+--+-- There are also several +module Text.Regex.DFA.Pattern+ (Pattern(..)+ ,PatternSet(..)+ ,PatternSetCharacterClass(..),PatternSetCollatingElement(..),PatternSetEquivalenceClass(..)+ ,PatternIndex+ ,showPattern+ ,showPatternP+ -- ** Pattern DoPa+ ,DoPa(..)+ ,newDoPa+ ) where++{- By Chris Kuklewicz, 2006. BSD License, see the LICENSE file. -}++import Data.List(intersperse,partition)+import qualified Data.Set as Set(toAscList,toList)+import Data.Set(Set)++data DoPa = DoPa {dopaIndex :: Int} deriving (Eq,Ord)+instance Show DoPa where+ show (DoPa {dopaIndex=i}) = show i++newDoPa :: Int -> DoPa+newDoPa i = DoPa i++data Pattern = PEmpty+ | PGroup PatternIndex Pattern+ | POr [Pattern]+ | PConcat [Pattern]+ | PQuest Pattern+ | PPlus Pattern+ | PStar Pattern+ | PBound Int (Maybe Int) Pattern+ -- The rest of these need an index of where in the regex string it is from+ | PCarat DoPa+ | PDollar DoPa+ -- The following test and accept a single character+ | PDot DoPa -- Any character (newline?) at all+ | PAny DoPa PatternSet -- Square bracketed things+ | PAnyNot DoPa PatternSet -- Inverted square bracketed things+ | PEscape DoPa Char -- Backslashed Character+ | PChar DoPa Char -- Specific Character+ deriving (Eq,Show)++showPattern :: Pattern -> String+showPattern pIn =+ case pIn of+ PEmpty -> "()"+ PGroup _ p -> ('(':showPattern p)++")"+ POr ps -> concat $ intersperse "|" (map showPattern ps)+ PConcat ps -> concatMap showPattern ps+ PQuest p -> (showPattern p)++"?"+ PPlus p -> (showPattern p)++"+"+ PStar p -> (showPattern p)++"*"+ PBound i (Just j) p | i==j -> showPattern p ++ ('{':show i)++"}"+ PBound i mj p -> showPattern p ++ ('{':show i) ++ maybe ",}" (\j -> ',':show j++"}") mj+ --+ PCarat _ -> "^"+ PDollar _ -> "$"+ PDot _ -> "."+ PAny _ (PatternSet s scc sce sec) ->+ let (special,normal) = maybe ("","") ((partition (`elem` "]-")) . Set.toAscList) s+ charSpec = (if ']' `elem` special then (']':) else id) (byRange normal)+ scc' = maybe "" ((concatMap (\ss -> "[:"++unSCC ss++":]")) . Set.toList) scc+ sce' = maybe "" ((concatMap (\ss -> "[."++unSCE ss++".]")) . Set.toList) sce+ sec' = maybe "" ((concatMap (\ss -> "[="++unSEC ss++"=]")) . Set.toList) sec+ in concat ['[':charSpec,scc',sce',sec',if '-' `elem` special then "-]" else "]"]+ PAnyNot _ (PatternSet s scc sce sec) ->+ let (special,normal) = maybe ("","") ((partition (`elem` "]-")) . Set.toAscList) s+ charSpec = (if ']' `elem` special then (']':) else id) (byRange normal)+ scc' = maybe "" ((concatMap (\ss -> "[:"++unSCC ss++":]")) . Set.toList) scc+ sce' = maybe "" ((concatMap (\ss -> "[."++unSCE ss++".]")) . Set.toList) sce+ sec' = maybe "" ((concatMap (\ss -> "[="++unSEC ss++"=]")) . Set.toList) sec+ in concat ["[^",charSpec,scc',sce',sec',if '-' `elem` special then "-]" else "]"]+ PEscape _ c -> '\\':c:[]+ PChar _ c -> [c]+ where byRange xAll@(x:xs) | length xAll <=3 = xAll+ | otherwise = groupRange x 1 xs+ byRange _ = undefined+ groupRange x n (y:ys) = if (fromEnum y)-(fromEnum x) == n then groupRange x (succ n) ys+ else (if n <=3 then take n [x..]+ else x:'-':(toEnum (pred n+fromEnum x)):[]) ++ groupRange y 1 ys+ groupRange x n [] = if n <=3 then take n [x..]+ else x:'-':(toEnum (pred n+fromEnum x)):[]++showPatternP :: Pattern -> String+showPatternP pIn =+ case pIn of+ PEmpty -> paren $ ""+ PGroup _ p -> paren $ showPatternP p+ POr ps -> paren $ concat $ intersperse "|" (map showPatternP ps)+ PConcat ps -> paren $ concatMap showPatternP ps+ PQuest p -> (showPatternP p)++"?"+ PPlus p -> (showPatternP p)++"+"+ PStar p -> ( showPatternP p)++"*"+ PBound i (Just j) p | i==j -> showPatternP p ++ ('{':show i)++"}"+ PBound i mj p -> showPatternP p ++ ('{':show i) ++ maybe ",}" (\j -> ',':show j++"}") mj+ --+ PCarat _ -> "^"+ PDollar _ -> "$"+ PDot _ -> "."+ PAny _ (PatternSet s scc sce sec) ->+ let (special,normal) = maybe ("","") ((partition (`elem` "]-")) . Set.toAscList) s+ charSpec = (if ']' `elem` special then (']':) else id) (byRange normal)+ scc' = maybe "" ((concatMap (\ss -> "[:"++unSCC ss++":]")) . Set.toList) scc+ sce' = maybe "" ((concatMap (\ss -> "[."++unSCE ss++".]")) . Set.toList) sce+ sec' = maybe "" ((concatMap (\ss -> "[="++unSEC ss++"=]")) . Set.toList) sec+ in concat ['[':charSpec,scc',sce',sec',if '-' `elem` special then "-]" else "]"]+ PAnyNot _ (PatternSet s scc sce sec) ->+ let (special,normal) = maybe ("","") ((partition (`elem` "]-")) . Set.toAscList) s+ charSpec = (if ']' `elem` special then (']':) else id) (byRange normal)+ scc' = maybe "" ((concatMap (\ss -> "[:"++unSCC ss++":]")) . Set.toList) scc+ sce' = maybe "" ((concatMap (\ss -> "[."++unSCE ss++".]")) . Set.toList) sce+ sec' = maybe "" ((concatMap (\ss -> "[="++unSEC ss++"=]")) . Set.toList) sec+ in concat ["[^",charSpec,scc',sce',sec',if '-' `elem` special then "-]" else "]"]+ PEscape _ c -> '\\':c:[]+ PChar _ c -> [c]+ where byRange xAll@(x:xs) | length xAll <=3 = xAll+ | otherwise = groupRange x 1 xs+ byRange _ = undefined+ groupRange x n (y:ys) = if (fromEnum y)-(fromEnum x) == n then groupRange x (succ n) ys+ else (if n <=3 then take n [x..]+ else x:'-':(toEnum (pred n+fromEnum x)):[]) ++ groupRange y 1 ys+ groupRange x n [] = if n <=3 then take n [x..]+ else x:'-':(toEnum (pred n+fromEnum x)):[]+ paren s = ('(':s)++")"++data PatternSet = PatternSet (Maybe (Set Char)) (Maybe (Set (PatternSetCharacterClass)))+ (Maybe (Set PatternSetCollatingElement)) (Maybe (Set PatternSetEquivalenceClass)) deriving (Eq,Show)++newtype PatternSetCharacterClass = PatternSetCharacterClass {unSCC::String} deriving (Eq,Ord,Show) -- [: :]+newtype PatternSetCollatingElement = PatternSetCollatingElement {unSCE::String} deriving (Eq,Ord,Show) -- [. .]+newtype PatternSetEquivalenceClass = PatternSetEquivalenceClass {unSEC::String} deriving (Eq,Ord,Show) -- [= =]++-- | PatternIndex is for indexing submatches from parenthesized groups (PGroup)+type PatternIndex = Int++{-+-- helper function+isPostAtom :: Pattern -> Bool+isPostAtom p = case p of+ PQuest _ -> True+ PPlus _ -> True+ PStar _ -> True+ PBound _ _ _ -> True+ _ -> False+-}+
+ Text/Regex/DFA/ReadRegex.hs view
@@ -0,0 +1,159 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+-- | This is a version of ReadRegex that allows NUL characters.+-- Lazy/Possessive/Backrefs are not recognized. Anchors ^ and $ are+-- now recognized (they used to be errors).+module Text.Regex.DFA.ReadRegex (PatternIndex,parseRegex,decodePatternSet,legalCharacterClasses) where++{- By Chris Kuklewicz, 2006. BSD License, see the LICENSE file. -}++import Text.Regex.DFA.Pattern+import Text.ParserCombinators.Parsec((<|>), (<?>), + unexpected, try, runParser, many, getState, setState, GenParser, ParseError,+ sepBy1, option, notFollowedBy, many1, lookAhead, eof, between,+ string, noneOf, digit, char, anyChar)+import Control.Monad(liftM, when, guard)+import qualified Data.Set as Set(fromList, toList, insert,empty)++-- | BracketElement is internal only+data BracketElement = BEChar Char | BEChars String | BEColl String | BEEquiv String | BEClass String++parseRegex :: String -> Either ParseError (Pattern,(Int,Int))+parseRegex x = runParser (do pat <- p_regex+ eof+ subs <- getState+ return (pat,subs)) (0,0) x x++p_regex :: GenParser Char (PatternIndex,Int) Pattern+p_regex = liftM POr $ sepBy1 p_branch (char '|')++-- man re_format helps alot, it says one-or-more pieces so this is+-- many1 not many. Use "()" to indicate an empty piece.+p_branch = liftM PConcat $ many1 p_piece++p_piece = p_anchor <|> (p_atom >>= p_post_atom) -- XXX variance from specification since regex-dfa can't repeat empty captures yet+-- p_piece = (p_anchor <|> p_atom) >>= p_post_atom -- correct specification++p_atom = p_group <|> p_bracket <|> p_char <?> "an atom"++group_index = do+ (gi,ci) <- getState+ let index = succ gi+ setState (index,ci)+ return index++p_group = lookAhead (char '(') >> do+ index <- group_index+ liftM (PGroup index) $ between (char '(') (char ')') p_regex++-- p_post_atom takes the previous atom as a parameter+p_post_atom atom = (char '?' >> return (PQuest atom))+ <|> (char '+' >> return (PPlus atom))+ <|> (char '*' >> return (PStar atom))+ <|> p_bound atom + <|> return atom++p_bound atom = try $ between (char '{') (char '}') (p_bound_spec atom)++p_bound_spec atom = do lowS <- many1 digit+ let lowI = read lowS+ highMI <- option (Just lowI) $ try $ do + char ','+ highS <- many digit+ if null highS then return Nothing -- no upper bound+ else do let highI = read highS+ guard (lowI <= highI)+ return (Just (read highS))+ return (PBound lowI highMI atom)++-- An anchor cannot be modified by a repetition specifier+p_anchor = (char '^' >> liftM PCarat char_index)+ <|> (char '$' >> liftM PDollar char_index)+ <|> try (do string "()" + index <- group_index+ return $ PGroup index PEmpty) + <?> "empty () or anchor ^ or $"++char_index = do (gi,ci) <- getState+ let ci' = succ ci+ setState (gi,ci')+ return (newDoPa ci')++p_char = p_dot <|> p_left_brace <|> p_escaped <|> p_other_char where+ p_dot = char '.' >> char_index >>= return . PDot+ p_left_brace = try $ (char '{' >> notFollowedBy digit >> char_index >>= return . (`PChar` '{'))+ p_escaped = char '\\' >> anyChar >>= \c -> char_index >>= return . (`PEscape` c)+ p_other_char = noneOf specials >>= \c -> char_index >>= return . (`PChar` c) + specials = "^.[$()|*+?{\\"++-- parse [bar] and [^bar] sets of characters+p_bracket = (char '[') >> ( (char '^' >> p_set True) <|> (p_set False) )++-- p_set does not support [.ch.] or [=y=] or [:foo:]+-- p_set :: Bool -> GenParser Char st Pattern+p_set invert = do initial <- (option "" ((char ']' >> return "]") <|> (char '-' >> return "-")))+ values <- many1 p_set_elem+ char ']'+ ci <- char_index+ let chars = maybe'set $ initial ++ [c | BEChar c <- values ] ++ concat [s | BEChars s <- values ] + colls = maybe'set [PatternSetCollatingElement coll | BEColl coll <- values ]+ equivs = maybe'set [PatternSetEquivalenceClass equiv | BEEquiv equiv <- values]+ class's = maybe'set [PatternSetCharacterClass a'class | BEClass a'class <- values]+ maybe'set x = if null x then Nothing else Just (Set.fromList x)+ sets = PatternSet chars class's colls equivs+ sets `seq` return $ if invert then PAnyNot ci sets else PAny ci sets++-- From here down the code is the parser and functions for pattern [ ] set things++p_set_elem = p_set_elem_class <|> p_set_elem_equiv <|> p_set_elem_coll+ <|> p_set_elem_range <|> p_set_elem_char <?> "Failed to parse bracketed string"++p_set_elem_class = liftM BEClass $+ try (between (string "[:") (string ":]") (many1 $ noneOf ":]"))++p_set_elem_equiv = liftM BEEquiv $+ try (between (string "[=") (string "=]") (many1 $ noneOf "=]"))++p_set_elem_coll = liftM BEColl $+ try (between (string "[.") (string ".]") (many1 $ noneOf ".]"))++p_set_elem_range = try $ do + start <- noneOf "]-"+ char '-'+ end <- noneOf "]"+ return (BEChars [start..end])++p_set_elem_char = do + c <- noneOf "]"+ when (c == '-') $ do+ atEnd <- (lookAhead (char ']') >> return True) <|> (return False)+ when (not atEnd) (unexpected "A dash is in the wrong place in a bracket")+ return (BEChar c)++-- | decodePatternSet cannot handle collating element and treats+-- equivalence classes as just their definition and nothing more.+decodePatternSet (PatternSet msc mscc _ msec) =+ let baseMSC = maybe Set.empty id msc+ withMSCC = foldl (flip Set.insert) baseMSC (maybe [] (concatMap decodeCharacterClass . Set.toList) mscc)+ withMSEC = foldl (flip Set.insert) withMSCC (maybe [] (concatMap unSEC . Set.toList) msec)+ in withMSEC++legalCharacterClasses = ["alnum","digit","punct","alpha","graph"+ ,"space","blank","lower","upper","cntrl","print","xdigit","word"]++decodeCharacterClass (PatternSetCharacterClass s) =+ case s of+ "alnum" -> ['0'..'9']++['a'..'z']++['A'..'Z']+ "digit" -> ['0'..'9']+ "punct" -> ['\33'..'\47']++['\58'..'\64']++['\91'..'\95']++"\96"++['\123'..'\126']+ "alpha" -> ['a'..'z']++['A'..'Z']+ "graph" -> ['\41'..'\126']+ "space" -> "\t\n\v\f\r "+ "blank" -> "\t "+ "lower" -> ['a'..'z']+ "upper" -> ['A'..'Z']+ "cntrl" -> ['\0'..'\31']++"\127" -- with NUL+ "print" -> ['\32'..'\126']+ "xdigit" -> ['0'..'9']++['a'..'f']++['A'..'F']+ "word" -> ['0'..'9']++['a'..'z']++['A'..'Z']++"_"+ _ -> []+
+ Text/Regex/DFA/Sequence.hs view
@@ -0,0 +1,96 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-| +This modules provides 'RegexMaker' and 'RegexLike' instances for using+'Seq Char' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and+"Text.Regex.Lazy.DFAEngine"). This module is usually used via import+"Text.Regex.DFA".++This exports instances of the high level API and the medium level+API of 'compile','execute', and 'regexec'.+-}+module Text.Regex.DFA.Sequence(+ -- ** Types+ Regex+ ,MatchOffset+ ,MatchLength+ ,CompOption+ ,ExecOption+ -- ** Medium level API functions+ ,compile+ ,execute+ ,regexec+ ) where++import Data.Array(listArray,Array,elems,(!))+import Data.Sequence as S+import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchOffset,MatchLength)+import Text.Regex.Base.Impl(polymatch,polymatchM)+import Text.Regex.DFA.EngineSeq(findRegex,matchesRegex,countRegex,accept,toList)+import Text.Regex.DFA.ReadRegex(parseRegex)+import Text.Regex.DFA.Transitions(noLoop)+import Text.Regex.DFA.Wrap(Regex(..),CompOption,ExecOption,makeCompat)++instance RegexContext Regex (Seq Char) (Seq Char) where+ match = polymatch+ matchM = polymatchM++unwrap :: Either String v -> v+unwrap x = case x of Left err -> error ("Text.Regex.DFA.Sequence died: "++ err)+ Right v -> v++compile :: CompOption -- ^ Flags (summed together)+ -> ExecOption -- ^ Flags (summed together)+ -> Seq Char -- ^ The regular expression to compile+ -> Either String Regex -- ^ Returns: the compiled regular expression+compile compOpt execOpt source =+ case parseRegex (toList source) of+ Left err -> Left ("parseRegex for DFA failed:"++show err)+ Right (patternRead,_) ->+ let pattern = noLoop patternRead+ lexer = accept (makeCompat compOpt pattern)+ in Right (Regex pattern lexer compOpt execOpt)++execute :: Regex -- ^ Compiled regular expression+ -> Seq Char -- ^ Seq Char to match against+ -> Either String (Maybe (Array Int (MatchOffset,MatchLength)))+execute r s = Right (matchOnce r s)++regexec :: Regex -- ^ Compiled regular expression+ -> Seq Char -- ^ Seq Char to match against+ -> Either String (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))+regexec r s =+ case matchOnceText r s of+ Nothing -> Right (Nothing)+ Just (pre,mt,post) ->+ let main = fst (mt!0)+ rest = map fst (tail (elems mt)) -- will be []+ in Right (Just (pre,main,post,rest))++instance RegexMaker Regex CompOption ExecOption (Seq Char) where+ makeRegexOpts c e source = unwrap $ compile c e source+ makeRegexOptsM c e source = either fail return $ compile c e source++instance RegexLike Regex (Seq Char) where+ matchOnce r source =+ case findRegex regex source of+ (_,_,Nothing) -> Nothing+ (_,lenBefore, Just (_,lenOf,_)) -> Just $+ listArray (0,0) [(lenBefore,lenOf)]+ where regex = asLexer r++ matchAll r source = loop 0 source+ where loop n s | n `seq` False = undefined+ | otherwise =+ case findRegex regex s of+ (_,_,Nothing) -> []+ (_,lenBefore, Just (_,0,_)) ->+ listArray (0,0) [(n+lenBefore,0)] : []+ (_,lenBefore, Just (_,lenOf,s')) -> + listArray (0,0) [(n+lenBefore,lenOf)] : loop (n+lenBefore+lenOf) s'+ regex = asLexer r++ matchTest r source = matchesRegex regex source+ where regex = asLexer r++ matchCount r source = countRegex regex source+ where regex = asLexer r
+ Text/Regex/DFA/String.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-| +This modules provides 'RegexMaker' and 'RegexLike' instances for using+'String' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and+"Text.Regex.Lazy.DFAEngine"). This module is usually used via import+"Text.Regex.DFA".++This exports instances of the high level API and the medium level+API of 'compile','execute', and 'regexec'.+-}+module Text.Regex.DFA.String(+ -- ** Types+ Regex+ ,MatchOffset+ ,MatchLength+ ,CompOption+ ,ExecOption+ -- ** Medium level API functions+ ,compile+ ,execute+ ,regexec+ ) where++import Data.Array(listArray,Array,elems,(!))+import Text.Regex.DFA.ReadRegex(parseRegex)+import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchOffset,MatchLength)+import Text.Regex.DFA.Wrap(Regex(..),CompOption,ExecOption,makeCompat)+import Text.Regex.DFA.Engine(findRegex,matchesRegex,countRegex,accept)+import Text.Regex.DFA.Transitions(noLoop)+import Text.Regex.Base.Impl(polymatch,polymatchM)++instance RegexContext Regex String String where+ match = polymatch+ matchM = polymatchM++unwrap :: Either String v -> v+unwrap x = case x of Left err -> error ("Text.Regex.Parsec.String died: "++ err)+ Right v -> v++compile :: CompOption -- ^ Flags (summed together)+ -> ExecOption -- ^ Flags (summed together)+ -> String -- ^ The regular expression to compile (ASCII only, no null bytes)+ -> Either String Regex -- ^ Returns: the compiled regular expression+compile compOpt execOpt source =+ case parseRegex source of+ Left err -> Left ("parseRegex for DFA failed:"++show err)+ Right (patternRead,_) ->+ let pattern = noLoop patternRead+ lexer = accept (makeCompat compOpt pattern)+ in Right (Regex pattern lexer compOpt execOpt)++execute :: Regex -- ^ Compiled regular expression+ -> String -- ^ String to match against+ -> Either String (Maybe (Array Int (MatchOffset,MatchLength)))+execute r s = Right (matchOnce r s)++regexec :: Regex -- ^ Compiled regular expression+ -> String -- ^ String to match against+ -> Either String (Maybe (String, String, String, [String]))+regexec r s =+ case matchOnceText r s of+ Nothing -> Right (Nothing)+ Just (pre,mt,post) ->+ let main = fst (mt!0)+ rest = map fst (tail (elems mt)) -- will be []+ in Right (Just (pre,main,post,rest))++instance RegexMaker Regex CompOption ExecOption String where+ makeRegexOpts c e source = unwrap (compile c e source)+ makeRegexOptsM c e source = either fail return (compile c e source)++instance RegexLike Regex String where+ matchOnce r source =+ case findRegex regex source of+ (_,_,Nothing) -> Nothing+ (_,lenBefore, Just (_,lenOf,_)) -> Just $+ listArray (0,0) [(lenBefore,lenOf)]+ where regex = asLexer r++ matchAll r source = loop 0 source+ where loop n s | n `seq` False = undefined+ | otherwise =+ case findRegex regex s of+ (_,_,Nothing) -> []+ (_,lenBefore, Just (_,0,_)) ->+ listArray (0,0) [(n+lenBefore,0)] : []+ (_,lenBefore, Just (_,lenOf,s')) -> + listArray (0,0) [(n+lenBefore,lenOf)] : loop (n+lenBefore+lenOf) s'+ regex = asLexer r++ matchTest r source = matchesRegex regex source+ where regex = asLexer r++ matchCount r source = countRegex regex source+ where regex = asLexer r
+ Text/Regex/DFA/Transitions.hs view
@@ -0,0 +1,362 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-binds #-}+module Text.Regex.DFA.Transitions(noLoop,topNoLoop,starTrans,simplify+ ,canMatchNull,cannotMatchNull,stateAn) where++import Text.Regex.DFA.Pattern+import Control.Monad.Writer+import Control.Monad.State+import Data.Maybe+import Data.List++-- -- -- Transformations on Pattern++-- die fn = error ("Text.Regex.DFA.Transitions "++fn++" failed"++show pIn)++-- | Change a pattern so it will not loop in the DFA construction.+-- Previously have used starTrans on the Pattern. The problems comes+-- from PStar applied to a pattern which may match 0 characters. This+-- *will* return a safe pattern, which can match null if and only if+-- the input pattern could.+noLoop :: Pattern -> Pattern+noLoop = simplify . topNoLoop . simplify . starTrans++-- | topNoLoop descends, looking for PStar, for which it calls+-- breakLoop. This *will* return a safe pattern, which can match null+-- "if" and "only if" the input pattern could.+topNoLoop :: Pattern -> Pattern+topNoLoop pIn =+ case pIn of+ POr ps -> POr (map topNoLoop ps) -- depend on "iff"+ PConcat ps -> PConcat (map topNoLoop ps) -- depend on "iff"+ PStar p -> if cannotMatchNull p+ then PStar (topNoLoop p) -- depend on "only if" to be safe+ else case breakLoop p of+ Nothing -> topNoLoop p -- depend on "if", remove PStar+ Just q -> PStar q -- depend on breakLoop to be safe+ _ -> pIn -- these cannot hide PStar, and so are safe++-- | This is called for patterns that can match null, and which must+-- be changed so they cannot match null. This may fail and return+-- Nothing, or may succeed and return (Just Pattern) which *will* be+-- both safe and unable to match null.+breakLoop :: Pattern -> Maybe Pattern+breakLoop pIn =+ case pIn of+ -- We know at least one of ps canMatchNull. It must be fixed or+ -- removed.+ POr ps -> let act p = if cannotMatchNull p+ then Just (topNoLoop p) -- depend on "only if"+ else breakLoop p -- try to fix this branch+ ps' = mapMaybe act $ ps -- destroy unfixable branches+ -- todo move unfixable branches to parallel position.+ in case ps' of+ [] -> Nothing+ [p] -> Just p+ _ -> Just (POr ps')+ -- We know every one of ps canMatchNull. This will likely+ -- replicate the PConcat into many slightly different branches of+ -- a POr. This is because we only need to fix one of the items in+ -- order to make a good branch.+ PConcat [] -> Nothing -- safe to be destroyed+ PConcat ps -> let act [] = [[]]+ act (q:qs) = let mr = breakLoop q+ rs = map topNoLoop qs+ q' = topNoLoop q+ qs' = act qs+ in case mr of+ Nothing -> map (q':) qs'+ Just r' -> (map (q':) qs') ++ [r':rs]+ -- The first item can match null, but later ones cannot+ -- if *any* nullable piece can be fixed, then this procedure works+ in case tail . map PConcat . act $ ps of+ [] -> Nothing -- all failed. probably not ok if had been simplify'd+ -- todo: return topNoLoop pIn to be moved to parallel position+ [pC] -> Just pC -- one piece was fixed.+ pCs -> Just (POr pCs)+ PStar p -> if cannotMatchNull p+ then let p' = topNoLoop p+ in Just (PConcat [p',PStar p']) -- depend "only if"+ else case breakLoop p of+ Nothing -> Nothing -- FAILED+ Just q -> Just (PConcat [q,PStar q])+ PEmpty -> Nothing+ PCarat {} -> Nothing+ PDollar {} -> Nothing+ _ -> Just pIn -- These cannot match null and so are safe, and cannot hide PStar++-- | starTrans replaces PQuest,PPlus,PBound,PGroup with combinations of+-- PEmpty,POr,PConcat,PStar. Malformed limits on the PBound will be+-- replaced with PEmpty rather than calling error. This will also+-- simplify the resulting Pattern as it works.+starTrans :: Pattern -> Pattern+starTrans = dfsPattern starTrans'++starTrans' :: Pattern -> Pattern+starTrans' pIn =+ case pIn of+ -- Eliminated+ PGroup _ p -> p+ PQuest p -> quest' p+ PPlus p -> PConcat [p,PStar p]+ PBound i _ _ | i<0 -> PEmpty+ PBound i (Just j) _ | i>j -> PEmpty+ PBound i Nothing p -> PConcat $ apply (p:) i [PStar p]+ PBound 0 (Just 0) _ -> PEmpty+ PBound 0 (Just 1) p -> quest' p+ PBound 0 (Just j) p -> apply (quest' . (concat' p)) (pred j) (quest' p)+ PBound i (Just j) p | i == j -> PConcat (replicate i p)+ | otherwise -> PConcat $ apply (p:) i+ [starTrans' $ PBound 0 (Just (j-i)) p]+ -- Left intact+ PEmpty -> pIn+ PStar {} -> pIn+ POr {} -> pIn+ PConcat {} -> pIn+ PCarat {} -> pIn+ PDollar {} -> pIn+ PDot {} -> pIn+ PAny {} -> pIn+ PAnyNot {} -> pIn+ PEscape {} -> pIn+ PChar {} -> pIn+ where+ quest' = (\p -> POr [p,PEmpty])+ concat' a b = PConcat [a,b]+ apply f n x = foldr ($) x (replicate n f)+++simplify :: Pattern -> Pattern+simplify = dfsPattern simplify'+++-- | Apply a Pattern transfomation function depth first+dfsPattern :: (Pattern -> Pattern) -- ^ The transformation function+ -> Pattern -- ^ The Pattern to transform+ -> Pattern -- ^ The transformed Pattern+dfsPattern f = dfs+ where unary c = f . c . dfs+ dfs pattern = case pattern of+ POr ps -> f (POr (map dfs ps))+ PConcat ps -> f (PConcat (map dfs ps))+ PGroup i p -> unary (PGroup i) p+ PQuest p -> unary PQuest p+ PPlus p -> unary PPlus p+ PStar p -> unary PStar p+ PBound i mi p -> unary (PBound i mi) p+ _ -> f pattern++-- | Function to transform a pattern into an equivalent, but less+-- redundant form. Nested 'POr' and 'PConcat' are flattened.+simplify' :: Pattern -> Pattern+simplify' x@(POr _) = + let ps' = case span notPEmpty (flatten x) of+ (notEmpty,[]) -> notEmpty+ (notEmpty,_:rest) -> notEmpty ++ (PEmpty:filter notPEmpty rest) -- keep 1st PEmpty only+ in case ps' of+ [] -> PEmpty+ [p] -> p+ _ -> POr ps'++simplify' x@(PConcat _) =+ let ps' = filter notPEmpty (flatten x)+ in case ps' of+ [] -> PEmpty+ [p] -> p+ _ -> PConcat ps'++simplify' (PBound _ (Just 0) _) = PEmpty+simplify' (PStar PEmpty) = PEmpty+simplify' other = other++-- | Function to flatten nested POr or nested PConcat applicataions.+-- Other patterns are returned unchanged+flatten :: Pattern -> [Pattern]+flatten (POr ps) = (concatMap (\x -> case x of+ POr ps' -> ps'+ p -> [p]) ps)+flatten (PConcat ps) = (concatMap (\x -> case x of+ PConcat ps' -> ps'+ p -> [p]) ps)+flatten _ = error "flatten can only be applied to POr or PConcat"+++notPEmpty :: Pattern -> Bool+notPEmpty PEmpty = False+notPEmpty _ = True++-- -- Analyze Pattern+{-+-- | This provides an unordered list of the PatternIndex values that+-- have back references in the pattern. This does not mean the+-- pattern will have these captured substrings, just that the pattern+-- referes to these indices.+backReferences :: Pattern -> [PatternIndex]+backReferences = foldPattern f []+ where f (PBack x) xs = (x:xs)+ f _ xs = xs+-}++foldPattern :: (Pattern -> a -> a) -> a -> Pattern -> a+foldPattern f = foldP+ where foldP a pIn = let unary p = f pIn (f p a) in+ case pIn of+ POr ps -> f pIn (foldr f a ps)+ PConcat ps -> f pIn (foldr f a ps)+ PGroup _ p -> unary p+ PQuest p -> unary p+ PPlus p -> unary p+ PStar p -> unary p+ PBound _ _ p -> unary p+ _ -> f pIn a++-- | Determines if pIn will always accept [] and never accept any characters+-- Treat PCarat and PDollar as False, since they do not always accept []+alwaysOnlyMatchNull :: Pattern -> Bool+alwaysOnlyMatchNull pIn =+ case pIn of+ PEmpty -> True+ PGroup _ p -> alwaysOnlyMatchNull p+ POr [] -> True+ POr ps -> all alwaysOnlyMatchNull ps+ PConcat [] -> True+ PConcat ps -> all alwaysOnlyMatchNull ps+ PQuest p -> alwaysOnlyMatchNull p+ PPlus p -> alwaysOnlyMatchNull p+ PStar p -> alwaysOnlyMatchNull p+ PBound _ (Just 0) _ -> True+ PBound _ _ p -> alwaysOnlyMatchNull p+ PCarat _ -> False+ PDollar _ -> False+ _ ->False++canMatchNull,cannotMatchNull :: Pattern -> Bool+canMatchNull = not . cannotMatchNull++-- | If 'cannotMatchNull' returns 'True' then it is known that the+-- 'Pattern' will never accept an empty string. If 'cannotMatchNull'+-- returns 'False' then it is possible but not definite that the+-- 'Pattern' could accept an empty string.+cannotMatchNull pIn =+ case pIn of+ PEmpty -> False+ PGroup _ p -> cannotMatchNull p+ POr [] -> False+ POr ps -> all cannotMatchNull ps+ PConcat [] -> False+ PConcat ps -> any cannotMatchNull ps+ PQuest _ -> False+ PPlus p -> cannotMatchNull p+ PStar _ -> False+ PBound 0 _ _ -> False+ PBound _ _ p -> cannotMatchNull p+ PCarat _ -> False+ PDollar _ -> False+ _ -> True++-- | Determines if pIn is always anchored at the front with PCarat+hasFrontCarat,hasBackDollar::Pattern -> Bool+hasFrontCarat pIn =+ case pIn of+ PCarat _ -> True+ POr [] -> False+ POr ps -> all hasFrontCarat ps+ PConcat [] -> False+ PConcat ps -> case dropWhile alwaysOnlyMatchNull ps of+ [] -> False+ (p:_) -> hasFrontCarat p+ _ -> False++-- | Determines if pIn is always anchored at the back with PDollar+hasBackDollar pIn =+ case pIn of+ PDollar _ -> True+ POr [] -> False+ POr ps -> all hasBackDollar ps+ PConcat [] -> False+ PConcat ps -> case dropWhile alwaysOnlyMatchNull (reverse ps) of+ [] -> False+ (p:_) -> hasBackDollar p+ _ -> False++-- | I did this overly cleverly. It descends the Pattern depth first+-- and computes what is nullable along with creating id numbers for+-- the DFA states. This works, but amusingly required mdo. The main+-- output is funnel out via the tell to the WriterT and is the NFA+-- state before, the DoPa index of the transition character,+stateAn :: Pattern -> [(Int,DoPa,Int)]+stateAn pIn = evalState (execWriterT (descend1 0 pIn)) 0++uniq :: WriterT [(Int,DoPa,Int)] (State Int) Int+uniq = do+ s <- get+ let s' = succ s+ put $! s'+ return s'++descend1 :: Int -> Pattern -> WriterT [(Int,DoPa,Int)] (State Int) (Bool,Int)+descend1 a pIn =+ case pIn of+ PEmpty -> return (True,a)+ PGroup _ p -> descend1 a p+ POr ps -> mdo foo <- mapM (descend2 a b) ps+ let n = any fst foo+ b <- if n then return a else uniq+ return (n,b)+ PConcat [] -> return (True,a)+ PConcat (p:ps) -> mdo foo <- descend2 a b p+ let n = fst foo+ b <- if n then return a else uniq+ rest <- descend1 b (PConcat ps)+ return (n && fst rest,snd rest)+ PStar p -> do descend2 a a p+ return (True,a)+ PCarat _ -> return (True,a)+ PDollar _ -> return (True,a)+ PDot d -> one d+ PAny d _ -> one d+ PAnyNot d _ -> one d+ PEscape d _ -> one d+ PChar d _ -> one d+ _ -> undefined+ where one d = do b <- uniq+ tell [(a,d,b)]+ return (False,b)++descend2 :: Int -> Int -> Pattern -> WriterT [(Int,DoPa,Int)] (State Int) (Bool,Int)+descend2 a b pIn =+ case pIn of+ PEmpty -> return (True,b)+ PGroup _ p -> descend2 a b p+ POr ps -> mdo foo <- mapM (descend2 a b) ps+ let n = any fst foo+ return (n,b)+ PConcat [] -> return (True,b)+ PConcat (p:ps) -> mdo foo <- descend2 a c1 p+ let n1 = fst foo+ c1 <- if n1 then return a else uniq+ rest <- descend2 c1 b (PConcat ps)+ let n2 = fst rest+ return (n1 && n2,snd rest)+{-+ PConcat (p:ps) -> mdo foo <- descend2 a c p+ let n1 = fst foo+ rest <- descend2 c b (PConcat ps)+ let n2 = fst rest+ c <- if n1 then return a+ else if n2 then return b+ else uniq+ return (n1 && n2,snd rest)+-}+ PStar p -> do descend2 a a p+ return (True,b)+ PCarat _ -> return (True,b)+ PDollar _ -> return (True,b)+ PDot d -> one d+ PAny d _ -> one d+ PAnyNot d _ -> one d+ PEscape d _ -> one d+ PChar d _ -> one d+ _ -> undefined+ where one d = do tell [(a,d,b)]+ return (False,b)+
+ Text/Regex/DFA/Wrap.hs view
@@ -0,0 +1,108 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}+{-|+The "Text.Regex.Lib.WrapDFAEngine" provides the backend for+"Text.Regex.DFA". This provides the 'Regex' type and 'RegexOptions'+instance for them, and 'RegexMaker' instances for 'String' and 'ByteString'.++Details on the DFA engine can be found in "Text.Regex.DFA" and license+information in "Text.Regex.Lazy.DFAEngine".+-}+module Text.Regex.DFA.Wrap(Regex(..),CompOption(..),ExecOption(..),(=~),(=~~),makeCompat) where++import Text.Regex.Base.RegexLike(RegexMaker(..),RegexOptions(..),RegexContext(..))+import Text.Regex.DFA.Common(CompOption(..),ExecOption(..))+import Text.Regex.DFA.Engine+import Text.Regex.DFA.Pattern+import Text.Regex.DFA.ReadRegex(decodePatternSet)+import Data.Char(toUpper,toLower)+import Data.List(nub,sort)+import qualified Data.Set as Set(toList)++-- | The DFA backend specific 'Regex' type, used by this module's '=~'+-- and '=~~' operators.+data Regex = Regex {asPattern::Pattern+ ,asLexer::Lexer+ ,compOptions::CompOption+ ,execOptions::ExecOption}++instance RegexOptions Regex CompOption ExecOption where+ blankCompOpt = CompOption {caseSensitive = True,multiline = True}+ blankExecOpt = ExecOption+ defaultCompOpt = CompOption {caseSensitive = True,multiline = True}+ defaultExecOpt = ExecOption+ setExecOpts e r = r {execOptions=e}+ getExecOpts r = execOptions r++-- | This is the pure functional matching operator. If the target+-- cannot be produced then some empty result will be returned. If+-- there is an error in processing, then 'error' will be called.+(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)+ => source1 -> source -> target+(=~) x r = let q :: Regex+ q = makeRegex r+ in match q x++-- | This is the monadic matching operator. If a single match fails,+-- then 'fail' will be called.+(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m)+ => source1 -> source -> m target+(=~~) x r = do (q::Regex) <- makeRegexM r+ matchM q x++-- | If ('dfaClean' pat) is True then ('makeCompat' pat) should not throw+-- an error. This translates a 'Pattern' into a DFA 'Regex'+makeCompat :: CompOption -> Pattern -> Regexp+makeCompat c pIn = makeCompatCont c pIn emptyOp++makeCompatCont :: CompOption -> Pattern -> Regexp -> Regexp+makeCompatCont CompOption {caseSensitive = caseOpt, multiline = lineOpt} = reflect+ where+ reflect :: Pattern -> Regexp -> Regexp+ reflect pIn cont =+ case pIn of+--+-- This first set of cases do not actually accept characters+-- + PEmpty -> cont+ PGroup _ p -> reflect p cont+ POr [] -> cont+ POr ps -> orRE (map (\p->reflect p cont) ps)+ PConcat [] -> cont+ PConcat ps -> foldr ($) cont (map reflect ps)+ PQuest p -> quest (reflect p emptyOp) cont+ PPlus p -> plus (reflect p emptyOp) cont+ PStar p -> star (reflect p emptyOp) cont+ -- Handle PBound by reduction to simpler Pattern forms+ PBound 0 Nothing p -> reflect (PStar p) cont+ PBound i Nothing p | 0<i -> reflect (PConcat ((replicate i p)++[PStar p])) cont+ | otherwise -> die+ PBound 0 (Just 0) _ -> cont+ PBound 0 (Just 1) p -> reflect (PQuest p) cont+ PBound 0 (Just j) p | j>1 -> reflect (PQuest (PConcat [p,PBound 0 (Just (pred j)) p])) cont+ | otherwise -> die+ PBound i (Just j) p | 0<i && i == j -> reflect (PConcat (replicate i p)) cont+ | 0<i && i < j -> reflect (PConcat ((replicate i p)++[PBound 0 (Just (j-i)) p])) cont+ | otherwise -> die+-- Predicates+ PCarat i -> (if lineOpt then beginLine i else beginInput i) +> cont+ PDollar i -> (if lineOpt then endLine i else endInput i) +> cont+--+-- From here down are the patterns that actually accept characters+--+ PDot i -> (if lineOpt then altNot i ['\n'] else allChar i) +> cont+ PAny i patset -> let chars = charCases . Set.toList . decodePatternSet $ patset+ in alt i chars +> cont+ PAnyNot i patset -> let chars = charCases . Set.toList . decodePatternSet $ patset+ in altNot i chars +> cont+ PEscape i c -> charOrAlt i c +> cont+ PChar i c -> charOrAlt i c +> cont+ where+ die = error ("Text.Regex.DFA.Wrap makeCompatCont failed: show pIn")+ charOrAlt i c = if caseOpt || (toUpper c == toLower c)+ then char i c+ else alt i [toLower c,toUpper c]+ charCases cs = if caseOpt+ then cs+ else let chars'up = map toUpper cs+ chars'down = map toLower cs+ in nub . sort $ (chars'up ++ chars'down)
+ regex-dfa.cabal view
@@ -0,0 +1,52 @@+Name: regex-dfa+Version: 0.91+-- Cabal-Version: >=1.1.4+License: BSD3+License-File: LICENSE+Copyright: Copyright (c) 2006, Christopher Kuklewicz+Author: Christopher Kuklewicz+Maintainer: TextRegexLazy@personal.mightyreason.com+Stability: Seems to work, passes a few tests+Homepage: http://sourceforge.net/projects/lazy-regex+Package-URL: http://darcs.haskell.org/packages/regex-unstable/regex-dfa+Synopsis: Replaces/Enhances Text.Regex+Description: The lazy DFA engine, based on CTKLight, for regex-base+Category: Text+Tested-With: GHC+Build-Depends: regex-base >= 0.80, base >= 2.0, parsec, mtl+-- Data-Files:+-- Extra-Source-Files:+-- Extra-Tmp-Files:+-- This is the library+Exposed-Modules: Text.Regex.DFA+ Text.Regex.DFA.Common+ Text.Regex.DFA.Wrap+ Text.Regex.DFA.String+ Text.Regex.DFA.Sequence+ Text.Regex.DFA.ByteString+ Text.Regex.DFA.ByteString.Lazy+ Text.Regex.DFA.Engine+ Text.Regex.DFA.EngineSeq+ Text.Regex.DFA.EngineFPS+ Text.Regex.DFA.ByteString.EngineFPS+ Text.Regex.DFA.Pattern+ Text.Regex.DFA.ReadRegex+ Text.Regex.DFA.Transitions+Buildable: True+-- Other-Modules:+-- HS-Source-Dirs: "."+Extensions: MultiParamTypeClasses, FunctionalDependencies+-- GHC-Options: -Wall+GHC-Options: -Wall -Werror -O2+-- GHC-Options: -Wall -ddump-minimal-imports+-- GHC-Prof-Options: +-- Hugs-Options:+-- NHC-Options:+-- Includes:+-- Include-Dirs:+-- C-Sources:+-- Extra-Libraries:+-- Extra-Lib-Dirs:+-- CC-Options:+-- LD-Options:+-- Frameworks: