restructured some of the new GF format; modules now in place up to gfo generation

14 files changed, 303 insertions, 1293 deletions

diff --git a/src/GF/Devel/Grammar/AppPredefined.hs b/src/GF/Devel/Grammar/AppPredefined.hs
index 41abf4886..c8d2988fd 100644
--- a/src/GF/Devel/Grammar/AppPredefined.hs
+++ b/src/GF/Devel/Grammar/AppPredefined.hs
@@ -18,7 +18,8 @@ module GF.Devel.Grammar.AppPredefined (
   appPredefined
   ) where
 
-import GF.Devel.Grammar.Terms
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 import GF.Devel.Grammar.Macros
 import GF.Devel.Grammar.PrGF (prt,prt_,prtBad)
 import GF.Infra.Ident
diff --git a/src/GF/Devel/Grammar/Compute.hs b/src/GF/Devel/Grammar/Compute.hs
index 82417ec99..449cd3b90 100644
--- a/src/GF/Devel/Grammar/Compute.hs
+++ b/src/GF/Devel/Grammar/Compute.hs
@@ -18,8 +18,8 @@ module GF.Devel.Grammar.Compute (
   computeTermRec
   ) where
 
-import GF.Devel.Grammar.Modules
-import GF.Devel.Grammar.Terms
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 import GF.Devel.Grammar.Macros
 import GF.Devel.Grammar.Lookup
 import GF.Devel.Grammar.PrGF
diff --git a/src/GF/Devel/Grammar/Construct.hs b/src/GF/Devel/Grammar/Construct.hs
new file mode 100644
index 000000000..92e88b577
--- /dev/null
+++ b/src/GF/Devel/Grammar/Construct.hs
@@ -0,0 +1,216 @@
+module GF.Devel.Grammar.Construct where
+
+import GF.Devel.Grammar.Grammar
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map
+import Debug.Trace (trace)
+
+------------------
+-- abstractions on Grammar
+------------------
+
+-- abstractions on GF
+
+emptyGF :: GF
+emptyGF = GF Nothing [] empty empty
+
+type SourceModule = (Ident,Module)
+
+listModules :: GF -> [SourceModule]
+listModules = assocs.gfmodules
+
+addModule :: Ident -> Module -> GF -> GF
+addModule c m gf = gf {gfmodules = insert c m (gfmodules gf)}
+
+-- abstractions on Module
+
+emptyModule :: Ident -> Module
+emptyModule m = Module MTGrammar True [] [] [] [] empty empty
+
+isCompleteModule :: Module -> Bool
+isCompleteModule = miscomplete
+
+isInterface :: Module -> Bool
+isInterface m = case mtype m of
+  MTInterface -> True
+  MTAbstract -> True
+  _ -> False
+
+interfaceName :: Module -> Maybe Ident
+interfaceName mo = case mtype mo of
+  MTInstance i -> return i
+  MTConcrete i -> return i
+  _ -> Nothing
+
+listJudgements :: Module -> [(Ident,Judgement)]
+listJudgements = assocs . mjments
+
+isInherited :: MInclude -> Ident -> Bool
+isInherited mi i = case mi of
+  MIExcept is -> notElem i is
+  MIOnly is -> elem i is
+  _ -> True
+
+-- abstractions on Judgement
+
+isConstructor :: Judgement -> Bool
+isConstructor j = jdef j == EData
+
+isLink :: Judgement -> Bool
+isLink j = jform j == JLink
+
+-- constructing judgements from parse tree
+
+emptyJudgement :: JudgementForm -> Judgement
+emptyJudgement form = Judgement form meta meta meta (identC "#NOLINK") 0 where
+  meta = Meta 0
+
+addJType :: Type -> Judgement -> Judgement
+addJType tr ju = ju {jtype = tr}
+
+addJDef :: Term -> Judgement -> Judgement
+addJDef tr ju = ju {jdef = tr}
+
+addJPrintname :: Term -> Judgement -> Judgement
+addJPrintname tr ju = ju {jprintname = tr}
+
+linkInherited :: Bool -> Ident -> Judgement
+linkInherited can mo = (emptyJudgement JLink){
+  jlink = mo,
+  jdef = if can then EData else Meta 0
+  }
+
+absCat :: Context -> Judgement
+absCat co = addJType (mkProd co typeType) (emptyJudgement JCat)
+
+absFun :: Type -> Judgement
+absFun ty = addJType ty (emptyJudgement JFun)
+
+cncCat :: Type -> Judgement
+cncCat ty = addJType ty (emptyJudgement JLincat)
+
+cncFun :: Term -> Judgement
+cncFun tr = addJDef tr (emptyJudgement JLin)
+
+resOperType :: Type -> Judgement
+resOperType ty = addJType ty (emptyJudgement JOper)
+
+resOperDef :: Term -> Judgement
+resOperDef tr = addJDef tr (emptyJudgement JOper)
+
+resOper :: Type -> Term -> Judgement
+resOper ty tr = addJDef tr (resOperType ty)
+
+resOverload :: [(Type,Term)] -> Judgement
+resOverload tts = resOperDef (Overload tts)
+
+-- param p = ci gi  is encoded as p : ((ci : gi) -> EData) -> Type
+-- we use EData instead of p to make circularity check easier  
+resParam :: [(Ident,Context)] -> Judgement
+resParam cos = addJType constrs (emptyJudgement JParam) where
+  constrs = mkProd [(c,mkProd co EData) | (c,co) <- cos] typeType
+
+-- to enable constructor type lookup:
+-- create an oper for each constructor p = c g, as c : g -> p = EData
+paramConstructors :: Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
+paramConstructors p cs = 
+  [(c,resOper (mkProd co (Con p)) EData) | (c,co) <- cs]
+
+-- unifying contents of judgements
+
+---- used in SourceToGF; make error-free and informative
+unifyJudgements j k = case unifyJudgement j k of
+  Ok l -> l
+  Bad s -> error s
+
+unifyJudgement :: Judgement -> Judgement -> Err Judgement
+unifyJudgement old new = do
+  testErr (jform old == jform new) "different judment forms"
+  [jty,jde,jpri] <- mapM unifyField [jtype,jdef,jprintname]
+  return $ old{jtype = jty, jdef = jde, jprintname = jpri}
+ where
+   unifyField field = unifyTerm (field old) (field new)
+   unifyTerm oterm nterm = case (oterm,nterm) of
+     (Meta _,t) -> return t
+     (t,Meta _) -> return t
+     _ -> do
+       if (nterm /= oterm) 
+          then (trace (unwords ["illegal update of",show oterm,"to",show nterm]) 
+                (return ()))
+          else return () ---- to recover from spurious qualification conflicts
+----       testErr (nterm == oterm) 
+----               (unwords ["illegal update of",prt oterm,"to",prt nterm])
+       return nterm
+
+
+
+-- abstractions on Term
+
+type Cat  = QIdent
+type Fun  = QIdent
+type QIdent = (Ident,Ident)
+
+-- | branches à la Alfa
+newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
+type Con = Ident ---
+
+varLabel :: Int -> Label
+varLabel = LVar
+
+wildPatt :: Patt
+wildPatt = PW
+
+type Trm = Term
+
+mkProd :: Context -> Type -> Type
+mkProd = flip (foldr (uncurry Prod))
+
+-- type constants
+
+typeType :: Type
+typeType = Sort "Type"
+
+typePType :: Type
+typePType = Sort "PType"
+
+typeStr :: Type
+typeStr = Sort "Str"
+
+typeTok :: Type      ---- deprecated
+typeTok = Sort "Tok"  
+
+cPredef :: Ident
+cPredef = identC "Predef"
+
+cPredefAbs :: Ident
+cPredefAbs = identC "PredefAbs"
+
+typeString, typeFloat, typeInt :: Term
+typeInts :: Integer -> Term
+
+typeString = constPredefRes "String"
+typeInt = constPredefRes "Int"
+typeFloat = constPredefRes "Float"
+typeInts i = App (constPredefRes "Ints") (EInt i)
+
+isTypeInts :: Term -> Bool
+isTypeInts ty = case ty of
+  App c _ -> c == constPredefRes "Ints"
+  _ -> False
+
+cnPredef = constPredefRes
+
+constPredefRes :: String -> Term
+constPredefRes s = Q (IC "Predef") (identC s)
+
+isPredefConstant :: Term -> Bool
+isPredefConstant t = case t of
+  Q (IC "Predef") _ -> True
+  Q (IC "PredefAbs") _ -> True
+  _ -> False
+
+
diff --git a/src/GF/Devel/Grammar/GF.cf b/src/GF/Devel/Grammar/GF.cf
deleted file mode 100644
index 6fc9307b2..000000000
--- a/src/GF/Devel/Grammar/GF.cf
+++ /dev/null
@@ -1,319 +0,0 @@
--- AR 2/5/2003, 14-16 o'clock, Torino
-
--- 17/6/2007: marked with suffix --% those lines that are obsolete and
--- should not be included in documentation
-
-entrypoints Grammar, ModDef, 
-  OldGrammar, --%
-  Exp ; -- let's see if more are needed
-
-comment "--" ;
-comment "{-" "-}" ;
-
-
--- identifiers
-
-position token PIdent (letter | '_') (letter | digit | '_' | '\'')* ;
-
--- the top-level grammar
-
-Gr. Grammar ::= [ModDef] ;
-
--- semicolon after module is permitted but not obligatory
-
-terminator ModDef "" ;
-_. ModDef ::= ModDef ";" ;
-
--- the individual modules
-
-MModule. ModDef ::= ComplMod ModType "=" ModBody ;
-
-MAbstract.  ModType ::= "abstract"  PIdent ;
-MResource.  ModType ::= "resource"  PIdent ;
-MGrammar.   ModType ::= "grammar"   PIdent ;
-MInterface. ModType ::= "interface" PIdent ;
-MConcrete.  ModType ::= "concrete"  PIdent "of" PIdent ;
-MInstance.  ModType ::= "instance"  PIdent "of" PIdent ;
-
-MBody.      ModBody ::= Extend Opens "{" [TopDef] "}" ;
-MNoBody.    ModBody ::= [Included] ;
-MWith.      ModBody ::=                 Included "with" [Open] ;
-MWithBody.  ModBody ::=                 Included "with" [Open] "**" Opens "{" [TopDef] "}" ; 
-MWithE.     ModBody ::= [Included] "**" Included "with" [Open] ;
-MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ; 
-
-MReuse. ModBody ::= "reuse" PIdent ; --%
-MUnion. ModBody ::= "union" [Included] ;--%
-
-separator TopDef "" ;
-
-Ext.   Extend ::= [Included] "**" ;
-NoExt. Extend ::= ;
-
-separator Open "," ;
-NoOpens. Opens ::= ;
-OpenIn.  Opens ::= "open" [Open] "in" ;
-
-OName.   Open ::= PIdent ;
--- OQualQO. Open ::= "(" PIdent ")" ; --%
-OQual.   Open ::= "(" PIdent "=" PIdent ")" ;
-
-CMCompl.   ComplMod ::= ;
-CMIncompl. ComplMod ::= "incomplete" ;
-
-separator Included "," ;
-
-IAll.   Included ::= PIdent ;
-ISome.  Included ::= PIdent "[" [PIdent] "]" ;
-IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ;
-
--- top-level definitions
-
-DefCat.    TopDef ::= "cat" [CatDef] ;
-DefFun.    TopDef ::= "fun" [FunDef] ;
-DefFunData.TopDef ::= "data" [FunDef] ;
-DefDef.    TopDef ::= "def" [Def] ;
-DefData.   TopDef ::= "data" [DataDef] ;
-
-DefPar.    TopDef ::= "param" [ParDef] ;
-DefOper.   TopDef ::= "oper"  [Def] ;
-
-DefLincat. TopDef ::= "lincat" [Def] ;
-DefLindef. TopDef ::= "lindef" [Def] ;
-DefLin.    TopDef ::= "lin"    [Def] ;
-
-DefPrintCat. TopDef ::= "printname" "cat" [Def] ;
-DefPrintFun. TopDef ::= "printname" "fun" [Def] ;
-DefFlag.     TopDef ::= "flags" [Def] ;
-
--- definitions after most keywords
-
-DDecl.  Def ::= [Name] ":" Exp ;
-DDef.   Def ::= [Name] "=" Exp ;
-DPatt.  Def ::= Name [Patt] "=" Exp ;  -- non-empty pattern list
-DFull.  Def ::= [Name] ":" Exp "=" Exp ;
-
-FDecl.  FunDef ::= [Name] ":" Exp ;
-
-SimpleCatDef.   CatDef ::= PIdent [DDecl] ;
-ListCatDef.     CatDef ::= "[" PIdent [DDecl] "]" ;
-ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ;
-
-DataDef.   DataDef    ::= Name "=" [DataConstr] ;
-DataId.    DataConstr ::= PIdent ;
-DataQId.   DataConstr ::= PIdent "." PIdent ;
-separator DataConstr "|" ;
-
-ParDefDir.   ParDef ::= PIdent "=" [ParConstr] ;
-ParDefAbs.   ParDef ::= PIdent ;
-
-ParConstr. ParConstr ::= PIdent [DDecl] ;
-
-terminator nonempty Def ";" ;
-terminator nonempty FunDef ";" ;
-terminator nonempty CatDef ";" ;
-terminator nonempty DataDef ";" ;
-terminator nonempty ParDef ";" ;
-
-separator ParConstr "|" ;
-
-separator nonempty PIdent "," ;
-
--- names of categories and functions in definition LHS
-
-PIdentName. Name ::= PIdent ;
-ListName.  Name ::= "[" PIdent "]" ;
-
-separator nonempty Name "," ;
-
--- definitions in records and $let$ expressions
-
-LDDecl.  LocDef ::= [PIdent] ":" Exp ;
-LDDef.   LocDef ::= [PIdent] "=" Exp ;
-LDFull.  LocDef ::= [PIdent] ":" Exp "=" Exp ;
-
-separator LocDef ";" ;
-
--- terms and types
-
-EPIdent.   Exp6 ::= PIdent ;
-EConstr.   Exp6 ::= "{" PIdent "}" ;--%
-ECons.     Exp6 ::= "%" PIdent "%" ;--%
-ESort.     Exp6 ::= Sort ;
-EString.   Exp6 ::= String ;
-EInt.      Exp6 ::= Integer ;
-EFloat.    Exp6 ::= Double ;
-EMeta.     Exp6 ::= "?" ;
-EEmpty.    Exp6 ::= "[" "]" ;
-EData.     Exp6 ::= "data" ;
-EList.     Exp6 ::= "[" PIdent Exps "]" ;
-EStrings.  Exp6 ::= "[" String "]" ;
-ERecord.   Exp6 ::= "{" [LocDef] "}" ; -- !
-ETuple.    Exp6 ::= "<" [TupleComp] ">" ;  --- needed for separator ","
-EIndir.    Exp6 ::= "(" "in" PIdent ")" ;   -- indirection, used in judgements --%
-ETyped.    Exp6 ::= "<" Exp ":" Exp ">" ;  -- typing, used for annotations
-
-EProj.     Exp5 ::= Exp5 "." Label ;
-EQConstr.  Exp5 ::= "{" PIdent "." PIdent "}" ;  -- qualified constructor --%
-EQCons.    Exp5 ::= "%" PIdent "." PIdent  ;     -- qualified constant --%
-
-EApp.      Exp4 ::= Exp4 Exp5 ;
-ETable.    Exp4 ::= "table" "{" [Case] "}" ;
-ETTable.   Exp4 ::= "table" Exp6 "{" [Case] "}" ;
-EVTable.   Exp4 ::= "table" Exp6 "[" [Exp] "]" ;
-ECase.     Exp4 ::= "case" Exp "of" "{" [Case] "}" ;
-EVariants. Exp4 ::= "variants" "{" [Exp] "}" ;
-EPre.      Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
-EStrs.     Exp4 ::= "strs" "{" [Exp] "}" ;
-
-ESelect.   Exp3 ::= Exp3 "!" Exp4 ;
-ETupTyp.   Exp3 ::= Exp3 "*" Exp4 ;
-EExtend.   Exp3 ::= Exp3 "**" Exp4 ;
-
-EGlue.     Exp1 ::= Exp2 "+"  Exp1 ;
-
-EConcat.   Exp  ::= Exp1 "++" Exp ;
-
-EAbstr.    Exp  ::= "\\" [Bind] "->" Exp ;
-ECTable.   Exp  ::= "\\""\\" [Bind] "=>" Exp ;
-EProd.     Exp  ::= Decl "->" Exp ;
-ETType.    Exp  ::= Exp3 "=>" Exp ; -- these are thus right associative
-ELet.      Exp  ::= "let" "{" [LocDef] "}" "in" Exp ;
-ELetb.     Exp  ::= "let" [LocDef] "in" Exp ;
-EWhere.    Exp  ::= Exp3 "where" "{" [LocDef] "}" ;
-EEqs.      Exp  ::= "fn" "{" [Equation] "}" ; --%
-
-EExample.  Exp  ::= "in" Exp5 String ;
-
-coercions Exp 6 ;
-
-separator Exp ";" ; -- in variants
-
--- list of arguments to category
-NilExp. Exps ::= ;
-ConsExp. Exps ::= Exp6 Exps ; -- Exp6 to force parantheses
-
--- patterns
-
-PW.     Patt2  ::= "_" ;
-PV.     Patt2  ::= PIdent ;
-PCon.   Patt2  ::= "{" PIdent "}" ; --%
-PQ.     Patt2  ::= PIdent "." PIdent ;
-PInt.   Patt2  ::= Integer ;
-PFloat. Patt2  ::= Double ;
-PStr.   Patt2  ::= String ;
-PR.     Patt2  ::= "{" [PattAss] "}" ;
-PTup.   Patt2  ::= "<" [PattTupleComp] ">" ;
-PC.     Patt1  ::= PIdent [Patt] ;
-PQC.    Patt1  ::= PIdent "." PIdent [Patt] ;
-PDisj.  Patt   ::= Patt "|" Patt1 ;
-PSeq.   Patt   ::= Patt "+" Patt1 ;
-PRep.   Patt1  ::= Patt2 "*" ;
-PAs.    Patt1  ::= PIdent "@" Patt2 ;
-PNeg.   Patt1  ::= "-" Patt2 ;
-
-coercions Patt 2 ;
-
-PA.  PattAss ::= [PIdent] "=" Patt ;
-
--- labels
-
-LPIdent. Label ::= PIdent ;
-LVar.   Label ::= "$" Integer ;
-
--- basic types
-
-rules Sort ::= 
-    "Type" 
-  | "PType" 
-  | "Tok"  --%
-  | "Str" 
-  | "Strs" ;
-
-separator PattAss ";" ;
-
--- this is explicit to force higher precedence level on rhs
-(:[]). [Patt] ::= Patt2 ;
-(:).   [Patt] ::= Patt2 [Patt] ;
-
-
--- binds in lambdas and lin rules
-
-BPIdent. Bind ::= PIdent ;
-BWild.  Bind ::= "_" ;
-
-separator Bind "," ;
-
-
--- declarations in function types
-
-DDec.  Decl ::= "(" [Bind] ":" Exp ")" ;
-DExp.  Decl ::= Exp4 ; -- can thus be an application
-
--- tuple component (term or pattern)
-
-TComp. TupleComp ::= Exp ;
-PTComp. PattTupleComp ::= Patt ;
-
-separator TupleComp "," ;
-separator PattTupleComp "," ;
-
--- case branches
-
-Case. Case ::= Patt "=>" Exp ;
-
-separator nonempty Case ";" ;
-
--- cases in abstract syntax --%
-
-Equ. Equation ::= [Patt] "->" Exp ; --%
-
-separator Equation ";" ; --%
-
--- prefix alternatives
-
-Alt. Altern ::= Exp "/" Exp ;
-
-separator Altern ";" ;
-
--- in a context, higher precedence is required than in function types
-
-DDDec.  DDecl ::= "(" [Bind] ":" Exp ")" ;
-DDExp.  DDecl ::= Exp6 ;  -- can thus *not* be an application
-
-separator DDecl "" ;
-
-
--------------------------------------- --%
-
--- for backward compatibility --%
-
-OldGr.  OldGrammar ::= Include [TopDef] ; --%
-
-NoIncl. Include ::= ; --%
-Incl.   Include ::= "include" [FileName] ; --%
-
-FString. FileName ::= String ; --%
-
-terminator nonempty FileName ";" ; --%
-
-FPIdent. FileName ::= PIdent ; --%
-FSlash.  FileName ::= "/" FileName ; --%
-FDot.    FileName ::= "." FileName ; --%
-FMinus.  FileName ::= "-" FileName ; --%
-FAddId.  FileName ::= PIdent FileName ; --%
-
-token LString '\'' (char - '\'')* '\'' ; --%
-ELString.  Exp6 ::= LString ; --%
-ELin.      Exp4 ::= "Lin" PIdent ; --%
-
-DefPrintOld.  TopDef ::= "printname" [Def] ; --%
-DefLintype.   TopDef ::= "lintype"   [Def] ; --%
-DefPattern.   TopDef ::= "pattern"   [Def] ; --%
-
--- deprecated packages are attempted to be interpreted --%
-DefPackage.   TopDef ::= "package" PIdent "=" "{" [TopDef] "}" ";" ; --%
-
--- these two are just ignored after parsing --%
-DefVars.      TopDef ::= "var" [Def] ; --%
-DefTokenizer. TopDef ::= "tokenizer" PIdent ";" ; --%
diff --git a/src/GF/Devel/Grammar/GFtoSource.hs b/src/GF/Devel/Grammar/GFtoSource.hs
index 2866c0446..9ac65469a 100644
--- a/src/GF/Devel/Grammar/GFtoSource.hs
+++ b/src/GF/Devel/Grammar/GFtoSource.hs
@@ -9,11 +9,10 @@ module GF.Devel.Grammar.GFtoSource (
   ) where
 
 
-import GF.Devel.Grammar.Modules
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.Terms
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 import GF.Devel.Grammar.Macros (contextOfType)
-import qualified GF.Devel.Grammar.AbsGF as P
+import qualified GF.Devel.Compile.AbsGF as P
 import GF.Infra.Ident
 
 import GF.Data.Operations
@@ -43,7 +42,7 @@ trModule (i,mo) = P.MModule compl typ body where
     body = P.MBody 
              (trExtends (mextends mo)) 
              (mkOpens (map trOpen (mopens mo)))
-             (concatMap trAnyDef [(c,j) | (c,Left j) <- listJudgements mo] ++ 
+             (concatMap trAnyDef [(c,j) | (c,j) <- listJudgements mo] ++ 
                         map trFlag (Map.assocs (mflags mo)))
 
 trExtends :: [(Ident,MInclude)] -> P.Extend
@@ -89,6 +88,7 @@ trAnyDef (i,ju) = let
   JLin -> 
     [P.DefLin [trDef i (Meta 0) (jdef ju)]] 
     ---- ++ [P.DefPrintFun [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
+  JLink -> []
 {-
   ---- encoding of AnyInd without changing syntax. AR 20/9/2007
   AnyInd s b -> 
diff --git a/src/GF/Devel/Grammar/Terms.hs b/src/GF/Devel/Grammar/Grammar.hs
index d57e7c160..eb6d2218a 100644
--- a/src/GF/Devel/Grammar/Terms.hs
+++ b/src/GF/Devel/Grammar/Grammar.hs
@@ -1,14 +1,69 @@
-module GF.Devel.Grammar.Terms where
+module GF.Devel.Grammar.Grammar where
 
 import GF.Infra.Ident
 
 import GF.Data.Operations
 
-type Type = Term
-type Cat  = QIdent
-type Fun  = QIdent
+import Data.Map
+
+
+------------------
+-- definitions  --
+------------------
+
+data GF = GF {
+  gfabsname   :: Maybe Ident ,
+  gfcncnames  :: [Ident] ,
+  gflags      :: Map Ident String ,   -- value of a global flag
+  gfmodules   :: Map Ident Module
+  }
+
+data Module = Module {
+  mtype       :: ModuleType,
+  miscomplete :: Bool,
+  minterfaces :: [(Ident,Ident)],           -- non-empty for functors 
+  minstances  :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for instant'ions
+  mextends    :: [(Ident,MInclude)],
+  mopens      :: [(Ident,Ident)],           -- used name, original name
+  mflags      :: Map Ident String,
+  mjments     :: Map Ident Judgement
+  }
+
+data ModuleType =
+    MTAbstract
+  | MTConcrete Ident
+  | MTInterface
+  | MTInstance Ident
+  | MTGrammar 
+  deriving Eq
+
+data MInclude =
+    MIAll
+  | MIExcept [Ident]
+  | MIOnly [Ident]
+
+type Indirection = (Ident,Bool) -- module of origin, whether canonical
+
+data Judgement = Judgement {
+  jform :: JudgementForm,  -- cat      fun   lincat  lin     oper    param
+  jtype :: Type,           -- context  type  lincat  -       type    constrs
+  jdef  :: Term,           -- lindef   def   lindef  lin     def     values
+  jprintname :: Term,      -- -        -     prname  prname  -       -
+  jlink :: Ident,
+  jposition :: Int
+  }
+
+data JudgementForm =
+    JCat
+  | JFun
+  | JLincat
+  | JLin
+  | JOper
+  | JParam
+  | JLink
+  deriving Eq
 
-type QIdent = (Ident,Ident)
+type Type = Term
 
 data Term =
    Vr Ident             -- ^ variable
@@ -104,15 +159,3 @@ type Assign    = (Label, (Maybe Type, Term))
 type Case      = (Patt, Term) 
 type LocalDef  = (Ident, (Maybe Type, Term))
 
-
--- | branches à la Alfa
-newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
-type Con = Ident ---
-
-varLabel :: Int -> Label
-varLabel = LVar
-
-wildPatt :: Patt
-wildPatt = PW
-
-type Trm = Term
diff --git a/src/GF/Devel/Grammar/Judgements.hs b/src/GF/Devel/Grammar/Judgements.hs
deleted file mode 100644
index b09576e50..000000000
--- a/src/GF/Devel/Grammar/Judgements.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module GF.Devel.Grammar.Judgements where
-
-import GF.Devel.Grammar.Terms
-import GF.Infra.Ident
-
-data Judgement = Judgement {
-  jform :: JudgementForm,  -- cat      fun   lincat  lin     oper    param
-  jtype :: Type,           -- context  type  lincat  -       type    constrs
-  jdef  :: Term,           -- lindef   def   lindef  lin     def     values
-  jprintname :: Term       -- -        -     prname  prname  -       -
-  }
-
-data JudgementForm =
-    JCat
-  | JFun
-  | JLincat
-  | JLin
-  | JOper
-  | JParam
-  deriving Eq
-
diff --git a/src/GF/Devel/Grammar/Lookup.hs b/src/GF/Devel/Grammar/Lookup.hs
index 756345f2e..ac55aec62 100644
--- a/src/GF/Devel/Grammar/Lookup.hs
+++ b/src/GF/Devel/Grammar/Lookup.hs
@@ -1,9 +1,8 @@
 module GF.Devel.Grammar.Lookup where
 
-import GF.Devel.Grammar.Modules
-import GF.Devel.Grammar.Judgements
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 import GF.Devel.Grammar.Macros
-import GF.Devel.Grammar.Terms
 import GF.Devel.Grammar.PrGF
 import GF.Infra.Ident
 
@@ -103,15 +102,19 @@ lookupModule :: GF -> Ident -> Err Module
 lookupModule gf m = do
   maybe (raiseIdent "module not found:" m) return $ mlookup m (gfmodules gf)
 
-lookupIdent :: GF -> Ident -> Ident -> Err JEntry
+-- this finds the immediate definition, which can be a link
+lookupIdent :: GF -> Ident -> Ident -> Err Judgement
 lookupIdent gf m c = do
   mo <- lookupModule gf m
-  maybe (raiseIdent "constant not found" c) return $ mlookup c (mjments mo)
+  maybe (raiseIdent "constant not found:" c) return $ mlookup c (mjments mo)
 
+-- this follows the link
 lookupJudgement :: GF -> Ident -> Ident -> Err Judgement
 lookupJudgement gf m c = do
-  eji <- lookupIdent gf m c
-  either return (\n -> lookupJudgement gf (fst n) c) eji 
+  ju <- lookupIdent gf m c
+  case jform ju of
+    JLink -> lookupJudgement gf (jlink ju) c
+    _ -> return ju
 
 mlookup = Data.Map.lookup
 
diff --git a/src/GF/Devel/Grammar/Macros.hs b/src/GF/Devel/Grammar/Macros.hs
index 0eebfda16..a9059578c 100644
--- a/src/GF/Devel/Grammar/Macros.hs
+++ b/src/GF/Devel/Grammar/Macros.hs
@@ -1,8 +1,7 @@
 module GF.Devel.Grammar.Macros where
 
-import GF.Devel.Grammar.Terms
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.Modules
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 import GF.Infra.Ident
 
 import GF.Data.Str
@@ -81,9 +80,6 @@ typeSkeleton typ = do
 
 -- construct types and terms
 
-mkProd :: Context -> Type -> Type
-mkProd = flip (foldr (uncurry Prod))
-
 mkFunType :: [Type] -> Type -> Type
 mkFunType tt t = mkProd ([(wildIdent, ty) | ty <- tt]) t -- nondep prod
 
@@ -156,49 +152,6 @@ plusRecord t1 t2 =
 zipAssign :: [Label] -> [Term] -> [Assign]
 zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
 
--- type constants
-
-typeType :: Type
-typeType = Sort "Type"
-
-typePType :: Type
-typePType = Sort "PType"
-
-typeStr :: Type
-typeStr = Sort "Str"
-
-typeTok :: Type      ---- deprecated
-typeTok = Sort "Tok"  
-
-cPredef :: Ident
-cPredef = identC "Predef"
-
-cPredefAbs :: Ident
-cPredefAbs = identC "PredefAbs"
-
-typeString, typeFloat, typeInt :: Term
-typeInts :: Integer -> Term
-
-typeString = constPredefRes "String"
-typeInt = constPredefRes "Int"
-typeFloat = constPredefRes "Float"
-typeInts i = App (constPredefRes "Ints") (EInt i)
-
-isTypeInts :: Term -> Bool
-isTypeInts ty = case ty of
-  App c _ -> c == constPredefRes "Ints"
-  _ -> False
-
-cnPredef = constPredefRes
-
-constPredefRes :: String -> Term
-constPredefRes s = Q (IC "Predef") (identC s)
-
-isPredefConstant :: Term -> Bool
-isPredefConstant t = case t of
-  Q (IC "Predef") _ -> True
-  Q (IC "PredefAbs") _ -> True
-  _ -> False
 
 defLinType :: Type
 defLinType = RecType [(LIdent "s",  typeStr)]
@@ -230,10 +183,8 @@ termOpModule f = judgementOpModule fj where
    
 judgementOpModule :: Monad m => (Judgement -> m Judgement) -> Module -> m Module
 judgementOpModule f m = do 
-  mjs <- mapMapM fj (mjments m)
+  mjs <- mapMapM f (mjments m)
   return m {mjments = mjs}
- where
-  fj = either (liftM Left . f) (return . Right)
 
 entryOpModule :: Monad m => 
                  (Ident -> Judgement -> m Judgement) -> Module -> m Module
@@ -241,8 +192,7 @@ entryOpModule f m = do
   mjs <- liftM Map.fromAscList $ mapm $ Map.assocs $ mjments m
   return $ m {mjments = mjs}
  where
-  mapm = mapM (\ (i,j) -> liftM ((,) i) (fe i j)) 
-  fe i j = either (liftM Left . f i) (return . Right) j
+  mapm = mapM (\ (i,j) -> liftM ((,) i) (f i j)) 
    
 termOpJudgement :: Monad m => (Term -> m Term) -> Judgement -> m Judgement
 termOpJudgement f j = do 
diff --git a/src/GF/Devel/Grammar/MkJudgements.hs b/src/GF/Devel/Grammar/MkJudgements.hs
deleted file mode 100644
index 01b5f97d7..000000000
--- a/src/GF/Devel/Grammar/MkJudgements.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-module GF.Devel.Grammar.MkJudgements where
-
-import GF.Devel.Grammar.Macros
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.Terms
-import GF.Devel.Grammar.PrGF
-import GF.Infra.Ident
-
-import GF.Data.Operations
-
-import Control.Monad
-import Data.Map
-
-import Debug.Trace (trace) ----
-
--- constructing judgements from parse tree
-
-emptyJudgement :: JudgementForm -> Judgement
-emptyJudgement form = Judgement form meta meta meta where
-  meta = Meta 0
-
-addJType :: Type -> Judgement -> Judgement
-addJType tr ju = ju {jtype = tr}
-
-addJDef :: Term -> Judgement -> Judgement
-addJDef tr ju = ju {jdef = tr}
-
-addJPrintname :: Term -> Judgement -> Judgement
-addJPrintname tr ju = ju {jprintname = tr}
-
-
-absCat :: Context -> Judgement
-absCat co = addJType (mkProd co typeType) (emptyJudgement JCat)
-
-absFun :: Type -> Judgement
-absFun ty = addJType ty (emptyJudgement JFun)
-
-cncCat :: Type -> Judgement
-cncCat ty = addJType ty (emptyJudgement JLincat)
-
-cncFun :: Term -> Judgement
-cncFun tr = addJDef tr (emptyJudgement JLin)
-
-resOperType :: Type -> Judgement
-resOperType ty = addJType ty (emptyJudgement JOper)
-
-resOperDef :: Term -> Judgement
-resOperDef tr = addJDef tr (emptyJudgement JOper)
-
-resOper :: Type -> Term -> Judgement
-resOper ty tr = addJDef tr (resOperType ty)
-
-resOverload :: [(Type,Term)] -> Judgement
-resOverload tts = resOperDef (Overload tts)
-
--- param p = ci gi  is encoded as p : ((ci : gi) -> EData) -> Type
--- we use EData instead of p to make circularity check easier  
-resParam :: [(Ident,Context)] -> Judgement
-resParam cos = addJType constrs (emptyJudgement JParam) where
-  constrs = mkProd [(c,mkProd co EData) | (c,co) <- cos] typeType
-
--- to enable constructor type lookup:
--- create an oper for each constructor p = c g, as c : g -> p = EData
-paramConstructors :: Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
-paramConstructors p cs = 
-  [(c,resOper (mkProd co (Con p)) EData) | (c,co) <- cs]
-
--- unifying contents of judgements
-
----- used in SourceToGF; make error-free and informative
-unifyJudgements (Left j) (Left k) = Left $ case unifyJudgement j k of
-  Ok l -> l
-  Bad s -> error s
-
-unifyJudgement :: Judgement -> Judgement -> Err Judgement
-unifyJudgement old new = do
-  testErr (jform old == jform new) "different judment forms"
-  [jty,jde,jpri] <- mapM unifyField [jtype,jdef,jprintname]
-  return $ old{jtype = jty, jdef = jde, jprintname = jpri}
- where
-   unifyField field = unifyTerm (field old) (field new)
-   unifyTerm oterm nterm = case (oterm,nterm) of
-     (Meta _,t) -> return t
-     (t,Meta _) -> return t
-     _ -> do
-       if (nterm /= oterm) 
-          then (trace (unwords ["illegal update of",prt oterm,"to",prt nterm]) 
-                (return ()))
-          else return () ---- to recover from spurious qualification conflicts
-----       testErr (nterm == oterm) 
-----               (unwords ["illegal update of",prt oterm,"to",prt nterm])
-       return nterm
-
diff --git a/src/GF/Devel/Grammar/Modules.hs b/src/GF/Devel/Grammar/Modules.hs
deleted file mode 100644
index 43458ce90..000000000
--- a/src/GF/Devel/Grammar/Modules.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-module GF.Devel.Grammar.Modules where
-
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.Terms
-import GF.Infra.Ident
-
-import GF.Data.Operations
-
-import Control.Monad
-import Data.Map
-
-
-data GF = GF {
-  gfabsname   :: Maybe Ident ,
-  gfcncnames  :: [Ident] ,
-  gflags      :: Map Ident String ,   -- value of a global flag
-  gfmodules   :: Map Ident Module
-  }
-
-emptyGF :: GF
-emptyGF = GF Nothing [] empty empty
-
-type SourceModule = (Ident,Module)
-
-listModules :: GF -> [SourceModule]
-listModules = assocs.gfmodules
-
-addModule :: Ident -> Module -> GF -> GF
-addModule c m gf = gf {gfmodules = insert c m (gfmodules gf)}
-
-data Module = Module {
-  mtype       :: ModuleType,
-  miscomplete :: Bool,
-  minterfaces :: [(Ident,Ident)],           -- non-empty for functors 
-  minstances  :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for instant'ions
-  mextends    :: [(Ident,MInclude)],
-  mopens      :: [(Ident,Ident)],           -- used name, original name
-  mflags      :: Map Ident String,
-  mjments     :: MapJudgement 
-  }
-
-emptyModule :: Ident -> Module
-emptyModule m = Module MTGrammar True [] [] [] [] empty empty
-
-type MapJudgement = Map Ident JEntry -- def or indirection
-
-isCompleteModule :: Module -> Bool
-isCompleteModule = miscomplete ---- Prelude.null . minterfaces 
-
-isInterface :: Module -> Bool
-isInterface m = case mtype m of
-  MTInterface -> True
-  MTAbstract -> True
-  _ -> False
-
-interfaceName :: Module -> Maybe Ident
-interfaceName mo = case mtype mo of
-  MTInstance i -> return i
-  MTConcrete i -> return i
-  _ -> Nothing
-
-listJudgements :: Module -> [(Ident,JEntry)]
-listJudgements = assocs . mjments
-
-type JEntry = Either Judgement Indirection
-
-data ModuleType =
-    MTAbstract
-  | MTConcrete Ident
-  | MTInterface
-  | MTInstance Ident
-  | MTGrammar 
-  deriving Eq
-
-data MInclude =
-    MIAll
-  | MIExcept [Ident]
-  | MIOnly [Ident]
-
-type Indirection = (Ident,Bool) -- module of origin, whether canonical
-
-isConstructorEntry :: Either Judgement Indirection -> Bool
-isConstructorEntry ji = case ji of
-  Left j -> isConstructor j
-  Right i -> snd i
-
-isConstructor :: Judgement -> Bool
-isConstructor j = jdef j == EData
-
-isInherited :: MInclude -> Ident -> Bool
-isInherited mi i = case mi of
-  MIExcept is -> notElem i is
-  MIOnly is -> elem i is
-  _ -> True
-
-
diff --git a/src/GF/Devel/Grammar/PatternMatch.hs b/src/GF/Devel/Grammar/PatternMatch.hs
index 193694a27..076aaa25a 100644
--- a/src/GF/Devel/Grammar/PatternMatch.hs
+++ b/src/GF/Devel/Grammar/PatternMatch.hs
@@ -18,7 +18,7 @@ module GF.Devel.Grammar.PatternMatch (matchPattern,
 		    ) where
 
 
-import GF.Devel.Grammar.Terms
+import GF.Devel.Grammar.Grammar
 import GF.Devel.Grammar.Macros
 import GF.Devel.Grammar.PrGF
 import GF.Infra.Ident
diff --git a/src/GF/Devel/Grammar/PrGF.hs b/src/GF/Devel/Grammar/PrGF.hs
index 83ab4c7f1..09df91efc 100644
--- a/src/GF/Devel/Grammar/PrGF.hs
+++ b/src/GF/Devel/Grammar/PrGF.hs
@@ -21,11 +21,10 @@
 
 module GF.Devel.Grammar.PrGF where
 
-import qualified GF.Devel.Grammar.PrintGF as P
+import qualified GF.Devel.Compile.PrintGF as P
 import GF.Devel.Grammar.GFtoSource
-import GF.Devel.Grammar.Modules
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.Terms
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
 ----import GF.Grammar.Values
 
 ----import GF.Infra.Option
@@ -68,9 +67,6 @@ prGF = cprintTree . trGrammar
 prModule :: SourceModule -> String
 prModule = cprintTree . trModule
 
-prJEntry :: JEntry -> String
-prJEntry = either prt show 
-
 instance Print Judgement where
   prt j = cprintTree $ trAnyDef (wildIdent, j)
 ----  prt_ = prExp
diff --git a/src/GF/Devel/Grammar/SourceToGF.hs b/src/GF/Devel/Grammar/SourceToGF.hs
deleted file mode 100644
index e09b9964c..000000000
--- a/src/GF/Devel/Grammar/SourceToGF.hs
+++ /dev/null
@@ -1,670 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : SourceToGF
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/04 11:05:07 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.28 $
---
--- based on the skeleton Haskell module generated by the BNF converter
------------------------------------------------------------------------------
-
-module GF.Devel.Grammar.SourceToGF ( 
-  transGrammar,
-  transModDef,
-  transExp,
-----  transOldGrammar,
-----  transInclude,
-  newReservedWords
-  ) where
-
-import qualified GF.Devel.Grammar.Terms as G
-----import qualified GF.Grammar.PrGrammar as GP
-import GF.Devel.Grammar.Judgements
-import GF.Devel.Grammar.MkJudgements
-import GF.Devel.Grammar.Modules
-import qualified GF.Devel.Grammar.Macros as M
-----import qualified GF.Compile.Update as U
---import qualified GF.Infra.Option as GO
---import qualified GF.Compile.ModDeps as GD
-import GF.Infra.Ident
-import GF.Devel.Grammar.AbsGF
-import GF.Devel.Grammar.PrintGF (printTree)
-----import GF.Source.PrintGF
-----import GF.Compile.RemoveLiT --- for bw compat
-import GF.Data.Operations
---import GF.Infra.Option
-
-import Control.Monad
-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
-
-failure :: Show a => a -> Err b
-failure x = Bad $ "Undefined case: " ++ show x
-
-getIdentPos :: PIdent -> Err (Ident,Int)
-getIdentPos x = case x of
-  PIdent ((line,_),c) -> return (IC c,line)
-
-transIdent :: PIdent -> Err Ident
-transIdent = liftM fst . getIdentPos
-
-transName :: Name -> Err Ident
-transName n = case n of
-  PIdentName i -> transIdent i
-  ListName  i  -> transIdent (mkListId i)
-
-transGrammar :: Grammar -> Err GF
-transGrammar x = case x of
-  Gr moddefs  -> do
-    moddefs' <- mapM transModDef moddefs
-    let mos = Map.fromList moddefs'
-    return $ emptyGF {gfmodules = mos}
-
-transModDef :: ModDef -> Err (Ident,Module)
-transModDef x = case x of
-  MModule compl mtyp body -> do
-
-    let isCompl = transComplMod compl
-
-    (trDef, mtyp', id') <- case mtyp of
-      MAbstract id -> do
-        id' <- transIdent id
-        return (transAbsDef, MTAbstract, id')
-      MGrammar id -> mkModRes id MTGrammar body 
-      MResource id -> mkModRes id MTGrammar body 
-      MConcrete id open -> do
-        id'   <- transIdent id
-        open' <- transIdent open
-        return (transCncDef, MTConcrete open', id')
-      MInterface id -> mkModRes id MTInterface body
-      MInstance id open -> do
-        open' <- transIdent open
-        mkModRes id (MTInstance open') body
-
-    mkBody (isCompl, trDef, mtyp', id') body
-  where
-      mkBody xx@(isc, 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
-        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' 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
-       MWithE extends m insts -> mkBody xx $ MWithEBody extends m insts NoOpens []
-       MWithEBody extends m insts opens defs -> do
-        extends' <- mapM transIncludedExt extends
-        m'       <- transIncludedExt m
-        insts'   <- mapM transOpen insts 
-        opens'   <- transOpens opens
-        defs0    <- mapM trDef $ getTopDefs defs
-        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' isc [] [(m',insts')] extends' opens' flags' defs')
-       _ -> fail "deprecated module form"
-
-
-      mkModRes id mtyp body = do
-        id' <- transIdent id
-        return (transResDef, mtyp, id')
-
-
-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
-  NoExt -> return []
-
-transOpens :: Opens -> Err [(Ident,Ident)]
-transOpens x = case x of
-  NoOpens  -> return []
-  OpenIn opens  -> mapM transOpen opens
-
-transOpen :: Open -> Err (Ident,Ident)
-transOpen x = case x of
-  OName id   -> transIdent id >>= \y -> return (y,y)
-  OQual id m -> liftM2 (,) (transIdent id) (transIdent m)
-
-transIncludedExt :: Included -> Err (Ident, MInclude)
-transIncludedExt x = case x of
-  IAll i       -> liftM2 (,) (transIdent i) (return MIAll)
-  ISome  i ids -> liftM2 (,) (transIdent i) (liftM MIOnly   $ mapM transIdent ids)
-  IMinus i ids -> liftM2 (,) (transIdent i) (liftM MIExcept $ mapM transIdent ids)
-
-transAbsDef :: TopDef -> Err (Either [(Ident,Judgement)] [(Ident,String)])
-transAbsDef x = case x of
-  DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs
-  DefFun fundefs -> do
-    fundefs' <- mapM transFunDef fundefs
-    returnl [(fun, absFun typ) | (funs,typ) <- fundefs', fun <- funs]
-{- ----
-  DefFunData fundefs -> do
-    fundefs' <- mapM transFunDef fundefs
-    returnl $
-      [(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs', 
-                                       fun <- funs, 
-                                       Ok (_,cat) <- [M.valCat typ]
-      ] ++
-      [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
-  DefDef defs  -> do
-    defs' <- liftM concat $ mapM getDefsGen defs
-    returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
-  DefData ds -> do
-    ds' <- mapM transDataDef ds
-    returnl $ 
-      [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
-      [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
--}
-  DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
-  _ -> return $ Left [] ----  
-----  _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
- where
-   -- to get data constructors as terms
-   funs t = case t of
-     G.Con f -> [f]
-     G.Q _ f -> [f]
-     G.QC _ f -> [f]
-     _ -> []
-
-returnl :: a -> Err (Either a b)
-returnl = return . Left
-
-transFlagDef :: Def -> Err [(Ident,String)]
-transFlagDef x = case x of
-  DDef f x -> do
-    fs <- mapM transName f
-    x' <- transExp x
-    v <- case x' of
-      G.K s -> return s
-      G.Vr (IC s) -> return s
-      G.EInt i -> return $ show i
-      _ -> fail $ "illegal flag value" +++ printTree x
-    return $ [(f',v) | f' <- fs]
-
-
--- | Cat definitions can also return some fun defs
---   if it is a list category definition
-transCatDef :: CatDef -> Err [(Ident, Judgement)]
-transCatDef x = case x of
-  SimpleCatDef id ddecls        -> liftM (:[]) $ cat id ddecls
-  ListCatDef id ddecls          -> listCat id ddecls 0
-  ListSizeCatDef id ddecls size -> listCat id ddecls size
- where 
-   cat id ddecls = do
-		       i <- transIdent id
-		       cont <- liftM concat $ mapM transDDecl ddecls
-		       return (i, absCat cont)
-   listCat id ddecls size = do
-	 let li = mkListId id
-         li' <- transIdent $ li
-         baseId <- transIdent $ mkBaseId id
-         consId <- transIdent $ mkConsId id
-	 catd0@(c,ju) <- cat li ddecls
-         id' <- transIdent id
-	 let
-           cont0 = [] ---- cat context
-  	   catd = (c,ju) ----(Yes cont0) (Yes [M.cn baseId,M.cn consId]))
-           cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
-           xs = map (G.Vr . fst) cont 
-           cd = M.mkDecl (M.mkApp (G.Vr id') xs)
-	   lc = M.mkApp (G.Vr li') xs
-	   niltyp = M.mkProd (cont ++ genericReplicate size cd) lc
-	   nilfund = (baseId, absFun niltyp) ---- (yes niltyp) (yes G.EData))
-	   constyp = M.mkProd (cont ++ [cd, M.mkDecl lc]) lc
-	   consfund = (consId, absFun constyp) ---- (yes constyp) (yes G.EData))
-	 return [catd,nilfund,consfund]
-   mkId x i = if isWildIdent x then (mkIdent "x" i) else x
-
-transFunDef :: FunDef -> Err ([Ident], G.Type)
-transFunDef x = case x of
-  FDecl ids typ  -> liftM2 (,) (mapM transName ids) (transExp typ)
-
-{- ----
-transDataDef :: DataDef -> Err (Ident,[G.Term])
-transDataDef x = case x of
-  DataDef id ds  -> liftM2 (,) (transIdent id) (mapM transData ds) 
- where
-   transData d = case d of
-     DataId id  -> liftM G.Con $ transIdent id
-     DataQId id0 id  -> liftM2 G.QC (transIdent id0) (transIdent id)
--}
-
-transResDef :: TopDef -> Err (Either [(Ident,Judgement)] [(Ident,String)])
-transResDef x = case x of
-  DefPar pardefs -> do
-    pardefs' <- mapM transParDef pardefs
-    returnl $ concatMap mkParamDefs pardefs'   
-
-  DefOper defs -> do
-    defs' <- liftM concat $ mapM getDefs defs
-    returnl $ concatMap mkOverload [(f, resOper pt pe) | (f,(pt,pe)) <- defs']
-
-  DefLintype defs -> do
-    defs' <- liftM concat $ mapM getDefs defs
-    returnl [(f, resOper pt pe) | (f,(pt,pe)) <- defs']
-
-  DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
-  _ -> Bad $ "illegal definition form in resource" +++ printTree x
- where
-
-   mkParamDefs (p,pars) =
-     if null pars 
-       then [(p,addJType M.meta0 (emptyJudgement JParam))]  -- in an interface
-       else (p,resParam pars) : paramConstructors p pars
-
-   mkOverload (c,j) = case (jtype j, jdef j) of
-     (_,G.App keyw (G.R fs@(_:_:_))) | isOverloading keyw c fs -> 
-         [(c,resOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
-
-     -- to enable separare type signature --- not type-checked
-     (G.App keyw (G.RecType fs@(_:_:_)),_) | isOverloading keyw c fs -> []
-     _ -> [(c,j)]
-   isOverloading (G.Vr keyw) c fs = 
-     prIdent keyw == "overload" &&       -- overload is a "soft keyword"
-     True ---- all (== GP.prt c) (map (GP.prt . fst) fs)
-
-transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)])
-transParDef x = case x of
-  ParDefDir id params  -> liftM2 (,) (transIdent id) (mapM transParConstr params)
-  ParDefAbs id -> liftM2 (,) (transIdent id) (return [])
-
-transCncDef :: TopDef -> Err (Either [(Ident,Judgement)] [(Ident,String)])
-transCncDef x = case x of
-  DefLincat defs  -> do
-    defs' <- liftM concat $ mapM transPrintDef defs
-    returnl [(f, cncCat t) | (f,t) <- defs']
-----  DefLindef defs  -> do
-----    defs' <- liftM concat $ mapM getDefs defs
-----    returnl [(f, G.CncCat pt pe nope) | (f,(pt,pe)) <- defs']
-  DefLin defs  -> do
-    defs' <- liftM concat $ mapM getDefs defs
-    returnl [(f, cncFun pe) | (f,(_,pe)) <- defs']
-{- ----
-  DefPrintCat defs -> do
-    defs' <- liftM concat $ mapM transPrintDef defs
-    returnl [(f, G.CncCat nope nope (yes e)) | (f,e) <- defs']    
-  DefPrintFun defs -> do
-    defs' <- liftM concat $ mapM transPrintDef defs
-    returnl [(f, G.CncFun Nothing nope (yes e)) | (f,e) <- defs']
-  DefPrintOld defs -> do  --- a guess, for backward compatibility
-    defs' <- liftM concat $ mapM transPrintDef defs
-    returnl [(f, G.CncFun Nothing nope (yes e)) | (f,e) <- defs']    
-  DefFlag defs -> liftM Right $ mapM transFlagDef defs
-  DefPattern defs  -> do
-    defs' <- liftM concat $ mapM getDefs defs
-    let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs']
-    returnl [(f, G.CncFun Nothing (yes t) nope) | (f,t) <- defs2]
--}
-  _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x
-
-transPrintDef :: Def -> Err [(Ident,G.Term)]
-transPrintDef x = case x of
-  DDef ids exp  -> do
-    (ids,e) <- liftM2 (,) (mapM transName ids) (transExp exp)
-    return $ [(i,e) | i <- ids]
-
-getDefsGen :: Def -> Err [(Ident, (G.Type, G.Term))]
-getDefsGen d = case d of
-  DDecl ids t -> do
-    ids' <- mapM transName ids
-    t'   <- transExp t
-    return [(i,(t', nope)) | i <- ids']
-  DDef ids e -> do
-    ids' <- mapM transName ids
-    e'   <- transExp e
-    return [(i,(nope, yes e')) | i <- ids']
-  DFull ids t e -> do
-    ids' <- mapM transName ids
-    t'   <- transExp t
-    e'   <- transExp e
-    return [(i,(yes t', yes e')) | i <- ids']
-  DPatt id patts e  -> do
-    id' <- transName id
-    ps' <- mapM transPatt patts
-    e'  <- transExp e
-    return [(id',(nope, yes (G.Eqs [(ps',e')])))]
- where
-   yes = id
-   nope = G.Meta 0
-
--- | sometimes you need this special case, e.g. in linearization rules
-getDefs :: Def -> Err [(Ident, (G.Type, G.Term))]
-getDefs d = case d of
-  DPatt id patts e  -> do
-    id' <- transName id
-    xs  <- mapM tryMakeVar patts
-    e'  <- transExp e
-    return [(id',(nope, (M.mkAbs xs e')))]
-  _ -> getDefsGen d
- where
-   nope = G.Meta 0
-
--- | accepts a pattern that is either a variable or a wild card
-tryMakeVar :: Patt -> Err Ident
-tryMakeVar p = do
-  p' <- transPatt p
-  case p' of
-    G.PV i -> return i
-    G.PW   -> return identW
-    _ -> Bad $ "not a legal pattern in lambda binding" +++ show p'
-
-transExp :: Exp -> Err G.Term
-transExp x = case x of
-  EPIdent id    -> liftM G.Vr $ transIdent id
-  EConstr id    -> liftM G.Con $ transIdent id
-  ECons id      -> liftM G.Con $ transIdent id
-  EQConstr m c  -> liftM2 G.QC (transIdent m) (transIdent c)
-  EQCons m c    -> liftM2 G.Q  (transIdent m) (transIdent c)
-  EString str   -> return $ G.K str 
-  ESort sort    -> liftM G.Sort $ transSort sort
-  EInt n        -> return $ G.EInt n
-  EFloat n      -> return $ G.EFloat n
-  EMeta         -> return $ G.Meta 0
-  EEmpty        -> return G.Empty
-  -- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
-  EList i es    -> transExp $ foldl EApp (EPIdent (mkListId i)) (exps2list es)
-  EStrings []   -> return G.Empty
-  EStrings str  -> return $ foldr1 G.C $ map G.K $ words str
-  ERecord defs  -> erecord2term defs
-  ETupTyp _ _   -> do
-    let tups t = case t of
-          ETupTyp x y -> tups x ++ [y] -- right-associative parsing
-          _ -> [t]
-    es <- mapM transExp $ tups x
-    return $ G.RecType $ [] ---- M.tuple2recordType es
-  ETuple tuplecomps  -> do
-    es <- mapM transExp [e | TComp e <- tuplecomps]
-    return $ G.R $  [] ---- M.tuple2record es
-  EProj exp id  -> liftM2 G.P (transExp exp) (trLabel id)
-  EApp exp0 exp  -> liftM2 G.App (transExp exp0) (transExp exp)
-  ETable cases  -> liftM (G.T G.TRaw) (transCases cases)
-  ETTable exp cases -> 
-    liftM2 (\t c -> G.T (G.TTyped t) c) (transExp exp) (transCases cases)
-  EVTable exp cases -> 
-    liftM2 (\t c -> G.V t c) (transExp exp) (mapM transExp cases)
-  ECase exp cases  -> do
-    exp' <- transExp exp
-    cases' <- transCases cases
-    let annot = case exp' of
-          G.Typed _ t -> G.TTyped t
-          _ -> G.TRaw 
-    return $ G.S (G.T annot cases') exp'
-  ECTable binds exp  -> liftM2 M.mkCTable (mapM transBind binds) (transExp exp)
-
-  EVariants exps    -> liftM  G.FV $ mapM transExp exps
-  EPre exp alts     -> liftM2 (curry G.Alts) (transExp exp) (mapM transAltern alts)
-  EStrs exps        -> liftM  G.FV $ mapM transExp exps
-  ESelect exp0 exp  -> liftM2 G.S (transExp exp0) (transExp exp)
-  EExtend exp0 exp  -> liftM2 G.ExtR (transExp exp0) (transExp exp)
-  EAbstr binds exp  -> liftM2 M.mkAbs (mapM transBind binds) (transExp exp)
-  ETyped exp0 exp   -> liftM2 G.Typed (transExp exp0) (transExp exp)
-  EExample exp str  -> liftM2 G.Example (transExp exp) (return str)
-
-  EProd decl exp    -> liftM2 M.mkProd (transDecl decl) (transExp exp)
-  ETType exp0 exp   -> liftM2 G.Table (transExp exp0) (transExp exp)
-  EConcat exp0 exp  -> liftM2 G.C (transExp exp0) (transExp exp)
-  EGlue exp0 exp    -> liftM2 G.Glue (transExp exp0) (transExp exp)
-  ELet defs exp  -> do
-    exp'  <- transExp exp
-    defs0 <- mapM locdef2fields defs
-    defs' <- mapM tryLoc $ concat defs0
-    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"
-  ELetb defs exp -> transExp $ ELet defs exp
-  EWhere exp defs -> transExp $ ELet defs exp
-
-  ELString (LString str) -> return $ G.K str 
-----  ELin id -> liftM G.LiT $ transIdent id
-
-  EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
-
-  _ -> Bad $ "translation not yet defined for" +++ printTree x ----
-
-exps2list :: Exps -> [Exp]
-exps2list NilExp = []
-exps2list (ConsExp e es) = e : exps2list es
-
---- this is complicated: should we change Exp or G.Term ?
- 
-erecord2term :: [LocDef] -> Err G.Term
-erecord2term ds = do
-  ds' <- mapM locdef2fields ds 
-  mkR $ concat ds'
- where
-  mkR fs = do 
-    fs' <- transF fs
-    return $ case fs' of
-      Left ts  -> G.RecType ts
-      Right ds -> G.R ds
-  transF [] = return $ Left [] --- empty record always interpreted as record type
-  transF fs@(f:_) = case f of
-    (lab,(Just ty,Nothing)) -> mapM tryRT fs >>= return . Left
-    _ -> mapM tryR fs >>= return . Right
-  tryRT f = case f of
-    (lab,(Just ty,Nothing)) -> return (M.ident2label lab,ty)
-    _ -> Bad $ "illegal record type field" +++ show (fst f) --- manifest fields ?!
-  tryR f = case f of
-    (lab,(mty, Just t)) -> return (M.ident2label lab,(mty,t))
-    _ -> Bad $ "illegal record field" +++ show (fst f)
-
-  
-locdef2fields :: LocDef -> Err [(Ident, (Maybe G.Type, Maybe G.Type))]
-locdef2fields d = case d of
-    LDDecl ids t -> do
-      labs <- mapM transIdent ids
-      t'   <- transExp t
-      return [(lab,(Just t',Nothing)) | lab <- labs]
-    LDDef ids e -> do
-      labs <- mapM transIdent ids
-      e'   <- transExp e
-      return [(lab,(Nothing, Just e')) | lab <- labs]
-    LDFull ids t e -> do
-      labs <- mapM transIdent ids
-      t'   <- transExp t
-      e'   <- transExp e
-      return [(lab,(Just t', Just e')) | lab <- labs]
-
-trLabel :: Label -> Err G.Label
-trLabel x = case x of
-
-  -- this case is for bward compatibiity and should be removed
-  LPIdent (PIdent (_,'v':ds)) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
-  
-  LPIdent (PIdent (_, s)) -> return $ G.LIdent s
-  LVar x   -> return $ G.LVar $ fromInteger x
-
-transSort :: Sort -> Err String
-transSort x = case x of
-  _ -> return $ printTree x
-
-transPatt :: Patt -> Err G.Patt
-transPatt x = case x of
-  PW  -> return G.wildPatt
-  PV id  -> liftM G.PV $ transIdent id
-  PC id patts  -> liftM2 G.PC (transIdent id) (mapM transPatt patts)
-  PCon id  -> liftM2 G.PC (transIdent id) (return [])
-  PInt n  -> return $ G.PInt n
-  PFloat n  -> return $ G.PFloat n
-  PStr str  -> return $ G.PString str
-  PR pattasss -> do
-    let (lss,ps) = unzip [(ls,p) | PA ls p <- pattasss]
-        ls = map LPIdent $ concat lss
-    liftM G.PR $ liftM2 zip (mapM trLabel ls) (mapM transPatt ps)
-  PTup pcs -> 
-    liftM (G.PR . M.tuple2recordPatt) (mapM transPatt [e | PTComp e <- pcs])
-  PQ id0 id  -> liftM3 G.PP (transIdent id0) (transIdent id) (return [])
-  PQC id0 id patts  -> 
-    liftM3 G.PP (transIdent id0) (transIdent id) (mapM transPatt patts)
-  PDisj p1 p2 -> liftM2 G.PAlt (transPatt p1) (transPatt p2)
-  PSeq p1 p2  -> liftM2 G.PSeq (transPatt p1) (transPatt p2)
-  PRep p      -> liftM  G.PRep (transPatt p)
-  PNeg p      -> liftM  G.PNeg (transPatt p)
-  PAs x p     -> liftM2 G.PAs  (transIdent x) (transPatt p)
-
-
-
-transBind :: Bind -> Err Ident
-transBind x = case x of
-  BPIdent id  -> transIdent id
-  BWild  -> return identW
-
-transDecl :: Decl -> Err [G.Decl]
-transDecl x = case x of
-  DDec binds exp  -> do
-    xs   <- mapM transBind binds
-    exp' <- transExp exp
-    return [(x,exp') | x <- xs]
-  DExp exp  -> liftM (return . M.mkDecl) $ transExp exp
-
-transCases :: [Case] -> Err [G.Case]
-transCases = mapM transCase
-
-transCase :: Case -> Err G.Case
-transCase (Case p exp) = do
-  patt <- transPatt p
-  exp'  <- transExp exp  
-  return (patt,exp')
-
-transEquation :: Equation -> Err G.Equation
-transEquation x = case x of
-  Equ apatts exp -> liftM2 (,) (mapM transPatt apatts) (transExp exp)
-
-transAltern :: Altern -> Err (G.Term, G.Term)
-transAltern x = case x of
-  Alt exp0 exp  -> liftM2 (,) (transExp exp0) (transExp exp)
-
-transParConstr :: ParConstr -> Err (Ident,G.Context)
-transParConstr x = case x of
-  ParConstr id ddecls  -> do
-    id' <- transIdent id
-    ddecls' <- mapM transDDecl ddecls
-    return (id',concat ddecls')
-
-transDDecl :: DDecl -> Err [G.Decl]
-transDDecl x = case x of
-  DDDec binds exp  -> transDecl $ DDec binds exp
-  DDExp exp  ->  transDecl $ DExp exp
-
-{- ----
--- | to deal with the old format, sort judgements in three modules, forming
--- their names from a given string, e.g. file name or overriding user-given string
-transOldGrammar :: Options -> FilePath -> OldGrammar -> Err G.SourceGrammar
-transOldGrammar opts name0 x = case x of
-  OldGr includes topdefs  -> do --- includes must be collected separately
-    let moddefs = sortTopDefs topdefs
-    g1 <- transGrammar $ Gr moddefs
-    removeLiT g1 --- needed for bw compatibility with an obsolete feature
- where
-   sortTopDefs ds = [mkAbs a,mkRes ops r,mkCnc ops c] ++ map mkPack ps
-     where 
-       ops = map fst ps
-       (a,r,c,ps) = foldr srt ([],[],[],[]) ds
-   srt d (a,r,c,ps) = case d of
-     DefCat catdefs  -> (d:a,r,c,ps)
-     DefFun fundefs  -> (d:a,r,c,ps)
-     DefFunData fundefs -> (d:a,r,c,ps)
-     DefDef defs     -> (d:a,r,c,ps)
-     DefData pardefs -> (d:a,r,c,ps)
-     DefPar pardefs  -> (a,d:r,c,ps)
-     DefOper defs    -> (a,d:r,c,ps)
-     DefLintype defs -> (a,d:r,c,ps)
-     DefLincat defs  -> (a,r,d:c,ps)
-     DefLindef defs  -> (a,r,d:c,ps)
-     DefLin defs     -> (a,r,d:c,ps)
-     DefPattern defs -> (a,r,d:c,ps)
-     DefFlag defs    -> (a,r,d:c,ps) --- a guess
-     DefPrintCat printdefs  -> (a,r,d:c,ps)
-     DefPrintFun printdefs  -> (a,r,d:c,ps)
-     DefPrintOld printdefs  -> (a,r,d:c,ps)
-     DefPackage m ds        -> (a,r,c,(m,ds):ps)
-     _ -> (a,r,c,ps)
-   mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn [])  (topDefs a))
-   mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r))
-                  where ops = map OName ps
-   mkCnc ps r = MModule q (MTConcrete cncName absName) 
-                               (MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
-   mkPack (m, ds) = MModule q (MTResource m) (MBody ne  (OpenIn []) (topDefs ds))
-   topDefs t = t
-   ne = NoExt
-   q = CMCompl
-
-   name = maybe name0 (++ ".gf") $ getOptVal opts useName
-   absName = identC $ maybe topic id $ getOptVal opts useAbsName
-   resName = identC $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
-   cncName = identC $ maybe lang id $ getOptVal opts useCncName
-
-   (beg,rest) = span (/='.') name
-   (topic,lang) = case rest of -- to avoid overwriting old files
-     ".gf" -> ("Abs" ++ beg,"Cnc" ++ beg)
-     ".cf" -> ("Abs" ++ beg,"Cnc" ++ beg)
-     ".ebnf" -> ("Abs" ++ beg,"Cnc" ++ beg)
-     []    -> ("Abs" ++ beg,"Cnc" ++ beg)
-     _:s   -> (beg, takeWhile (/='.') s)
-
-transInclude :: Include -> Err [FilePath]
-transInclude x = case x of
-  NoIncl -> return []
-  Incl filenames  -> return $ map trans filenames
- where
-   trans f = case f of
-     FString s  -> s
-     FIdent (IC s) -> modif s
-     FSlash filename  -> '/' : trans filename
-     FDot filename  -> '.' : trans filename
-     FMinus filename  -> '-' : trans filename
-     FAddId (IC s) filename  -> modif s ++ trans filename
-   modif s = let s' = init s ++ [toLower (last s)] in 
-             if elem s' newReservedWords then s' else s 
-                      --- unsafe hack ; cf. GetGrammar.oldLexer
--}
-
-newReservedWords :: [String]
-newReservedWords =
-  words $ "abstract concrete interface incomplete " ++ 
-          "instance out open resource reuse transfer union with where"
-
-termInPattern :: G.Term -> G.Term
-termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where
-  toP t = case t of
-    G.Vr x -> G.P t s
-    _ -> M.composSafeOp toP t
-  s = G.LIdent "s"
-  (xx,body) = abss [] t
-  abss xs t = case t of
-    G.Abs x b -> abss (x:xs) b
-    _ -> (reverse xs,t)
-
-mkListId,mkConsId,mkBaseId  :: PIdent -> PIdent
-mkListId = prefixId "List"
-mkConsId = prefixId "Cons"
-mkBaseId = prefixId "Base"
-
-prefixId :: String -> PIdent -> PIdent
-prefixId pref (PIdent (p,id)) = PIdent (p, pref ++ id)