diff --git a/source/BNFC.cabal b/source/BNFC.cabal index 8565addc9..c120f73d0 100644 --- a/source/BNFC.cabal +++ b/source/BNFC.cabal @@ -178,6 +178,7 @@ library BNFC.CF BNFC.Check.EmptyTypes BNFC.Regex + BNFC.RegexMinus BNFC.TypeChecker BNFC.GetCF BNFC.Lexing @@ -318,6 +319,7 @@ test-suite unit-tests BNFC.CFSpec BNFC.GetCFSpec BNFC.OptionsSpec + BNFC.RegexMinusSpec BNFC.Hspec BNFC.Backend.BaseSpec BNFC.Backend.Common.MakefileSpec diff --git a/source/CHANGELOG.md b/source/CHANGELOG.md index 726f52e2d..5b702ab0b 100644 --- a/source/CHANGELOG.md +++ b/source/CHANGELOG.md @@ -3,6 +3,7 @@ [[#461](https://github.com/BNFC/bnfc/issues/461)] * Haskell: fix incorrect AST when `define`ing labels without argument [[#560](https://github.com/BNFC/bnfc/issues/560)] +* all: implement general regex subtraction as a module (`BNFC.RegexMinus`) # 2.9.6.3 diff --git a/source/src/BNFC/RegexMinus.hs b/source/src/BNFC/RegexMinus.hs new file mode 100644 index 000000000..6892c4e32 --- /dev/null +++ b/source/src/BNFC/RegexMinus.hs @@ -0,0 +1,753 @@ +{-| + Module : BNFC.RegexMinus + Description : Converts away subtraction in regexes + License : Public Domain + + This module is intended to be imported qualified to use in lexer backends + which wish to support general subtraction. + + Inspired by David J. Sankel's implementation. + + Many ideas taken from: + + - + - + - + - + + (accessible via the Wayback Machine). + + = EXPLANATION + + First, we define: + + - λ = the empty string ""; + - φ = the empty language []; + - δR (for some regex R) = if λ∊R then λ else φ. + For example, δ(a*b*) = λ; δ(ab*) = φ; + - The derivative Dc(R) (for some character c and regex R) = a regex S such + that S matches exactly the strings that are in R and start with @c@, but + without the first character @c@. + For example, Da((ab|cd)*) = b(ab|cd)*; Da(a*) = a*; Da(λ) = φ. + + Also note that: + + - λR = Rλ = R; + - φR = Rφ = φ; + - R|φ = R; + - R-φ = R; + - φ-R = φ; + - Dc(R-S)=DcR-DcS. + + The main observation: if R contains strings that start with + @a@, @b@, ..., @z@, then + + R = a(DaR)|b(DbR)|...|z(DzR)|δR. + + Our strategy is to derive the subtraction until we arrive at a new subtraction + that we have seen before, or eliminate the subtrahend. + + We obtain an FSA with states representing different subtractions and + transitions being the characters we derive on. We add a fictitious final state + and add transitions to it: + - from all nullable states (where δR=λ) - a spontaneous transition λ; + - from all states where a derivation on a character "c" eliminates the + subtraction (Dc(R-S) = T) - a transition "cT". + + The obtained FSA is converted to a regex using state elimination + (, section 3.2). + + Let's consider an example: we have to convert (ab|ac)*-(ac)* to an equivalent + regex without the subtraction operator. + + We name the initial state (R). + + > Da(R) = (b|c)(ab|ac)* - c(ac)* = (new state S1) + > Db(S1) = (ab|ac)* (subtraction eliminated) + > Dc(S1) = (ab|ac)* - (ac)* = (loop to R) + + Since δR=δS1=φ, we have no spontaneous transitions to the final state. + The FSA: + + (---) ----a----> (----) (-----) + -->( R ) ( S1 ) ---b(ab|ac)*---> ( Fin ) + (___) <----c---- (____) (_____) + + We eliminate S1 by adding an R->R transition "aφ*c" = "ac" and an R->Fin + transition "aφ*b(ab|ac)*" = "ab(ab|ac)*": + + -->(---) ---ab(ab|ac)*-->(-----) + ( R ) ( Fin ) + +-(___)<-+ (_____) + | | + +---ac --+ + + We eliminate R and obtain (ac)*ab(ab|ac)*. + + This implementation assigns a unique ID to every regex and uses the IDs to + compare states. +-} + +module BNFC.RegexMinus + ( + -- * The 'SimpleRegex' type and its smart constructors + SimpleRegex(..) + , charset + , string + + -- * 'SimpleRegex' conversions + , toSimpleRegex + , regexToString + + -- * 'SimpleRegex' transformations + , removeMinuses + ) where + +-- Data types +import qualified Data.Set as Set +import Data.Set (Set) +import qualified Data.IntSet as IntSet +import Data.IntSet (IntSet) +import qualified Data.Map as Map +import Data.Map (Map) +import qualified Data.IntMap as IntMap +import Data.IntMap (IntMap) + +-- Interaction with the Reg type +import qualified BNFC.Abs as Abs + +-- | Describes a regular expression. +-- Purposefully minimalistic for simpler processing. +data SimpleRegex a + = Term a -- ^ Matches one character + | Lambda -- ^ This is the 0-length string + | Phi -- ^ Recognizes no strings + | Rep (SimpleRegex a) -- ^ Kleene Star (*) + | Or (SimpleRegex a) (SimpleRegex a) -- ^ Or (|) + | Sub (SimpleRegex a) (SimpleRegex a) -- ^ Regex Subtraction (-) + | Seq (SimpleRegex a) (SimpleRegex a) -- ^ Sequence (ab) + deriving (Eq, Ord, Show) + +-- | Converts from richer canonical 'Abs.Reg's +-- to the 'SimpleRegex' representation. +toSimpleRegex :: Ord a => + (Char -> SimpleRegex a) -- ^ converts a single character. + -> SimpleRegex a -- ^ all Unicode characters. + -> SimpleRegex a -- ^ all digits. + -> SimpleRegex a -- ^ all isolatin1 letters. + -> SimpleRegex a -- ^ all uppercase isolatin1 letters. + -> SimpleRegex a -- ^ all lowercase isolatin1 letters. + -> Abs.Reg -- ^ the 'Abs.Reg' to simplify into a 'SimpleRegex'. + -> SimpleRegex a +toSimpleRegex fromChar any digit letter upper lower = helper + where + helper = \case + Abs.RAlt l r -> Or (helper l) (helper r) + Abs.RMinus l r -> Sub (helper l) (helper r) + Abs.RSeq l r -> Seq (helper l) (helper r) + Abs.RStar reg -> Rep (helper reg) + Abs.RPlus reg -> let sreg = helper reg in sreg `Seq` Rep sreg + Abs.ROpt reg -> Lambda `Or` helper reg + Abs.REps -> Lambda + Abs.RChar ch -> fromChar ch + Abs.RAlts s -> foldr Or Phi $ map fromChar s + Abs.RSeqs s -> foldr Seq Lambda $ map fromChar s + Abs.RDigit -> digit + Abs.RLetter -> letter + Abs.RUpper -> upper + Abs.RLower -> lower + Abs.RAny -> any + +-- | Returns a 'SimpleRegex' that matches any one of the items in the list. +charset :: Ord a => [a] -> SimpleRegex a +charset = \case + [] -> Phi + chars -> foldr1 Or $ map Term chars + +-- | Returns a 'SimpleRegex' that matches the exact sequence of items as in the +-- list. +string :: Ord a => [a] -> SimpleRegex a +string = \case + [] -> Lambda + chars -> foldr1 Seq $ map Term chars + +-- | Used in place of actual regexes. Makes equality checking doable in /O(1)/. +newtype RegexID = RegexID Int + deriving (Ord, Eq, Show) + +-- | Extracts the @Int@ representation of the t'RegexID'. +-- Used with @IntMap@s and @IntSet@s. +regexID2Int :: RegexID -> Int +regexID2Int (RegexID i) = i + +-- | A more convenient representation of regex trees. +-- The empty language is represented as @v'RegexNodeOr' IntSet.empty@. +data RegexNode a + = RegexNodeTerm !a -- ^ Matches the single element @a@. + | RegexNodeEmpty -- ^ Matches the empty string. + | RegexNodeOr !IntSet -- ^ Union of regexes with IDs in the set. + | RegexNodeSeq !RegexID !RegexID -- ^ Sequence of regexes with given IDs. + | RegexNodeStar !RegexID -- ^ Kleene star of the regex with given ID. + deriving (Ord, Eq) + +-- | 'SimpleRegex' with precomputed possible starting characters nullability +data AnnotatedRegexNode a = AnnotatedRegexNode + { regexID :: !RegexID -- ^ The ID. + , regexNode :: !(RegexNode a) -- ^ The regex tree node. + , regexStarts :: !(Set a) + -- ^ all characters/elements that start a string matching the regex. + , regexContainsEmpty :: !Bool + -- ^ Does the empty string match this regex? + } + +-- | Bidirectional mapping: +-- t'RegexID' <-> the t'AnnotatedRegexNode' with precomputed values +data RegexTrees a = RegexTrees + { tree2id :: (Map (RegexNode a) (AnnotatedRegexNode a)) + -- ^ Maps the tree node to its ID. + , id2tree :: (IntMap (AnnotatedRegexNode a)) + -- ^ Maps the node ID to the tree node. + } + +-- | Returns the empty t'RegexTrees' data structure. +emptyRegexTrees :: Ord a => RegexTrees a +emptyRegexTrees = RegexTrees + { tree2id = Map.empty + , id2tree = IntMap.empty + } + +-- | Returns the information about the regex tree node by its ID. +-- This throws on lookup failure because if the algorithm is correct then +-- no lookup should fail. +getByID :: RegexID -> RegexTrees a -> AnnotatedRegexNode a +getByID (RegexID regID) mp = case regID `IntMap.lookup` id2tree mp of + Nothing -> error "RegexID not found in map" + Just node -> node + +-- | Insert a new node into the mapping. +-- Assumes that such an (ID, node) combination has not been inserted before. +-- Constructing the t'AnnotatedRegexNode' is the user's responsibility for +-- performance reasons. +insertNode :: Ord a => + AnnotatedRegexNode a + -> RegexTrees a + -> RegexTrees a +insertNode annot mp = RegexTrees + { tree2id = Map.insert (regexNode annot) annot $ tree2id mp + , id2tree = IntMap.insert (regexID2Int $ regexID annot) annot $ id2tree mp + } + +-- | Looks up the regex node in the map. +getByNode :: Ord a => + RegexNode a + -> RegexTrees a + -> Maybe (AnnotatedRegexNode a) +getByNode node mp = node `Map.lookup` tree2id mp + +-- | Creates a new node or returns an existing one if it is exactly the same. +getOrNewID :: Ord a => + RegexNode a -- ^ The contents of the regex node. + -> Set a -- ^ Start characters the regex accepts. + -> Bool -- ^ Does the regex accept the empty string? + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewID node regexIDStarts regexIDContainsEmpty mp = + case getByNode node mp of + Just annot -> (mp, annot) + Nothing -> let + newID = IntMap.size $ id2tree mp + annot = AnnotatedRegexNode + { regexID = RegexID newID + , regexNode = node + , regexStarts = regexIDStarts + , regexContainsEmpty = regexIDContainsEmpty} + in (insertNode annot mp, annot) + +-- | Returns the empty string regex (creates one if none exists yet). +getOrNewLambda :: Ord a => + RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewLambda = getOrNewID RegexNodeEmpty Set.empty True + +-- | Returns the empty language regex (creates one if none exists yet). +getOrNewPhi :: Ord a => + RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewPhi = getOrNewID (RegexNodeOr IntSet.empty) Set.empty False + +-- | Returns a new regex that is equivalent to the union of the given regexes. +-- Unites nested v'RegexNodeOr's; if only one regex is given, +-- returns it unmodified. If an exact copy of the new v'RegexNodeOr' has already +-- been created, returns that one. +getOrNewOr :: Ord a => + [AnnotatedRegexNode a] -- ^ Alternatives to unite. + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewOr anns mp = let + uniqAnns = IntMap.fromList $ map (\ a -> (regexID2Int $ regexID a, a)) + $ concatMap listAnns anns + in case IntMap.toList uniqAnns of + [(_, ann)] -> (mp, ann) + _ -> getOrNewID (RegexNodeOr $ IntMap.keysSet uniqAnns) + (Set.unions $ map regexStarts $ IntMap.elems uniqAnns) + (any regexContainsEmpty $ IntMap.elems uniqAnns) mp + where + -- listAnns :: AnnotatedRegexNode a -> [AnnotatedRegexNode a] + listAnns ann = + case regexNode $ getByID (regexID ann) mp of + RegexNodeOr idset -> map (flip getByID mp . RegexID) + $ IntSet.toList idset + _ -> [ann] + +-- | Returns a new regex that is a sequence of the given two. +-- Normalizes such that the left regex is not a v'RegexNodeSeq' itself +-- (maintains right-associativity). This is done so that removing one term from +-- the left is fast. +-- Removes v'RegexNodeEmpty' regexes; returns an empty language if the left or +-- the right argument is an empty language. +-- If an exact copy of the new v'RegexNodeSeq' has already been created, +-- returns that one. +getOrNewSeq :: Ord a => + AnnotatedRegexNode a -- ^ The left node. + -> AnnotatedRegexNode a -- ^ The right node. + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewSeq left right mp = let rightNode = regexNode right in + if isPhi rightNode + then (mp, right) + else case rightNode of + RegexNodeEmpty -> (mp, left) + _ -> helper left right mp + where + -- | Does not check @right@. + helper left right mp = let + leftID = regexID left + leftNode = regexNode left + in + if isPhi leftNode + then (mp, left) + else case leftNode of + RegexNodeSeq llID lrID -> let + ll = getByID llID mp + lr = getByID lrID mp + (mp1, mid) = helper lr right mp + in helper ll mid mp1 + RegexNodeEmpty -> (mp, right) + _ -> getOrNewID + (RegexNodeSeq leftID (regexID right)) + (if regexContainsEmpty left + then Set.union (regexStarts left) (regexStarts right) + else regexStarts left) + (regexContainsEmpty left && regexContainsEmpty right) mp + -- | Is the regex an empty language? + isPhi = \case + RegexNodeOr idset -> IntSet.null idset + _ -> False + +-- | Returns a new or existing regex matching a single term (e.g. @Char@). +getOrNewTerm :: Ord a => + a -- ^ The singular regex term (@Char@, @Int8@...). + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewTerm ch = getOrNewID (RegexNodeTerm ch) (Set.singleton ch) False + +-- | Returns a new or existing regex matching zero or more strings that the +-- argument matches (Kleene star). +getOrNewStar :: Ord a => + AnnotatedRegexNode a -- ^ The regex to put under a Kleene star. + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +getOrNewStar node = + getOrNewID (RegexNodeStar (regexID node)) (regexStarts node) True + +-- | Converts the simple regex into an internal representation with precomputed +-- starts and nullability. +-- Converts away subtractions. +makeAnnotated :: Ord a => + SimpleRegex a + -- ^ The regular expression to convert (could contain subtractions). + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +makeAnnotated reg mp = case reg of + Term a -> getOrNewTerm a mp + Lambda -> getOrNewLambda mp + Phi -> getOrNewPhi mp + Rep r -> let (newmp, rann) = makeAnnotated r mp in getOrNewStar rann newmp + Or a b -> let + rs = flattenOr a ++ flattenOr b + (newmp, anns) = + foldr (\ r (mp, anns) -> + let (newmp, ann) = makeAnnotated r mp in (newmp, ann : anns)) + (mp, []) rs + in getOrNewOr anns newmp + Sub a b -> let + (mp1, nodeA) = makeAnnotated a mp + (mp2, nodeB) = makeAnnotated b mp1 + in convertSub nodeA nodeB mp2 + Seq a b -> let + (a', b') = reorderSeq a b + (mp1, nodeA) = makeAnnotated a' mp + (mp2, nodeB) = makeAnnotated b' mp1 + in getOrNewSeq nodeA nodeB mp2 + where + flattenOr = \case + Or a b -> flattenOr a ++ flattenOr b + Phi -> [] + other -> [other] + -- | Maintains right-associativity of v'Seq'. + reorderSeq :: + SimpleRegex a + -> SimpleRegex a + -> (SimpleRegex a, SimpleRegex a) + reorderSeq a b = case a of + Seq l r -> reorderSeq l (Seq r b) + _ -> (a, b) + +-- | Computes the derivative: +-- Da(a) = λ +-- Da(b) = φ +-- Da(λ) = φ +-- Da(φ) = φ +-- Da(AB) = DaA|(δA)DaB +-- Da(A|B) = DaA|DaB +-- Da(A*) = (DaA)A* +derive :: Ord a => + a -- ^ The starting character. + -> AnnotatedRegexNode a -- ^ The regex to derive. + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +derive ch reg mp = case regNode of + RegexNodeTerm a -> + if ch == a + then getOrNewLambda mp + else getOrNewPhi mp + RegexNodeEmpty -> getOrNewPhi mp + RegexNodeOr regs -> let + (newmp, derivs) = IntSet.foldr (\ regID (mp, derivs) -> + let (mpnew, deriv) = derive ch (getByID (RegexID regID) mp) mp + in (mpnew, deriv:derivs)) (mp, []) regs + in getOrNewOr derivs newmp + RegexNodeSeq leftID rightID -> let + left = getByID leftID mp + right = getByID rightID mp + (mp1, derivLeft) = derive ch left mp + (mp2, onlyLeftRes) = getOrNewSeq derivLeft right mp1 + in + if regexContainsEmpty left + then + let (mp3, derivRight) = derive ch right mp2 + in getOrNewOr [onlyLeftRes, derivRight] mp3 + else (mp2, onlyLeftRes) + RegexNodeStar aID -> let + a = getByID aID mp + (mp1, derivA) = derive ch a mp + in getOrNewSeq derivA reg mp1 + where + regNode = regexNode reg + +-- | Produces an equivalent regex without any v'Sub's +removeMinuses :: Ord a => SimpleRegex a -> SimpleRegex a +removeMinuses reg = convertToSimpleRegex (regexID annot) mp + where + (mp, annot) = makeAnnotated reg emptyRegexTrees + +-- | An internal record used by @'convertSub'::makeFSA@. +data ConversionState a = ConversionState + { conv_trees :: RegexTrees a -- ^ The current regex collection. + , conv_fsa :: FSA a + -- ^ The finite state automaton that is under construction. + , conv_vertices :: Map (RegexID, RegexID) Int + -- ^ Translates subtractions (pairs of minuend and subtrahend) + -- into FSA nodes. + , conv_tovisit :: Set (RegexID, RegexID) + -- ^ Unvisited FSA nodes (to be visited). + } + +-- | Converts (A-B) into an equivalent regex without subtraction (A and B do not +-- contain subtraction already). +convertSub :: Ord a => + AnnotatedRegexNode a -- ^ The minuend. + -> AnnotatedRegexNode a -- ^ The subtrahend. + -> RegexTrees a -- ^ The current regex collection. + -> (RegexTrees a, AnnotatedRegexNode a) +convertSub a b mp = + -- We create an FSA where state 0 represents a - b (the starting state) + -- and state 1 is the only accepting state. State 1 does not correspond to a + -- subtraction expression. + let + initstate = (regexID a, regexID b) + initfsa = fst $ fsaAddVertex $ fst $ fsaAddVertex fsaEmpty + ConversionState + { conv_fsa = fullfsa + , conv_trees = mp1 + } = makeFSA ConversionState + { conv_fsa = initfsa + , conv_tovisit = Set.singleton initstate + , conv_vertices = Map.singleton initstate startingvertex + , conv_trees = mp + } + -- Eliminate all created states, leave the 2 original. + (mp2, reducedfsa) = fullReduceFSA mp1 fullfsa + Just starttrans = IntMap.lookup startingvertex $ fsa_transitions reducedfsa + -- The answer is |(0)->(0)|* |(0)->(1)|. + in case IntMap.lookup finalvertex starttrans of + Nothing -> getOrNewPhi mp -- the initial mp is enough + Just regToFinal -> case IntMap.lookup startingvertex starttrans of + Nothing -> (mp2, regToFinal) + Just reg -> + let (mp3, repeatstart) = getOrNewStar reg mp2 + in getOrNewSeq repeatstart regToFinal mp3 + where + startingvertex = 0 :: Int + finalvertex = 1 :: Int + makeFSA convstate_start@ConversionState + { conv_trees = mp + , conv_fsa = fsa + , conv_vertices = vertices + , conv_tovisit = tovisit_start + } + | Set.null tovisit_start = convstate_start + | otherwise = let + (mp1, lambda) = getOrNewLambda mp + ((minuendID, subtrID), tovisit_popped) = + Set.deleteFindMin tovisit_start + minuend = getByID minuendID mp1 + subtr = getByID subtrID mp1 + Just thisvertex = Map.lookup (minuendID, subtrID) vertices + uniqLeftStarts = regexStarts minuend + `Set.difference` regexStarts subtr + sharedStarts = regexStarts minuend + `Set.intersection` regexStarts subtr + resDelta = regexContainsEmpty minuend + && not (regexContainsEmpty subtr) + baseResList = if resDelta then [lambda] else [] + + -- derive over terms not subtracted from 'minuend' + (mp2, immediateResList) = foldr (\ startch (mp_, reslist) -> let + (mp', deriv) = derive startch minuend mp_ + (mp'', term) = getOrNewTerm startch mp' + (mp''', seq) = getOrNewSeq term deriv mp'' + in (mp''', seq : reslist)) (mp1, baseResList) uniqLeftStarts + + -- add transition to final state if needed + (mp3, fsa1) = case immediateResList of + [] -> (mp2, fsa) + _ -> + let (mp', trans) = getOrNewOr immediateResList mp2 + in fsaAddTransition thisvertex finalvertex trans mp' fsa + + -- derive over terms that are subtracted + in makeFSA $ foldr (\ startch state_ -> + let + (mp', derivMinuend) = derive startch minuend $ conv_trees state_ + (mp'', derivSubtr) = derive startch subtr mp' + newstate = (regexID derivMinuend, regexID derivSubtr) + (verts', fsa', tovisit', destIndex) = destination newstate + (conv_vertices state_) (conv_fsa state_) (conv_tovisit state_) + (mp''', term) = getOrNewTerm startch mp'' + (mp'''', fsa'') = + fsaAddTransition thisvertex destIndex term mp''' fsa' + in ConversionState + { conv_vertices = verts' + , conv_trees = mp'''' + , conv_fsa = fsa'' + , conv_tovisit = tovisit' + } + ) ConversionState + { conv_trees = mp3 + , conv_fsa = fsa1 + , conv_vertices = vertices + , conv_tovisit = tovisit_popped + } sharedStarts + where + destination newstate curVerts curFsa curToVisit = + case Map.lookup newstate curVerts of + Nothing -> let + (fsa', index) = fsaAddVertex curFsa + in + ( Map.insert newstate index curVerts + , fsa' + , Set.insert newstate curToVisit + , index + ) + Just index -> (curVerts, curFsa, curToVisit, index) + + -- | Reduces all new states, leaving the 2 original ones. + fullReduceFSA mp fsa + | IntMap.size (fsa_transitions fsa) > 2 = + uncurry fullReduceFSA $ fsaEliminate mp fsa + | otherwise = (mp, fsa) + +-- | The Finite State Automaton. Represented with an adjacency list of +-- transitions and a (maintained manually) adjacency list of back-transitions. +data FSA a = FSA + { fsa_transitions :: IntMap (IntMap (AnnotatedRegexNode a)) + -- ^ Map: vertex -> @IntMap.fromList [(destinationNode, transitionRegex)]@. + , fsa_revEdges :: IntMap (IntSet) + -- ^ Map: vertex -> the set of all vertices that have transitions to this + -- vertex, __EXCLUDING__ itself. + } + +-- | Creates an empty FSA. +fsaEmpty :: FSA a +fsaEmpty = FSA + { fsa_transitions = IntMap.empty + , fsa_revEdges = IntMap.empty + } + +-- | Creates a new vertex with the next unoccupied index. Indices are numbered +-- starting from 0. +fsaAddVertex :: + FSA a -- ^ The finite state automaton to modify. + -> (FSA a, Int) -- ^ (The new automaton, the new vertex's index). +fsaAddVertex FSA + { fsa_transitions = trans + , fsa_revEdges = rev + } = (FSA + { fsa_transitions = IntMap.insert n IntMap.empty trans + , fsa_revEdges = IntMap.insert n IntSet.empty rev + }, n) + where + n = IntMap.size trans + +-- | Creates a new transition with the specified regex or merges the regex with +-- an existing transition. +fsaAddTransition :: Ord a => + Int -- ^ Transition source. + -> Int -- ^ Transition destination. + -> AnnotatedRegexNode a -- ^ The transition regex. + -> RegexTrees a -- ^ The current regex collection. + -> FSA a -- ^ The FSA to modify. + -> (RegexTrees a, FSA a) + -- ^ (The updated regex collection, the modified automaton). +fsaAddTransition from to how mp (FSA + { fsa_transitions = trans + , fsa_revEdges = rev + }) = let + Just transFrom = IntMap.lookup from trans + (mp', trans') = case IntMap.lookup to transFrom of + Nothing -> (mp, IntMap.update (Just . IntMap.insert to how) from trans) + Just prevEdge -> + let (mp1, mergedEdge) = getOrNewOr [prevEdge, how] mp + in (mp1, IntMap.update (Just . IntMap.insert to mergedEdge) from trans) + in + ( mp' + , FSA + { fsa_transitions = trans' + , fsa_revEdges = + if from /= to + then IntMap.update (Just . IntSet.insert from) to rev + else rev + } + ) + +-- | Removes the node with the largest index (last added) from the automaton. +-- Also erases all transitions to and from it. +fsaPop :: Ord a => + FSA a -- ^ The FSA to modify. + -> (FSA a, Int, IntMap (AnnotatedRegexNode a), IntSet) + -- ^ + -- ( The modified automaton + -- , the removed index + -- , all transitions from the removed vertex (including the one to itself) + -- , all vertices that used to have transitions to the vertex (excluding + -- itself) + -- ). +fsaPop FSA + { fsa_transitions = trans + , fsa_revEdges = rev + } = + ( FSA + { fsa_transitions = IntMap.map (IntMap.delete index) trans' + , fsa_revEdges = IntMap.map (IntSet.delete index) rev' + } + , index + , mytrans + , myRevEdges + ) + where + ((index, mytrans), trans') = IntMap.deleteFindMax trans + ((_, myRevEdges), rev') = IntMap.deleteFindMax rev + +-- | Eliminates the node with the largest index (last added) from the automaton, +-- but updates other transitions to produce an equivalent FSA. +-- +-- If the deleted node is (n), then for all nodes (u) that have transitions to +-- (n) and for all nodes (v) that have transitions from (n), we add the +-- transition |(u)->(n)| |(n)->(n)|* |(n)->(v)|. +fsaEliminate :: Ord a => + RegexTrees a -- ^ The current regex collection. + -> FSA a -- ^ The FSA to modify. + -> (RegexTrees a, FSA a) + -- ^ (The updated regex collection, the reduced automaton). +fsaEliminate mp fsa = + foldr (\ (u, utrans, v, vtrans) (mp_, fsa_) -> + let (mp', merged) = mergeTrans utrans vtrans mp_ + in fsaAddTransition u v merged mp' fsa_) + (mp, fsaPopped) + [ let + Just fromU = IntMap.lookup u (fsa_transitions fsa) + Just utrans = IntMap.lookup index fromU + in (u, utrans, v, vtrans) + | u <- IntSet.toList myrev, (v, vtrans) <- IntMap.toList transToOthers + ] + where + (fsaPopped, index, mytrans, myrev) = fsaPop fsa + (transToOthers, mergeTrans) = case index `IntMap.lookup` mytrans of + Nothing -> (mytrans, getOrNewSeq) + Just r -> + ( IntMap.delete index mytrans + , (\ from to mp -> + let + (mp', star) = getOrNewStar r mp + (mp'', seqr) = getOrNewSeq star to mp' + in getOrNewSeq from seqr mp'') + ) + +-- | Converts an internal 'RegexNode' (represented with a t'RegexID') +-- into a 'SimpleRegex'. +convertToSimpleRegex :: Ord a => + RegexID -- ^ The regex node to convert. + -> RegexTrees a -- ^ The current regex collection. + -> SimpleRegex a +convertToSimpleRegex regID mp = case node of + RegexNodeEmpty -> Lambda + RegexNodeTerm a -> Term a + RegexNodeSeq leftID rightID -> + convertToSimpleRegex leftID mp `Seq` convertToSimpleRegex rightID mp + RegexNodeOr idset -> + if IntSet.null idset + then Phi + else foldr1 Or + (map (flip convertToSimpleRegex mp . RegexID) + $ IntSet.toList idset) + RegexNodeStar rID -> Rep (convertToSimpleRegex rID mp) + where + reg = getByID regID mp + node = regexNode reg + +-- | Visualizes the regex, showing the empty string as () and the empty language +-- as []. Uses parentheses to resolve precedence. +regexToString :: SimpleRegex Char -> String +regexToString = \case + Term ch -> [ch] + Lambda -> "" + Phi -> "[]" + Rep reg -> helper 5 reg ++ "*" + Or l r -> helper 2 l ++ "|" ++ helper 2 r + Sub l r -> helper 1 l ++ "-" ++ helper 2 r + Seq l r -> helper 3 l ++ helper 3 r + where + helper :: Int -> SimpleRegex Char -> String + helper prec reg + | prec <= precedence reg = repr + | otherwise = "(" ++ repr ++ ")" + where repr = regexToString reg + precedence = \case + Term _ -> 5 + Lambda -> 0 + Phi -> 5 + Rep _ -> 4 -- Rep 5 + Or _ _ -> 2 -- Or 2 2 + Sub _ _ -> 1 -- Sub 1 2 + Seq _ _ -> 3 -- Seq 3 3 diff --git a/source/src/BNFC/regexMinus.hs b/source/src/BNFC/regexMinus.hs deleted file mode 100644 index 0c6b30c5f..000000000 --- a/source/src/BNFC/regexMinus.hs +++ /dev/null @@ -1,183 +0,0 @@ --- Written by David J. Sankel (camior@gmail.com) --- --- License: Public Domain --- --- Illustrates an algorithm to that converts a regular expression that uses --- a difference operator (-) in to an equivalent one that does not. --- --- Most ideas taken from http://home.chello.no/~mgrsby/sgmlintr/file0005.htm --- - -import List - -data Regex a = Term a | - Lambda | -- This is the 0-length string - Phi | -- Recognizes no strings ( 0 ) - Rep (Regex a) | -- Kleen Star (*) - Or (Regex a) (Regex a) | -- Or (+) - Sub (Regex a) (Regex a) | -- Regex Subtraction (-) - Seq (Regex a) (Regex a) -- Sequence (ab) - deriving (Eq,Show) - --- Character set notation [asdf] -charset s = foldr Or Phi (map Term s) --- Convenient seq notation "asdf" -string s = foldr Seq Lambda (map Term s) - --- Simple function used below -removeFirst p [] = [] -removeFirst p (a:as) | p a = as - | otherwise = a:(removeFirst p as) - --- Takes a Regex and returns it without Subs. -removeMinuses (Term a) = Term a -removeMinuses Lambda = Lambda -removeMinuses Phi = Phi -removeMinuses (Rep a)= Rep a -removeMinuses (Or a b)= (Or a b) -removeMinuses (Seq a b)= (Seq a b) -removeMinuses e@(Sub a b) = - let - symbs = symbols e - -- all (symbol,derivative) pairs - derivatives = [(s,simplify $ derivative s e) | s <- symbs ] - -- The delta function applied - deltae = delta e - -- Whether or not a (symbol,derivative)'s derivitive component is - -- equal to our original formula - loopCondition = (\(a,b) -> b == (simplify e)) - -- Maybe a (symbol,derivative) pair where the derivative is the same as our - -- original expression - loopedDerivative = find loopCondition derivatives - -- all (symbol,derivative) pairs except for loopedDerivative - derivativesMinusLooped = removeFirst loopCondition derivatives - -- To understand the following: draw out a tree on a piece of paper. - -- We are invoking the identity: R = (\Sigma_a aDaR) + \delta R. - -- The loop condition recalls that if DaR = R then - -- R = aDaR + stuff -> R = aR + stuff -> R = a*(stuff) - result = case loopedDerivative of - Nothing -> Or (foldr Or Phi [ (Seq (Term sym) (removeMinuses reg)) | (sym,reg) <- derivatives ]) deltae - Just (sym,_) -> (Seq (Rep (Term sym)) - (Or (foldr Or Phi [ (Seq (Term sym) (removeMinuses reg)) | (sym,reg) <- derivativesMinusLooped ]) deltae ) ) - in - simplify result - --- Takes a Regex and returns an equivalent one somewhat simplified. -simplify (Term a) = (Term a) -simplify Lambda = Lambda -simplify Phi = Phi -simplify (Rep a) = let a_s = simplify a - in case a_s of - Lambda -> Lambda - Phi -> Lambda - _ -> (Rep a_s) -simplify (Or a b) = let a_s = simplify a - b_s = simplify b - in case (a_s,b_s) of - (_,Phi)-> a_s - (Phi,_) -> b_s - (Lambda,Lambda) -> Lambda - (_,Lambda) | delta a_s == Lambda -> a_s - | otherwise -> (Or a_s b_s) - (Lambda,_) | delta b_s == Lambda -> b_s - | otherwise -> (Or a_s b_s) - _ -> (Or a_s b_s) -simplify (Seq a b) = let a_s = simplify a - b_s = simplify b - in case (a_s,b_s) of - (_,Lambda)-> a_s - (Lambda,_) -> b_s - (_,Phi)-> Phi - (Phi,_) -> Phi - _ -> (Seq a_s b_s) -simplify (Sub a b) = let a_s = simplify a - b_s = simplify b - in case (a_s,b_s) of - (Lambda,Lambda) -> Phi - (_,Lambda) | delta a_s == Phi -> a_s - | otherwise -> (Sub a_s b_s) - (Lambda,_) | delta b_s == Phi -> Lambda - | otherwise -> Phi - (Phi,_) -> Phi - (_,Phi) -> a_s - _ -> (Sub a_s b_s) - --- Special Regex delta function. --- See http://home.chello.no/~mgrsby/sgmlintr/file0004.htm -delta :: (Eq a) => (Regex a) -> (Regex a) -delta (Term a) = Phi -delta (Lambda) = Lambda -delta (Phi) = Phi -delta (Or a b) | ((delta a) == Phi) && - ((delta b) == Phi) = Phi - | otherwise = Lambda -delta (Sub a b) | ((delta a) == Lambda) && - ((delta b) == Phi) = Lambda - | otherwise = Phi -delta (Seq a b) | ((delta a) == Lambda) && - ((delta b) == Lambda) = Lambda - | otherwise = Phi -delta (Rep _) = Lambda - --- Special Regex derivative function. --- See http://home.chello.no/~mgrsby/sgmlintr/file0004.htm -derivative :: (Eq a) => a -> Regex a -> Regex a -derivative a (Term b) | a == b = Lambda - | otherwise = Phi -derivative a Lambda = Phi -derivative a Phi = Phi -derivative a (Or b c) = Or (derivative a b) (derivative a c) -derivative a (Sub b c) = Sub (derivative a b) (derivative a c) -derivative a (Seq b c) = let dab = (derivative a b) - dac = (derivative a c) - in Or (Seq dab c) - (Seq (delta b) dac) -derivative a (Rep b) = Seq (derivative a b) (Rep b) - --- The symbols that a regex is over -symbols (Term a) = [a] -symbols (Rep a) = symbols a -symbols (Or a b) = nub $ symbols a ++ symbols b -symbols (Sub a b) = nub $ symbols a ++ symbols b -symbols (Seq a b) = nub $ symbols a ++ symbols b -symbols _ = [] - --- Shows a Regex in compact form. For example: (a+b+c)d* -compactShow :: Regex Char -> String -compactShow (Term a) = [a] -compactShow Lambda = "\\" -compactShow Phi = "0" -compactShow (Rep (Term a)) = a:"*" -compactShow (Rep a) = "(" ++ (compactShow a) ++ ")*" -compactShow (Sub a b ) = (compactShow a) ++ "-" ++ (compactShow b) -compactShow (Or (Term a) (Term b) ) = [a] ++ "+" ++ [b] -compactShow (Or (Term a) b@(Or _ _) ) = [a] ++ "+" ++ (compactShow b) -compactShow (Or a@(Or _ _) (Term b) ) = (compactShow a) ++ "+" ++ [b] -compactShow (Or a@(Or _ _) b@(Or _ _) ) = (compactShow a) ++ "+" ++ (compactShow b) -compactShow (Or a b@(Or _ _) ) = "(" ++ (compactShow a) ++ ")+" ++ (compactShow b) -compactShow (Or a b ) = "(" ++ (compactShow a) ++ ")+(" ++ (compactShow b) ++ ")" -compactShow (Seq (Term a) (Term b) ) = [a] ++ [b] -compactShow (Seq (Term a) b@(Seq _ _) ) = [a] ++ (compactShow b) -compactShow (Seq (Term a) b@(Rep _) ) = [a] ++ (compactShow b) -compactShow (Seq a@(Seq _ _) b@(Seq _ _) ) = (compactShow a) ++ (compactShow b) -compactShow (Seq a b ) = "(" ++ (compactShow a) ++ ")" ++ "(" ++ (compactShow b) ++ ")" - --- Example that requires loop detection. Taken From: --- http://home.chello.no/~mgrsby/sgmlintr/file0005.htm --- (a+b)* - aa* -test = Sub (Rep (Or (Term 'a') (Term 'b') )) (Seq (Term 'a') (Rep (Term 'a')) ) --- a-b -test2 = Sub (Term 'a') (Term 'b') --- (a+b) - b -test3 = Sub (Or (Term 'a') (Term 'b')) (Term 'b') --- (a+b)c - b -test4 = Sub (Seq (Or (Term 'a') (Term 'b')) (Term 'c')) (Term 'b') --- (b*(a+b)c) - b -test5 = Sub (Seq (Rep (Term 'b'))(Seq (Or (Term 'a') (Term 'b')) (Term 'c'))) (Term 'b') --- Some normal looking string regexes. -test6 = Sub (Rep (charset "abcdefghijklmnopqrstuvwxyz")) (string "hello") -test7 = Sub (Rep (charset "abcdef")) (string "fad") -test8 = Sub (Rep (charset "abcdef")) (string "db") --- Simplified Case of above -test9 = Sub (Rep (charset "abcdef")) (string "b") - diff --git a/source/test/BNFC/RegexMinusSpec.hs b/source/test/BNFC/RegexMinusSpec.hs new file mode 100644 index 000000000..a5a57f98c --- /dev/null +++ b/source/test/BNFC/RegexMinusSpec.hs @@ -0,0 +1,354 @@ +module BNFC.RegexMinusSpec where + +import Test.Hspec +import BNFC.RegexMinus + +-- | Lists matched prefix lengths in the STRICTLY ASCENDING order. +match :: SimpleRegex Char -> String -> [Int] +match = \case + Term ch -> \case + h : _ -> if h == ch then [1] else [] + _ -> [] + Lambda -> const [0] + Phi -> const [] + Rep reg -> helper 0 [] + where + helper dropped todo s = + let + matches = map (+dropped) $ matchNonempty reg s + newtodo = merge todo matches + in dropped : case newtodo of + [] -> [] + nx : tail -> helper nx tail $ drop (nx - dropped) s + matchNonempty r s = case match r s of + 0:tail -> tail + other -> other + Or a b -> \ s -> match a s `merge` match b s + Seq a b -> \ s -> let + amatches = match a s + amatchessuf = zip amatches $ sufs amatches s + in mergeMany [map (+dropped) $ match b s | (dropped, s) <- amatchessuf] + Sub _ _ -> error "No Sub promised, but one encountered" + where + merge :: [Int] -> [Int] -> [Int] + merge = \case + [] -> id + as@(a : at) -> \case + [] -> as + bs@(b : bt) -> case a `compare` b of + LT -> a : merge at bs + GT -> b : merge as bt + EQ -> a : merge at bt + mergeMany :: [[Int]] -> [Int] + mergeMany = foldr merge [] + sufs :: [Int] -> String -> [String] + sufs = helper 0 + where + helper prevlen lens prevsuf = case lens of + [] -> [] + len : tail -> + let newsuf = drop (len - prevlen) prevsuf + in newsuf : helper len tail newsuf + +-- | Checks if a string matches a regex. +matchFull :: SimpleRegex Char -> String -> Bool +matchFull reg s = length s `elem` match reg s + +-- | Test cases. +spec :: Spec +spec = do + let testcase function s expected = + it ((if null s then "Empty" else s) + ++ (if expected then " matches" else " does not match")) + $ function s `shouldBe` expected + + -- Check that the 'matchFull' function works. + describe "self-check" $ do + let + exp = Rep (Term 'a') + test = testcase (matchFull exp) + test "" True + test "a" True + test "aaA" False + test "b" False + test "aaaaaab" False + test "aaaaaaa" True + test "baaaaaa" False + + -- Example that requires loop detection. Taken From: + -- http://home.chello.no/~mgrsby/sgmlintr/file0005.htm + describe "(a+b)* - aa*" $ do + let + exp = removeMinuses $ + Sub (Rep (Or (Term 'a') (Term 'b'))) + (Seq (Term 'a') (Rep (Term 'a'))) + test = testcase (matchFull exp) + test "" True + test "a" False + test "aaA" False + test "b" True + test "aaaaaab" True + test "aaaaaaa" False + test "baaaaaa" True + + describe "a-b" $ do + let + exp = removeMinuses $ Sub (Term 'a') (Term 'b') + test = testcase (matchFull exp) + test "a" True + test "aa" False + test "b" False + test "" False + test "c" False + + describe "(a+b) - b" $ do + let + exp = removeMinuses $ Sub (Or (Term 'a') (Term 'b')) (Term 'b') + test = testcase (matchFull exp) + test "" False + test "a" True + test "b" False + test "ab" False + test "aa" False + test "bb" False + test "ba" False + + describe "(a+b)c - b" $ do + let + exp = removeMinuses + $ Sub (Seq (Or (Term 'a') (Term 'b')) (Term 'c')) + (Term 'b') + test = testcase (matchFull exp) + test "" False + test "ac" True + test "bc" True + test "a" False + test "b" False + test "c" False + test "abc" False + + describe "(b*(a+b)c) - b" $ do + let + exp = removeMinuses + $ Sub (Seq (Rep (Term 'b')) + (Seq (Or (Term 'a') (Term 'b')) (Term 'c'))) + (Term 'b') + test = testcase (matchFull exp) + test "" False + test "ac" True + test "bc" True + test "bac" True + test "bbc" True + test "bbac" True + test "bbbc" True + test "a" False + test "b" False + test "c" False + test "acc" False + test "bcc" False + test "bacc" False + test "bbcc" False + test "bbacc" False + test "bbbcc" False + test "ab" False + test "bb" False + test "bab" False + test "bbb" False + test "bbab" False + test "bbbb" False + test "acb" False + + describe "[abcdefghijklmnopqrstuvwxyz]* - hello" $ do + let + exp = removeMinuses + $ Sub (Rep (charset "abcdefghijklmnopqrstuvwxyz")) + (string "hello") + test = testcase (matchFull exp) + test "hello" False + test "" True + test "a" True + test "g" True + test "sdcskjgnkjren" True + test "helloworld" True + test "ahello" True + test "helloa" True + test "_" False + test "a b" False + test "hell" True + test "ello" True + + describe "[abcdef]* - fad" $ do + let + exp = removeMinuses $ Sub (Rep (charset "abcdef")) (string "fad") + test = testcase (matchFull exp) + test "fad" False + test "" True + test "a" True + test "f" True + test "deadbeef" True + test "feeddad" True + test "afad" True + test "fada" True + test "_" False + test "a b" False + test "fa" True + test "ad" True + + describe "[abcdef]* - b" $ do + let + exp = removeMinuses $ Sub (Rep (charset "abcdef")) (string "b") + test = testcase (matchFull exp) + test "" True + test "a" True + test "b" False + test "c" True + test "d" True + test "e" True + test "f" True + test "deadbeef" True + test "feeddad" True + test "ab" True + test "ba" True + test "_" False + test "a d" False + + describe ("[a-z]* - [aeiouy]*") $ do + let + exp = removeMinuses + $ Sub (Rep (charset "abcdefghijklmnopqrstuvwxyz")) + (Rep (charset "aeiouy")) + test = testcase (matchFull exp) + test "" False + test "abcd" True + test "aaa" False + test "bcd" True + test "xfsckhzbtlpmgnrvqjwd" True + test "yoaueaiueaieiau" False + test "xfsckhzbtlpmagnrvqjwd" True + test "yoaueaiueaiveiau" True + + describe "([a-z]* - [aeiouy]*) - bnfc" $ do + let + exp = removeMinuses + $ Sub (Sub (Rep (charset "abcdefghijklmnopqrstuvwxyz")) + (Rep (charset "aeiouy"))) + (string "bnfc") + test = testcase (matchFull exp) + test "" False + test "abcd" True + test "aaa" False + test "bcd" True + test "xfsckhzbtlpmgnrvqjwd" True + test "yoaueaiueaieiau" False + test "xfsckhzbtlpmagnrvqjwd" True + test "yoaueaiueaiveiau" True + test "bnfc" False + test "nfc" True + test "bnf" True + + describe "[a-z]* - ([bcdfghjklmnpqrstvwxz]* - bnfc)" $ do + let + exp = removeMinuses + $ Sub (Rep (charset "abcdefghijklmnopqrstuvwxyz")) + (Sub (Rep (charset "bcdfghjklmnpqrstvwxz")) + (string "bnfc")) + test = testcase (matchFull exp) + test "" False + test "abcd" True + test "bcd" False + test "xfsckhzbtlpmgnrvqjwd" False + test "bnfc" True + test "nfc" False + test "bnf" False + + describe "d(a*(bc)*) - d(ab(c)*+aa*+bc(a*))" $ do + let + exp = removeMinuses + $ Sub (Seq (Term 'd') + $ Rep (Term 'a') `Seq` Rep (Term 'b' `Seq` Term 'c')) + (Seq (Term 'd') + $ (Term 'a' `Seq` Term 'b' `Seq` Rep (Term 'c')) + `Or` (Term 'a' `Seq` Rep (Term 'a')) + `Or` (Term 'b' `Seq` Term 'c' `Seq` Rep (Term 'a'))) + test = testcase (matchFull exp) + test "" False + test "a" False + test "d" True + test "da" False + test "daa" False + test "dbc" False + test "dbca" False + test "dbcaa" False + test "dab" False + test "dabc" False + test "dabcc" False + test "dbcbc" True + test "dabcbc" True + test "daabc" True + test "daabcbc" True + test "dbca" False + + describe "a*(bc)* - aa*(bc*) = (bc)*" $ do + let + exp = removeMinuses + ((Rep (Term 'a') `Seq` Rep (Term 'b' `Seq` Term 'c')) + `Sub` (Term 'a' `Seq` + Rep (Term 'a') `Seq` Rep (Term 'b' `Seq` Term 'c'))) + test = testcase (matchFull exp) + test "" True + test "bc" True + test "bcbc" True + test "bcbcbc" True + test "a" False + test "abc" False + test "abcbc" False + test "aa" False + test "aabc" False + test "c" False + test "b" False + test "bcb" False + test "bca" False + test "bcabc" False + + describe "a*(bc)* - (a*|(bc)*) = aa*(bc)(bc)*" $ do + let + exp = removeMinuses + ((Rep (Term 'a') `Seq` Rep (Term 'b' `Seq` Term 'c')) + `Sub` (Rep (Term 'a') `Or` Rep (Term 'b' `Seq` Term 'c'))) + test = testcase (matchFull exp) + test "" False + test "a" False + test "aa" False + test "bc" False + test "bcbc" False + test "abc" True + test "abcbc" True + test "aabc" True + test "cb" False + test "acb" False + test "ab" False + + describe "(a|b|c)* - (a|b|c)*ab(a|b|c)*" $ do + let + abcs = Rep $ charset "abc" + exp = removeMinuses + $ abcs `Sub` foldr Seq Lambda [abcs, string "ab", abcs] + test = testcase (matchFull exp) + test "" True + test "abc" False + test "a" True + test "b" True + test "c" True + test "ab" False + test "ac" True + test "bc" True + test "ba" True + test "ca" True + test "cb" True + test "aa" True + test "bb" True + test "cc" True + test "aaa" True + test "bbb" True + test "ccc" True + test "aacaaa" True