refactor the GF.Grammar.Grammar syntax. The obsolete constructions are removed

3 files changed, 14 insertions, 62 deletions

diff --git a/src/GF/Source/CF.hs b/src/GF/Source/CF.hs
index b268a8ecd..ae42958b6 100644
--- a/src/GF/Source/CF.hs
+++ b/src/GF/Source/CF.hs
@@ -81,8 +81,8 @@ type CFFun = String
 
 cf2gf :: String -> CF -> SourceGrammar
 cf2gf name cf = MGrammar [
-  (aname, ModMod (emptyModule {mtype = MTAbstract,       jments = abs})),
-  (cname, ModMod (emptyModule {mtype = MTConcrete aname, jments = cnc}))
+  (aname, emptyModInfo{mtype = MTAbstract,       jments = abs}),
+  (cname, emptyModInfo{mtype = MTConcrete aname, jments = cnc})
   ]
  where
    (abs,cnc) = cf2grammar cf
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index 73b0feafd..d16d75971 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -35,13 +35,13 @@ trGrammar :: SourceGrammar -> P.Grammar
 trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
 
 trModule :: (Ident,SourceModInfo) -> P.ModDef
-trModule (i,mo) = case mo of
-  ModMod m -> P.MModule compl typ body where
+trModule (i,m) = P.MModule compl typ body
+  where
     compl = case mstatus m of
       MSIncomplete -> P.CMIncompl
       _ -> P.CMCompl
     i' = tri i
-    typ = case typeOfModule mo of
+    typ = case mtype m of
       MTResource -> P.MTResource i'
       MTAbstract -> P.MTAbstract i'
       MTConcrete a -> P.MTConcrete i' (tri a)
@@ -66,15 +66,8 @@ forName (MTConcrete a) = tri a
 
 trOpen :: OpenSpec Ident -> P.Open
 trOpen o = case o of
-  OSimple OQNormal i -> P.OName (tri i)
-  OSimple q i -> P.OQualQO (trQualOpen q) (tri i)
-  OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j)
-
-trQualOpen q = case q of
-  OQNormal -> P.QOCompl
-  OQIncomplete -> P.QOIncompl
-  OQInterface -> P.QOInterface
-
+  OSimple i   -> P.OName (tri i)
+  OQualif i j -> P.OQual P.QOCompl (tri i) (tri j)
 
 mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
 mkTopDefs ds = ds
@@ -87,8 +80,6 @@ trAnyDef (i,info) = let i' = tri i in case info of
     Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
     _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
-  ---- don't destroy definitions!
-  AbsTrans f -> [P.DefTrans [P.DDef [mkName i'] (trt f)]]
 
   ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
   ResParam pp -> [P.DefPar [case pp of
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index da5ab180d..61912704b 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -70,15 +70,9 @@ transGrammar x = case x of
     moddefs' <- mapM transModDef moddefs
     GD.mkSourceGrammar moddefs'
 
-transModDef :: ModDef -> Err (Ident, G.SourceModInfo)
+transModDef :: ModDef -> Err G.SourceModule
 transModDef x = case x of
 
-  MMain id0 id concspecs  -> do
-    id0' <- transIdent id0
-    id'  <- transIdent id
-    concspecs' <- mapM transConcSpec concspecs
-    return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs'))
-
   MModule compl mtyp body -> do
 
     let mstat' = transComplMod compl
@@ -117,14 +111,7 @@ transModDef x = case x of
         defs'    <- U.buildAnyTree [(i,d) | Left  ds <- defs0, (i,_,d) <- ds]
         flags'   <- return $ concatOptions [o | Right o <- defs0]
         let poss1 = buildPosTree id' poss0
-        return (id',
-          GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1))
-       MReuse _ -> do
-        return (id', GM.ModMod (GM.Module mtyp' mstat' noOptions [] [] emptyBinTree poss))
-       MUnion imps -> do
-        imps' <- mapM transIncluded imps        
-        return (id', 
-          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' noOptions [] [] emptyBinTree poss))
+        return (id', GM.ModInfo mtyp' mstat' flags' extends' Nothing opens' defs' poss1)
 
        MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
        MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
@@ -139,21 +126,11 @@ transModDef x = case x of
         defs'    <- U.buildAnyTree [(i,d) | Left  ds <- defs0, (i,_,d) <- ds]
         flags'   <- return $ concatOptions [o | Right o <- defs0]
         let poss1 = buildPosTree id' poss0
-        return (id',
-          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1) m' insts')
+        return (id', GM.ModInfo mtyp' mstat' flags' extends' (Just (fst m',snd m',insts')) opens' defs' poss1)
 
       mkModRes id mtyp body = do
          id' <- transIdent id
-         case body of
-           MReuse c -> do
-             c' <- transIdent c
-             mtyp' <- trMReuseType mtyp c'
-             return (transResDef, GM.MTReuse mtyp', id')
-           _ -> return (transResDef, mtyp, id')
-      trMReuseType mtyp c = case mtyp of
-         GM.MTInterface -> return $ GM.MRInterface c
-         GM.MTInstance op -> return $ GM.MRInstance c op
-         GM.MTResource -> return $ GM.MRResource c
+         return (transResDef, mtyp, id')
 
 
 transComplMod :: ComplMod -> GM.ModuleStatus
@@ -164,13 +141,6 @@ transComplMod x = case x of
 getTopDefs :: [TopDef] -> [TopDef]
 getTopDefs x = x
 
-transConcSpec :: ConcSpec -> Err (GM.MainConcreteSpec Ident)
-transConcSpec x = case x of
-  ConcSpec id concexp  -> do
-    id' <- transIdent id
-    (m,mi,mo) <- transConcExp concexp
-    return $ GM.MainConcreteSpec id' m mi mo
-
 transConcExp :: ConcExp -> 
        Err (Ident, Maybe (GM.OpenSpec Ident),Maybe (GM.OpenSpec Ident))
 transConcExp x = case x of
@@ -205,15 +175,9 @@ transOpens x = case x of
 
 transOpen :: Open -> Err (GM.OpenSpec Ident)
 transOpen x = case x of
-  OName id     -> liftM   (GM.OSimple GM.OQNormal) $ transIdent id
-  OQualQO q id -> liftM2  GM.OSimple (transQualOpen q) (transIdent id)
-  OQual q id m -> liftM3  GM.OQualif  (transQualOpen q) (transIdent id) (transIdent m)
-
-transQualOpen :: QualOpen -> Err GM.OpenQualif
-transQualOpen x = case x of
-  QOCompl  -> return GM.OQNormal
-  QOInterface  -> return GM.OQInterface
-  QOIncompl  -> return GM.OQIncomplete
+  OName id     -> liftM  GM.OSimple (transIdent id)
+  OQualQO q id -> liftM  GM.OSimple (transIdent id)
+  OQual q id m -> liftM2 GM.OQualif (transIdent id) (transIdent m)
 
 transIncluded :: Included -> Err (Ident,[Ident])
 transIncluded x = case x of
@@ -261,9 +225,6 @@ transAbsDef x = case x of
     returnl $ 
       [(c, nopos, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
       [(f, nopos, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
-  DefTrans defs  -> do
-    defs' <- liftM concat $ mapM getDefsGen defs
-    returnl [(c, nopos, G.AbsTrans f) | ((c,p),(_,Yes f)) <- defs']
   DefFlag defs -> liftM (Right . concatOptions) $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
  where