restored work on Extend and Rename

1 files changed, 14 insertions, 7 deletions

diff --git a/src/GF/Devel/Grammar/SourceToGF.hs b/src/GF/Devel/Grammar/SourceToGF.hs
index fecb5b4ea..e09b9964c 100644
--- a/src/GF/Devel/Grammar/SourceToGF.hs
+++ b/src/GF/Devel/Grammar/SourceToGF.hs
@@ -43,6 +43,8 @@ import Data.Char
 import qualified Data.Map as Map
 import Data.List (genericReplicate)
 
+import Debug.Trace (trace) ----
+
 -- based on the skeleton Haskell module generated by the BNF converter
 
 type Result = Err String
@@ -73,7 +75,7 @@ transModDef :: ModDef -> Err (Ident,Module)
 transModDef x = case x of
   MModule compl mtyp body -> do
 
-    --- let mstat' = transComplMod compl
+    let isCompl = transComplMod compl
 
     (trDef, mtyp', id') <- case mtyp of
       MAbstract id -> do
@@ -90,9 +92,9 @@ transModDef x = case x of
         open' <- transIdent open
         mkModRes id (MTInstance open') body
 
-    mkBody (trDef, mtyp', id') body
+    mkBody (isCompl, trDef, mtyp', id') body
   where
-      mkBody xx@(trDef, mtyp', id') bod = case bod of 
+      mkBody xx@(isc, trDef, mtyp', id') bod = case bod of 
        MNoBody incls -> do
         mkBody xx $ MBody (Ext incls) NoOpens []
        MBody extends opens defs -> do
@@ -102,7 +104,7 @@ transModDef x = case x of
         let defs' = Map.fromListWith unifyJudgements 
                        [(i,Left d) | Left ds <- defs0, (i,d) <- ds]
         let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
-        return (id', Module mtyp' [] [] extends' opens' flags' defs')
+        return (id', Module mtyp' isc [] [] extends' opens' flags' defs')
 
        MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
        MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
@@ -116,7 +118,7 @@ transModDef x = case x of
         let defs'  = Map.fromListWith unifyJudgements 
                        [(i,Left d) | Left ds <- defs0, (i,d) <- ds]
         let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
-        return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs')
+        return (id', Module mtyp' isc [] [(m',insts')] extends' opens' flags' defs')
        _ -> fail "deprecated module form"
 
 
@@ -128,6 +130,11 @@ transModDef x = case x of
 getTopDefs :: [TopDef] -> [TopDef]
 getTopDefs x = x
 
+transComplMod :: ComplMod -> Bool
+transComplMod x = case x of
+  CMCompl   -> True
+  CMIncompl -> False
+
 transExtend :: Extend -> Err [(Ident,MInclude)]
 transExtend x = case x of
   Ext ids  -> mapM transIncludedExt ids
@@ -279,7 +286,7 @@ transResDef x = case x of
      _ -> [(c,j)]
    isOverloading (G.Vr keyw) c fs = 
      prIdent keyw == "overload" &&       -- overload is a "soft keyword"
-     False ---- all (== GP.prt c) (map (GP.prt . fst) fs)
+     True ---- all (== GP.prt c) (map (GP.prt . fst) fs)
 
 transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)])
 transParDef x = case x of
@@ -426,7 +433,7 @@ transExp x = case x of
     exp'  <- transExp exp
     defs0 <- mapM locdef2fields defs
     defs' <- mapM tryLoc $ concat defs0
-    return $ exp' ---- M.mkLet defs' exp'
+    return $ M.mkLet defs' exp'
    where
      tryLoc (c,(mty,Just e)) = return (c,(mty,e))
      tryLoc (c,_) = Bad $ "local definition of" +++ prIdent c +++ "without value"