Founding the newly structured GF2.0 cvs archive.

8 files changed, 1942 insertions, 0 deletions

diff --git a/src/GF/Source/AbsGF.hs b/src/GF/Source/AbsGF.hs
new file mode 100644
index 000000000..16d342dd8
--- /dev/null
+++ b/src/GF/Source/AbsGF.hs
@@ -0,0 +1,242 @@
+module AbsGF where
+
+import Ident --H
+
+-- Haskell module generated by the BNF converter, except for --H
+
+-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
+
+newtype LString = LString String deriving (Eq,Ord,Show)
+
+data Grammar =
+   Gr [ModDef]
+  deriving (Eq,Ord,Show)
+
+data ModDef =
+   MMain Ident Ident [ConcSpec]
+ | MAbstract Ident Extend Opens [TopDef]
+ | MResource Ident Extend Opens [TopDef]
+ | MResourceInt Ident Extend Opens [TopDef]
+ | MResourceImp Ident Ident Opens [TopDef]
+ | MConcrete Ident Ident Extend Opens [TopDef]
+ | MConcreteInt Ident Ident Extend Opens [TopDef]
+ | MConcreteImp Open Ident Ident
+ | MTransfer Ident Open Open Extend Opens [TopDef]
+ | MReuseAbs Ident Ident
+ | MReuseCnc Ident Ident
+ | MReuseAll Ident Extend Ident
+  deriving (Eq,Ord,Show)
+
+data ConcSpec =
+   ConcSpec Ident ConcExp
+  deriving (Eq,Ord,Show)
+
+data ConcExp =
+   ConcExp Ident [Transfer]
+  deriving (Eq,Ord,Show)
+
+data Transfer =
+   TransferIn Open
+ | TransferOut Open
+  deriving (Eq,Ord,Show)
+
+data Extend =
+   Ext Ident
+ | NoExt
+  deriving (Eq,Ord,Show)
+
+data Opens =
+   NoOpens
+ | Opens [Open]
+  deriving (Eq,Ord,Show)
+
+data Open =
+   OName Ident
+ | OQual Ident Ident
+  deriving (Eq,Ord,Show)
+
+data Def =
+   DDecl [Ident] Exp
+ | DDef [Ident] Exp
+ | DPatt Ident [Patt] Exp
+ | DFull [Ident] Exp Exp
+  deriving (Eq,Ord,Show)
+
+data TopDef =
+   DefCat [CatDef]
+ | DefFun [FunDef]
+ | DefDef [Def]
+ | DefData [ParDef]
+ | DefTrans [FlagDef]
+ | DefPar [ParDef]
+ | DefOper [Def]
+ | DefLincat [PrintDef]
+ | DefLindef [Def]
+ | DefLin [Def]
+ | DefPrintCat [PrintDef]
+ | DefPrintFun [PrintDef]
+ | DefFlag [FlagDef]
+ | DefPrintOld [PrintDef]
+ | DefLintype [Def]
+ | DefPattern [Def]
+  deriving (Eq,Ord,Show)
+
+data CatDef =
+   CatDef Ident [DDecl]
+  deriving (Eq,Ord,Show)
+
+data FunDef =
+   FunDef [Ident] Exp
+  deriving (Eq,Ord,Show)
+
+data ParDef =
+   ParDef Ident [ParConstr]
+ | ParDefIndir Ident Ident
+ | ParDefAbs Ident
+  deriving (Eq,Ord,Show)
+
+data ParConstr =
+   ParConstr Ident [DDecl]
+  deriving (Eq,Ord,Show)
+
+data PrintDef =
+   PrintDef [Ident] Exp
+  deriving (Eq,Ord,Show)
+
+data FlagDef =
+   FlagDef Ident Ident
+  deriving (Eq,Ord,Show)
+
+data LocDef =
+   LDDecl [Ident] Exp
+ | LDDef [Ident] Exp
+ | LDFull [Ident] Exp Exp
+  deriving (Eq,Ord,Show)
+
+data Exp =
+   EIdent Ident
+ | EConstr Ident
+ | ECons Ident
+ | ESort Sort
+ | EString String
+ | EInt Integer
+ | EMeta
+ | EEmpty
+ | EStrings String
+ | ERecord [LocDef]
+ | ETuple [TupleComp]
+ | EIndir Ident
+ | ETyped Exp Exp
+ | EProj Exp Label
+ | EQConstr Ident Ident
+ | EQCons Ident Ident
+ | EApp Exp Exp
+ | ETable [Case]
+ | ETTable Exp [Case]
+ | ECase Exp [Case]
+ | EVariants [Exp]
+ | EPre Exp [Altern]
+ | EStrs [Exp]
+ | EConAt Ident Exp
+ | ESelect Exp Exp
+ | ETupTyp Exp Exp
+ | EExtend Exp Exp
+ | EAbstr [Bind] Exp
+ | ECTable [Bind] Exp
+ | EProd Decl Exp
+ | ETType Exp Exp
+ | EConcat Exp Exp
+ | EGlue Exp Exp
+ | ELet [LocDef] Exp
+ | EEqs [Equation]
+ | ELString LString
+ | ELin Ident
+  deriving (Eq,Ord,Show)
+
+data Patt =
+   PW
+ | PV Ident
+ | PCon Ident
+ | PQ Ident Ident
+ | PInt Integer
+ | PStr String
+ | PR [PattAss]
+ | PTup [PattTupleComp]
+ | PC Ident [Patt]
+ | PQC Ident Ident [Patt]
+  deriving (Eq,Ord,Show)
+
+data PattAss =
+   PA [Ident] Patt
+  deriving (Eq,Ord,Show)
+
+data Label =
+   LIdent Ident
+ | LVar Integer
+  deriving (Eq,Ord,Show)
+
+data Sort =
+   Sort_Type
+ | Sort_PType
+ | Sort_Tok
+ | Sort_Str
+ | Sort_Strs
+  deriving (Eq,Ord,Show)
+
+data PattAlt =
+   AltP Patt
+  deriving (Eq,Ord,Show)
+
+data Bind =
+   BIdent Ident
+ | BWild
+  deriving (Eq,Ord,Show)
+
+data Decl =
+   DDec [Bind] Exp
+ | DExp Exp
+  deriving (Eq,Ord,Show)
+
+data TupleComp =
+   TComp Exp
+  deriving (Eq,Ord,Show)
+
+data PattTupleComp =
+   PTComp Patt
+  deriving (Eq,Ord,Show)
+
+data Case =
+   Case [PattAlt] Exp
+  deriving (Eq,Ord,Show)
+
+data Equation =
+   Equ [Patt] Exp
+  deriving (Eq,Ord,Show)
+
+data Altern =
+   Alt Exp Exp
+  deriving (Eq,Ord,Show)
+
+data DDecl =
+   DDDec [Bind] Exp
+ | DDExp Exp
+  deriving (Eq,Ord,Show)
+
+data OldGrammar =
+   OldGr Include [TopDef]
+  deriving (Eq,Ord,Show)
+
+data Include =
+   NoIncl
+ | Incl [FileName]
+  deriving (Eq,Ord,Show)
+
+data FileName =
+   FString String
+ | FIdent Ident
+ | FSlash FileName
+ | FDot FileName
+ | FMinus FileName
+ | FAddId Ident FileName
+  deriving (Eq,Ord,Show)
+
diff --git a/src/GF/Source/CompileM.hs b/src/GF/Source/CompileM.hs
new file mode 100644
index 000000000..3d97a029e
--- /dev/null
+++ b/src/GF/Source/CompileM.hs
@@ -0,0 +1,141 @@
+module CompileM where
+
+import Grammar
+import Ident
+import Option
+import PrGrammar
+import Update
+import Lookup
+import Modules
+---import Rename
+
+import Operations
+import UseIO
+
+import Monad
+
+compileMGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
+compileMGrammar opts sgr = do
+
+  ioeErr $ checkUniqueModuleNames sgr
+
+  deps <- ioeErr $ moduleDeps sgr
+
+  deplist <- either return 
+                 (\ms -> ioeBad $ "circular modules" +++ unwords (map show ms)) $ 
+                 topoTest deps
+
+  let deps' = closureDeps deps
+
+  foldM (compileModule opts deps' sgr) emptyMGrammar deplist
+
+checkUniqueModuleNames :: MGrammar i f a r c -> Err ()
+checkUniqueModuleNames gr = do
+  let ms = map fst $ tree2list $ modules gr
+      msg = checkUnique ms
+  if null msg then return () else Bad $ unlines msg
+
+-- to decide what modules immediately depend on what, and check if the
+-- dependencies are appropriate
+
+moduleDeps :: MGrammar i f a c r -> Err Dependencies
+moduleDeps gr = mapM deps $ tree2list $ modules gr where
+  deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
+    ModAbs m -> chDep (IdentM c MTAbstract) 
+                      (extends m) MTAbstract (opens m) MTAbstract
+    ModRes m -> chDep (IdentM c MTResource) 
+                      (extends m) MTResource (opens m) MTResource
+    ModCnc m -> do
+      a:ops <- case opens m of
+        os@(_:_) -> return os
+        _ -> Bad "no abstract indicated for concrete module"
+      aty <- lookupModuleType gr a
+      testErr (aty == MTAbstract) "the for-module is not an abstract syntax" 
+      chDep (IdentM c (MTConcrete a)) (extends m) MTResource ops MTResource
+
+  chDep it es ety os oty = do
+    ests <- mapM (lookupModuleType gr) es
+    testErr (all (==ety) ests) "inappropriate extension module type" 
+    osts <- mapM (lookupModuleType gr) os
+    testErr (all (==oty) osts) "inappropriate open module type" 
+    return (it, [IdentM e ety | e <- es] ++ [IdentM o oty | o <- os])
+
+type Dependencies = [(IdentM Ident,[IdentM Ident])]
+
+---compileModule :: Options -> Dependencies -> SourceGrammar -> 
+---                 CanonGrammar -> IdentM -> IOE CanonGrammar
+compileModule opts deps sgr cgr i = do
+  
+   let name = identM i 
+
+   testIfCompiled deps name
+
+   mi <- ioeErr $ lookupModule sgr name
+
+   mi' <- case typeM i of
+     -- previously compiled cgr used as symbol table
+     MTAbstract   -> compileAbstract cgr mi
+     MTResource   -> compileResource cgr mi
+     MTConcrete a -> compileConcrete a cgr mi 
+
+   ifIsOpt doOutput $ writeCanonFile name mi'
+
+   return $ addModule cgr name mi'
+
+ where
+
+   ifIsOpt o f = if (oElem o opts) then f else return ()
+   doOutput    = iOpt "o"
+
+
+testIfCompiled :: Dependencies -> Ident -> IOE Bool
+testIfCompiled _ _ = return False ----
+
+---writeCanonFile :: Ident -> CanonModInfo -> IOE ()
+writeCanonFile name mi' = ioeIO $ writeFile (canonFileName name) [] ----
+
+canonFileName n = n ++ ".gfc" ---- elsewhere!
+
+---compileAbstract :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
+compileAbstract can (ModAbs m0) = do
+  let m1 = renameMAbstract m0
+{-
+  checkUnique
+  typeCheck
+  generateCode
+  addToCanon
+-}
+  ioeBad "compile abs not yet"
+
+---compileResource :: CanonGrammar -> SourceModInfo -> IOE CanonModInfo
+compileResource can md = do
+{-
+  checkUnique
+  typeCheck
+  topoSort
+  compileOpers -- conservative, since more powerful than lin
+  generateCode
+  addToCanon
+-}
+  ioeBad "compile res not yet"
+
+---compileConcrete :: Ident -> CanonGrammar -> SourceModInfo -> IOE CanonModInfo
+compileConcrete ab can md = do
+{-
+  checkUnique
+  checkComplete ab
+  typeCheck
+  topoSort
+  compileOpers
+  optimize
+  createPreservedOpers
+  generateCode
+  addToCanon
+-}
+  ioeBad "compile cnc not yet"
+
+
+-- to be imported
+
+closureDeps :: [(a,[a])] -> [(a,[a])]
+closureDeps ds = ds ---- fix-point iteration
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
new file mode 100644
index 000000000..6303bcd99
--- /dev/null
+++ b/src/GF/Source/GrammarToSource.hs
@@ -0,0 +1,181 @@
+module GrammarToSource where
+
+import Operations
+import Grammar
+import Modules
+import Option
+import qualified AbsGF as P
+import Ident
+
+-- AR 13/5/2003
+-- translate internal to parsable and printable source
+
+trGrammar :: SourceGrammar -> P.Grammar
+trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
+
+trModule :: (Ident,SourceModInfo) -> P.ModDef
+trModule (i,mo) = case mo of
+  ModMod m -> mkModule i' (trExtend (extends m)) (mkOpens (map trOpen (opens m)))
+                 (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ 
+                            (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)
+
+trExtend :: Maybe Ident -> P.Extend
+trExtend i = maybe P.NoExt (P.Ext . tri) i
+
+---- this has to be completed with other mtys
+forName (MTConcrete a) = tri a
+
+trOpen :: OpenSpec Ident -> P.Open
+trOpen o = case o of
+  OSimple i   -> P.OName (tri i)
+  OQualif i j -> P.OQual (tri i) (tri j)
+
+mkOpens ds = if null ds then P.NoOpens else P.Opens ds
+mkTopDefs ds = ds
+
+trAnyDef :: (Ident,Info) -> [P.TopDef]
+trAnyDef (i,info) = let i' = tri i in case info of
+  AbsCat (Yes co) _ -> [P.DefCat [P.CatDef i' (map trDecl co)]]
+  AbsFun (Yes ty) _ -> [P.DefFun [P.FunDef [i'] (trt ty)]]
+  AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
+  ---- don't destroy definitions!
+
+  ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
+  ResParam pp -> [P.DefPar [case pp of
+    Yes ps -> P.ParDef i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
+    May b  -> P.ParDefIndir i' $ tri b
+    _      -> P.ParDefAbs i']]
+
+  CncCat (Yes ty) Nope _ -> 
+    [P.DefLincat [P.PrintDef [i'] (trt ty)]] 
+  CncCat pty ptr ppr -> 
+    [P.DefLindef [trDef i' pty ptr]] 
+    ---- P.DefPrintCat [P.PrintDef i' (trt pr)]]
+  CncFun _ ptr ppr -> 
+    [P.DefLin [trDef i' nope ptr]] 
+    ---- P.DefPrintFun [P.PrintDef i' (trt pr)]]
+  _ -> [] 
+
+trDef :: Ident -> Perh Type -> Perh Term -> P.Def
+trDef i pty ptr = case (pty,ptr) of
+  (Nope,     Nope) -> P.DDef  [i] (P.EMeta) ---
+  (_,        Nope) -> P.DDecl [i] (trPerh pty)
+  (Nope,     _   ) -> P.DDef  [i] (trPerh ptr)
+  (_,        _   ) -> P.DFull [i] (trPerh pty) (trPerh ptr)
+
+trPerh p = case p of
+  Yes t -> trt t
+  May b -> P.EIndir $ tri b
+  _ -> P.EMeta ---
+
+
+trFlag :: Option -> P.TopDef
+trFlag o = case o of
+  Opt (f,[x]) -> P.DefFlag [P.FlagDef (identC f) (identC x)]
+  _ -> P.DefFlag [] --- warning?
+
+trt :: Term -> P.Exp 
+trt trm = case trm of
+    Vr s -> P.EIdent $ tri s
+    Cn s -> P.ECons $ tri s
+    Con s -> P.EConstr $ tri s
+----    ConAt id typ -> P.EConAt (tri id) (trt typ)
+
+    Sort s -> P.ESort $ case s of
+      "Type" -> P.Sort_Type
+      "PType" -> P.Sort_PType
+      "Tok" -> P.Sort_Tok
+      "Str" -> P.Sort_Str
+      "Strs" -> P.Sort_Strs
+      _ -> error $ "not yet sort " +++ show trm ----
+
+
+    App c a -> P.EApp (trt c) (trt a)
+    Abs x b -> P.EAbstr [trb x] (trt b)
+
+----    Eqs pts -> "fn" +++ prCurlyList [prtBranchOld pst | pst <- pts] ---
+----    ECase e bs -> "case" +++ prt e +++ "of" +++ prCurlyList (map prtBranch bs) 
+
+    Meta m  -> P.EMeta
+    Prod x a b | isWildIdent x -> P.EProd (P.DExp (trt a)) (trt b)
+    Prod x a b -> P.EProd (P.DDec [trb x] (trt a)) (trt b)
+
+    R r -> P.ERecord $ map trAssign r
+    RecType r -> P.ERecord $ map trLabelling r
+    ExtR x y -> P.EExtend (trt x) (trt y)
+    P t l -> P.EProj (trt t) (trLabel l)
+    Q t l -> P.EQCons (tri t) (tri l)
+    QC t l -> P.EQConstr (tri t) (tri l)
+    T (TTyped ty) cc -> P.ETTable (trt ty) (map trCase cc)
+    T (TComp ty) cc -> P.ETTable (trt ty) (map trCase cc)
+    T (TWild ty) cc -> P.ETTable (trt ty) (map trCase cc)
+    T _ cc -> P.ETable (map trCase cc)
+
+    Table x v -> P.ETType (trt x) (trt v)
+    S f x -> P.ESelect  (trt f) (trt x)
+----    Alias c a t -> "{-" +++ prt c +++ "=" +++ "-}" +++ prt t
+--    Alias c a t -> prt (Let (c,(Just a,t)) (Vr c))  -- thus Alias is only internal
+
+    Let (x,(ma,b)) t -> 
+      P.ELet [maybe (P.LDDef x' b') (\ty -> P.LDFull x' (trt ty) b')  ma] (trt t)
+                          where 
+                            b' = trt b
+                            x' = [tri x]
+
+    Empty -> P.EEmpty
+    K [] -> P.EEmpty
+    K a -> P.EString a
+    C a b -> P.EConcat (trt a) (trt b)
+
+    EInt i -> P.EInt $ toInteger i
+
+    Glue a b -> P.EGlue (trt a) (trt b)
+    Alts (t, tt) -> P.EPre (trt t) [P.Alt (trt v) (trt c) | (v,c) <- tt]
+    FV ts -> P.EVariants $ map trt ts
+    Strs tt -> P.EStrs $ map trt tt
+    _ -> error $ "not yet" +++ show trm ----
+
+trp :: Patt -> P.Patt
+trp p = case p of
+    PV s | isWildIdent s -> P.PW
+    PV s -> P.PV $ tri s
+    PC c [] -> P.PCon $ tri c
+    PC c a -> P.PC (tri c) (map trp a)
+    PP p c [] -> P.PQ (tri p) (tri c)
+    PP p c a -> P.PQC (tri p) (tri c) (map trp a)
+    PR r -> P.PR [P.PA [trLabelIdent l] (trp p) | (l,p) <- r]
+----    PT t p -> prt p ---- prParenth (prt p +++ ":" +++ prt t)
+
+
+trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
+  where 
+    t' = trt t
+    x  = [trLabelIdent lab]
+
+trLabelling (lab,ty) = P.LDDecl [trLabelIdent lab] (trt ty)
+
+trCase (patt,trm) = P.Case [P.AltP (trp patt)] (trt trm)
+
+trDecl (x,ty) = P.DDDec [trb x] (trt ty)
+
+tri :: Ident -> Ident
+tri i = case prIdent i of
+  s@('_':_:_) -> identC $ 'h':s ---- unsafe; needed since _3 etc are generated 
+  s -> identC $ s
+  
+trb i = if isWildIdent i then P.BWild else P.BIdent (tri i)
+
+trLabel i = case i of
+  LIdent s -> P.LIdent $ identC s
+  LVar i -> P.LVar $ toInteger i
+
+trLabelIdent i = identC $ case i of
+  LIdent s -> s
+  LVar i -> "v" ++ show i --- should not happen
+
diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs
new file mode 100644
index 000000000..e9406dd78
--- /dev/null
+++ b/src/GF/Source/LexGF.hs
@@ -0,0 +1,127 @@
+module LexGF where
+
+import Alex
+import ErrM
+
+pTSpec p = PT p . TS    
+
+mk_LString p = PT p . eitherResIdent T_LString 
+
+ident  p = PT p . eitherResIdent TV 
+
+string p = PT p . TL . unescapeInitTail 
+
+int    p = PT p . TI    
+
+
+data Tok =
+   TS String     -- reserved words
+ | TL String     -- string literals
+ | TI String     -- integer literals
+ | TV String     -- identifiers
+ | TD String     -- double precision float literals
+ | TC String     -- character literals
+ | T_LString String
+
+ deriving (Eq,Show)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving Show
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+prToken t = case t of
+  PT _ (TS s) -> s
+  PT _ (TI s) -> s
+  PT _ (TV s) -> s
+  PT _ (TD s) -> s
+  PT _ (TC s) -> s
+  _ -> show t
+
+tokens:: String -> [Token]
+tokens inp = scan tokens_scan inp
+
+tokens_scan:: Scan Token
+tokens_scan = load_scan (tokens_acts,stop_act) tokens_lx
+        where
+        stop_act p ""  = []
+        stop_act p inp = [Err p]
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
+  isResWord s = isInTree s $
+    B "let" (B "concrete" (B "Tok" (B "Str" (B "PType" (B "Lin" N N) N) (B "Strs" N N)) (B "case" (B "abstract" (B "Type" N N) N) (B "cat" N N))) (B "fun" (B "flags" (B "def" (B "data" N N) N) (B "fn" N N)) (B "in" (B "grammar" N N) (B "include" N N)))) (B "pattern" (B "of" (B "lindef" (B "lincat" (B "lin" N N) N) (B "lintype" 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 "transfer" (B "table" N N) (B "variants" N N))))
+
+data BTree = N | B String BTree BTree deriving (Show)
+
+isInTree :: String -> BTree -> Bool
+isInTree x tree = case tree of
+  N -> False
+  B a left right
+   | x < a  -> isInTree x left
+   | x > a  -> isInTree x right
+   | x == a -> True
+
+unescapeInitTail :: String -> String
+unescapeInitTail = unesc . tail where
+  unesc s = case s of
+    '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+    '\\':'n':cs  -> '\n' : unesc cs
+    '\\':'t':cs  -> '\t' : unesc cs
+    '"':[]    -> []
+    c:cs      -> c : unesc cs
+    _         -> []
+
+tokens_acts = [("ident",ident),("int",int),("mk_LString",mk_LString),("pTSpec",pTSpec),("string",string)]
+
+tokens_lx :: [(Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))]
+tokens_lx = [lx__0_0,lx__1_0,lx__2_0,lx__3_0,lx__4_0,lx__5_0,lx__6_0,lx__7_0,lx__8_0,lx__9_0,lx__10_0,lx__11_0,lx__12_0,lx__13_0,lx__14_0,lx__15_0,lx__16_0,lx__17_0,lx__18_0,lx__19_0,lx__20_0,lx__21_0]
+lx__0_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__0_0 = (False,[],-1,(('\t','\255'),[('\t',10),('\n',10),('\v',10),('\f',10),('\r',10),(' ',10),('!',14),('"',18),('$',14),('\'',15),('(',14),(')',14),('*',11),('+',13),(',',14),('-',1),('.',14),('/',14),('0',21),('1',21),('2',21),('3',21),('4',21),('5',21),('6',21),('7',21),('8',21),('9',21),(':',14),(';',14),('<',14),('=',12),('>',14),('?',14),('@',14),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('[',14),('\\',14),(']',14),('_',14),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('{',4),('|',14),('}',14),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
+lx__1_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__1_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('-','>'),[('-',2),('>',14)]))
+lx__2_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__2_0 = (False,[],2,(('\n','\n'),[('\n',3)]))
+lx__3_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__3_0 = (True,[(0,"",[],Nothing,Nothing)],-1,(('0','0'),[]))
+lx__4_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__4_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('-','-'),[('-',5)]))
+lx__5_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__5_0 = (False,[],5,(('-','-'),[('-',8)]))
+lx__6_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__6_0 = (False,[],5,(('-','}'),[('-',8),('}',7)]))
+lx__7_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__7_0 = (True,[(1,"",[],Nothing,Nothing)],5,(('-','-'),[('-',8)]))
+lx__8_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__8_0 = (False,[],5,(('-','}'),[('-',6),('}',9)]))
+lx__9_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__9_0 = (True,[(1,"",[],Nothing,Nothing)],-1,(('0','0'),[]))
+lx__10_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__10_0 = (True,[(2,"",[],Nothing,Nothing)],-1,(('\t',' '),[('\t',10),('\n',10),('\v',10),('\f',10),('\r',10),(' ',10)]))
+lx__11_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__11_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('*','*'),[('*',14)]))
+lx__12_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__12_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('>','>'),[('>',14)]))
+lx__13_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__13_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('+','+'),[('+',14)]))
+lx__14_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__14_0 = (True,[(3,"pTSpec",[],Nothing,Nothing)],-1,(('0','0'),[]))
+lx__15_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__15_0 = (False,[],15,(('\'','\''),[('\'',16)]))
+lx__16_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__16_0 = (True,[(4,"mk_LString",[],Nothing,Nothing)],15,(('\'','\''),[('\'',16)]))
+lx__17_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__17_0 = (True,[(5,"ident",[],Nothing,Nothing)],-1,(('\'','\255'),[('\'',17),('0',17),('1',17),('2',17),('3',17),('4',17),('5',17),('6',17),('7',17),('8',17),('9',17),('A',17),('B',17),('C',17),('D',17),('E',17),('F',17),('G',17),('H',17),('I',17),('J',17),('K',17),('L',17),('M',17),('N',17),('O',17),('P',17),('Q',17),('R',17),('S',17),('T',17),('U',17),('V',17),('W',17),('X',17),('Y',17),('Z',17),('_',17),('a',17),('b',17),('c',17),('d',17),('e',17),('f',17),('g',17),('h',17),('i',17),('j',17),('k',17),('l',17),('m',17),('n',17),('o',17),('p',17),('q',17),('r',17),('s',17),('t',17),('u',17),('v',17),('w',17),('x',17),('y',17),('z',17),('\192',17),('\193',17),('\194',17),('\195',17),('\196',17),('\197',17),('\198',17),('\199',17),('\200',17),('\201',17),('\202',17),('\203',17),('\204',17),('\205',17),('\206',17),('\207',17),('\208',17),('\209',17),('\210',17),('\211',17),('\212',17),('\213',17),('\214',17),('\216',17),('\217',17),('\218',17),('\219',17),('\220',17),('\221',17),('\222',17),('\223',17),('\224',17),('\225',17),('\226',17),('\227',17),('\228',17),('\229',17),('\230',17),('\231',17),('\232',17),('\233',17),('\234',17),('\235',17),('\236',17),('\237',17),('\238',17),('\239',17),('\240',17),('\241',17),('\242',17),('\243',17),('\244',17),('\245',17),('\246',17),('\248',17),('\249',17),('\250',17),('\251',17),('\252',17),('\253',17),('\254',17),('\255',17)]))
+lx__18_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__18_0 = (False,[],18,(('\n','\\'),[('\n',-1),('"',20),('\\',19)]))
+lx__19_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__19_0 = (False,[],-1,(('"','t'),[('"',18),('\'',18),('\\',18),('n',18),('t',18)]))
+lx__20_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__20_0 = (True,[(6,"string",[],Nothing,Nothing)],-1,(('0','0'),[]))
+lx__21_0 :: (Bool, [(Int,String,[Int],Maybe((Char,Char),[(Char,Bool)]),Maybe Int)], Int, ((Char,Char),[(Char,Int)]))
+lx__21_0 = (True,[(7,"int",[],Nothing,Nothing)],-1,(('0','9'),[('0',21),('1',21),('2',21),('3',21),('4',21),('5',21),('6',21),('7',21),('8',21),('9',21)]))
+
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
new file mode 100644
index 000000000..9d71dfe6e
--- /dev/null
+++ b/src/GF/Source/PrintGF.hs
@@ -0,0 +1,435 @@
+module PrintGF where
+
+-- pretty-printer generated by the BNF converter, except --H
+
+import AbsGF
+import Ident --H
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+-- you may want to change render and parenth
+
+render :: [String] -> String
+render = rend 0 where
+  rend i ss = case ss of
+
+    --H these three are hand-written
+    "{0"     :ts -> cons "{"  $ rend (i+1) ts
+    t :"}0"  :ts -> cons t    $ space "}"  $ rend (i-1) ts
+    t : "."  :ts -> cons t    $ cons "."  $ rend i ts
+
+    "["      :ts -> cons "["  $ rend i ts
+    "("      :ts -> cons "("  $ rend i ts
+    "{"      :ts -> cons "{"  $ new (i+1) $ rend (i+1) ts
+    "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
+    "}"      :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
+    ";"      :ts -> cons ";"  $ new i $ rend i ts
+    t  : "," :ts -> cons t    $ space "," $ rend i ts
+    t  : ")" :ts -> cons t    $ cons ")"  $ rend i ts
+    t  : "]" :ts -> cons t    $ cons "]"  $ rend i ts
+    t        :ts -> space t   $ rend i ts
+    _            -> ""
+  cons s t  = s ++ t
+  new i s   = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
+  space t s = if null s then t else t ++ " " ++ s
+
+parenth :: [String] -> [String]
+parenth ss = ["("] ++ ss ++ [")"]
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> [String]
+  prtList :: [a] -> [String]
+  prtList = concat . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Integer where
+  prt _ = (:[]) . show
+
+instance Print Double where
+  prt _ = (:[]) . show
+
+instance Print Char where
+  prt _ s = ["'" ++ mkEsc s ++ "'"]
+  prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]
+
+mkEsc s = case s of
+  _ | elem s "\\\"'" -> '\\':[s]
+  '\n' -> "\\n"
+  '\t' -> "\\t"
+  _ -> [s]
+
+prPrec :: Int -> Int -> [String] -> [String]
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Ident where
+  prt _ i = [prIdent i] --H
+  prtList es = case es of
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+
+instance Print LString where
+  prt _ (LString i) = [i]
+
+
+
+instance Print Grammar where
+  prt i e = case e of
+   Gr moddefs -> prPrec i 0 (concat [prt 0 moddefs])
+
+
+instance Print ModDef where
+  prt i e = case e of
+   MMain id0 id concspecs -> prPrec i 0 (concat [["grammar"] , prt 0 id0 , ["="] , ["{"] , ["abstract"] , ["="] , prt 0 id , [";"] , prt 0 concspecs , ["}"]])
+   MAbstract id extend opens topdefs -> prPrec i 0 (concat [["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MResource id extend opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MResourceInt id extend opens topdefs -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MResourceImp id0 id opens topdefs -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MConcrete id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MConcreteInt id0 id extend opens topdefs -> prPrec i 0 (concat [["concrete"] , ["abstract"] , ["of"] , prt 0 id0 , ["in"] , prt 0 id , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MConcreteImp open id0 id -> prPrec i 0 (concat [["concrete"] , ["of"] , prt 0 open , ["="] , prt 0 id0 , ["**"] , prt 0 id])
+   MTransfer id open0 open extend opens topdefs -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open , ["="] , prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
+   MReuseAbs id0 id -> prPrec i 0 (concat [["resource"] , ["abstract"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
+   MReuseCnc id0 id -> prPrec i 0 (concat [["resource"] , ["concrete"] , prt 0 id0 , ["="] , ["reuse"] , prt 0 id])
+   MReuseAll id0 extend id -> prPrec i 0 (concat [["resource"] , prt 0 id0 , ["="] , prt 0 extend , ["reuse"] , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concat [])
+   x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print ConcSpec where
+  prt i e = case e of
+   ConcSpec id concexp -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 concexp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ConcExp where
+  prt i e = case e of
+   ConcExp id transfers -> prPrec i 0 (concat [prt 0 id , prt 0 transfers])
+
+
+instance Print Transfer where
+  prt i e = case e of
+   TransferIn open -> prPrec i 0 (concat [["("] , ["transfer"] , ["in"] , prt 0 open , [")"]])
+   TransferOut open -> prPrec i 0 (concat [["("] , ["transfer"] , ["out"] , prt 0 open , [")"]])
+
+  prtList es = case es of
+   [] -> (concat [])
+   x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print Extend where
+  prt i e = case e of
+   Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
+   NoExt  -> prPrec i 0 (concat [])
+
+
+instance Print Opens where
+  prt i e = case e of
+   NoOpens  -> prPrec i 0 (concat [])
+   Opens opens -> prPrec i 0 (concat [["open"] , prt 0 opens , ["in"]])
+
+
+instance Print Open where
+  prt i e = case e of
+   OName id -> prPrec i 0 (concat [prt 0 id])
+   OQual id0 id -> prPrec i 0 (concat [["("] , prt 0 id0 , ["="] , prt 0 id , [")"]])
+
+  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
+   DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+   DDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+   DPatt id patts exp -> prPrec i 0 (concat [prt 0 id , prt 0 patts , ["="] , prt 0 exp])
+   DFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print TopDef where
+  prt i e = case e of
+   DefCat catdefs -> prPrec i 0 (concat [["cat"] , prt 0 catdefs])
+   DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
+   DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
+   DefData pardefs -> prPrec i 0 (concat [["data"] , prt 0 pardefs])
+   DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
+   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])
+   DefLindef defs -> prPrec i 0 (concat [["lindef"] , prt 0 defs])
+   DefLin defs -> prPrec i 0 (concat [["lin"] , prt 0 defs])
+   DefPrintCat printdefs -> prPrec i 0 (concat [["printname"] , ["cat"] , prt 0 printdefs])
+   DefPrintFun printdefs -> prPrec i 0 (concat [["printname"] , ["fun"] , prt 0 printdefs])
+   DefFlag flagdefs -> prPrec i 0 (concat [["flags"] , prt 0 flagdefs])
+   DefPrintOld printdefs -> prPrec i 0 (concat [["printname"] , prt 0 printdefs])
+   DefLintype defs -> prPrec i 0 (concat [["lintype"] , prt 0 defs])
+   DefPattern defs -> prPrec i 0 (concat [["pattern"] , prt 0 defs])
+
+  prtList es = case es of
+   [] -> (concat [])
+   x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print CatDef where
+  prt i e = case e of
+   CatDef id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print FunDef where
+  prt i e = case e of
+   FunDef ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ParDef where
+  prt i e = case e of
+   ParDef id parconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 parconstrs])
+   ParDefIndir id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , ["("] , ["in"] , prt 0 id , [")"]])
+   ParDefAbs id -> prPrec i 0 (concat [prt 0 id])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print ParConstr where
+  prt i e = case e of
+   ParConstr id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
+
+instance Print PrintDef where
+  prt i e = case e of
+   PrintDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print FlagDef where
+  prt i e = case e of
+   FlagDef id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , prt 0 id])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print LocDef where
+  prt i e = case e of
+   LDDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
+   LDDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
+   LDFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Exp where
+  prt i e = case e of
+   EIdent id -> prPrec i 4 (concat [prt 0 id])
+   EConstr id -> prPrec i 4 (concat [["{0"] , prt 0 id , ["}0"]]) --H
+   ECons id -> prPrec i 4 (concat [["["] , prt 0 id , ["]"]])
+   ESort sort -> prPrec i 4 (concat [prt 0 sort])
+   EString str -> prPrec i 4 (concat [prt 0 str])
+   EInt n -> prPrec i 4 (concat [prt 0 n])
+   EMeta  -> prPrec i 4 (concat [["?"]])
+   EEmpty  -> prPrec i 4 (concat [["["] , ["]"]])
+   EStrings str -> prPrec i 4 (concat [["["] , prt 0 str , ["]"]])
+   ERecord locdefs -> prPrec i 4 (concat [["{"] , prt 0 locdefs , ["}"]])
+   ETuple tuplecomps -> prPrec i 4 (concat [["<"] , prt 0 tuplecomps , [">"]])
+   EIndir id -> prPrec i 4 (concat [["("] , ["in"] , prt 0 id , [")"]])
+   ETyped exp0 exp -> prPrec i 4 (concat [["<"] , prt 0 exp0 , [":"] , prt 0 exp , [">"]])
+   EProj exp label -> prPrec i 3 (concat [prt 3 exp , ["."] , prt 0 label])
+   EQConstr id0 id -> prPrec i 3 (concat [["{0"] , prt 0 id0 , ["."] , prt 0 id , ["}0"]]) --H
+   EQCons id0 id -> prPrec i 3 (concat [["["] , prt 0 id0 , ["."] , prt 0 id , ["]"]])
+   EApp exp0 exp -> prPrec i 2 (concat [prt 2 exp0 , prt 3 exp])
+   ETable cases -> prPrec i 2 (concat [["table"] , ["{"] , prt 0 cases , ["}"]])
+   ETTable exp cases -> prPrec i 2 (concat [["table"] , prt 4 exp , ["{"] , prt 0 cases , ["}"]])
+   ECase exp cases -> prPrec i 2 (concat [["case"] , prt 0 exp , ["of"] , ["{"] , prt 0 cases , ["}"]])
+   EVariants exps -> prPrec i 2 (concat [["variants"] , ["{"] , prt 0 exps , ["}"]])
+   EPre exp alterns -> prPrec i 2 (concat [["pre"] , ["{"] , prt 0 exp , [";"] , prt 0 alterns , ["}"]])
+   EStrs exps -> prPrec i 2 (concat [["strs"] , ["{"] , prt 0 exps , ["}"]])
+   EConAt id exp -> prPrec i 2 (concat [prt 0 id , ["@"] , prt 4 exp])
+   ESelect exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["!"] , prt 2 exp])
+   ETupTyp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["*"] , prt 2 exp])
+   EExtend exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["**"] , prt 2 exp])
+   EAbstr binds exp -> prPrec i 0 (concat [["\\"] , prt 0 binds , ["->"] , prt 0 exp])
+   ECTable binds exp -> prPrec i 0 (concat [["\\"] , ["\\"] , prt 0 binds , ["=>"] , prt 0 exp])
+   EProd decl exp -> prPrec i 0 (concat [prt 0 decl , ["->"] , prt 0 exp])
+   ETType exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["=>"] , prt 0 exp])
+   EConcat exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["++"] , prt 0 exp])
+   EGlue exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["+"] , prt 0 exp])
+   ELet locdefs exp -> prPrec i 0 (concat [["let"] , ["{"] , prt 0 locdefs , ["}"] , ["in"] , prt 0 exp])
+   EEqs equations -> prPrec i 0 (concat [["fn"] , ["{"] , prt 0 equations , ["}"]])
+   ELString lstring -> prPrec i 4 (concat [prt 0 lstring])
+   ELin id -> prPrec i 2 (concat [["Lin"] , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Patt where
+  prt i e = case e of
+   PW  -> prPrec i 1 (concat [["_"]])
+   PV id -> prPrec i 1 (concat [prt 0 id])
+   PCon id -> prPrec i 1 (concat [["{0"] , prt 0 id , ["}0"]]) --H
+   PQ id0 id -> prPrec i 1 (concat [prt 0 id0 , ["."] , prt 0 id])
+   PInt n -> prPrec i 1 (concat [prt 0 n])
+   PStr str -> prPrec i 1 (concat [prt 0 str])
+   PR pattasss -> prPrec i 1 (concat [["{"] , prt 0 pattasss , ["}"]])
+   PTup patttuplecomps -> prPrec i 1 (concat [["<"] , prt 0 patttuplecomps , [">"]])
+   PC id patts -> prPrec i 0 (concat [prt 0 id , prt 0 patts])
+   PQC id0 id patts -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id , prt 0 patts])
+
+  prtList es = case es of
+   [x] -> (concat [prt 1 x])
+   x:xs -> (concat [prt 1 x , prt 0 xs])
+
+instance Print PattAss where
+  prt i e = case e of
+   PA ids patt -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 patt])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Label where
+  prt i e = case e of
+   LIdent id -> prPrec i 0 (concat [prt 0 id])
+   LVar n -> prPrec i 0 (concat [["$"] , prt 0 n])
+
+
+instance Print Sort where
+  prt i e = case e of
+   Sort_Type  -> prPrec i 0 (concat [["Type"]])
+   Sort_PType  -> prPrec i 0 (concat [["PType"]])
+   Sort_Tok  -> prPrec i 0 (concat [["Tok"]])
+   Sort_Str  -> prPrec i 0 (concat [["Str"]])
+   Sort_Strs  -> prPrec i 0 (concat [["Strs"]])
+
+
+instance Print PattAlt where
+  prt i e = case e of
+   AltP patt -> prPrec i 0 (concat [prt 0 patt])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
+
+instance Print Bind where
+  prt i e = case e of
+   BIdent id -> prPrec i 0 (concat [prt 0 id])
+   BWild  -> prPrec i 0 (concat [["_"]])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print Decl where
+  prt i e = case e of
+   DDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
+   DExp exp -> prPrec i 0 (concat [prt 2 exp])
+
+
+instance Print TupleComp where
+  prt i e = case e of
+   TComp exp -> prPrec i 0 (concat [prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print PattTupleComp where
+  prt i e = case e of
+   PTComp patt -> prPrec i 0 (concat [prt 0 patt])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
+
+instance Print Case where
+  prt i e = case e of
+   Case pattalts exp -> prPrec i 0 (concat [prt 0 pattalts , ["=>"] , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Equation where
+  prt i e = case e of
+   Equ patts exp -> prPrec i 0 (concat [prt 0 patts , ["->"] , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print Altern where
+  prt i e = case e of
+   Alt exp0 exp -> prPrec i 0 (concat [prt 0 exp0 , ["/"] , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print DDecl where
+  prt i e = case e of
+   DDDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
+   DDExp exp -> prPrec i 0 (concat [prt 4 exp])
+
+  prtList es = case es of
+   [] -> (concat [])
+   x:xs -> (concat [prt 0 x , prt 0 xs])
+
+instance Print OldGrammar where
+  prt i e = case e of
+   OldGr include topdefs -> prPrec i 0 (concat [prt 0 include , prt 0 topdefs])
+
+
+instance Print Include where
+  prt i e = case e of
+   NoIncl  -> prPrec i 0 (concat [])
+   Incl filenames -> prPrec i 0 (concat [["include"] , prt 0 filenames])
+
+
+instance Print FileName where
+  prt i e = case e of
+   FString str -> prPrec i 0 (concat [prt 0 str])
+   FIdent id -> prPrec i 0 (concat [prt 0 id])
+   FSlash filename -> prPrec i 0 (concat [["/"] , prt 0 filename])
+   FDot filename -> prPrec i 0 (concat [["."] , prt 0 filename])
+   FMinus filename -> prPrec i 0 (concat [["-"] , prt 0 filename])
+   FAddId id filename -> prPrec i 0 (concat [prt 0 id , prt 0 filename])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+
diff --git a/src/GF/Source/SkelGF.hs b/src/GF/Source/SkelGF.hs
new file mode 100644
index 000000000..cf0932a87
--- /dev/null
+++ b/src/GF/Source/SkelGF.hs
@@ -0,0 +1,289 @@
+module SkelGF where
+
+-- Haskell module generated by the BNF converter
+
+import AbsGF
+import Ident
+import ErrM
+type Result = Err String
+
+failure :: Show a => a -> Result
+failure x = Bad $ "Undefined case: " ++ show x
+
+transIdent :: Ident -> Result
+transIdent x = case x of
+  _  -> failure x
+
+
+transLString :: LString -> Result
+transLString x = case x of
+  LString str  -> failure x
+
+
+transGrammar :: Grammar -> Result
+transGrammar x = case x of
+  Gr moddefs  -> failure x
+
+
+transModDef :: ModDef -> Result
+transModDef x = case x of
+  MMain id0 id concspecs  -> failure x
+  MAbstract id extend opens topdefs  -> failure x
+  MResource id extend opens topdefs  -> failure x
+  MResourceInt id extend opens topdefs  -> failure x
+  MResourceImp id0 id opens topdefs  -> failure x
+  MConcrete id0 id extend opens topdefs  -> failure x
+  MConcreteInt id0 id extend opens topdefs  -> failure x
+  MConcreteImp open id0 id  -> failure x
+  MTransfer id open0 open extend opens topdefs  -> failure x
+  MReuseAbs id0 id  -> failure x
+  MReuseCnc id0 id  -> failure x
+  MReuseAll id0 extend id  -> failure x
+
+
+transConcSpec :: ConcSpec -> Result
+transConcSpec x = case x of
+  ConcSpec id concexp  -> failure x
+
+
+transConcExp :: ConcExp -> Result
+transConcExp x = case x of
+  ConcExp id transfers  -> failure x
+
+
+transTransfer :: Transfer -> Result
+transTransfer x = case x of
+  TransferIn open  -> failure x
+  TransferOut open  -> failure x
+
+
+transExtend :: Extend -> Result
+transExtend x = case x of
+  Ext id  -> failure x
+  NoExt  -> failure x
+
+
+transOpens :: Opens -> Result
+transOpens x = case x of
+  NoOpens  -> failure x
+  Opens opens  -> failure x
+
+
+transOpen :: Open -> Result
+transOpen x = case x of
+  OName id  -> failure x
+  OQual id0 id  -> failure x
+
+
+transDef :: Def -> Result
+transDef x = case x of
+  DDecl ids exp  -> failure x
+  DDef ids exp  -> failure x
+  DPatt id patts exp  -> failure x
+  DFull ids exp0 exp  -> failure x
+
+
+transTopDef :: TopDef -> Result
+transTopDef x = case x of
+  DefCat catdefs  -> failure x
+  DefFun fundefs  -> failure x
+  DefDef defs  -> failure x
+  DefData pardefs  -> failure x
+  DefTrans flagdefs  -> failure x
+  DefPar pardefs  -> failure x
+  DefOper defs  -> failure x
+  DefLincat printdefs  -> failure x
+  DefLindef defs  -> failure x
+  DefLin defs  -> failure x
+  DefPrintCat printdefs  -> failure x
+  DefPrintFun printdefs  -> failure x
+  DefFlag flagdefs  -> failure x
+  DefPrintOld printdefs  -> failure x
+  DefLintype defs  -> failure x
+  DefPattern defs  -> failure x
+
+
+transCatDef :: CatDef -> Result
+transCatDef x = case x of
+  CatDef id ddecls  -> failure x
+
+
+transFunDef :: FunDef -> Result
+transFunDef x = case x of
+  FunDef ids exp  -> failure x
+
+
+transParDef :: ParDef -> Result
+transParDef x = case x of
+  ParDef id parconstrs  -> failure x
+  ParDefIndir id0 id  -> failure x
+  ParDefAbs id  -> failure x
+
+
+transParConstr :: ParConstr -> Result
+transParConstr x = case x of
+  ParConstr id ddecls  -> failure x
+
+
+transPrintDef :: PrintDef -> Result
+transPrintDef x = case x of
+  PrintDef ids exp  -> failure x
+
+
+transFlagDef :: FlagDef -> Result
+transFlagDef x = case x of
+  FlagDef id0 id  -> failure x
+
+
+transLocDef :: LocDef -> Result
+transLocDef x = case x of
+  LDDecl ids exp  -> failure x
+  LDDef ids exp  -> failure x
+  LDFull ids exp0 exp  -> failure x
+
+
+transExp :: Exp -> Result
+transExp x = case x of
+  EIdent id  -> failure x
+  EConstr id  -> failure x
+  ECons id  -> failure x
+  ESort sort  -> failure x
+  EString str  -> failure x
+  EInt n  -> failure x
+  EMeta  -> failure x
+  EEmpty  -> failure x
+  EStrings str  -> failure x
+  ERecord locdefs  -> failure x
+  ETuple tuplecomps  -> failure x
+  EIndir id  -> failure x
+  ETyped exp0 exp  -> failure x
+  EProj exp label  -> failure x
+  EQConstr id0 id  -> failure x
+  EQCons id0 id  -> failure x
+  EApp exp0 exp  -> failure x
+  ETable cases  -> failure x
+  ETTable exp cases  -> failure x
+  ECase exp cases  -> failure x
+  EVariants exps  -> failure x
+  EPre exp alterns  -> failure x
+  EStrs exps  -> failure x
+  EConAt id exp  -> failure x
+  ESelect exp0 exp  -> failure x
+  ETupTyp exp0 exp  -> failure x
+  EExtend exp0 exp  -> failure x
+  EAbstr binds exp  -> failure x
+  ECTable binds exp  -> failure x
+  EProd decl exp  -> failure x
+  ETType exp0 exp  -> failure x
+  EConcat exp0 exp  -> failure x
+  EGlue exp0 exp  -> failure x
+  ELet locdefs exp  -> failure x
+  EEqs equations  -> failure x
+  ELString lstring  -> failure x
+  ELin id  -> failure x
+
+
+transPatt :: Patt -> Result
+transPatt x = case x of
+  PW  -> failure x
+  PV id  -> failure x
+  PCon id  -> failure x
+  PQ id0 id  -> failure x
+  PInt n  -> failure x
+  PStr str  -> failure x
+  PR pattasss  -> failure x
+  PTup patttuplecomps  -> failure x
+  PC id patts  -> failure x
+  PQC id0 id patts  -> failure x
+
+
+transPattAss :: PattAss -> Result
+transPattAss x = case x of
+  PA ids patt  -> failure x
+
+
+transLabel :: Label -> Result
+transLabel x = case x of
+  LIdent id  -> failure x
+  LVar n  -> failure x
+
+
+transSort :: Sort -> Result
+transSort x = case x of
+  Sort_Type  -> failure x
+  Sort_PType  -> failure x
+  Sort_Tok  -> failure x
+  Sort_Str  -> failure x
+  Sort_Strs  -> failure x
+
+
+transPattAlt :: PattAlt -> Result
+transPattAlt x = case x of
+  AltP patt  -> failure x
+
+
+transBind :: Bind -> Result
+transBind x = case x of
+  BIdent id  -> failure x
+  BWild  -> failure x
+
+
+transDecl :: Decl -> Result
+transDecl x = case x of
+  DDec binds exp  -> failure x
+  DExp exp  -> failure x
+
+
+transTupleComp :: TupleComp -> Result
+transTupleComp x = case x of
+  TComp exp  -> failure x
+
+
+transPattTupleComp :: PattTupleComp -> Result
+transPattTupleComp x = case x of
+  PTComp patt  -> failure x
+
+
+transCase :: Case -> Result
+transCase x = case x of
+  Case pattalts exp  -> failure x
+
+
+transEquation :: Equation -> Result
+transEquation x = case x of
+  Equ patts exp  -> failure x
+
+
+transAltern :: Altern -> Result
+transAltern x = case x of
+  Alt exp0 exp  -> failure x
+
+
+transDDecl :: DDecl -> Result
+transDDecl x = case x of
+  DDDec binds exp  -> failure x
+  DDExp exp  -> failure x
+
+
+transOldGrammar :: OldGrammar -> Result
+transOldGrammar x = case x of
+  OldGr include topdefs  -> failure x
+
+
+transInclude :: Include -> Result
+transInclude x = case x of
+  NoIncl  -> failure x
+  Incl filenames  -> failure x
+
+
+transFileName :: FileName -> Result
+transFileName x = case x of
+  FString str  -> failure x
+  FIdent id  -> failure x
+  FSlash filename  -> failure x
+  FDot filename  -> failure x
+  FMinus filename  -> failure x
+  FAddId id filename  -> failure x
+
+
+
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
new file mode 100644
index 000000000..f9e098e08
--- /dev/null
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -0,0 +1,505 @@
+module SourceToGrammar where
+
+import qualified Grammar as G
+import qualified PrGrammar as GP
+import qualified Modules as GM
+import qualified Macros as M
+import qualified Update as U
+import qualified Option as GO
+import qualified ModDeps as GD
+import Ident
+import AbsGF
+import PrintGF
+import RemoveLiT --- for bw compat
+import Operations
+
+import Monad
+import Char
+
+-- 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
+
+transIdent :: Ident -> Err Ident
+transIdent x = case x of
+  x  -> return x
+
+transGrammar :: Grammar -> Err G.SourceGrammar
+transGrammar x = case x of
+  Gr moddefs  -> do
+    moddefs' <- mapM transModDef moddefs
+    GD.mkSourceGrammar moddefs'
+
+transModDef :: ModDef -> Err (Ident, G.SourceModInfo)
+transModDef x = case x of
+  MMain id0 id concspecs  -> do
+    id0' <- transIdent id0
+    id'  <- transIdent id
+    concspecs' <- mapM transConcSpec concspecs
+    return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs'))
+  MAbstract id extends opens defs  -> do
+    id'      <- transIdent id
+    extends' <- transExtend extends
+    opens'   <- transOpens opens
+    defs0    <- mapM transAbsDef $ getTopDefs defs
+    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+    flags    <- return       [f | Right fs <- defs0, f <- fs]
+    return $ (id', GM.ModMod (GM.Module GM.MTAbstract flags extends' opens' defs')) 
+  MResource id extends opens defs  -> do
+    id'      <- transIdent id
+    extends' <- transExtend extends
+    opens'   <- transOpens opens
+    defs0    <- mapM transResDef $ getTopDefs defs
+    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+    flags    <- return       [f | Right fs <- defs0, f <- fs]
+    return $ (id', GM.ModMod (GM.Module GM.MTResource flags extends' opens' defs')) 
+  MConcrete id open extends opens defs -> do
+    id'      <- transIdent id
+    open'    <- transIdent open
+    extends' <- transExtend extends
+    opens'   <- transOpens opens
+    defs0    <- mapM transCncDef $ getTopDefs defs
+    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+    flags    <- return       [f | Right fs <- defs0, f <- fs]
+    return $ (id', 
+      GM.ModMod (GM.Module (GM.MTConcrete open') flags extends' opens' defs'))
+  MTransfer id open0 open extends opens defs -> do
+    id'      <- transIdent id
+    open0'   <- transOpen open0
+    open'    <- transOpen open
+    extends' <- transExtend extends
+    opens'   <- transOpens opens
+    defs0    <- mapM transAbsDef $ getTopDefs defs
+    defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+    flags    <- return       [f | Right fs <- defs0, f <- fs]
+    return $ (id', 
+     GM.ModMod (GM.Module (GM.MTTransfer open0' open') flags extends' opens' defs'))
+
+  MReuseAbs id0 id  -> failure x
+  MReuseCnc id0 id  -> failure x
+  MReuseAll r e c  -> do
+    r' <- transIdent r
+    e' <- transExtend e
+    c' <- transIdent c
+    return $ (r', GM.ModMod (GM.Module (GM.MTReuse c') [] e' [] NT)) 
+
+getTopDefs :: [TopDef] -> [TopDef]
+getTopDefs x = x
+
+transConcSpec :: ConcSpec -> Err (GM.MainConcreteSpec Ident)
+transConcSpec x = case x of
+  ConcSpec id concexp  -> do
+    id' <- transIdent id
+    (m,mi,mo) <- transConcExp concexp
+    return $ GM.MainConcreteSpec id' m mi mo
+
+transConcExp :: ConcExp -> 
+       Err (Ident, Maybe (GM.OpenSpec Ident),Maybe (GM.OpenSpec Ident))
+transConcExp x = case x of
+  ConcExp id transfers  -> do
+    id' <- transIdent id
+    trs <- mapM transTransfer transfers
+    tin <- case [o | Left o <- trs] of
+      [o] -> return $ Just o
+      []  -> return $ Nothing
+      _   -> Bad "ambiguous transfer in"
+    tout <- case [o | Right o <- trs] of
+      [o] -> return $ Just o
+      []  -> return $ Nothing
+      _   -> Bad "ambiguous transfer out"
+    return (id',tin,tout)
+
+transTransfer :: Transfer -> 
+                 Err (Either (GM.OpenSpec Ident)(GM.OpenSpec Ident))
+transTransfer x = case x of
+  TransferIn open  -> liftM Left  $ transOpen open
+  TransferOut open -> liftM Right $ transOpen open
+
+transExtend :: Extend -> Err (Maybe Ident)
+transExtend x = case x of
+  Ext id  -> transIdent id >>= return . Just
+  NoExt -> return Nothing
+
+transOpens :: Opens -> Err [GM.OpenSpec Ident]
+transOpens x = case x of
+  NoOpens  -> return []
+  Opens opens  -> mapM transOpen opens
+
+transOpen :: Open -> Err (GM.OpenSpec Ident)
+transOpen x = case x of
+  OName id   -> liftM  GM.OSimple $ transIdent id
+  OQual id m -> liftM2 GM.OQualif (transIdent id) (transIdent m)
+
+transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
+transAbsDef x = case x of
+  DefCat catdefs -> do
+    catdefs' <- mapM transCatDef catdefs
+    returnl [(cat, G.AbsCat (yes cont) nope) | (cat,cont) <- catdefs']
+  DefFun fundefs -> do
+    fundefs' <- mapM transFunDef fundefs
+    returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
+  DefDef defs  -> do
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
+  DefData _ -> returnl [] ----
+  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']
+  DefFlag defs -> liftM Right $ mapM transFlagDef defs
+  _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
+
+returnl :: a -> Err (Either a b)
+returnl = return . Left
+
+transFlagDef :: FlagDef -> Err GO.Option
+transFlagDef x = case x of
+  FlagDef f x  -> return $ GO.Opt (prIdent f,[prIdent x])
+
+transCatDef :: CatDef -> Err (Ident, G.Context)
+transCatDef x = case x of
+  CatDef id ddecls  -> liftM2 (,) (transIdent id) 
+                                  (mapM transDDecl ddecls >>= return . concat)
+
+transFunDef :: FunDef -> Err ([Ident], G.Type)
+transFunDef x = case x of
+  FunDef ids typ  -> liftM2 (,) (mapM transIdent ids) (transExp typ)
+
+transResDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
+transResDef x = case x of
+  DefPar pardefs -> do
+    pardefs' <- mapM transParDef pardefs
+    returnl $ [(p, G.ResParam (if null pars 
+                                  then nope -- abstract param type 
+                                  else (yes pars))) | (p,pars) <- pardefs']
+           ++ [(f, G.ResValue (yes (M.mkProdSimple co (G.Cn p)))) |
+                     (p,pars) <- pardefs', (f,co) <- pars]
+  DefOper defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, G.ResOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefLintype defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, G.ResOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefFlag defs -> liftM Right $ mapM transFlagDef defs
+  _ -> Bad $ "illegal definition form in resource" +++ printTree x
+
+transParDef :: ParDef -> Err (Ident, [G.Param])
+transParDef x = case x of
+  ParDef id params  -> liftM2 (,) (transIdent id) (mapM transParConstr params)
+  ParDefAbs id -> liftM2 (,) (transIdent id) (return [])
+  _ -> Bad $ "illegal definition in resource:" ++++ printTree x
+
+transCncDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
+transCncDef x = case x of
+  DefLincat defs  -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, G.CncCat (yes t) nope nope) | (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, G.CncFun Nothing pe nope) | (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]
+
+  _ -> Bad $ "illegal definition in concrete syntax:" ++++ printTree x
+
+transPrintDef :: PrintDef -> Err [(Ident,G.Term)]
+transPrintDef x = case x of
+  PrintDef id exp  -> do
+    (ids,e) <- liftM2 (,) (mapM transIdent id) (transExp exp)
+    return $ [(i,e) | i <- ids]
+
+getDefsGen :: Def -> Err [(Ident, (G.Perh G.Type, G.Perh G.Term))]
+getDefsGen d = case d of
+  DDecl ids t -> do
+    ids' <- mapM transIdent ids
+    t'   <- transExp t
+    return [(i,(yes t', nope)) | i <- ids']
+  DDef ids e -> do
+    ids' <- mapM transIdent ids
+    e'   <- transExp e
+    return [(i,(nope, yes e')) | i <- ids']
+  DFull ids t e -> do
+    ids' <- mapM transIdent ids
+    t'   <- transExp t
+    e'   <- transExp e
+    return [(i,(yes t', yes e')) | i <- ids']
+  DPatt id patts e  -> do
+    id' <- transIdent id
+    ps' <- mapM transPatt patts
+    e'  <- transExp e
+    return [(id',(nope, yes (G.Eqs [(ps',e')])))]
+
+-- sometimes you need this special case, e.g. in linearization rules
+getDefs :: Def -> Err [(Ident, (G.Perh G.Type, G.Perh G.Term))]
+getDefs d = case d of
+  DPatt id patts e  -> do
+    id' <- transIdent id
+    xs  <- mapM tryMakeVar patts
+    e'  <- transExp e
+    return [(id',(nope, yes (M.mkAbs xs e')))]
+  _ -> getDefsGen d
+
+-- 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" +++ GP.prt p'
+
+transExp :: Exp -> Err G.Term
+transExp x = case x of
+  EIdent id     -> liftM G.Vr $ transIdent id
+  EConstr id    -> liftM G.Con $ transIdent id
+  ECons id      -> liftM G.Cn $ 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 $ fromInteger n
+  EMeta         -> return $ M.meta $ M.int2meta 0
+  EEmpty        -> return G.Empty
+  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)
+  ECase exp cases  -> do
+    exp' <- transExp exp
+    cases' <- transCases cases
+    return $ G.S (G.T G.TRaw 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.Strs $ 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)
+
+  EProd decl exp    -> liftM2 M.mkProdSimple (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" +++ GP.prt c +++ "without value"
+
+  ELString (LString str) -> return $ G.K str 
+  ELin id -> liftM G.LiT $ transIdent id
+
+  _ -> Bad $ "translation not yet defined for" +++ printTree x ----
+
+--- 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" +++ GP.prt (fst f) --- manifest fields ?!
+  tryR f = case f of
+    (lab,(mty, Just t)) -> return (M.ident2label lab,(mty,t))
+    _ -> Bad $ "illegal record field" +++ GP.prt (fst f)
+
+  
+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
+  LIdent (IC ('v':ds)) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
+  
+  LIdent (IC 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 (fromInteger n)
+  PStr str  -> return $ G.PString str
+  PR pattasss -> do
+    let (lss,ps) = unzip [(ls,p) | PA ls p <- pattasss]
+        ls = map LIdent $ 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)
+
+transBind :: Bind -> Err Ident
+transBind x = case x of
+  BIdent 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 = liftM concat . mapM transCase
+
+transCase :: Case -> Err [G.Case]
+transCase (Case pattalts exp) = do
+  patts <- mapM transPatt [p | AltP p <- pattalts]
+  exp'  <- transExp exp  
+  return [(p,exp') | p <- patts]
+
+transAltern :: Altern -> Err (G.Term, G.Term)
+transAltern x = case x of
+  Alt exp0 exp  -> liftM2 (,) (transExp exp0) (transExp exp)
+
+transParConstr :: ParConstr -> Err G.Param
+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 :: OldGrammar -> String -> Err G.SourceGrammar
+transOldGrammar x name = 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 r,mkCnc c] 
+     where (a,r,c) = foldr srt ([],[],[]) ds
+   srt d (a,r,c) = case d of
+     DefCat catdefs  -> (d:a,r,c)
+     DefFun fundefs  -> (d:a,r,c)
+     DefDef defs     -> (d:a,r,c)
+     DefData pardefs -> (d:a,r,c)
+     DefPar pardefs  -> (a,d:r,c)
+     DefOper defs    -> (a,d:r,c)
+     DefLintype defs -> (a,d:r,c)
+     DefLincat defs  -> (a,r,d:c)
+     DefLindef defs  -> (a,r,d:c)
+     DefLin defs     -> (a,r,d:c)
+     DefPattern defs -> (a,r,d:c)
+     DefFlag defs    -> (a,r,d:c) --- a guess
+     DefPrintCat printdefs  -> (a,r,d:c)
+     DefPrintFun printdefs  -> (a,r,d:c)
+     DefPrintOld printdefs  -> (a,r,d:c)
+   mkAbs a = MAbstract absName NoExt (Opens []) $ topDefs a
+   mkRes r = MResource resName NoExt (Opens []) $ topDefs r
+   mkCnc r = MConcrete cncName absName NoExt (Opens [OName resName]) $ topDefs r
+   topDefs t = t
+
+   absName = identC topic
+   resName = identC ("Res" ++ lang)
+   cncName = identC lang
+
+   (beg,rest) = span (/='.') name
+   (topic,lang) = case rest of -- to avoid overwriting old files
+     ".gf" -> ("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) -> s
+     FSlash filename  -> '/' : trans filename
+     FDot filename  -> '.' : trans filename
+     FMinus filename  -> '-' : trans filename
+     FAddId (IC s) filename  -> s ++ trans filename
+
+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)
diff --git a/src/GF/Source/TestGF.hs b/src/GF/Source/TestGF.hs
new file mode 100644
index 000000000..f1c8e49a1
--- /dev/null
+++ b/src/GF/Source/TestGF.hs
@@ -0,0 +1,22 @@
+-- automatically generated by BNF Converter
+module TestGF where 
+
+import LexGF
+import ParGF
+import SkelGF
+import PrintGF
+import AbsGF
+import ErrM
+
+type ParseFun a = [Token] -> Err a
+
+runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO()
+runFile p f = readFile f >>= run p
+
+run :: (Print a, Show a) => ParseFun a -> String -> IO()
+run p s = case (p (myLexer s)) of
+           Bad s    -> do  putStrLn "\nParse Failed...\n"
+                           putStrLn s
+           Ok  tree -> do putStrLn "\nParse Successful!"
+                          putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree
+                          putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree