regexp-tries (empty) → 0.1.0
raw patch · 10 files changed
+571/−0 lines, 10 filesdep +basedep +containersdep +derive-triesetup-changed
Dependencies added: base, containers, derive-trie, template-haskell, weighted-regexp
Files
- LICENSE +32/−0
- README +0/−0
- Setup.hs +6/−0
- examples/RegExp.hs +36/−0
- regexp-tries.cabal +58/−0
- src/Data/ListTrie.hs +17/−0
- src/Data/ListTrie/ListTrie.hs +28/−0
- src/Data/ListTrie/RegExp.hs +9/−0
- src/Data/ListTrie/RegExp/Common.hs +162/−0
- src/Data/ListTrie/RegExp/Weighted.hs +223/−0
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2010, Andreas Baldeau++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ 1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ 2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.++ 3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Simple++main = defaultMain+
+ examples/RegExp.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE+ MultiParamTypeClasses,+ TemplateHaskell,+ UndecidableInstances+ #-}++module RegExp where++import Prelude hiding (lookup)++import Data.ListTrie.RegExp++import Data.Bits++import Data.KeyMap (empty, insert, toList)+import qualified Data.KeyMap as KeyMap+import Data.Derive.Trie++$(deriveTrie [''Bool])++toBits :: Int -> [Bool]+toBits n = map (testBit n) [0..7]++fromBits :: [Bool] -> Int+fromBits bs = foldr (\ b n -> let n' = shiftL n 1+ in if b then n' + 1 else n') 0 bs++exampleTrie :: ListTrie BoolTrie Int+exampleTrie = foldr (\ n -> insert (toBits n) n) empty [0..255]++re1 = rep (sym True)+re2 = rep (sym False)+re3 = rep (sym True `seq_` sym False)+re4 = rep anySym `seq_` sym False `seq` sym True `seq_` rep anySym+re5 = sym True `seq_` rep anySym+
+ regexp-tries.cabal view
@@ -0,0 +1,58 @@+Name: regexp-tries+Version: 0.1.0+Stability: Alpha+Synopsis: Regular Expressions on Tries.+Description: Regular Expressions on Tries.+License: BSD3+License-File: LICENSE+Build-Type: Simple+Author: Andreas Baldeau+Maintainer: Andreas Baldeau <andreas@baldeau.net>+Homepage: http://github.com/baldo/regexp-tries+Bug-Reports: http://github.com/baldo/regexp-tries/issues+Category: Data+Tested-With: GHC == 6.12.3+Cabal-Version: >= 1.8++Extra-Source-Files:+ Setup.hs+ README+ examples/RegExp.hs++Source-Repository head+ Type: git+ Location: git://github.com/baldo/regexp-tries.git++Library+ Build-Depends:+ base == 4.*,+ containers == 0.3.*,+ derive-trie == 0.1.*,+ template-haskell == 2.4.*,+ weighted-regexp >= 0.3.1 && <= 0.4++ Ghc-Options:+ -Wall++ Hs-Source-Dirs:+ src++ Exposed-Modules:+ Data.ListTrie+ Data.ListTrie.RegExp+ Data.ListTrie.RegExp.Weighted++ Other-Modules:+ Data.ListTrie.ListTrie+ Data.ListTrie.RegExp.Common++ Extensions:+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ MultiParamTypeClasses+ OverlappingInstances+ TemplateHaskell+ TypeSynonymInstances+ UndecidableInstances+
+ src/Data/ListTrie.hs view
@@ -0,0 +1,17 @@+{- | This module provides 'StringTrie' and 'ListTrie' as an instance of+ 'KeyMap'.+-}++module Data.ListTrie+ ( -- * Trie types+ ListTrie+ , StringTrie++ -- * 'KeyMap' module providing Trie operations+ , module Data.KeyMap+ )+where++import Data.ListTrie.ListTrie+import Data.KeyMap+
+ src/Data/ListTrie/ListTrie.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE+ MultiParamTypeClasses,+ TemplateHaskell,+ TypeSynonymInstances,+ UndecidableInstances+ #-}+{-# OPTIONS_GHC+ -fno-warn-missing-signatures+ -fno-warn-unused-binds+ -fno-warn-unused-matches+ #-}++-- Hidden module used for deriving Trie types.++module Data.ListTrie.ListTrie+ ( StringTrie (..)+ , ListTrie (..)++ , module KeyMap+ )+where++import Data.Derive.Trie+import Data.KeyMap+import qualified Data.KeyMap as KeyMap++$(deriveTrie [''String])+
+ src/Data/ListTrie/RegExp.hs view
@@ -0,0 +1,9 @@+-- | This module reexports 'Data.ListTrie.RegExp.Weighted' for now.++module Data.ListTrie.RegExp+ ( module Data.ListTrie.RegExp.Weighted+ )+where++import Data.ListTrie.RegExp.Weighted+
+ src/Data/ListTrie/RegExp/Common.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE+ FlexibleContexts,+ FlexibleInstances,+ FunctionalDependencies,+ MultiParamTypeClasses+ #-}++{- | This module provides functionality that all regular expression+ implementations share.+-}++module Data.ListTrie.RegExp.Common+ ( WrapClass (..)++ -- * Expression Type for Combinators+ , Expr (..)+ , ExprClass (..)++ -- * Regular Expression Combinators+ , complement+ , intersection+ , union++ -- * Trie operations+ , LookupRegExpClass (..)+ , lookup+ , delete++ -- * Optimzation of combined Regular Expressions+ , OptimizeClass (..)+ , optimize+ )+where++import Prelude hiding (lookup)+import qualified Data.KeyMap as KM+import Data.ListTrie.ListTrie hiding+ ( delete+ , intersection+ , lookup+ , union+ )+import Data.Map (Map)++-- Wrapping and unwrapping of StringTrie ---------------------------------------++{- | Allows the usage of 'StringTrie' and 'ListTrie' the same way.+-}+class (KeyMap [sym] map, KeyMap sym emap)+ => WrapClass map emap sym | map -> emap where+ wrap :: ListTrie emap v -> map v+ unwrap :: map v -> ListTrie emap v++instance WrapClass StringTrie (Map Char) Char where+ wrap = StringTrie+ unwrap = unStringTrie++instance (KeyMap sym emap) => WrapClass (ListTrie emap) emap sym where+ wrap = id+ unwrap = id++-- Regular Expression Combinators ----------------------------------------------++{- | Expressions may be build by using the combinators 'complement',+ 'intersection' and 'union'. They can then be used with 'lookup' and+ 'delete'.+-}+data Expr regexp = REExpr regexp+ | Complement (Expr regexp)+ | Intersection (Expr regexp) (Expr regexp)+ | Union (Expr regexp) (Expr regexp)++-- | Allows to also use regular expressions directly instead of 'Expr' types.+class ExprClass e regexp | e -> regexp where+ toExpr :: e -> (Expr regexp)++instance ExprClass (Expr regexp) regexp where+ toExpr = id++-- | Perform the operation with the complement of the expression.+complement+ :: ExprClass e regexp+ => e -- ^ an expression+ -> Expr regexp -- ^ the complement+complement = Complement . toExpr++-- | Intersection of the result of two expressions.+intersection+ :: (ExprClass e1 regexp, ExprClass e2 regexp)+ => e1+ -> e2+ -> Expr regexp+intersection e1 e2 = Intersection (toExpr e1) (toExpr e2)++-- | Union of the result of two expressions.+union+ :: (ExprClass e1 regexp, ExprClass e2 regexp)+ => e1+ -> e2+ -> Expr regexp+union e1 e2 = (Union (toExpr e1) (toExpr e2))++-- Trie operations -------------------------------------------------------------++class (WrapClass map emap sym, OptimizeClass regexp)+ => LookupRegExpClass regexp map emap sym | regexp -> sym where+ lookupRegExp+ :: regexp+ -> map v+ -> map v+ lookupComplement+ :: regexp+ -> map v+ -> map v++-- | Lookup the given expression in the given Trie and return a Trie of results.+lookup+ :: (LookupRegExpClass (regexp sym) map emap sym, ExprClass e (regexp sym))+ => e -- ^ expression to lookup+ -> map v -- ^ Trie on wich to perform the lookup+ -> map v -- ^ resulting Trie+lookup = lookupExpr . optimize++-- | Delete entries matching the expression from the given Trie.+delete+ :: (LookupRegExpClass (regexp sym) map emap sym, ExprClass e (regexp sym))+ => e -- ^ expression+ -> map v -- ^ Trie to delete from+ -> map v -- ^ Trie missing the entries that matched the expression.+delete = lookupExpr . optimize . complement++-- | Evaluates the given expression on the given Trie.+lookupExpr+ :: LookupRegExpClass (regexp sym) map emap sym+ => Expr (regexp sym)+ -> map v+ -> map v+lookupExpr (REExpr re) t = lookupRegExp re t+lookupExpr (Complement (REExpr re)) t = lookupComplement re t+lookupExpr (Complement (Complement e)) t = lookupExpr e t+lookupExpr (Complement e) t = difference t $ lookupExpr e t+lookupExpr (Intersection e1 e2) t = lookupExpr e2 (lookupExpr e1 t)+lookupExpr (Union e1 e2) t = KM.union t1 t2+ where+ t1 = lookupExpr e1 t+ t2 = lookupExpr e2 t++-- Optimzation of combined Regular Expressions ---------------------------------++class OptimizeClass regexp where+ -- | Optimize the given expression.+ optimizeExpr+ :: Expr regexp -- ^ expression+ -> Expr regexp -- ^ optimized expression++-- | Optimize the given expression.+optimize+ :: (ExprClass e regexp, OptimizeClass regexp)+ => e -- ^ expression+ -> Expr regexp -- ^ optimized expression+optimize = optimizeExpr . toExpr+
+ src/Data/ListTrie/RegExp/Weighted.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE+ FlexibleContexts,+ FlexibleInstances,+ FunctionalDependencies,+ MultiParamTypeClasses,+ OverlappingInstances,+ UndecidableInstances+ #-}+{-# OPTIONS_GHC+ -fno-warn-orphans+ #-}++{- | This module provides 'delete' and 'lookup' functions for 'StringTrie'+ using regular expressions. The algorithm used is the one from the package+ 'weighted-regexp': <http://sebfisch.github.com/haskell-regexp/>.+-}++module Data.ListTrie.RegExp.Weighted+ (+ -- * Trie types+ ListTrie+ , StringTrie++ -- * Construction of regular expressions+ , RegExp++ , eps+ , char+ , sym+ , psym++ , anySym+ , noMatch++ , alt+ , seq_++ , rep+ , rep1+ , opt+ , brep++ , perm++ -- * Expression Type for Combinators+ , Expr+ , ExprClass++ -- * Regular Expression Combinators+ , complement+ , intersection+ , union++ -- * Trie operations+ , lookup+ , delete++ , lookupW+ )+where++import Prelude hiding+ ( lookup+ , mod+ , null+ , pred+ )+import Data.ListTrie.ListTrie hiding+ ( delete+ , empty+ , intersection+ , lookup+ , union+ )+import Data.ListTrie.RegExp.Common+import Data.Maybe+import Data.Semiring+import Text.RegExp+import Text.RegExp.Internal++-- Storing weights within the Trie ---------------------------------------------++class StoreWeights v w v' | v v' -> w where+ store :: w -> v -> v'+ select :: m v -> m v' -> m v'++instance StoreWeights v Bool v where+ store _ v = v+ select m _ = m++instance StoreWeights v w (v, w) where+ store w v = (v, w)+ select _ m = m++-- Regular Expression lookup ---------------------------------------------------++instance WrapClass map emap sym+ => LookupRegExpClass (RegExp sym) map emap sym where+ lookupRegExp = lookupReW 0 True id empty+ lookupComplement = lookupReW 0 True not empty++lookupReW+ :: (WrapClass map emap sym, StoreWeights v w v', Weight sym sym w)+ => Int+ -> w+ -> (w -> w)+ -> (RegW w sym -> w)+ -> RegExp sym+ -> map v+ -> map v'+lookupReW n mark mod pred (RegExp re) t =+ wrap $ lookupRe n mark mod pred re $ unwrap t++lookupRe+ :: (KeyMap sym map, StoreWeights v w v', Weight sym sym w)+ => Int+ -> w+ -> (w -> w)+ -> (RegW w sym -> w)+ -> RegW w sym+ -> ListTrie map v+ -> ListTrie map v'+lookupRe _ _ _ _ _ NoListTrie = NoListTrie+lookupRe n mark mod pred re t@(ListTrie tn tc)+ | n > 0 && not (active re) =+ if mod one' /= zero+ then NoListTrie+ else select t $ error "This should never haqppen!"+ -- (KM.map (store one') t)+ | otherwise =+ if isJust tn' || not (null tc')+ then ListTrie tn' tc'+ else NoListTrie+ where+ one' = one+ tn' = if w /= zero then fmap (store w) tn else Nothing+ w = mod $ pred re+ tc' = mapMaybeWithKey go tc++ go c ts =+ cleanup $ lookupRe (n + 1) zero mod final (shift mark (reg re) c) ts++ cleanup ts+ | null ts = Nothing+ | otherwise = Just ts++-- Expression instances --------------------------------------------------------++instance ExprClass (RegExp sym) (RegExp sym) where+ toExpr = REExpr++instance ExprClass e (RegExp Char) => Show e where+ showsPrec _ e =+ case toExpr e of+ REExpr re ->+ showString "(RegExp<" . shows re . showString ">)"+ Complement e' ->+ showString "(Complement " . shows e' . showString ")"+ Intersection e1 e2 ->+ showString "(Intersection " . shows e1 . showChar ' '+ . shows e2 . showString ")"+ Union e1 e2 ->+ showString "(Union" . shows e1 . showChar ' '+ . shows e2 . showString ")"++-- Trie operations -------------------------------------------------------------++{- | Lookup the given regular expression in the Trie and return a Trie of+ results, containing also the calculated weights.++ Note: As weights don't make much sense with delete (would all be 'zero'),+ there is no 'deleteW'.++ Note: Since there doesn't seem to be a way to efficiently allow combining+ of weighted regular expressions, there are no combinators for this for now.+-}+lookupW+ :: (WrapClass map emap sym, StoreWeights v w (v, w), Weight sym sym w)+ => RegExp sym+ -> map v+ -> map (v, w)+lookupW (RegExp re) t = wrap $ lookupRe 0 one id empty (weighted re) $ unwrap t++-- Optimzation of combined Regular Expressions ---------------------------------++instance OptimizeClass (RegExp sym) where+ optimizeExpr e@(REExpr _) =+ e++ optimizeExpr (Complement e) =+ case optimizeExpr e of+ (Complement e') ->+ e'++ (Intersection (Complement e1') (Complement e2')) ->+ Union e1' e2'++ e' ->+ Complement e'++ optimizeExpr (Intersection e1 e2) =+ case (optimizeExpr e1, optimizeExpr e2) of+ (e1', e2') ->+ Intersection (optimizeExpr e1') (optimizeExpr e2')++ optimizeExpr (Union e1 e2) =+ case (optimizeExpr e1, optimizeExpr e2) of+ (REExpr r1, REExpr r2) ->+ REExpr $ r1 `alt` r2++ -- Complement of regular expressions is cheap.+ (e1'@(Complement (REExpr _)), e2') ->+ Union e1' e2'+ (e1', e2'@(Complement (REExpr _))) ->+ Union e1' e2'++ -- Evaluating Complement once is cheaper than doing it twice.+ (Complement e1', Complement e2') ->+ Complement $ Intersection e1' e2'++ (e1', e2') ->+ Union e1' e2'+