diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -28,3 +28,8 @@ * Amended 'regexdot.cabal' to more correctly specify dependency on package 'toolshed'. * Used new module "ToolShed.Pair" from package toolshed-0.12.0.0. * Guarded 'eager-blackholing' flag in cabal file. +0.11.0.0 + * Replaced '(+ 1)' and '(- 1)' with the faster calls 'succ' and 'pred', in "RegExDot.RegEx". + * Reacted to new module-hierarchy, creation of new module "ToolShed.Data.List.Splits" and addition of method 'ToolShed.SelfValidate.getErrors', in toolshed-0.13.0.0, and used it to improved error-reporting in @instance Read RegExDot.RegEx.ExtendedRegEx@. + * Minor reworking of 'RegExDot.Repeatable.repeatableParser'. + * Replaced "System" with "System.Environment" and "System.Exit". diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -1,18 +1,18 @@ # Copyright (C) 2010 Dr. Alistair Ward -# +# # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. -# +# # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program. If not, see . - + .PHONY: all build check clean configure copy haddock help hlint install prof sdist all: install @@ -40,7 +40,7 @@ PATH=~/.cabal/bin:$$PATH runhaskell Setup.hs $@ --hyperlink-source #Amend path to find 'HsColour', as required for 'hyperlink-source'. hlint: - @$@ src/ + @$@ -i 'Use &&' src/ -i 'Use ||' sdist: configure runhaskell Setup.hs $@ @@ -50,7 +50,7 @@ clean: runhaskell Setup.hs $@ - find src -type f \( -name '*.o' -o -name '*.hi' \) -delete + find src -type f \( -name '*.hc' -o -name '*.hcr' -o -name '*.hi' -o -name '*.o' \) -delete help: @grep '^[a-zA-Z].*:' makefile | sed -e 's/:.*//' diff --git a/regexdot.cabal b/regexdot.cabal --- a/regexdot.cabal +++ b/regexdot.cabal @@ -1,6 +1,6 @@ --Package-properties Name: regexdot -Version: 0.10.2.2 +Version: 0.11.0.0 Cabal-Version: >= 1.6 Copyright: (C) 2010 Dr. Alistair Ward License: GPL @@ -58,10 +58,14 @@ Build-depends: base == 4.*, parsec == 3.*, - toolshed >= 0.12 + toolshed == 0.13.* GHC-options: -Wall -O2 - GHC-prof-options: -prof -auto-all -caf-all + + if impl(ghc >= 7.4.1) + GHC-prof-options: -prof -fprof-auto -fprof-cafs + else + GHC-prof-options: -prof -auto-all -caf-all if flag(haveDeepSeq) Build-depends: deepseq >= 1.1 diff --git a/src/RegExDot/BracketExpression.hs b/src/RegExDot/BracketExpression.hs --- a/src/RegExDot/BracketExpression.hs +++ b/src/RegExDot/BracketExpression.hs @@ -42,7 +42,7 @@ -- | A /Bracket-expression/ consists of a list of 'BracketExpressionMember.Member's. type BracketExpression m = [BracketExpressionMember.Member m] --- | 'True' if the specified datum matches any 'BracketExpressionMember.Member' of the 'BracketExpression'. +-- | True if the specified datum matches any 'BracketExpressionMember.Member' of the 'BracketExpression'. containsMatch :: Eq m => m -- ^ The input datum. -> BracketExpression m -- ^ The list of bracket-expression members within which to find a match. diff --git a/src/RegExDot/CompilationOptions.hs b/src/RegExDot/CompilationOptions.hs --- a/src/RegExDot/CompilationOptions.hs +++ b/src/RegExDot/CompilationOptions.hs @@ -32,17 +32,17 @@ CompilationOptions(..) ) where -import qualified ToolShed.Defaultable as Defaultable -import qualified ToolShed.Options as Options +import qualified ToolShed.Defaultable +import qualified ToolShed.Options -- | The switch(es) used to control compilation of the /regex/-engine. data CompilationOptions = MkCompilationOptions { complyStrictlyWithPosix :: Bool -- ^ Define the offset of captured data, corresponding to a sub-expression which matched zero times, as the artificial value @-1@ specified by POSIX. } deriving (Eq, Show) -instance Defaultable.Defaultable CompilationOptions where - defaultValue = Options.blankValue { complyStrictlyWithPosix = True } +instance ToolShed.Defaultable.Defaultable CompilationOptions where + defaultValue = ToolShed.Options.blankValue { complyStrictlyWithPosix = True } -instance Options.Options CompilationOptions where +instance ToolShed.Options.Options CompilationOptions where blankValue = MkCompilationOptions { complyStrictlyWithPosix = undefined } diff --git a/src/RegExDot/ConsumptionProfile.hs b/src/RegExDot/ConsumptionProfile.hs --- a/src/RegExDot/ConsumptionProfile.hs +++ b/src/RegExDot/ConsumptionProfile.hs @@ -45,7 +45,7 @@ import Control.Applicative((<$>), (<*>)) import qualified Data.List import qualified RegExDot.ConsumptionBounds as ConsumptionBounds -import qualified ToolShed.SelfValidate as SelfValidate +import qualified ToolShed.SelfValidate infixr 5 |+| --Same as (++). infixr 2 <> --Same as (||). @@ -61,31 +61,34 @@ canConsumeAnything :: Bool -- ^ Whether at least one arbitrary input datum can be consumed. } deriving (Eq, Read, Show) -instance SelfValidate.SelfValidator ConsumptionProfile where - isValid c@( +instance ToolShed.SelfValidate.SelfValidator ConsumptionProfile where + getErrors c@( MkConsumptionProfile { consumptionBounds = (fewest, most), hasSpecificRequirement = hasSpecificRequirement', canConsumeAnything = canConsumeAnything' } - ) = and [ - fewest >= 0, - case most of - Nothing -> True - Just m -> m >= fewest, - or [c == zero, hasSpecificRequirement', canConsumeAnything'] + ) = ToolShed.SelfValidate.extractErrors [ + (fewest < 0, "Negative fewest=" ++ show fewest ++ "."), + ( + case most of + Just m -> m < fewest + _ -> False, + "Invalid 'most'; " ++ show c ++ "." + ), + (not $ or [c == zero, hasSpecificRequirement', canConsumeAnything'], "Invalid " ++ show c ++ ".") ] {- --- | 'True' if there's no choice in the quantity of data to consume. +-- | True if there's no choice in the quantity of data to consume. isPrecise :: ConsumptionProfile -> Bool isPrecise = ConsumptionBounds.isPrecise . consumptionBounds -} -- | Predicate, which is 'True' if the specified data-length, falls within the specified 'ConsumptionBounds.ConsumptionBounds'. -withinConsumptionBounds :: - ConsumptionBounds.DataLength -- ^ The actual quantity of data consumed. - -> ConsumptionProfile -- ^ The bounds within which data-consumption is required to fall. +withinConsumptionBounds + :: ConsumptionBounds.DataLength -- ^ The actual quantity of data consumed. + -> ConsumptionProfile -- ^ The bounds within which data-consumption is required to fall. -> Bool withinConsumptionBounds dataLength MkConsumptionProfile { consumptionBounds = (minConsumption, maxConsumption) diff --git a/src/RegExDot/DSL.hs b/src/RegExDot/DSL.hs --- a/src/RegExDot/DSL.hs +++ b/src/RegExDot/DSL.hs @@ -106,8 +106,8 @@ * Accounts for the unusual requirement to place an 'Anchor.Stern' at the start of the 'RegEx.Concatenation', or an 'Anchor.Bow' at the end. -} -(<~>) :: - (Maybe Anchor.Anchor, Maybe Anchor.Anchor) -- ^ A specification for the anchors required around the expression. +(<~>) + :: (Maybe Anchor.Anchor, Maybe Anchor.Anchor) -- ^ A specification for the anchors required around the expression. -> RegEx.Concatenation a -- ^ The bare list of repeatable patterns to anchor. -> RegEx.ExtendedRegEx a -- ^ The completed regex. (bow, stern) <~> concatenation = RegEx.MkExtendedRegEx { diff --git a/src/RegExDot/DataSpan.hs b/src/RegExDot/DataSpan.hs --- a/src/RegExDot/DataSpan.hs +++ b/src/RegExDot/DataSpan.hs @@ -54,8 +54,8 @@ * Expects a gap-free, sorted list. -} -join :: - ConsumptionBounds.DataLength -- ^ The offset at which the concatenated match is considered to have occurred. +join + :: ConsumptionBounds.DataLength -- ^ The offset at which the concatenated match is considered to have occurred. -> [DataSpan a] -- ^ The list to be concatenated. -> DataSpan a join offset = (concat *** Span.join offset) . unzip diff --git a/src/RegExDot/DataSpanTree.hs b/src/RegExDot/DataSpanTree.hs --- a/src/RegExDot/DataSpanTree.hs +++ b/src/RegExDot/DataSpanTree.hs @@ -53,8 +53,8 @@ toDataSpan (_, inputDataOffset, inputData) = (inputData, (inputDataOffset, length inputData)) -- | Condenses a 'DataSpanTreeList's into a list of 'DataSpan.DataSpan's, using 'DataSpan.join'. -flattenTreeList :: - ConsumptionBounds.DataLength -- ^ The offset into the input-data at which a match occurred. +flattenTreeList + :: ConsumptionBounds.DataLength -- ^ The offset into the input-data at which a match occurred. -> DataSpanTreeList a -- ^ The tree to flatten. -> [DataSpan.DataSpan a] flattenTreeList _ [] = [] @@ -87,8 +87,8 @@ @ I consider this a poor convention, resulting from the focus of POSIX on C, which makes subsequent calculation from the list of 'DataSpan's difficult & error-prone. -} -extractCaptureGroups :: - Bool -- ^ Whether to strictly comply with /POSIX/. +extractCaptureGroups + :: Bool -- ^ Whether to strictly comply with /POSIX/. -> DataSpanTreeList a -- ^ The tree-structure from which to extract the capture-groups. -> [DataSpan.DataSpan a] extractCaptureGroups complyStrictlyWithPosix = extractCaptureGroups' 0 where diff --git a/src/RegExDot/ExecutionOptions.hs b/src/RegExDot/ExecutionOptions.hs --- a/src/RegExDot/ExecutionOptions.hs +++ b/src/RegExDot/ExecutionOptions.hs @@ -35,8 +35,8 @@ setVerbose ) where -import qualified ToolShed.Defaultable as Defaultable -import qualified ToolShed.Options as Options +import qualified ToolShed.Defaultable +import qualified ToolShed.Options -- | The switches used to control execution of the /regex/-engine. data ExecutionOptions = MkExecutionOptions { @@ -57,8 +57,8 @@ validateMinConsumptionOfAlternatives :: Bool -- ^ When the number of repetitions of a /RegExDot.RegEx.CaptureGroup/ is precisely specified, check whether the resulting minimum data-requirement is available. } deriving (Eq, Show) -instance Defaultable.Defaultable ExecutionOptions where - defaultValue = setVerbose False $ Options.blankValue { +instance ToolShed.Defaultable.Defaultable ExecutionOptions where + defaultValue = setVerbose False $ ToolShed.Options.blankValue { abortTrialRepetitionsOnInherentFailure = True, --Regrettably, this slightly reduces performance for most non-pathological patterns. catchIncompatibleAnchors = True, checkExistenceOfInelasticTail = True, @@ -72,7 +72,7 @@ validateMinConsumptionOfAlternatives = False --The cost outweighs the small infrequent dividend. } -instance Options.Options ExecutionOptions where +instance ToolShed.Options.Options ExecutionOptions where blankValue = MkExecutionOptions { abortTrialRepetitionsOnInherentFailure = undefined, abortTrialRepetitionsOnZeroConsumption = undefined, diff --git a/src/RegExDot/Meta.hs b/src/RegExDot/Meta.hs --- a/src/RegExDot/Meta.hs +++ b/src/RegExDot/Meta.hs @@ -53,7 +53,7 @@ import qualified RegExDot.Consumer as Consumer import qualified RegExDot.ConsumptionProfile as ConsumptionProfile import qualified RegExDot.ShowablePredicate as ShowablePredicate -import qualified ToolShed.SelfValidate as SelfValidate +import qualified ToolShed.SelfValidate #ifdef HAVE_DEEPSEQ import Control.DeepSeq(NFData, rnf) @@ -83,8 +83,8 @@ -- Show --Specialised below. ) -instance SelfValidate.SelfValidator (Meta m) where - isValid _ = True +instance ToolShed.SelfValidate.SelfValidator (Meta m) where + getErrors _ = [] instance Show m => Show (Meta m) where showsPrec _ Any = showChar anyToken @@ -99,9 +99,9 @@ readsPrec _ ('\t' : s) = reads s --Consume white-space. readsPrec _ ('.' : s) = [(Any, s)] readsPrec _ ('[' : '^' : noneOf) = Control.Arrow.first NoneOf `map` reads (fst BracketExpression.delimiterTokens : noneOf) {-Reconstruct without negation, & recurse-} - readsPrec _ anyOf@('[' : _) = Control.Arrow.first AnyOf `map` reads anyOf + readsPrec _ anyOf@('[' : _) = Control.Arrow.first AnyOf `map` reads anyOf {-singleton-} readsPrec _ ('\\' : c : s) = [(expand c, s)] - readsPrec _ literal = Control.Arrow.first Literal `map` reads literal + readsPrec _ literal = Control.Arrow.first Literal `map` reads literal {-singleton-} instance Consumer.Consumer (Meta m) where consumptionProfile meta = let @@ -125,7 +125,7 @@ rnf (NoneOf bracketExpression) = rnf bracketExpression rnf (Predicate showablePredicate) = rnf showablePredicate --- | 'True' if the specified datum matches. +-- | True if the specified datum matches. isMatch :: Eq m => m -- ^ The input datum. -> Meta m -- ^ The meta-entity against which the input datum is to be matched. diff --git a/src/RegExDot/RegEx.hs b/src/RegExDot/RegEx.hs --- a/src/RegExDot/RegEx.hs +++ b/src/RegExDot/RegEx.hs @@ -180,7 +180,6 @@ import Control.Applicative((<$>)) import Control.Arrow((&&&)) -import RegExDot.Repeatable((^#->)) import qualified Control.Arrow import qualified Data.Char import qualified Data.Foldable @@ -195,9 +194,11 @@ import qualified RegExDot.Meta as Meta import qualified RegExDot.RegExOpts as RegExOpts import qualified RegExDot.Repeatable as Repeatable +import RegExDot.Repeatable((^#->)) import qualified RegExDot.Tree as Tree -import qualified ToolShed.ListPlus as ListPlus -import qualified ToolShed.SelfValidate as SelfValidate +import qualified ToolShed.Data.List +import qualified ToolShed.Data.List.Splits +import qualified ToolShed.SelfValidate #if MIN_VERSION_parallel(3,0,0) import qualified Control.Parallel.Strategies @@ -234,8 +235,8 @@ deconstructAlternatives (MkAlternatives extendedRegExList) = extendedRegExList -- | Similar to 'fmap', but operates on ['ExtendedRegEx'], rather than just @a@. -transformAlternatives :: - ([ExtendedRegEx m] -> [ExtendedRegEx m]) -- ^ The transformation function to apply to the list of data behind the constructor. +transformAlternatives + :: ([ExtendedRegEx m] -> [ExtendedRegEx m]) -- ^ The transformation function to apply to the list of data behind the constructor. -> Alternatives m -> Alternatives m transformAlternatives f = MkAlternatives . f . deconstructAlternatives @@ -245,7 +246,7 @@ readsPrec _ ('\t' : s) = reads s --Consume white-space. readsPrec _ s = case reads s of [(extendedRegEx, s1)] -> case dropWhile Data.Char.isSpace s1 of - ('|' : s2) -> Control.Arrow.first (transformAlternatives (extendedRegEx :)) `map` reads s2 + ('|' : s2) -> Control.Arrow.first (transformAlternatives (extendedRegEx :)) `map` reads s2 {-singleton-} _ -> [(MkAlternatives [extendedRegEx], s1)] _ -> [] --No parse. @@ -256,8 +257,8 @@ consumptionProfile = Consumer.aggregateConsumptionProfilesFromAlternatives . deconstructAlternatives starHeight = Consumer.starHeight . deconstructAlternatives --Must evaluate all Alternatives to determine best. -instance SelfValidate.SelfValidator (Alternatives m) where - isValid = SelfValidate.isValid . deconstructAlternatives +instance ToolShed.SelfValidate.SelfValidator (Alternatives m) where + getErrors = ToolShed.SelfValidate.getErrors . deconstructAlternatives instance NFData m => NFData (Alternatives m) where rnf = rnf . deconstructAlternatives @@ -314,9 +315,9 @@ starHeight (Require meta) = Consumer.starHeight meta starHeight (CaptureGroup alternatives) = Consumer.starHeight alternatives -instance SelfValidate.SelfValidator (Pattern m) where - isValid (Require meta) = SelfValidate.isValid meta - isValid (CaptureGroup alternatives) = SelfValidate.isValid alternatives +instance ToolShed.SelfValidate.SelfValidator (Pattern m) where + getErrors (Require meta) = ToolShed.SelfValidate.getErrors meta + getErrors (CaptureGroup alternatives) = ToolShed.SelfValidate.getErrors alternatives instance NFData m => NFData (Pattern m) where rnf (Require meta) = rnf meta @@ -326,7 +327,7 @@ captureGroup :: [ExtendedRegEx m] -> Pattern m captureGroup = CaptureGroup . MkAlternatives --- | 'True' if the 'Pattern' was constructed via 'CaptureGroup'. +-- | True if the 'Pattern' was constructed via 'CaptureGroup'. isCaptureGroup :: Pattern m -> Bool isCaptureGroup (CaptureGroup _) = True isCaptureGroup _ = False @@ -345,8 +346,8 @@ type RepeatablePattern m = Repeatable.Repeatable (Pattern m) -- | Construct a null 'Match' by assuming that the specified 'RepeatablePattern' consumes zero 'InputData'; of which the caller should ensure it's capable. -mkNullMatchFromRepeatablePattern :: - ConsumptionBounds.DataLength -- ^ The offset into the list of input data at which the zero-length match occurred. +mkNullMatchFromRepeatablePattern + :: ConsumptionBounds.DataLength -- ^ The offset into the list of input data at which the zero-length match occurred. -> RepeatablePattern m -- ^ The pattern that the input data matched. -> Match m -- ^ The resulting match-structure. mkNullMatchFromRepeatablePattern offset r = case Repeatable.base r of @@ -377,8 +378,8 @@ type Concatenation m = [RepeatablePattern m] -- | Construct a null 'Match' by assuming that the specified 'Concatenation' consumes zero 'InputData'. -mkNullMatchFromConcatenation :: - ConsumptionBounds.DataLength -- ^ The offset into the list of input data at which the zero-length match occurred. +mkNullMatchFromConcatenation + :: ConsumptionBounds.DataLength -- ^ The offset into the list of input data at which the zero-length match occurred. -> Concatenation m -- ^ The list of repeatable patterns that the input data matched. -> MatchList m -- ^ The resulting match-structure. mkNullMatchFromConcatenation offset = map $ mkNullMatchFromRepeatablePattern offset @@ -402,8 +403,8 @@ type Transformation m = ExtendedRegEx m -> ExtendedRegEx m -- | Similar to 'fmap', but operates on 'Concatenation', rather than just @a@. -transformExtendedRegEx :: - (Concatenation m -> Concatenation m) -- ^ The function used to transform the data behind the constructor. +transformExtendedRegEx + :: (Concatenation m -> Concatenation m) -- ^ The function used to transform the data behind the constructor. -> Transformation m transformExtendedRegEx f extendedRegEx = extendedRegEx { concatenation = f $ concatenation extendedRegEx } @@ -412,24 +413,30 @@ readsPrec _ (' ' : s) = reads s --Consume white-space. readsPrec _ ('\t' : s) = reads s --Consume white-space. readsPrec _ ('\\' : c : s) = [(expand c, s)] - readsPrec _ s = (SelfValidate.isValid . fst) `filter` [ - ( - MkExtendedRegEx { - bowAnchor = maybeBowAnchor, - concatenation = concatenation', - sternAnchor = maybeSternAnchor - }, - remainder - ) | - (maybeBowAnchor, s1) <- readsMaybeAnchor s, - (concatenation', s2) <- reads s1, - (maybeSternAnchor, remainder) <- readsMaybeAnchor s2 - - ] where - readsMaybeAnchor :: ReadS (Maybe Anchor.Anchor) - readsMaybeAnchor s' = return {-to List-monad-} $ case reads s' of - [pair] -> Control.Arrow.first Just pair - _ -> (Nothing, s') + readsPrec _ s = case singleton of + [(extendedRegEx, _)] + | ToolShed.SelfValidate.isValid extendedRegEx -> singleton + | otherwise -> error $ ToolShed.SelfValidate.getFirstError extendedRegEx --Parsed OK, but invalid. + _ -> [] --No parse. + where +-- singleton :: (ShortcutExpander m, Meta.ShortcutExpander m, Eq m, Read m) => [(ExtendedRegEx m, String)] + singleton = [ + ( + MkExtendedRegEx { + bowAnchor = maybeBowAnchor, + concatenation = concatenation', + sternAnchor = maybeSternAnchor + }, + remainder + ) | + (maybeBowAnchor, s1) <- readsMaybeAnchor s, + (concatenation', s2) <- reads s1, + (maybeSternAnchor, remainder) <- readsMaybeAnchor s2 + ] where + readsMaybeAnchor :: ReadS (Maybe Anchor.Anchor) + readsMaybeAnchor s' = return {-to List-monad-} $ case reads s' of + [pair] -> Control.Arrow.first Just pair + _ -> (Nothing, s') -- | Shows either the specified 'Anchor.Anchor', or a null string where 'Nothing' is specified. showsMaybeAnchor :: Maybe Anchor.Anchor -> String -> String @@ -448,8 +455,8 @@ consumptionProfile = Consumer.aggregateConsumptionProfilesFromConcatenation . concatenation starHeight = Consumer.starHeight . concatenation -instance SelfValidate.SelfValidator (ExtendedRegEx m) where - isValid = SelfValidate.isValid {-delegate-} . concatenation --NB: null 'Concatenation' is OK. +instance ToolShed.SelfValidate.SelfValidator (ExtendedRegEx m) where + getErrors = ToolShed.SelfValidate.getErrors . concatenation instance NFData m => NFData (ExtendedRegEx m) where rnf MkExtendedRegEx { @@ -475,15 +482,15 @@ ) ) extendedRegEx --- | 'True' if the specified 'ExtendedRegEx' has an initial 'Anchor.Bow'. CAVEAT: though typically the alternative is no 'Anchor.Anchor', there may perversely be an initial 'Anchor.Stern', but neither qualify. +-- | True if the specified 'ExtendedRegEx' has an initial 'Anchor.Bow'. CAVEAT: though typically the alternative is no 'Anchor.Anchor', there may perversely be an initial 'Anchor.Stern', but neither qualify. hasBowAnchor :: ExtendedRegEx m -> Bool hasBowAnchor = (== Just Anchor.Bow) . bowAnchor --- | 'True' if the specified 'ExtendedRegEx' has a terminal 'Anchor.Stern'. CAVEAT: though typically the alternative is no 'Anchor.Anchor', there may perversely be a terminal 'Anchor.Bow', but neither qualify. +-- | True if the specified 'ExtendedRegEx' has a terminal 'Anchor.Stern'. CAVEAT: though typically the alternative is no 'Anchor.Anchor', there may perversely be a terminal 'Anchor.Bow', but neither qualify. hasSternAnchor :: ExtendedRegEx m -> Bool hasSternAnchor = (== Just Anchor.Stern) . sternAnchor --- | 'True' if there's at least one 'RepeatablePattern' in the 'Concatenation', ie that it's non-null. +-- | True if there's at least one 'RepeatablePattern' in the 'Concatenation', ie that it's non-null. isDefined :: ExtendedRegEx m -> Bool isDefined = not . null . concatenation @@ -511,8 +518,8 @@ type MatchedData m = (RepeatablePattern m, ConsumptionBounds.DataLength, InputData m) -- | Shifts the offset of the specified 'MatchedData'. -shiftMatchedData :: - ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a match occurred. +shiftMatchedData + :: ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a match occurred. -> MatchedData m -- ^ The match-structure whose offset is to be shifted. -> MatchedData m shiftMatchedData i (r, offset, d) = (r, offset + i, d) @@ -525,8 +532,8 @@ type Match m = Tree.Tree (MatchedData m) -- | Shifts the offsets of all the 'MatchedData' contained in the specified 'Match'. -shiftMatch :: - ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a match occurred. +shiftMatch + :: ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a match occurred. -> Match m -- ^ The match-structure whose offset is to be shifted. -> Match m shiftMatch i = (shiftMatchedData i <$>) @@ -544,8 +551,8 @@ type MatchList m = [Match m] -- | Shifts the offsets of all the 'MatchedData' contained in the specified 'MatchList'. -shiftMatchList :: - ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a each listed match occurred. +shiftMatchList + :: ConsumptionBounds.DataLength -- ^ The offset by which to shift the position into the input-data at which a each listed match occurred. -> MatchList m -- ^ The list of match-structures, each of whose offsets are to be shifted. -> MatchList m shiftMatchList i = map (shiftMatch i) @@ -744,13 +751,13 @@ mostData = {-#SCC "mostData" #-} {-Unsafe.printShow "mostData:\t" $-} maxData - measureUnmatchableTail inputData maxData where maxData :: ConsumptionBounds.DataLength maxData = case most of - Just cap -> cap {-:: Repeatable.Repetitions-} `min` maxDataAvailable {-:: ConsumptionBounds.DataLength-} --CAVEAT: conceptually different types. + Just cap -> cap {- :: Repeatable.Repetitions-} `min` maxDataAvailable {- :: ConsumptionBounds.DataLength-} --CAVEAT: conceptually different types. _ -> maxDataAvailable -- measureUnmatchableTail :: InputData m -> ConsumptionBounds.DataLength -> ConsumptionBounds.DataLength measureUnmatchableTail _ 0 = 0 --Have matched all the data. measureUnmatchableTail (a : as) unmatched - | a `Meta.isMatch` meta = measureUnmatchableTail as $ unmatched - 1 --Recurse. + | a `Meta.isMatch` meta = measureUnmatchableTail as $ pred unmatched --Recurse. | otherwise = unmatched --Return the unmatchable tail-length. measureUnmatchableTail [] _ = error "RegExDot.RegEx.findMatch.findMatchSlave.maybeMatchList.mostData.measureUnmatchableTail:\tdata unexpectedly exhausted." {- @@ -769,11 +776,11 @@ _ -> {-Unsafe.printShow "Peg match-failure:\t" $-} negate 1 --Guaranteed to be < 'fewestData'. | otherwise {-no requirement for this optimisation-} = mostData in ( - 1 + {-fence-post-} mostData' - fewestData --CAVEAT: possibly <= 0. + succ {-fence-post-} mostData' - fewestData --CAVEAT: possibly <= 0. ) `take` ( if isGreedy - then ListPlus.splitsLeftFrom mostData' - else ListPlus.splitsRightFrom fewestData + then ToolShed.Data.List.Splits.splitsLeftFrom mostData' + else ToolShed.Data.List.Splits.splitsRightFrom fewestData ) inputData CaptureGroup alternatives @@ -817,7 +824,7 @@ (minConsumptionConcatenationFromAlternative, maybeMaxConsumptionConcatenationFromAlternative) = ConsumptionProfile.consumptionBounds $ ConsumptionProfile.aggregateFromConcatenation consumptionProfileConcatenationFromAlternative in ( if ExecutionOptions.abortTrialRepetitionsOnZeroConsumption executionOptions && Data.Maybe.isNothing most {-constrained only by 'inputDataLength'-} - then {-#SCC "abortTrialRepetitionsOnZeroConsumption" #-} ListPlus.takeUntil $ \maybeMatchPair -> case maybeMatchPair of + then {-#SCC "abortTrialRepetitionsOnZeroConsumption" #-} ToolShed.Data.List.takeUntil $ \maybeMatchPair -> case maybeMatchPair of Just (match, _) -> ($ Tree.pop match) `all` [ (>= fewest) . length, --Must achieve 'Repeatable.getFewest', regardless of data-consumption. null . extractDataFromMatchList . last --If the n-th repetition consumed nothing, so will the (n + 1)-th. @@ -853,7 +860,7 @@ then ( shiftMatch inputDataOffset . Tree.Node . ( : replicate ( - repetitions - 1 --Typically degenerates to zero, since anchored sub-expressions aren't normally repeatable. + pred repetitions --Typically degenerates to zero, since anchored sub-expressions aren't normally repeatable. ) ( mkNullMatchFromExtendedRegEx 0 extendedRegExFromAlternative --Other Alternatives may be available & suitable. ) --Repeated null match may, lacking other suitable Alternatives, correspond to this stern-anchored ExtendedRegEx, so data must be consumed before them. @@ -889,7 +896,7 @@ not $ hasBowAnchor extendedRegExFromAlternative ] = ( Control.Arrow.first ( - Tree.Node . ListPlus.chunk components + Tree.Node . ToolShed.Data.List.chunk components ) . splitAt ( components * repetitions ), --Bisect the 'MatchList', into the part resulting from (Alternative){n}, & that for 'concatenationTail'. @@ -898,7 +905,7 @@ ) | otherwise {-choice of Alternatives or has Anchor.Bow-} = let remainingRepetitions :: Repeatable.Repetitions - remainingRepetitions = repetitions - 1 --Expand just the first repetition of the set of 'Alternatives'. + remainingRepetitions = pred repetitions --Expand just the first repetition of the set of 'Alternatives'. -- singletonRepeatable :: RepeatablePattern a singletonRepeatable = Repeatable.toSingleton repeatablePatternHead @@ -969,13 +976,13 @@ maxDataAvailable' = maxDataAvailable - minConsumptionConcatenationFromAlternative --CAVEAT: potentially negative. in if minConsumptionAlternatives == 0 --Denominator. then {-@ least one Alternative can consume zero-} if maxDataAvailable' == 0 --Numerator. - then {-zero data available $-} fewestAlternatives - 1 --Repeat as required. CAVEAT: an annoying dependency, which prevents parallel-evaluation. + then {-zero data available $-} pred fewestAlternatives --Repeat as required. CAVEAT: an annoying dependency, which prevents parallel-evaluation. else {-data available-} if and [ False, --The cost outweighs the small infrequent dividend. minConsumptionConcatenationFromAlternative == 0, maxDataAvailable > fewest ] --If 'fewest' can be met, without unconsuming repetitions of 'concatenationFromAlternative', then stop short of permitting it. - then maxDataAvailable - 1 --Any greater, & one repetition (possibly that currently expanded) must needlessly consume nothing. + then pred maxDataAvailable --Any greater, & one repetition (possibly that currently expanded) must needlessly consume nothing. else maxDataAvailable' --Either all n repetitions consumes something, or (n - 1) is a better solution. else {-non-zero => can divide-} maxDataAvailable' `div` minConsumptionAlternatives --Divide & round down. {- @@ -1185,8 +1192,8 @@ * A rather dubious requirement, so internal use only. -} --(/+) :: Integral i => i -> i -> i -(/+) :: - Int -- ^ Numerator. +(/+) + :: Int -- ^ Numerator. -> Int -- ^ Denominator. -> Int --10% faster in unoptimised code, & more in optimised. _ /+ 0 = error "RegExDot.RegEx.(/+):\tzero denominator => infinity" diff --git a/src/RegExDot/RegExOpts.hs b/src/RegExDot/RegExOpts.hs --- a/src/RegExDot/RegExOpts.hs +++ b/src/RegExDot/RegExOpts.hs @@ -32,13 +32,14 @@ -- ** Data-types RegExOpts(..), -- * Functions - mkRegEx, - setVerbose + setVerbose, +-- ** Constructors + mkRegEx ) where import qualified RegExDot.CompilationOptions as CompilationOptions import qualified RegExDot.ExecutionOptions as ExecutionOptions -import qualified ToolShed.Defaultable as Defaultable +import qualified ToolShed.Defaultable -- | Aggregates both 'ExecutionOptions.ExecutionOptions' & 'CompilationOptions.CompilationOptions' with a polymorphic /regex/, to form a complete job-description. data RegExOpts a = MkRegExOpts { @@ -50,11 +51,11 @@ instance Functor RegExOpts where fmap f regExOpts = regExOpts { regEx = f $ regEx regExOpts } --- | Build using 'Defaultable.defaultValue'. +-- | Smart constructor using 'ToolShed.Defaultable.defaultValue'. mkRegEx :: a -> RegExOpts a mkRegEx r = MkRegExOpts { - compilationOptions = Defaultable.defaultValue, - executionOptions = Defaultable.defaultValue, + compilationOptions = ToolShed.Defaultable.defaultValue, + executionOptions = ToolShed.Defaultable.defaultValue, regEx = r } diff --git a/src/RegExDot/Repeatable.hs b/src/RegExDot/Repeatable.hs --- a/src/RegExDot/Repeatable.hs +++ b/src/RegExDot/Repeatable.hs @@ -82,14 +82,13 @@ import Control.Applicative((<$>), (<*>)) import Control.Arrow((***)) -import Text.ParserCombinators.Parsec(()) -import qualified Control.Monad import qualified Data.List import qualified RegExDot.Consumer as Consumer import qualified RegExDot.ConsumptionProfile as ConsumptionProfile import qualified Text.ParserCombinators.Parsec as Parsec -import qualified ToolShed.Pair as Pair -import qualified ToolShed.SelfValidate as SelfValidate +import Text.ParserCombinators.Parsec(()) +import qualified ToolShed.Data.Pair +import qualified ToolShed.SelfValidate #ifdef HAVE_DEEPSEQ import Control.DeepSeq(NFData, rnf) @@ -123,7 +122,7 @@ instance Functor Repeatable where fmap f repeatable = repeatable { base = f $ base repeatable } --- | 'True' if there's no choice in the number of repetitions; implemented via 'isPrecise'. +-- | True if there's no choice in the number of repetitions; implemented via 'isPrecise'. isPrecise :: Repeatable a -> Bool isPrecise = hasPreciseBounds . repetitionBounds @@ -136,20 +135,20 @@ (Parsec.char oneOrMoreToken "Repeatable.oneOrMoreToken " ++ show oneOrMoreToken) >> return {-to GenParser-monad-} (oneOrMore b), (Parsec.char zeroOrOneToken "Repeatable.zeroOrOneToken " ++ show zeroOrOneToken) >> return {-to GenParser-monad-} (zeroOrOne b), (Parsec.char zeroOrMoreToken "Repeatable.zeroOrMoreToken " ++ show zeroOrMoreToken) >> return {-to GenParser-monad-} (zeroOrMore b), - (b ^#->#) {-arbitrarily greedy for now-} <$> uncurry Parsec.between (Pair.mirror Parsec.char rangeDelimiters) ( + (b ^#->#) {-arbitrarily greedy for now-} <$> uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.char rangeDelimiters) ( do - fewest <- Parsec.skipMany Parsec.space >> (read <$> Parsec.many1 Parsec.digit "Repetition-range minimum") - most <- Parsec.skipMany Parsec.space >> Parsec.option ( + fewest <- Parsec.spaces >> (read <$> Parsec.many1 Parsec.digit "Repetition-range minimum") + most <- Parsec.spaces >> Parsec.option ( Just fewest --The default. ) ( do i <- ( Parsec.char rangeSeparatorToken "Repeatable.rangeSeparatorToken " ++ show rangeSeparatorToken - ) >> Parsec.skipMany Parsec.space >> Parsec.option Nothing {-default to open-ended range-} ( + ) >> Parsec.spaces >> Parsec.option Nothing {-default to open-ended range-} ( Just . read <$> Parsec.many1 Parsec.digit "Repetition-range maximum" ) - Parsec.skipMany Parsec.space >> return {-to GenParser-monad-} i + Parsec.spaces >> return {-to GenParser-monad-} i ) return {-to GenParser-monad-} (fewest, most) @@ -162,7 +161,7 @@ instance Read a => Read (Repeatable a) where readsPrec _ s = case reads s {-first, read the base-type-} of - [(base', s1)] -> (error . ("readsPrec Repeatable:\tparse-error; " ++) . show) `either` return $ Parsec.parse (Control.Monad.liftM2 (,) (repeatableParser base') Parsec.getInput) "Repeatable" s1 + [(base', s1)] -> (error . ("readsPrec Repeatable:\tparse-error; " ++) . show) `either` return $ Parsec.parse ((,) <$> repeatableParser base' <*> Parsec.getInput) "Repeatable" s1 _ -> [] --No parse. {- | @@ -173,7 +172,7 @@ showSuffix :: Repeatable a -> ShowS showSuffix repeatable = let showRange :: ShowS -> ShowS - showRange x = (\(begin, end) -> begin . x . end) $ Pair.mirror showChar rangeDelimiters + showRange x = (\(begin, end) -> begin . x . end) $ ToolShed.Data.Pair.mirror showChar rangeDelimiters in ( case repetitionBounds repeatable of (0, Nothing) -> showChar zeroOrMoreToken @@ -207,21 +206,27 @@ repetitionBounds = r } = Consumer.starHeight b + if hasPreciseBounds r then 0 else 1 -instance SelfValidate.SelfValidator a => SelfValidate.SelfValidator (Repeatable a) where - isValid MkRepeatable { +instance ToolShed.SelfValidate.SelfValidator a => ToolShed.SelfValidate.SelfValidator (Repeatable a) where + getErrors MkRepeatable { base = b, repetitionBounds = (fewest, most), isGreedy = g - } = and [ - SelfValidate.isValid b, --Delegate. - fewest >= 0, - case most of - Just m -> m >= fewest --Exactly zero instances is perverse, but legal. - _ -> True, - g || case most of - Just m -> fewest < m --There ought to be potential for non-greediness, where specified: the converse isn't true, since greediness isn't explicit, & may not have been wanted. - _ -> True - ] + } + | not $ ToolShed.SelfValidate.isValid b = ToolShed.SelfValidate.getErrors b --Delegate. + | otherwise = ToolShed.SelfValidate.extractErrors [ + (fewest < 0, "Negative fewest=" ++ show fewest ++ "."), + ( + case most of + Just m -> m < fewest + _ -> False, + "Invalid repetition-range; '" ++ show (fewest, most) ++ "'." + ), ( + not g && case most of + Just m -> fewest >= m --There ought to be potential for non-greediness, where specified: the converse isn't true, since greediness isn't explicit, & may not have been wanted. + _ -> False, + "Invalid non-greedy repetition-range; '" ++ show (fewest, most) ++ "'." + ) + ] instance NFData a => NFData (Repeatable a) where rnf MkRepeatable { @@ -241,8 +246,8 @@ * /a{f, m}/ -} -(^#->#) :: - a -- ^ The polymorphic payload from which to construct the 'Repeatable'. +(^#->#) + :: a -- ^ The polymorphic payload from which to construct the 'Repeatable'. -> RepetitionBounds -- ^ The permissible repetition-bounds for the polymorphic data. -> Repeatable a b ^#-># bounds = MkRepeatable { @@ -256,8 +261,8 @@ * /a{f, m}?/ -} -(^#->#?) :: - a -- ^ The polymorphic payload from which to construct the 'Repeatable'. +(^#->#?) + :: a -- ^ The polymorphic payload from which to construct the 'Repeatable'. -> RepetitionBounds -- ^ The permissible repetition-bounds for the polymorphic data. -> Repeatable a b ^#->#? bounds = setNonGreedy (b ^#-># bounds) @@ -269,8 +274,8 @@ * /a{f,}/ -} -(^#->) :: - a -- ^ The polymorphic payload from which to construct the 'Repeatable'. +(^#->) + :: a -- ^ The polymorphic payload from which to construct the 'Repeatable'. -> Repetitions -- ^ The minimum permissible repetitions of the polymorphic data. -> Repeatable a b ^#-> fewest = b ^#-># (fewest, Nothing) @@ -280,8 +285,8 @@ * /a{f,}?/ -} -(^#->?) :: - a -- ^ The polymorphic payload from which to construct the 'Repeatable'. +(^#->?) + :: a -- ^ The polymorphic payload from which to construct the 'Repeatable'. -> Repetitions -- ^ The minimum permissible repetitions of the polymorphic data. -> Repeatable a b ^#->? fewest = setNonGreedy (b ^#-> fewest) @@ -293,8 +298,8 @@ * /a{f}/ -} -(^#) :: - a -- ^ The polymorphic payload from which to construct the 'Repeatable'. +(^#) + :: a -- ^ The polymorphic payload from which to construct the 'Repeatable'. -> Repetitions -- ^ The precise number of repetitions of the polymorphic data which is required. -> Repeatable a b ^# r = b ^#-># precisely r @@ -325,7 +330,7 @@ * A specific case of '^#->'. -} zeroOrMore :: a -> Repeatable a -zeroOrMore = (^#-> 0) +zeroOrMore = (^#-> 0) -- | Construct a non-greedy version of 'zeroOrMore'. zeroOrMore' :: a -> Repeatable a diff --git a/src/RegExDot/Result.hs b/src/RegExDot/Result.hs --- a/src/RegExDot/Result.hs +++ b/src/RegExDot/Result.hs @@ -49,7 +49,7 @@ getMatchList :: RegEx.Result a -> Maybe (RegEx.MatchList a) getMatchList (_, maybeMatchList, _) = maybeMatchList --- | 'True' if the 'RegEx.InputData' matched the 'RegEx.ExtendedRegEx'. +-- | True if the 'RegEx.InputData' matched the 'RegEx.ExtendedRegEx'. isMatch :: RegEx.Result a -> Bool isMatch = Data.Maybe.isJust . getMatchList diff --git a/src/RegExDot/ShowablePredicate.hs b/src/RegExDot/ShowablePredicate.hs --- a/src/RegExDot/ShowablePredicate.hs +++ b/src/RegExDot/ShowablePredicate.hs @@ -21,7 +21,7 @@ [@DESCRIPTION@] Used to implement /Perl-shortcut/s, /BracketExpression/-ranges & /POSIX Character-classes/. -} -module RegExDot.ShowablePredicate ( +module RegExDot.ShowablePredicate( -- * Types Predicate, -- ** Data-types diff --git a/src/RegExDot/Span.hs b/src/RegExDot/Span.hs --- a/src/RegExDot/Span.hs +++ b/src/RegExDot/Span.hs @@ -53,8 +53,8 @@ * Expects a gap-free, sorted list. -} -join :: - ConsumptionBounds.DataLength -- ^ The offset into the list of input-data to use when a null list of spans is received. +join + :: ConsumptionBounds.DataLength -- ^ The offset into the list of input-data to use when a null list of spans is received. -> [Span] -> Span join offset [] = empty offset --The offset can't be deduced from a null list, so use the value provided. diff --git a/src/RegExDot/Tree.hs b/src/RegExDot/Tree.hs --- a/src/RegExDot/Tree.hs +++ b/src/RegExDot/Tree.hs @@ -20,7 +20,7 @@ [@DESCRIPTION@] - * Defines a specific type of tree-structure, which is composed from either a datum, or a list of Tree-lists. + * Defines a specific type of tree-structure, which is composed from either a datum, or a list of Tree-lists; . * This more general tree-structure has the shape of a regular-expression match. @@ -62,8 +62,8 @@ showsPrec _ (Node treeLists) = showList treeLists instance Read a => Read (Tree a) where - readsPrec _ node@('[' : _) = Control.Arrow.first Node `map` readList node - readsPrec _ leaf = Control.Arrow.first Leaf `map` reads leaf + readsPrec _ node@('[' : _) = Control.Arrow.first Node `map` readList node {-singleton-} + readsPrec _ leaf = Control.Arrow.first Leaf `map` reads leaf {-singleton-} instance NFData a => NFData (Tree a) where rnf (Leaf a) = rnf a @@ -78,8 +78,8 @@ foldMap f (Node treeLists) = Data.List.foldl' (Data.List.foldl' (\monoid -> (monoid `Data.Monoid.mappend`) . Data.Foldable.foldMap f)) Data.Monoid.mempty treeLists -- | Deconstruct the specified 'Node'; i.e. lop the apex from the 'Tree', leaving a flat top. -pop :: - Tree a -- ^ The tree from which to extract the list of trees hanging immediately beneath its apex. +pop + :: Tree a -- ^ The tree from which to extract the list of trees hanging immediately beneath its apex. -> [TreeList a] pop (Node treeLists) = treeLists pop _ = error "RegExDot.Tree.pop:\tunexpected Leaf"