move GF.Formalism.FCFG types to GF.GFCC.DataGFCC

1 files changed, 52 insertions, 53 deletions

diff --git a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
index cebc06a31..73b362888 100644
--- a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
+++ b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
@@ -5,12 +5,11 @@ import GF.GFCC.DataGFCC
 import GF.GFCC.Raw.AbsGFCCRaw
 
 import GF.Infra.PrintClass
-import GF.Formalism.FCFG
 import GF.Formalism.Utilities
-import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
+import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
 
 import qualified Data.Array as Array
-import Data.Map
+import qualified Data.Map   as Map
 
 pgfMajorVersion, pgfMinorVersion :: Integer
 (pgfMajorVersion, pgfMinorVersion) = (1,0)
@@ -30,35 +29,35 @@ toGFCC (Grm [
   ]) = GFCC {
     absname = mkCId a,
     cncnames = [mkCId c | App c [] <- cs],
-    gflags = fromAscList [(mkCId f,v) | App f [AStr v] <- gfs],
+    gflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs],
     abstract = 
      let
-      aflags  = fromAscList [(mkCId f,v) | App f [AStr v] <- gfs]
+      aflags  = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs]
       lfuns   = [(mkCId f,(toType typ,toExp def)) | App f [typ, def] <- fs]
-      funs    = fromAscList lfuns
+      funs    = Map.fromAscList lfuns
       lcats   = [(mkCId c, Prelude.map toHypo hyps) | App c hyps <- cts]
-      cats    = fromAscList lcats
-      catfuns = fromAscList 
+      cats    = Map.fromAscList lcats
+      catfuns = Map.fromAscList 
         [(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
      in Abstr aflags funs cats catfuns,
-    concretes = fromAscList [(mkCId lang, toConcr ts) | App lang ts <- ccs]
+    concretes = Map.fromAscList [(mkCId lang, toConcr ts) | App lang ts <- ccs]
     }
  where
 
 toConcr :: [RExp] -> Concr
 toConcr = foldl add (Concr {
-               cflags       = empty,
-               lins         = empty,
-               opers        = empty,
-               lincats      = empty,
-               lindefs      = empty,
-               printnames   = empty,
-               paramlincats = empty,
+               cflags       = Map.empty,
+               lins         = Map.empty,
+               opers        = Map.empty,
+               lincats      = Map.empty,
+               lindefs      = Map.empty,
+               printnames   = Map.empty,
+               paramlincats = Map.empty,
                parser       = Nothing
              })
   where
     add :: Concr -> RExp -> Concr
-    add cnc (App "flags" ts)     = cnc { cflags = fromAscList [(mkCId f,v) | App f [AStr v] <- ts] }
+    add cnc (App "flags" ts)     = cnc { cflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- ts] }
     add cnc (App "lin" ts)       = cnc { lins = mkTermMap ts }
     add cnc (App "oper" ts)      = cnc { opers = mkTermMap ts }
     add cnc (App "lincat" ts)    = cnc { lincats = mkTermMap ts }
@@ -70,8 +69,8 @@ toConcr = foldl add (Concr {
 toPInfo :: [RExp] -> FCFPInfo
 toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
   where 
-    rules = lmap toFRule rs
-    cats = fromList [(mkCId c, lmap expToInt fs) | App c fs <- cs]
+    rules = map toFRule rs
+    cats = Map.fromList [(mkCId c, map expToInt fs) | App c fs <- cs]
 
     toFRule :: RExp -> FRule
     toFRule (App "rule"
@@ -80,13 +79,13 @@ toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
                App "R" ls]) = FRule fun prof args res lins
       where 
         (fun,prof) = toFName n
-        args = lmap expToInt at
+        args = map expToInt at
         res  = expToInt rt
         lins = mkArray [mkArray [toSymbol s | s <- l] | App "S" l <- ls]
 
 toFName :: RExp -> (CId,[Profile])
 toFName (App "_A" [x]) = (wildCId, [[expToInt x]])
-toFName (App f ts)     = (mkCId f, lmap toProfile ts)
+toFName (App f ts)     = (mkCId f, map toProfile ts)
     where
       toProfile :: RExp -> Profile
       toProfile AMet           = []
@@ -100,7 +99,7 @@ toSymbol (AStr t) = FSymTok t
 toType :: RExp -> Type
 toType e = case e of
   App cat [App "H" hypos, App "X" exps] -> 
-    DTyp (lmap toHypo hypos) (mkCId cat) (lmap toExp exps) 
+    DTyp (map toHypo hypos) (mkCId cat) (map toExp exps) 
   _ -> error $ "type " ++ show e
 
 toHypo :: RExp -> Hypo
@@ -111,9 +110,9 @@ toHypo e = case e of
 toExp :: RExp -> Exp
 toExp e = case e of
   App "App" [App fun [], App "B" xs, App "X" exps] ->
-    DTr [mkCId x | App x [] <- xs] (AC (mkCId fun)) (lmap toExp exps)
+    DTr [mkCId x | App x [] <- xs] (AC (mkCId fun)) (map toExp exps)
   App "Eq" eqs -> 
-    EEq [Equ (lmap toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
+    EEq [Equ (map toExp ps) (toExp v) | App "E" (v:ps) <- eqs]
   App "Var" [App i []] -> DTr [] (AV (mkCId i)) []
   AMet -> DTr [] (AM 0) []
   AInt i -> DTr [] (AI i) []
@@ -123,9 +122,9 @@ toExp e = case e of
 
 toTerm :: RExp -> Term
 toTerm e = case e of
-  App "R" es    -> R  (lmap toTerm es)
-  App "S" es    -> S  (lmap toTerm es)
-  App "FV" es   -> FV (lmap toTerm es)
+  App "R" es    -> R  (map toTerm es)
+  App "S" es    -> S  (map toTerm es)
+  App "FV" es   -> FV (map toTerm es)
   App "P" [e,v] -> P  (toTerm e) (toTerm v)
   App "W" [AStr s,v] -> W s (toTerm v)
   App "A" [AInt i] -> V (fromInteger i)
@@ -142,33 +141,33 @@ toTerm e = case e of
 fromGFCC :: GFCC -> Grammar
 fromGFCC gfcc0 = Grm [
   App "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
-             : App (prCId (absname gfcc)) [] : lmap (flip App [] . prCId) (cncnames gfcc)), 
-  App "flags" [App (prCId f) [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)],
+             : App (prCId (absname gfcc)) [] : map (flip App [] . prCId) (cncnames gfcc)), 
+  App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (gflags gfcc `Map.union` aflags agfcc)],
   App "abstract" [
-    App "fun"   [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
-    App "cat"   [App (prCId f) (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
+    App "fun"   [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- Map.toList (funs agfcc)],
+    App "cat"   [App (prCId f) (map fromHypo hs) | (f,hs) <- Map.toList (cats agfcc)]
     ],
-  App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
+  App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- Map.toList (concretes gfcc)]
   ]
  where
   gfcc = utf8GFCC gfcc0
   agfcc = abstract gfcc
   fromConcrete cnc = [
-      App "flags"     [App (prCId f) [AStr v]     | (f,v) <- toList (cflags cnc)],
-      App "lin"       [App (prCId f) [fromTerm v] | (f,v) <- toList (lins cnc)],
-      App "oper"      [App (prCId f) [fromTerm v] | (f,v) <- toList (opers cnc)],
-      App "lincat"    [App (prCId f) [fromTerm v] | (f,v) <- toList (lincats cnc)],
-      App "lindef"    [App (prCId f) [fromTerm v] | (f,v) <- toList (lindefs cnc)],
-      App "printname" [App (prCId f) [fromTerm v] | (f,v) <- toList (printnames cnc)],
-      App "param"     [App (prCId f) [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
+      App "flags"     [App (prCId f) [AStr v]     | (f,v) <- Map.toList (cflags cnc)],
+      App "lin"       [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lins cnc)],
+      App "oper"      [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (opers cnc)],
+      App "lincat"    [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lincats cnc)],
+      App "lindef"    [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lindefs cnc)],
+      App "printname" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (printnames cnc)],
+      App "param"     [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (paramlincats cnc)]
      ] ++ maybe [] (\p -> [fromPInfo p]) (parser cnc)
 
 fromType :: Type -> RExp
 fromType e = case e of
   DTyp hypos cat exps -> 
     App (prCId cat) [
-      App "H" (lmap fromHypo hypos), 
-      App "X" (lmap fromExp exps)] 
+      App "H" (map fromHypo hypos), 
+      App "X" (map fromExp exps)] 
 
 fromHypo :: Hypo -> RExp
 fromHypo e = case e of
@@ -177,21 +176,21 @@ fromHypo e = case e of
 fromExp :: Exp -> RExp
 fromExp e = case e of
   DTr xs (AC fun) exps ->
-    App "App" [App (prCId fun) [], App "B" (lmap (flip App [] . prCId) xs), App "X" (lmap fromExp exps)]
+    App "App" [App (prCId fun) [], App "B" (map (flip App [] . prCId) xs), App "X" (map fromExp exps)]
   DTr [] (AV x) [] -> App "Var" [App (prCId x) []]
   DTr [] (AS s) [] -> AStr s
   DTr [] (AF d) [] -> AFlt d
   DTr [] (AI i) [] -> AInt (toInteger i)
   DTr [] (AM _) [] -> AMet ----
   EEq eqs -> 
-    App "Eq" [App "E" (lmap fromExp (v:ps)) | Equ ps v <- eqs]
+    App "Eq" [App "E" (map fromExp (v:ps)) | Equ ps v <- eqs]
   _ -> error $ "exp " ++ show e
 
 fromTerm :: Term -> RExp
 fromTerm e = case e of
-  R es    -> App "R" (lmap fromTerm es)
-  S es    -> App "S" (lmap fromTerm es)
-  FV es   -> App "FV" (lmap fromTerm es)
+  R es    -> App "R" (map fromTerm es)
+  S es    -> App "S" (map fromTerm es)
+  FV es   -> App "FV" (map fromTerm es)
   P e v   -> App "P"  [fromTerm e, fromTerm v]
   W s v   -> App "W" [AStr s, fromTerm v]
   C i     -> AInt (toInteger i)
@@ -201,31 +200,31 @@ fromTerm e = case e of
   K (KS s) -> AStr s ----
   K (KP d vs) -> App "FV" (str d : [str v | Var v _ <- vs]) ----
  where
-   str v = App "S" (lmap AStr v)
+   str v = App "S" (map AStr v)
 
 -- ** Parsing info
 
 fromPInfo :: FCFPInfo -> RExp
 fromPInfo p = App "parser" [
           App "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
-          App "startupcats"   [App (prCId f) (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
+          App "startupcats"   [App (prCId f) (map intToExp cs) | (f,cs) <- Map.toList (startupCats p)]
         ]
 
 fromFRule :: FRule -> RExp
 fromFRule (FRule fun prof args res lins) = 
     App "rule" [fromFName (fun,prof),
-                App "cats" (intToExp res:lmap intToExp args),
+                App "cats" (intToExp res:map intToExp args),
                 App "R" [App "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
                ]
 
 fromFName :: (CId,[Profile]) -> RExp
 fromFName (f,ps) | f == wildCId = fromProfile (head ps)
-                 | otherwise    = App (prCId f) (lmap fromProfile ps)
+                 | otherwise    = App (prCId f) (map fromProfile ps)
   where
     fromProfile :: Profile -> RExp
     fromProfile []   = AMet
     fromProfile [x]  = daughter x
-    fromProfile args = App "_U" (lmap daughter args)
+    fromProfile args = App "_U" (map daughter args)
 
     daughter n = App "_A" [intToExp n]
 
@@ -235,8 +234,8 @@ fromSymbol (FSymTok t) = AStr t
 
 -- ** Utilities
 
-mkTermMap :: [RExp] -> Map CId Term
-mkTermMap ts = fromAscList [(mkCId f,toTerm v) | App f [v] <- ts]
+mkTermMap :: [RExp] -> Map.Map CId Term
+mkTermMap ts = Map.fromAscList [(mkCId f,toTerm v) | App f [v] <- ts]
 
 mkArray :: [a] -> Array.Array Int a
 mkArray xs = Array.listArray (0, length xs - 1) xs