Added treatment of transfer modules. Aggregation is an example.

5 files changed, 12 insertions, 10 deletions

diff --git a/src/GF/Source/AbsGF.hs b/src/GF/Source/AbsGF.hs
index ce307ee17..0dd825891 100644
--- a/src/GF/Source/AbsGF.hs
+++ b/src/GF/Source/AbsGF.hs
@@ -5,6 +5,7 @@ import Ident --H
 -- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
+
 newtype LString = LString String deriving (Eq,Ord,Show)
 data Grammar =
    Gr [ModDef]
@@ -65,7 +66,7 @@ data TopDef =
  | DefFun [FunDef]
  | DefDef [Def]
  | DefData [DataDef]
- | DefTrans [FlagDef]
+ | DefTrans [Def]
  | DefPar [ParDef]
  | DefOper [Def]
  | DefLincat [PrintDef]
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index a211605fc..73f65c85c 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -20,10 +20,11 @@ trModule (i,mo) = case mo of
                             (map trFlag (flags m))))
  where
    i' = tri i
-   mkModule = case typeOfModule mo of
-     MTResource -> P.MResource
-     MTAbstract -> P.MAbstract
-     MTConcrete a -> P.MConcrete (tri a)
+   mkModule m = case typeOfModule mo of
+     MTResource -> P.MResource m
+     MTAbstract -> P.MAbstract m
+     MTConcrete a -> P.MConcrete m (tri a)
+     MTTransfer a b -> P.MTransfer m (trOpen a) (trOpen b)
 
 trExtend :: Maybe Ident -> P.Extend
 trExtend i = maybe P.NoExt (P.Ext . tri) i
@@ -50,6 +51,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
     _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
   ---- don't destroy definitions!
+  AbsTrans f -> [P.DefTrans [P.DDef [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/PrintGF.hs b/src/GF/Source/PrintGF.hs
index fbb5afafa..3024d49db 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -166,7 +166,7 @@ instance Print TopDef where
    DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
    DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
    DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs])
-   DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
+   DefTrans defs -> prPrec i 0 (concat [["transfer"] , prt 0 defs])
    DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
    DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
    DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs])
diff --git a/src/GF/Source/SkelGF.hs b/src/GF/Source/SkelGF.hs
index f18b5bd7b..5f5c16227 100644
--- a/src/GF/Source/SkelGF.hs
+++ b/src/GF/Source/SkelGF.hs
@@ -88,7 +88,7 @@ transTopDef x = case x of
   DefFun fundefs  -> failure x
   DefDef defs  -> failure x
   DefData datadefs  -> failure x
-  DefTrans flagdefs  -> failure x
+  DefTrans defs  -> failure x
   DefPar pardefs  -> failure x
   DefOper defs  -> failure x
   DefLincat printdefs  -> failure x
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index b6c3f3a44..9e016d711 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -150,9 +150,8 @@ transAbsDef x = case x of
       [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
       [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
   DefTrans defs  -> do
-    let (ids,vals) = unzip [(i,v) | FlagDef i v <- defs]
-    defs' <- liftM2 zip (mapM transIdent ids) (mapM transIdent vals)
-    returnl [(c, G.AbsTrans f) | (c,f) <- defs']
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsTrans f) | (c,(_,Yes f)) <- defs']
   DefFlag defs -> liftM Right $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
  where