diff options
| author | krasimir <krasimir@chalmers.se> | 2009-06-16 11:56:08 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-06-16 11:56:08 +0000 |
| commit | 8bc8929c59d2bd6f28d5dab9c7a9ca8a1c23609e (patch) | |
| tree | 84244e9cc3b969e86167b309538dfe08d7374630 /src/GF/Data/TrieMap.hs | |
| parent | b442cde3bd01fb935c215446097592510cf8e713 (diff) | |
completely phrase based parser and support for pre {} in PMCFG
Diffstat (limited to 'src/GF/Data/TrieMap.hs')
| -rw-r--r-- | src/GF/Data/TrieMap.hs | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/src/GF/Data/TrieMap.hs b/src/GF/Data/TrieMap.hs new file mode 100644 index 000000000..37c56fc3a --- /dev/null +++ b/src/GF/Data/TrieMap.hs @@ -0,0 +1,55 @@ +module GF.Data.TrieMap
+ ( TrieMap
+
+ , empty
+ , singleton
+
+ , lookup
+
+ , null
+ , decompose
+
+ , insertWith
+
+ , unionWith
+ ) where
+
+import Prelude hiding (lookup, null)
+import qualified Data.Map as Map
+
+data TrieMap k v = Tr (Maybe v) (Map.Map k (TrieMap k v))
+
+empty = Tr Nothing Map.empty
+
+singleton :: [k] -> a -> TrieMap k a
+singleton [] v = Tr (Just v) Map.empty
+singleton (k:ks) v = Tr Nothing (Map.singleton k (singleton ks v))
+
+lookup :: Ord k => [k] -> TrieMap k a -> Maybe a
+lookup [] (Tr mb_v m) = mb_v
+lookup (k:ks) (Tr mb_v m) = Map.lookup k m >>= lookup ks
+
+null :: TrieMap k v -> Bool
+null (Tr Nothing m) = Map.null m
+null _ = False
+
+decompose :: TrieMap k v -> (Maybe v, Map.Map k (TrieMap k v))
+decompose (Tr mb_v m) = (mb_v,m)
+
+insertWith :: Ord k => (v -> v -> v) -> [k] -> v -> TrieMap k v -> TrieMap k v
+insertWith f [] v0 (Tr mb_v m) = case mb_v of
+ Just v -> Tr (Just (f v0 v)) m
+ Nothing -> Tr (Just v0 ) m
+insertWith f (k:ks) v0 (Tr mb_v m) = case Map.lookup k m of
+ Nothing -> Tr mb_v (Map.insert k (singleton ks v0) m)
+ Just tr -> Tr mb_v (Map.insert k (insertWith f ks v0 tr) m)
+
+unionWith :: Ord k => (v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
+unionWith f (Tr mb_v1 m1) (Tr mb_v2 m2) =
+ let mb_v = case (mb_v1,mb_v2) of
+ (Nothing,Nothing) -> Nothing
+ (Just v ,Nothing) -> Just v
+ (Nothing,Just v ) -> Just v
+ (Just v1,Just v2) -> Just (f v1 v2)
+ m = Map.unionWith (unionWith f) m1 m2
+ in Tr mb_v m
|