diff --git a/src/GF/Canon/Subexpressions.hs b/src/GF/Canon/Subexpressions.hs index 4ec645b05..683f9eecf 100644 --- a/src/GF/Canon/Subexpressions.hs +++ b/src/GF/Canon/Subexpressions.hs @@ -27,7 +27,8 @@ import GF.Data.Operations import qualified GF.Infra.Modules as M import Control.Monad -import Data.FiniteMap +import Data.Map (Map) +import qualified Data.Map as Map import Data.List {- @@ -60,7 +61,7 @@ cse is possible in the grammar. It is used by the flag pg -printer=subs. elimSubtermsMod :: (Ident,CanonModInfo) -> Err (Ident, CanonModInfo) elimSubtermsMod (mo,m) = case m of M.ModMod (M.Module mt st fs me ops js) -> do - (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (emptyFM,0) + (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0) js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js return (mo,M.ModMod (M.Module mt st fs me ops js2)) _ -> return (mo,m) @@ -69,8 +70,8 @@ prSubtermStat :: CanonGrammar -> String prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where mos = [(i, tree2list (M.jments m)) | (i, M.ModMod m) <- M.modules gr, M.isModCnc m] expsIn mo js = err id id $ do - (tree,_) <- appSTM (getSubtermsMod mo js) (emptyFM,0) - let list0 = fmToList tree + (tree,_) <- appSTM (getSubtermsMod mo js) (Map.empty,0) + let list0 = Map.toList tree let list1 = sortBy (\ (_,(m,_)) (_,(n,_)) -> compare n m) list0 return $ unlines [show n ++ "\t" ++ prt trm | (trm,(n,_)) <- list1] @@ -100,10 +101,10 @@ unSubelimModule mo@(i,m) = case m of -- implementation -type TermList = FiniteMap Term (Int,Int) -- number of occs, id +type TermList = Map Term (Int,Int) -- number of occs, id type TermM a = STM (TermList,Int) a -addSubexpConsts :: Ident -> FiniteMap Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)] +addSubexpConsts :: Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)] addSubexpConsts mo tree lins = do let opers = [oper id trm | (trm,(_,id)) <- list] mapM mkOne $ opers ++ lins @@ -117,19 +118,19 @@ addSubexpConsts mo tree lins = do trm' <- recomp f trm return (f,ResOper ty trm') _ -> return (f,def) - recomp f t = case lookupFM tree t of + recomp f t = case Map.lookup t tree of Just (_,id) | ident id /= f -> return $ I $ cident mo id _ -> composOp (recomp f) t - list = fmToList tree + list = Map.toList tree oper id trm = (ident id, ResOper TStr trm) --- type TStr does not matter -getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (FiniteMap Term (Int,Int)) +getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int)) getSubtermsMod mo js = do mapM (getInfo (collectSubterms mo)) js (tree0,_) <- readSTM - return $ filterFM (\_ (nu,_) -> nu > 1) tree0 + return $ Map.filter (\ (nu,_) -> nu > 1) tree0 where getInfo get fi@(f,i) = case i of CncFun ci xs trm pn -> do @@ -156,10 +157,10 @@ collectSubterms mo t = case t of add t = do (ts,i) <- readSTM let - ((count,id),next) = case lookupFM ts t of + ((count,id),next) = case Map.lookup t ts of Just (nu,id) -> ((nu+1,id), i) _ -> ((1, i ), i+1) - writeSTM (addToFM ts t (count,id), next) + writeSTM (Map.insert t (count,id) ts, next) return t --- only because of composOp ident :: Int -> Ident diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index ce4d89da0..e81ae4781 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -36,7 +36,8 @@ import GF.Probabilistic.Probabilistic (Probs) import Data.List import Data.Maybe (fromMaybe) -import Data.FiniteMap +import Data.Map (Map) +import qualified Data.Map as Map data SRG = SRG { grammarName :: String -- ^ grammar name , startCat :: String -- ^ start category name @@ -58,7 +59,7 @@ data SRGAlt = SRGAlt (Maybe Double) Name [Symbol String Token] -- | SRG category name and original name type CatName = (String,String) -type CatNames = FiniteMap String String +type CatNames = Map String String -- | Create a non-left-recursive SRG. -- FIXME: the probabilities, names and profiles in the returned @@ -103,7 +104,7 @@ makeSRG_ f i opts probs gr rs = map (cfgRulesToSRGRule names probs) cfgRules -- FIXME: merge alternatives with same rhs and profile but different probabilities -cfgRulesToSRGRule :: FiniteMap String String -> Maybe Probs -> [CFRule_] -> SRGRule +cfgRulesToSRGRule :: Map String String -> Maybe Probs -> [CFRule_] -> SRGRule cfgRulesToSRGRule names probs rs@(r:_) = SRGRule cat origCat rhs where origCat = lhsCat r cat = lookupFM_ names origCat @@ -122,16 +123,16 @@ lookupProb probs i = lookupTree prIdent i probs mkCatNames :: String -- ^ Category name prefix -> [String] -- ^ Original category names - -> FiniteMap String String -- ^ Maps original names to SRG names -mkCatNames prefix origNames = listToFM (zip origNames names) + -> Map String String -- ^ Maps original names to SRG names +mkCatNames prefix origNames = Map.fromList (zip origNames names) where names = [prefix ++ "_" ++ show x | x <- [0..]] -- -- * Utilities for building and printing SRGs -- -lookupFM_ :: (Ord key, Show key) => FiniteMap key elt -> key -> elt -lookupFM_ fm k = lookupWithDefaultFM fm (error $ "Key not found: " ++ show k) k +lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt +lookupFM_ fm k = Map.findWithDefault (error $ "Key not found: " ++ show k) k fm prtS :: Print a => a -> ShowS prtS = showString . prt \ No newline at end of file diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 38148418c..44ecd1bb0 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -34,7 +34,8 @@ import GF.Infra.Print import GF.Speech.FiniteState import Control.Monad -import Data.FiniteMap +import Data.Map (Map) +import qualified Data.Map as Map import Data.List import Data.Maybe (fromMaybe) import Data.Monoid (mconcat) @@ -60,7 +61,7 @@ getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s" -- | Group productions by their lhs categories groupProds :: [CFRule_] -> CFRules -groupProds = fmToList . addListToFM_C (++) emptyFM . map (\r -> (lhsCat r,[r])) +groupProds = Map.toList . Map.fromListWith (++) . map (\r -> (lhsCat r,[r])) ungroupProds :: CFRules -> [CFRule_] ungroupProds = concat . map snd