restricted inheritance almost implemented

2 files changed, 19 insertions, 14 deletions

diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index 8b10b7dee..ad89d5540 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/26 14:18:17 $ 
+-- > CVS $Date: 2005/05/30 21:08:15 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.21 $
+-- > CVS $Revision: 1.22 $
 --
 -- From internal source syntax to BNFC-generated (used for printing).
 -----------------------------------------------------------------------------
@@ -45,12 +45,17 @@ trModule (i,mo) = case mo of
       MTInstance a -> P.MTInstance i' (tri a)
       MTInterface -> P.MTInterface i'
     body = P.MBody 
-             (trExtend (extends m)) 
+             (trExtends (extend m)) 
              (mkOpens (map trOpen (opens m)))
              (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ map trFlag (flags m)))
 
-trExtend :: [Ident] -> P.Extend
-trExtend i = ifNull P.NoExt (P.Ext . map (P.IAll . tri)) i ---- IAll
+trExtends :: [(Ident,MInclude Ident)] -> P.Extend
+trExtends [] = P.NoExt 
+trExtends es = (P.Ext $ map tre es) where
+  tre (i,c) = case c of 
+    MIAll       -> P.IAll   (tri i)
+    MIOnly is   -> P.ISome  (tri i) (map tri is)
+    MIExcept is -> P.IMinus (tri i) (map tri is)
 
 ---- this has to be completed with other mtys
 forName (MTConcrete a) = tri a
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 2247bd8d7..4af60f1bf 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/30 18:39:44 $ 
+-- > CVS $Date: 2005/05/30 21:08:15 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.25 $
+-- > CVS $Revision: 1.26 $
 --
 -- based on the skeleton Haskell module generated by the BNF converter
 -----------------------------------------------------------------------------
@@ -112,7 +112,7 @@ transModDef x = case x of
         opens'   <- mapM transOpen opens 
         return (id', GM.ModWith mtyp' mstat' m' [] opens')
       MWithE extends m opens -> do
-        extends' <- mapM transIncludedExt extends
+        extends' <- liftM (map fst) $ mapM transIncludedExt extends
         m'       <- transIdent m
         opens'   <- mapM transOpen opens 
         return (id', GM.ModWith mtyp' mstat' m' extends' opens')
@@ -168,7 +168,7 @@ transTransfer x = case x of
   TransferIn open  -> liftM Left  $ transOpen open
   TransferOut open -> liftM Right $ transOpen open
 
-transExtend :: Extend -> Err [Ident]
+transExtend :: Extend -> Err [(Ident,GM.MInclude Ident)]
 transExtend x = case x of
   Ext ids  -> mapM transIncludedExt ids
   NoExt -> return []
@@ -192,15 +192,15 @@ transQualOpen x = case x of
 
 transIncluded :: Included -> Err (Ident,[Ident])
 transIncluded x = case x of
-  IAll i  -> liftM (flip (curry id) []) $ transIdent i
+  IAll i        -> liftM (flip (curry id) []) $ transIdent i
   ISome  i ids  -> liftM2 (curry id) (transIdent i) (mapM transIdent ids)
   IMinus i ids  -> liftM2 (curry id) (transIdent i) (mapM transIdent ids) ----
 
-transIncludedExt :: Included -> Err Ident ---- (Ident,[Ident])
+transIncludedExt :: Included -> Err (Ident, GM.MInclude Ident)
 transIncludedExt x = case x of
-  IAll i       -> transIdent i
-  ISome  i ids -> transIdent i
-  IMinus i ids -> transIdent i
+  IAll i       -> liftM2 (,) (transIdent i) (return GM.MIAll)
+  ISome  i ids -> liftM2 (,) (transIdent i) (liftM GM.MIOnly   $ mapM transIdent ids) 
+  IMinus i ids -> liftM2 (,) (transIdent i) (liftM GM.MIExcept $ mapM transIdent ids)
 
 transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
 transAbsDef x = case x of