extended functor syntax

1 files changed, 25 insertions, 17 deletions

diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 7e525a4b9..28cb9025b 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -92,32 +92,40 @@ transModDef x = case x of
         open' <- transIdent open
         mkModRes id (GM.MTInstance open') body
 
-    case body of 
-      MBody extends opens defs -> do
+    mkBody (mstat', trDef, mtyp', id') body
+  where
+      mkBody xx@(mstat', trDef, mtyp', id') bod = case bod of 
+       MNoBody incls -> do
+        mkBody xx $ MBody (Ext incls) NoOpens []
+       MBody extends opens defs -> do
         extends' <- transExtend extends
         opens'   <- transOpens opens
         defs0    <- mapM trDef $ getTopDefs defs
         defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
         flags'   <- return       [f | Right fs <- defs0, f <- fs]
         return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
-      MReuse _ -> do
+       MReuse _ -> do
         return (id', GM.ModMod (GM.Module mtyp' mstat' [] [] [] emptyBinTree))
-      MUnion imps -> do
+       MUnion imps -> do
         imps' <- mapM transIncluded imps        
         return (id', 
           GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] [] [] emptyBinTree))
-  
-      MWith m opens -> do
-        m'       <- transIdent m
-        opens'   <- mapM transOpen opens 
-        return (id', GM.ModWith mtyp' mstat' m' [] opens')
-      MWithE extends m opens -> do
+
+       MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
+       MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
+       MWithE extends m insts -> mkBody xx $ MWithEBody extends m insts NoOpens []
+       MWithEBody extends m insts opens defs -> do
         extends' <- mapM transIncludedExt extends
-        m'       <- transIdent m
-        opens'   <- mapM transOpen opens 
-        return (id', GM.ModWith mtyp' mstat' m' extends' opens')
- where
-       mkModRes id mtyp body = do
+        m'       <- transIncludedExt m
+        insts'   <- mapM transOpen insts 
+        opens'   <- transOpens opens
+        defs0    <- mapM trDef $ getTopDefs defs
+        defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+        flags'   <- return       [f | Right fs <- defs0, f <- fs]
+        return (id',
+          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs') m' insts')
+
+      mkModRes id mtyp body = do
          id' <- transIdent id
          case body of
            MReuse c -> do
@@ -125,7 +133,7 @@ transModDef x = case x of
              mtyp' <- trMReuseType mtyp c'
              return (transResDef, GM.MTReuse mtyp', id')
            _ -> return (transResDef, mtyp, id')
-       trMReuseType mtyp c = case mtyp of
+      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
@@ -715,4 +723,4 @@ mkConsId = prefixId "Cons"
 mkBaseId = prefixId "Base"
 
 prefixId :: String -> Ident -> Ident
-prefixId pref id = IC (pref ++ prIdent id)
\ No newline at end of file
+prefixId pref id = IC (pref ++ prIdent id)