diff --git a/GF.cabal b/GF.cabal index 9c26e52d4..d4c3b242c 100644 --- a/GF.cabal +++ b/GF.cabal @@ -50,11 +50,9 @@ library PGF.Morphology PGF.ShowLinearize PGF.VisualizeTree - GF.Data.MultiMap GF.Data.TrieMap GF.Data.Utilities GF.Data.SortedList - GF.Data.Assoc GF.Data.ErrM GF.Data.Relation GF.Data.Operations @@ -97,11 +95,9 @@ executable gf GF.JavaScript.PrintJS GF.Infra.CompactPrint GF.Text.UTF8 - GF.Data.MultiMap GF.Data.TrieMap GF.Data.Utilities GF.Data.SortedList - GF.Data.Assoc GF.Data.ErrM GF.Data.Operations GF.Infra.Ident diff --git a/src/compiler/GF/Data/Assoc.hs b/src/compiler/GF/Data/Assoc.hs deleted file mode 100644 index f775319ea..000000000 --- a/src/compiler/GF/Data/Assoc.hs +++ /dev/null @@ -1,143 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : Assoc --- Maintainer : Peter Ljunglöf --- Stability : Stable --- Portability : Haskell 98 --- --- > CVS $Date: 2005/05/09 09:28:44 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.4 $ --- --- Association lists, or finite maps, --- including sets as maps with result type @()@. --- function names stolen from module @Array@. --- /O(log n)/ key lookup ------------------------------------------------------------------------------ - -module GF.Data.Assoc ( Assoc, - Set, - emptyAssoc, - emptySet, - listAssoc, - listSet, - accumAssoc, - aAssocs, - aElems, - assocMap, - assocFilter, - lookupAssoc, - lookupWith, - (?), - (?=) - ) where - -import GF.Data.SortedList - -infixl 9 ?, ?= - --- | a set is a finite map with empty values -type Set a = Assoc a () - -emptyAssoc :: Ord a => Assoc a b -emptySet :: Ord a => Set a - --- | creating a finite map from a sorted key-value list -listAssoc :: Ord a => SList (a, b) -> Assoc a b - --- | creating a set from a sorted list -listSet :: Ord a => SList a -> Set a - --- | building a finite map from a list of keys and 'b's, --- and a function that combines a sorted list of 'b's into a value -accumAssoc :: (Ord a, Ord c) => (SList c -> b) -> [(a, c)] -> Assoc a b - --- | all key-value pairs from an association list -aAssocs :: Ord a => Assoc a b -> SList (a, b) - --- | all keys from an association list -aElems :: Ord a => Assoc a b -> SList a - --- fmap :: Ord a => (b -> b') -> Assoc a b -> Assoc a b' - --- | mapping values to other values. --- the mapping function can take the key as information -assocMap :: Ord a => (a -> b -> b') -> Assoc a b -> Assoc a b' - -assocFilter :: Ord a => (b -> Bool) -> Assoc a b -> Assoc a b -assocFilter pred = listAssoc . filter (pred . snd) . aAssocs - --- | monadic lookup function, --- returning failure if the key does not exist -lookupAssoc :: (Ord a, Monad m) => Assoc a b -> a -> m b - --- | if the key does not exist, --- the first argument is returned -lookupWith :: Ord a => b -> Assoc a b -> a -> b - --- | if the values are monadic, we can return the value type -(?) :: (Ord a, Monad m) => Assoc a (m b) -> a -> m b - --- | checking wheter the map contains a given key -(?=) :: Ord a => Assoc a b -> a -> Bool - - ------------------------------------------------------------- - -data Assoc a b = ANil | ANode (Assoc a b) a b (Assoc a b) - deriving (Eq, Ord, Show) - -emptyAssoc = ANil -emptySet = emptyAssoc - -listAssoc as = assoc - where (assoc, []) = sl2bst (length as) as - sl2bst 0 xs = (ANil, xs) - sl2bst 1 (x:xs) = (ANode ANil (fst x) (snd x) ANil, xs) - sl2bst n xs = (ANode left (fst x) (snd x) right, zs) - where llen = (n-1) `div` 2 - rlen = n - 1 - llen - (left, x:ys) = sl2bst llen xs - (right, zs) = sl2bst rlen ys - -listSet as = listAssoc (zip as (repeat ())) - -accumAssoc join = listAssoc . map (mapSnd join) . groupPairs . nubsort - where mapSnd f (a, b) = (a, f b) - -aAssocs as = prs as [] - where prs ANil = id - prs (ANode left a b right) = prs left . ((a,b) :) . prs right - -aElems = map fst . aAssocs - - -instance Ord a => Functor (Assoc a) where - fmap f = assocMap (const f) - -assocMap f ANil = ANil -assocMap f (ANode left a b right) = ANode (assocMap f left) a (f a b) (assocMap f right) - - -lookupAssoc ANil _ = fail "key not found" -lookupAssoc (ANode left a b right) a' = case compare a a' of - GT -> lookupAssoc left a' - LT -> lookupAssoc right a' - EQ -> return b - -lookupWith z ANil _ = z -lookupWith z (ANode left a b right) a' = case compare a a' of - GT -> lookupWith z left a' - LT -> lookupWith z right a' - EQ -> b - -(?) = lookupWith (fail "key not found") - -(?=) = \assoc -> maybe False (const True) . lookupAssoc assoc - - - - - - - diff --git a/src/compiler/GF/Data/MultiMap.hs b/src/compiler/GF/Data/MultiMap.hs deleted file mode 100644 index e565f433b..000000000 --- a/src/compiler/GF/Data/MultiMap.hs +++ /dev/null @@ -1,47 +0,0 @@ -module GF.Data.MultiMap where - -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Prelude hiding (map) -import qualified Prelude - -type MultiMap k a = Map k (Set a) - -empty :: MultiMap k a -empty = Map.empty - -keys :: MultiMap k a -> [k] -keys = Map.keys - -elems :: MultiMap k a -> [a] -elems = concatMap Set.toList . Map.elems - -(!) :: Ord k => MultiMap k a -> k -> [a] -m ! k = Set.toList $ Map.findWithDefault Set.empty k m - -member :: (Ord k, Ord a) => k -> a -> MultiMap k a -> Bool -member k x m = x `Set.member` Map.findWithDefault Set.empty k m - -insert :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a -insert k x m = Map.insertWith Set.union k (Set.singleton x) m - -insert' :: (Ord k, Ord a) => k -> a -> MultiMap k a -> Maybe (MultiMap k a) -insert' k x m | member k x m = Nothing -- FIXME: inefficient - | otherwise = Just (insert k x m) - -union :: (Ord k, Ord a) => MultiMap k a -> MultiMap k a -> MultiMap k a -union = Map.unionWith Set.union - -size :: MultiMap k a -> Int -size = sum . Prelude.map Set.size . Map.elems - -map :: (Ord a, Ord b) => (a -> b) -> MultiMap k a -> MultiMap k b -map f = Map.map (Set.map f) - -fromList :: (Ord k, Ord a) => [(k,a)] -> MultiMap k a -fromList xs = Map.fromListWith Set.union [(k, Set.singleton x) | (k,x) <- xs] - -toList :: MultiMap k a -> [(k,a)] -toList m = [(k,x) | (k,s) <- Map.toList m, x <- Set.toList s] \ No newline at end of file