Started with unions.

src/GF/Source/AbsGF.hs

@@ -41,6 +41,7 @@ data ModBody =
    MBody Extend Opens [TopDef]
  | MWith Ident [Open]
  | MReuse Ident
+ | MUnion [Included]
   deriving (Eq,Ord,Show)
 
 data Extend =
@@ -70,6 +71,11 @@ data QualOpen =
  | QOInterface
   deriving (Eq,Ord,Show)
 
+data Included =
+   IAll Ident
+ | ISome Ident [Ident]
+  deriving (Eq,Ord,Show)
+
 data Def =
    DDecl [Ident] Exp
  | DDef [Ident] Exp

src/GF/Source/GF.cf

@@ -41,6 +41,7 @@ MTTransfer.  ModType ::= "transfer" Ident ":" Open "->" Open ;
 MBody.  ModBody ::= Extend Opens "{" [TopDef] "}" ;
 MWith.  ModBody ::= Ident "with" [Open] ;
 MReuse. ModBody ::= "reuse" Ident ;
+MUnion. ModBody ::= "union" [Included] ;
 
 separator TopDef "" ;
 
@@ -62,6 +63,11 @@ QOCompl.     QualOpen ::= ;
 QOIncompl.   QualOpen ::= "incomplete" ;
 QOInterface. QualOpen ::= "interface" ;
 
+separator Included "," ;
+
+IAll.  Included ::= Ident ;
+ISome. Included ::= Ident "[" [Ident] "]" ;
+
 -- definitions after the $oper$ keywords
 
 DDecl.  Def ::= [Ident] ":" Exp ;

src/GF/Source/LexGF.hs

@@ -55,7 +55,7 @@ tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
   isResWord s = isInTree s $
-    B "interface" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "grammar" (B "fn" (B "flags" (B "def" N N) N) (B "fun" N N)) (B "incomplete" (B "include" (B "in" N N) N) (B "instance" N N)))) (B "pattern" (B "of" (B "lincat" (B "lin" (B "let" N N) N) (B "lintype" (B "lindef" N N) N)) (B "out" (B "oper" (B "open" N N) N) (B "param" N N))) (B "strs" (B "resource" (B "printname" (B "pre" N N) N) (B "reuse" N N)) (B "variants" (B "transfer" (B "table" N N) N) (B "with" N N))))
+    B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N))))
 
 data BTree = N | B String BTree BTree deriving (Show)
 

src/GF/Source/PrintGF.hs

@@ -134,7 +134,7 @@ instance Print ModBody where
    MBody extend opens topdefs -> prPrec i 0 (concat [prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
    MWith id opens -> prPrec i 0 (concat [prt 0 id , ["with"] , prt 0 opens])
    MReuse id -> prPrec i 0 (concat [["reuse"] , prt 0 id])
-
+   MUnion includeds -> prPrec i 0 (concat [["union"] , prt 0 includeds])
 
 instance Print Extend where
   prt i e = case e of
@@ -171,6 +171,15 @@ instance Print QualOpen where
    QOIncompl  -> prPrec i 0 (concat [["incomplete"]])
    QOInterface  -> prPrec i 0 (concat [["interface"]])
 
+instance Print Included where
+  prt i e = case e of
+   IAll id -> prPrec i 0 (concat [prt 0 id])
+   ISome id ids -> prPrec i 0 (concat [prt 0 id , ["["] , prt 0 ids , ["]"]])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
 
 instance Print Def where
   prt i e = case e of

src/GF/Source/SkelGF.hs

@@ -61,6 +61,7 @@ transModBody x = case x of
   MBody extend opens topdefs  -> failure x
   MWith id opens  -> failure x
   MReuse id  -> failure x
+  MUnion includeds  -> failure x
 
 
 transExtend :: Extend -> Result
@@ -95,6 +96,12 @@ transQualOpen x = case x of
   QOInterface  -> failure x
 
 
+transIncluded :: Included -> Result
+transIncluded x = case x of
+  IAll id  -> failure x
+  ISome id ids  -> failure x
+
+
 transDef :: Def -> Result
 transDef x = case x of
   DDecl ids exp  -> failure x
@@ -209,6 +216,8 @@ transExp x = case x of
   EConcat exp0 exp  -> failure x
   EGlue exp0 exp  -> failure x
   ELet locdefs exp  -> failure x
+  ELetb locdefs exp  -> failure x
+  EWhere exp locdefs  -> failure x
   EEqs equations  -> failure x
   ELString lstring  -> failure x
   ELin id  -> failure x

src/GF/Source/SourceToGrammar.hs

@@ -76,6 +76,11 @@ transModDef x = case x of
         return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
       MReuse _ -> do
         return (id', GM.ModMod (GM.Module mtyp' mstat' [] Nothing [] NT))
+      MUnion imps -> do
+        imps' <- mapM transIncluded imps        
+        return (id', 
+          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] Nothing [] NT))
+  
       MWith m opens -> do
         m'     <- transIdent m
         opens' <- mapM transOpen opens 
@@ -154,6 +159,12 @@ transQualOpen x = case x of
   QOInterface  -> return GM.OQInterface
   QOIncompl  -> return GM.OQIncomplete
 
+transIncluded :: Included -> Err (Ident,[Ident])
+transIncluded x = case x of
+  IAll i  -> liftM (flip (curry id) []) $ transIdent i
+  ISome i ids  -> liftM2 (curry id) (transIdent i) (mapM transIdent ids)
+
+
 transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
 transAbsDef x = case x of
   DefCat catdefs -> do