GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

56 files changed, 16689 insertions, 0 deletions

diff --git a/src-3.0/GF/Devel/AbsCompute.hs b/src-3.0/GF/Devel/AbsCompute.hs
new file mode 100644
index 000000000..a55fbc83f
--- /dev/null
+++ b/src-3.0/GF/Devel/AbsCompute.hs
@@ -0,0 +1,145 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : AbsCompute
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.8 $
+--
+-- computation in abstract syntax w.r.t. explicit definitions.
+--
+-- old GF computation; to be updated
+-----------------------------------------------------------------------------
+
+module GF.Devel.AbsCompute (LookDef,
+		   compute, 
+		   computeAbsTerm, 
+		   computeAbsTermIn, 
+		   beta
+		  ) where
+
+import GF.Data.Operations
+
+import GF.Grammar.Abstract
+import GF.Grammar.PrGrammar
+import GF.Grammar.LookAbs
+import GF.Devel.Compute
+
+import Debug.Trace
+import Data.List(intersperse)
+import Control.Monad (liftM, liftM2)
+
+-- for debugging
+tracd m t = t 
+-- tracd = trace
+
+compute :: GFCGrammar -> Exp -> Err Exp
+compute = computeAbsTerm
+
+computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
+computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
+
+-- | a hack to make compute work on source grammar as well
+type LookDef = Ident -> Ident -> Err (Maybe Term)
+
+computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp
+computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
+  compt vv t = case t of
+--    Prod x a b  -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
+--    Abs x b     -> liftM  (Abs  x)              (compt (x:vv) b)
+    _ -> do
+      let t' = beta vv t
+      (yy,f,aa) <- termForm t'
+      let vv' = yy ++ vv
+      aa'    <- mapM (compt vv') aa
+      case look f of
+        Just (Eqs eqs) -> tracd ("\nmatching" +++ prt f) $ 
+                          case findMatch eqs aa' of
+          Ok (d,g) -> do
+            --- let (xs,ts) = unzip g
+            --- ts' <- alphaFreshAll vv' ts
+            let g' = g --- zip xs ts'
+            d' <- compt vv' $ substTerm vv' g' d
+            tracd ("by Egs:" +++ prt d') $ return $ mkAbs yy $ d'
+          _ -> tracd ("no match" +++ prt t') $ 
+               do
+            let v = mkApp f aa'
+            return $ mkAbs yy $ v
+        Just d -> tracd ("define" +++ prt t') $ do
+          da <- compt vv' $ mkApp d aa' 
+          return $ mkAbs yy $ da
+        _ -> do
+          let t2 = mkAbs yy $ mkApp f aa'
+          tracd ("not defined" +++ prt_ t2) $ return t2
+
+  look t = case t of
+     (Q m f) -> case lookd m f of
+       Ok (Just EData) -> Nothing  -- canonical --- should always be QC
+       Ok md -> md
+       _ -> Nothing
+     Eqs _ -> return t ---- for nested fn
+     _ -> Nothing
+
+beta :: [Ident] -> Exp -> Exp
+beta vv c = case c of
+  Let (x,(_,a)) b -> beta vv $ substTerm vv [(x,beta vv a)] (beta (x:vv) b) 
+  App f         a -> 
+    let (a',f') = (beta vv a, beta vv f) in 
+    case f' of
+      Abs x b -> beta vv $ substTerm vv [(x,a')] (beta (x:vv) b) 
+      _ ->               (if a'==a && f'==f then id else beta vv) $ App f' a'
+  Prod x a b      -> Prod x (beta vv a) (beta (x:vv) b)
+  Abs x b         -> Abs x (beta (x:vv) b)
+  _               -> c
+
+-- special version of pattern matching, to deal with comp under lambda
+
+findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)
+findMatch cases terms = case cases of
+  [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms))
+  (patts,_):_ | length patts /= length terms -> 
+       Bad ("wrong number of args for patterns :" +++ 
+            unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms))
+  (patts,val):cc -> case mapM tryMatch (zip patts terms) of
+     Ok substs -> return (tracd ("value" +++ prt_ val) val, concat substs)
+     _         -> findMatch cc terms
+
+tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
+tryMatch (p,t) = do 
+  t' <- termForm t
+  trym p t'
+ where
+
+  trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- 
+              case (p,t') of
+    (PV IW, _) | notMeta t -> return [] -- optimization with wildcard
+    (PV x,  _) | notMeta t -> return [(x,t)]
+    (PString s, ([],K i,[])) | s==i -> return []
+    (PInt s, ([],EInt i,[])) | s==i -> return []
+    (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
+    (PP q p pp, ([], QC r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PP q p pp, ([], Q r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PT _ p',_) -> trym p' t'
+    (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
+    (PAs x p',_) -> do
+       subst <- trym p' t'
+       return $ (x,t) : subst
+    _ -> Bad ("no match in pattern" +++ prt p +++ "for" +++ prt t)
+
+  notMeta e = case e of
+    Meta _  -> False
+    App f a -> notMeta f &&  notMeta a  
+    Abs _ b -> notMeta b
+    _ -> True
+
+  prtm p g = 
+    prt p +++ ":" ++++ unwords ["  " ++ prt_ x +++ "=" +++ prt_ y +++ ";" | (x,y) <- g]
diff --git a/src-3.0/GF/Devel/Arch.hs b/src-3.0/GF/Devel/Arch.hs
new file mode 100644
index 000000000..dedb1b4f5
--- /dev/null
+++ b/src-3.0/GF/Devel/Arch.hs
@@ -0,0 +1,89 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Arch
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/10 14:55:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- architecture\/compiler dependent definitions for unix\/hbc
+-----------------------------------------------------------------------------
+
+module GF.Devel.Arch (
+ myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime,
+ welcomeArch, laterModTime) where
+
+import System.Time
+import System.Random
+import System.CPUTime
+import Control.Monad (filterM)
+import System.Directory
+
+
+---- import qualified UnicodeF as U --(fudlogueWrite)
+
+-- architecture/compiler dependent definitions for unix/hbc
+
+myStdGen :: Int -> IO StdGen ---
+--- myStdGen _ = newStdGen --- gives always the same result
+myStdGen int0 = do
+  t0  <- getClockTime 
+  cal <- toCalendarTime t0 
+  let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000)
+  return $ mkStdGen int
+
+prCPU :: Integer -> IO Integer
+prCPU cpu = do 
+  cpu' <- getCPUTime
+  putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec")
+  return cpu'
+
+welcomeArch :: String
+welcomeArch = "This is the system compiled with ghc."
+
+-- | selects the one with the later modification time of two
+selectLater :: FilePath -> FilePath -> IO FilePath
+selectLater x y = do
+  ex <- doesFileExist x
+  if not ex 
+    then return y --- which may not exist
+    else do
+      ey <- doesFileExist y
+      if not ey 
+        then return x
+        else do 
+          tx <- getModificationTime x
+          ty <- getModificationTime y
+          return $ if tx < ty then y else x
+
+-- | a file is considered modified also if it has not been read yet
+--
+-- new 23\/2\/2004: the environment ofs has just module names
+modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath]
+modifiedFiles ofs fs = do
+  filterM isModified fs
+ where
+  isModified file = case lookup (justModName file) ofs of
+    Just to -> do
+      t <- getModificationTime file
+      return $ to < t
+    _ -> return True
+
+  justModName = 
+    reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse
+
+type ModTime = ClockTime
+
+laterModTime :: ModTime -> ModTime -> Bool
+laterModTime = (>)
+
+getModTime :: FilePath -> IO (Maybe ModTime)
+getModTime f = do
+  b <- doesFileExist f
+  if b then (getModificationTime f >>= return . Just) else return Nothing
+
+getNowTime :: IO ModTime
+getNowTime = getClockTime
diff --git a/src-3.0/GF/Devel/CheckGrammar.hs b/src-3.0/GF/Devel/CheckGrammar.hs
new file mode 100644
index 000000000..0910802d1
--- /dev/null
+++ b/src-3.0/GF/Devel/CheckGrammar.hs
@@ -0,0 +1,1090 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CheckGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:33 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.31 $
+--
+-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
+--
+-- type checking also does the following modifications:
+--
+--  - types of operations and local constants are inferred and put in place
+--
+--  - both these types and linearization types are computed
+--
+--  - tables are type-annotated
+-----------------------------------------------------------------------------
+
+module GF.Devel.CheckGrammar (
+  showCheckModule, justCheckLTerm, allOperDependencies, topoSortOpers) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.Refresh ----
+
+import GF.Devel.TypeCheck
+import GF.Grammar.Values (cPredefAbs) ---
+
+import GF.Grammar.PrGrammar
+import GF.Grammar.Lookup
+import GF.Grammar.LookAbs
+import GF.Grammar.Macros
+import GF.Grammar.ReservedWords ----
+import GF.Grammar.PatternMatch
+import GF.Grammar.AppPredefined
+import GF.Grammar.Lockfield (isLockLabel)
+
+import GF.Data.Operations
+import GF.Infra.CheckM
+
+import Data.List
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Control.Monad
+import Debug.Trace ---
+
+
+showCheckModule :: [SourceModule] -> SourceModule -> Err ([SourceModule],String)
+showCheckModule mos m = do
+  (st,(_,msg)) <- checkStart $ checkModule mos m
+  return (st, unlines $ reverse msg)
+
+-- | checking is performed in the dependency order of modules
+checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
+checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
+
+  ModMod mo@(Module mt st fs me ops js) -> do
+    checkRestrictedInheritance ms (name, mo)
+    js' <- case mt of
+      MTAbstract -> mapMTree (checkAbsInfo gr name) js
+
+      MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
+
+      MTResource -> mapMTree (checkResInfo gr name) js
+
+      MTConcrete a -> do
+        checkErr $ topoSortOpers $ allOperDependencies name js
+        ModMod abs <- checkErr $ lookupModule gr a
+        js1 <- checkCompleteGrammar abs mo
+        mapMTree (checkCncInfo gr name (a,abs)) js1
+
+      MTInterface -> mapMTree (checkResInfo gr name) js
+
+      MTInstance a -> do
+        ModMod abs <- checkErr $ lookupModule gr a
+        -- checkCompleteInstance abs mo -- this is done in Rebuild
+        mapMTree (checkResInfo gr name) js
+
+    return $ (name, ModMod (Module mt st fs me ops js')) : ms
+
+  _ -> return $ (name,mod) : ms
+ where
+   gr  = MGrammar $ (name,mod):ms
+
+-- check if restricted inheritance modules are still coherent
+-- i.e. that the defs of remaining names don't depend on omitted names
+---checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check ()
+checkRestrictedInheritance mos (name,mo) = do
+  let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll]  -- names with restr. inh.
+  let mrs = [((i,m),mi) | (i,ModMod m) <- mos, Just mi <- [lookup i irs]] 
+                             -- the restr. modules themself, with restr. infos
+  mapM_ checkRem mrs
+ where
+   checkRem ((i,m),mi) = do
+     let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
+     let incld c   = Set.member c (Set.fromList incl)
+     let illegal c = Set.member c (Set.fromList excl)
+     let illegals = [(f,is) | 
+           (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
+     case illegals of 
+       [] -> return ()
+       cs -> fail $ "In inherited module" +++ prt i ++
+               ", dependence of excluded constants:" ++++
+               unlines ["  " ++ prt f +++ "on" +++ unwords (map prt is) | 
+                              (f,is) <- cs]
+   allDeps = ---- transClosure $ Map.fromList $ 
+             concatMap (allDependencies (const True)) 
+                              [jments m | (_,ModMod m) <- mos]
+   transClosure ds = ds ---- TODO: check in deeper modules
+
+-- | check if a term is typable
+justCheckLTerm :: SourceGrammar -> Term -> Err Term
+justCheckLTerm src t = do
+  ((t',_),_) <- checkStart (inferLType src t)
+  return t'
+
+checkAbsInfo :: SourceGrammar -> Ident -> (Ident,Info) -> Check (Ident,Info)
+checkAbsInfo st m (c,info) = do
+---- checkReservedId c
+ case info of
+   AbsCat (Yes cont) _ -> mkCheck "category" $ 
+     checkContext st cont ---- also cstrs
+   AbsFun (Yes typ0) md -> do
+    typ <- compAbsTyp [] typ0   -- to calculate let definitions
+    mkCheck "type of function" $ checkTyp st typ 
+    md' <- case md of
+       Yes d -> do
+         let d' = elimTables d
+         mkCheckWarn "definition of function" $ checkEquation st (m,c) d'
+         return $ Yes d'
+       _ -> return md
+    return $ (c,AbsFun (Yes typ) md')
+   _ -> return (c,info)
+ where
+   mkCheck cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkErr $ prtBad (unlines ss ++++ "in" +++ cat) c
+   ---- temporary solution when tc of defs is incomplete
+   mkCheckWarn cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
+   compAbsTyp g t = case t of
+     Vr x -> maybe (fail ("no value given to variable" +++ prt x)) return $ lookup x g
+     Let (x,(_,a)) b -> do
+       a' <- compAbsTyp g a
+       compAbsTyp ((x, a'):g) b
+     Prod x a b -> do
+       a' <- compAbsTyp g a
+       b' <- compAbsTyp ((x,Vr x):g) b
+       return $ Prod x a' b'
+     Abs _ _ -> return t
+     _ -> composOp (compAbsTyp g) t
+
+   elimTables e = case e of
+     S t a  -> elimSel (elimTables t) (elimTables a)
+     T _ cs -> Eqs [(elimPatt p, elimTables t) | (p,t) <- cs]
+     _ -> composSafeOp elimTables e
+   elimPatt p = case p of
+     PR lps -> map snd lps
+     _ -> [p]
+   elimSel t a = case a of
+     R fs -> mkApp t (map (snd . snd) fs)
+     _ -> mkApp t [a]
+
+checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree Ident Info)
+checkCompleteGrammar abs cnc = do
+  let js = jments cnc
+  let fs = tree2list $ jments abs
+  foldM checkOne js fs
+ where
+   checkOne js i@(c,info) = case info of
+     AbsFun (Yes _) _ -> case lookupIdent c js of
+       Ok _ -> return js
+       _ -> do
+         checkWarn $ "WARNING: no linearization of" +++ prt c
+         return js
+     AbsCat (Yes _) _ -> case lookupIdent c js of
+       Ok (AnyInd _ _) -> return js
+       Ok (CncCat (Yes _) _ _) -> return js
+       Ok (CncCat _ mt mp) -> do
+         checkWarn $ 
+           "Warning: no linearization type for" +++ prt c ++ 
+           ", inserting default {s : Str}" 
+         return $ updateTree (c,CncCat (Yes defLinType) mt mp) js
+       _ -> do
+         checkWarn $ 
+           "Warning: no linearization type for" +++ prt c ++ 
+           ", inserting default {s : Str}" 
+         return $ updateTree (c,CncCat (Yes defLinType) nope nope) js
+     _ -> return js
+
+-- | General Principle: only Yes-values are checked. 
+-- A May-value has always been checked in its origin module.
+checkResInfo :: SourceGrammar -> Ident -> (Ident,Info) -> Check (Ident,Info)
+checkResInfo gr mo (c,info) = do
+  checkReservedId c
+  case info of
+    ResOper pty pde -> chIn "operation" $ do
+      (pty', pde') <- case (pty,pde) of
+         (Yes ty, Yes de) -> do
+           ty'     <- check ty typeType >>= comp . fst
+           (de',_) <- check de ty'
+           return (Yes ty', Yes de')
+         (_, Yes de) -> do
+           (de',ty') <- infer de
+           return (Yes ty', Yes de')
+         (_,Nope) -> do
+           checkWarn "No definition given to oper"
+           return (pty,pde)
+         _ -> return (pty, pde) --- other cases are uninteresting
+      return (c, ResOper pty' pde')
+
+    ResOverload tysts -> chIn "overloading" $ do
+      tysts' <- mapM (uncurry $ flip check) tysts
+      let tysts2 = [(y,x) | (x,y) <- tysts']
+      --- this can only be a partial guarantee, since matching
+      --- with value type is only possible if expected type is given
+      checkUniq $ 
+        sort [t : map snd xs | (x,_) <- tysts2, Ok (xs,t) <- [typeFormCnc x]]
+      return (c,ResOverload tysts2)
+
+    ResParam (Yes (pcs,_)) -> chIn "parameter type" $ do
+----      mapM ((mapM (computeLType gr . snd)) . snd) pcs
+      mapM_ ((mapM_ (checkIfParType gr . snd)) . snd) pcs
+      ts <- checkErr $ lookupParamValues gr mo c
+      return (c,ResParam (Yes (pcs, Just ts)))
+
+    _ ->  return (c,info)
+ where
+   infer = inferLType gr
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+   comp = computeLType gr
+
+   checkUniq xss = case xss of
+     x:y:xs 
+      | x == y -> raise $ "ambiguous for argument list" +++ 
+                         unwords (map (prtType gr) x)  
+      | otherwise -> checkUniq $ y:xs
+     _ -> return ()
+
+
+checkCncInfo :: SourceGrammar -> Ident -> (Ident,SourceAbs) -> 
+                (Ident,Info) -> Check (Ident,Info)
+checkCncInfo gr m (a,abs) (c,info) = do
+  checkReservedId c
+  case info of
+
+    CncFun _ (Yes trm) mpr -> chIn "linearization of" $ do
+      typ        <- checkErr $ lookupFunTypeSrc gr a c
+      cat0       <- checkErr $ valCat typ
+      (cont,val) <- linTypeOfType gr m typ         -- creates arg vars
+      (trm',_)   <- check trm (mkFunType (map snd cont) val)  -- erases arg vars
+      checkPrintname gr mpr
+      cat        <- return $ snd cat0
+      return (c, CncFun (Just (cat,(cont,val))) (Yes trm') mpr)
+                                                   -- cat for cf, typ for pe
+
+    CncCat (Yes typ) mdef mpr -> chIn "linearization type of" $ do
+      checkErr $ lookupCatContextSrc gr a c
+      typ'  <- checkIfLinType gr typ
+      mdef' <- case mdef of
+        Yes def -> do
+          (def',_) <- checkLType gr def (mkFunType [typeStr] typ)
+          return $ Yes def'
+        _ -> return mdef
+      checkPrintname gr mpr
+      return (c,CncCat (Yes typ') mdef' mpr)
+
+    _ -> checkResInfo gr m (c,info)
+
+ where
+   env = gr
+   infer = inferLType gr
+   comp = computeLType gr 
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+
+checkIfParType :: SourceGrammar -> Type -> Check ()
+checkIfParType st typ = checkCond ("Not parameter type" +++ prt typ) (isParType typ)
+  where
+   isParType ty = True ----
+{- case ty of
+     Cn typ -> case lookupConcrete st typ of
+       Ok (CncParType _ _ _) -> True
+       Ok (CncOper _ ty' _) -> isParType ty'
+       _ -> False
+     Q p t -> case lookupInPackage st (p,t) of
+       Ok (CncParType _ _ _) -> True
+       _ -> False
+     RecType r -> all (isParType . snd) r
+     _ -> False
+-}
+
+checkIfStrType :: SourceGrammar -> Type -> Check ()
+checkIfStrType st typ = case typ of
+  Table arg val -> do
+    checkIfParType st arg 
+    checkIfStrType st val
+  _ | typ == typeStr -> return ()
+  _ -> prtFail "not a string type" typ
+
+
+checkIfLinType :: SourceGrammar -> Type -> Check Type
+checkIfLinType st typ0 = do
+  typ <- computeLType st typ0
+{- ---- should check that not fun type
+  case typ of
+    RecType r -> do
+      let (lins,ihs) = partition (isLinLabel .fst) r
+      --- checkErr $ checkUnique $ map fst r
+      mapM_ checkInh ihs
+      mapM_ checkLin lins
+    _ -> prtFail "a linearization type cannot be" typ
+-}
+  return typ
+
+ where
+   checkInh (label,typ) = checkIfParType st typ
+   checkLin (label,typ) = return () ---- checkIfStrType st typ
+
+
+computeLType :: SourceGrammar -> Type -> Check Type
+computeLType gr t = do
+  g0 <- checkGetContext
+  let g = [(x, Vr x) | (x,_) <- g0]
+  checkInContext g $ comp t
+ where
+  comp ty = case ty of
+
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
+
+    Q m c | elem c [cPredef,cPredefAbs] -> return ty
+    Q m c | elem c [zIdent "Int"] -> 
+      return $ linTypeInt
+    Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ----
+
+    Q m ident -> checkIn ("module" +++ prt m) $ do
+      ty' <- checkErr (lookupResDef gr m ident) 
+      if ty' == ty then return ty else comp ty' --- is this necessary to test?
+
+    Vr ident  -> checkLookup ident -- never needed to compute!
+
+    App f a -> do
+      f' <- comp f
+      a' <- comp a
+      case f' of
+        Abs x b -> checkInContext [(x,a')] $ comp b
+        _ -> return $ App f' a'
+
+    Prod x a b -> do
+      a' <- comp a
+      b' <- checkInContext [(x,Vr x)] $ comp b
+      return $ Prod x a' b'
+
+    Abs x b -> do
+      b' <- checkInContext [(x,Vr x)] $ comp b
+      return $ Abs x b'
+
+    ExtR r s -> do
+      r' <- comp r
+      s' <- comp s
+      case (r',s') of
+        (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp
+        _ -> return $ ExtR r' s'
+
+    RecType fs -> do
+      let fs' = sortBy (\x y -> compare (fst x) (fst y)) fs
+      liftM RecType $ mapPairsM comp fs'
+
+    _ | ty == typeTok -> return typeStr
+    _ | isPredefConstant ty -> return ty
+
+    _ -> composOp comp ty
+
+checkPrintname :: SourceGrammar -> Perh Term -> Check ()
+checkPrintname st (Yes t) = checkLType st t typeStr >> return ()
+checkPrintname _ _ = return ()
+
+-- | for grammars obtained otherwise than by parsing ---- update!!
+checkReservedId :: Ident -> Check ()
+checkReservedId x = let c = prt x in
+         if isResWord c 
+            then checkWarn ("Warning: reserved word used as identifier:" +++ c)
+            else return ()
+
+-- to normalize records and record types
+labelIndex :: Type -> Label -> Int
+labelIndex ty lab = case ty of
+  RecType ts -> maybe (error ("label index" +++ prt lab)) id $ lookup lab $ labs ts
+  _ -> error $ "label index" +++ prt ty
+ where 
+  labs ts = zip (map fst (sortBy (\ x y -> compare (fst x) (fst y)) ts)) [0..]
+
+-- the underlying algorithms
+
+inferLType :: SourceGrammar -> Term -> Check (Term, Type)
+inferLType gr trm = case trm of
+
+   Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
+
+   Q m ident -> checks [
+     termWith trm $ checkErr (lookupResType gr m ident) >>= comp
+     ,
+     checkErr (lookupResDef gr m ident) >>= infer
+     ,
+{-
+     do
+       over <- getOverload gr Nothing trm
+       case over of
+         Just trty -> return trty
+         _ -> prtFail "not overloaded" trm
+     ,
+-}
+     prtFail "cannot infer type of constant" trm
+     ]
+
+   QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
+
+   QC m ident -> checks [
+       termWith trm $ checkErr (lookupResType gr m ident) >>= comp
+       ,
+       checkErr (lookupResDef gr m ident) >>= infer
+       ,
+       prtFail "cannot infer type of canonical constant" trm
+       ]
+
+   Val ty i -> termWith trm $ return ty
+
+   Vr ident -> termWith trm $ checkLookup ident
+
+   Typed e t -> do
+     t' <- comp t
+     check e t'
+     return (e,t')
+
+   App f a -> do
+     over <- getOverload gr Nothing trm
+     case over of
+       Just trty -> return trty
+       _ -> do
+         (f',fty) <- infer f
+         fty' <- comp fty
+         case fty' of
+           Prod z arg val -> do 
+             a' <- justCheck a arg
+             ty <- if isWildIdent z 
+                      then return val
+                      else substituteLType [(z,a')] val
+             return (App f' a',ty) 
+           _ -> raise ("function type expected for"+++ 
+                      prt f +++"instead of" +++ prtType env fty)
+
+   S f x -> do
+     (f', fty) <- infer f
+     case fty of
+       Table arg val -> do
+         x'<- justCheck x arg
+         return (S f' x', val)
+       _ -> prtFail "table lintype expected for the table in" trm
+
+   P t i -> do
+     (t',ty) <- infer t   --- ??
+     ty' <- comp ty
+-----     let tr2 = PI t' i (labelIndex ty' i)
+     let tr2 = P t' i
+     termWith tr2 $ checkErr $ case ty' of
+       RecType ts -> maybeErr ("unknown label" +++ prt i +++ "in" +++ prt ty') $ 
+                     lookup i ts
+       _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty'
+   PI t i _ -> infer $ P t i
+
+   R r -> do
+     let (ls,fs) = unzip r
+     fsts <- mapM inferM fs
+     let ts = [ty | (Just ty,_) <- fsts]
+     checkCond ("cannot infer type of record"+++ prt trm) (length ts == length fsts)
+     return $ (R (zip ls fsts), RecType (zip ls ts))
+
+   T (TTyped arg) pts -> do
+     (_,val) <- checks $ map (inferCase (Just arg)) pts
+     check trm (Table arg val)
+   T (TComp arg) pts -> do
+     (_,val) <- checks $ map (inferCase (Just arg)) pts
+     check trm (Table arg val)
+   T ti pts -> do  -- tries to guess: good in oper type inference
+     let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
+     case pts' of 
+       [] -> prtFail "cannot infer table type of" trm
+----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
+       _  -> do 
+         (arg,val) <- checks $ map (inferCase Nothing) pts'
+         check trm (Table arg val)
+   V arg pts -> do
+     (_,val) <- checks $ map infer pts
+     return (trm, Table arg val)
+
+   K s  -> do
+     if elem ' ' s
+        then checkWarn ("WARNING: space in token \"" ++ s ++ 
+                        "\". Lexical analysis may fail.")
+        else return ()
+     return (trm, typeStr)
+
+   EInt i -> return (trm, typeInt)
+
+   EFloat i -> return (trm, typeFloat)
+
+   Empty -> return (trm, typeStr)
+
+   C s1 s2 -> 
+     check2 (flip justCheck typeStr) C s1 s2 typeStr
+
+   Glue s1 s2 -> 
+     check2 (flip justCheck typeStr) Glue s1 s2 typeStr ---- typeTok
+
+---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
+   Strs (Cn (IC "#conflict") : ts) -> do
+     trace ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts)) (infer $ head ts)
+--     checkWarn ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts))
+--     infer $ head ts
+
+   Strs ts -> do
+     ts' <- mapM (\t -> justCheck t typeStr) ts 
+     return (Strs ts', typeStrs)
+
+   Alts (t,aa) -> do
+     t'  <- justCheck t typeStr
+     aa' <- flip mapM aa (\ (c,v) -> do
+        c' <- justCheck c typeStr 
+        v' <- justCheck v typeStrs
+        return (c',v'))
+     return (Alts (t',aa'), typeStr)
+
+   RecType r -> do
+     let (ls,ts) = unzip r
+     ts' <- mapM (flip justCheck typeType) ts 
+     return (RecType (zip ls ts'), typeType)
+
+   ExtR r s -> do
+     (r',rT) <- infer r 
+     rT'     <- comp rT
+     (s',sT) <- infer s
+     sT'     <- comp sT
+
+     let trm' = ExtR r' s'
+     ---- trm'    <- checkErr $ plusRecord r' s'
+     case (rT', sT') of
+       (RecType rs, RecType ss) -> do
+         rt <- checkErr $ plusRecType rT' sT'
+         check trm' rt ---- return (trm', rt)
+       _ | rT' == typeType && sT' == typeType -> return (trm', typeType)
+       _ -> prtFail "records or record types expected in" trm
+
+   Sort _     -> 
+     termWith trm $ return typeType
+
+   Prod x a b -> do
+     a' <- justCheck a typeType
+     b' <- checkInContext [(x,a')] $ justCheck b typeType
+     return (Prod x a' b', typeType)
+
+   Table p t  -> do
+     p' <- justCheck p typeType --- check p partype! 
+     t' <- justCheck t typeType
+     return $ (Table p' t', typeType)
+
+   FV vs -> do
+     (_,ty) <- checks $ map infer vs
+---     checkIfComplexVariantType trm ty
+     check trm ty
+
+   EPattType ty -> do
+     ty' <- justCheck ty typeType
+     return (ty',typeType)
+   EPatt p -> do
+     ty <- inferPatt p
+     return (trm, EPattType ty)
+
+   _ -> prtFail "cannot infer lintype of" trm
+
+ where
+   env = gr
+   infer = inferLType env
+   comp = computeLType env 
+
+   check = checkLType env
+   
+   isPredef m = elem m [cPredef,cPredefAbs]
+
+   justCheck ty te = check ty te >>= return . fst
+
+   -- for record fields, which may be typed
+   inferM (mty, t) = do
+     (t', ty') <- case mty of
+       Just ty -> check ty t
+       _ -> infer t
+     return (Just ty',t')
+
+   inferCase mty (patt,term) = do
+     arg  <- maybe (inferPatt patt) return mty
+     cont <- pattContext env arg patt
+     i    <- checkUpdates cont
+     (_,val) <- infer term
+     checkResets i
+     return (arg,val)
+   isConstPatt p = case p of
+     PC _ ps -> True --- all isConstPatt ps
+     PP _ _ ps -> True --- all isConstPatt ps
+     PR ps -> all (isConstPatt . snd) ps
+     PT _ p -> isConstPatt p
+     PString _ -> True
+     PInt _ -> True
+     PFloat _ -> True
+     PChar -> True
+     PChars _ -> True
+     PSeq p q -> isConstPatt p && isConstPatt q
+     PAlt p q -> isConstPatt p && isConstPatt q
+     PRep p -> isConstPatt p
+     PNeg p -> isConstPatt p
+     PAs _ p -> isConstPatt p
+     _ -> False
+
+   inferPatt p = case p of
+     PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc
+     PAs _ p  -> inferPatt p
+     PNeg p   -> inferPatt p
+     PAlt p q -> checks [inferPatt p, inferPatt q]
+     PSeq _ _ -> return $ typeStr
+     PRep _   -> return $ typeStr
+     PChar    -> return $ typeStr
+     PChars _ -> return $ typeStr
+     _ -> infer (patt2term p) >>= return . snd
+
+
+-- type inference: Nothing, type checking: Just t
+-- the latter permits matching with value type
+getOverload :: SourceGrammar -> Maybe Type -> Term -> Check (Maybe (Term,Type))
+getOverload env@gr mt t = case appForm t of
+     (f@(Q m c), ts) -> case lookupOverload gr m c of
+       Ok typs -> do
+         ttys <- mapM infer ts
+         v <- matchOverload f typs ttys
+         return $ Just v
+       _ -> return Nothing
+     _ -> return Nothing
+ where
+   infer = inferLType env
+   matchOverload f typs ttys = do
+     let (tts,tys) = unzip ttys
+     let vfs = lookupOverloadInstance tys typs
+
+     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
+       [(val,fun)] -> return (mkApp fun tts, val)
+       [] -> raise $ "no overload instance of" +++ prt f +++ 
+         "for" +++ unwords (map (prtType env) tys) +++ "among" ++++ 
+         unlines ["  " ++ unwords (map (prtType env) ty) | (ty,_) <- typs] ++
+         maybe [] (("with value type" +++) . prtType env) mt
+
+      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
+      ----  ++++ unlines (map (show . fst) typs) ----
+
+       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
+         [(val,fun)] -> do
+           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
+             "resolved by excluding partial applications:" ++++
+             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+           return (mkApp fun tts, val)
+
+         _ -> raise $ "ambiguous overloading of" +++ prt f +++
+           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
+           unlines [prtType env ty | (ty,_) <- vfs']
+
+   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
+     unlocked = case v of
+       RecType fs -> [Just $ RecType $ filter (not . isLockLabel . fst) fs]
+       _ -> []
+   ---- TODO: accept subtypes
+   ---- TODO: use a trie
+   lookupOverloadInstance tys typs = 
+     [(mkFunType rest val, t) | 
+       let lt = length tys,
+       (ty,(val,t)) <- typs, length ty >= lt,
+       let (pre,rest) = splitAt lt ty, 
+       pre == tys
+     ]
+
+   noProd ty = case ty of
+     Prod _ _ _ -> False
+     _ -> True
+
+checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type)
+checkLType env trm typ0 = do
+
+  typ <- comp typ0
+
+  case trm of
+
+    Abs x c -> do
+      case typ of
+        Prod z a b -> do 
+          checkUpdate (x,a)
+          (c',b') <- if isWildIdent z
+                        then check c b
+                        else do
+                          b' <- checkIn "abs" $ substituteLType [(z,Vr x)] b
+                          check c b'
+          checkReset
+          return $ (Abs x c', Prod x a b')
+        _ -> raise $ "product expected instead of" +++ prtType env typ
+
+    App f a -> do
+       over <- getOverload env (Just typ) trm
+       case over of
+         Just trty -> return trty
+         _ -> do
+          (trm',ty') <- infer trm
+          termWith trm' $ checkEq typ ty' trm'
+
+    Q _ _ -> do
+       over <- getOverload env (Just typ) trm
+       case over of
+         Just trty -> return trty
+         _ -> do
+          (trm',ty') <- infer trm
+          termWith trm' $ checkEq typ ty' trm'
+
+    T _ [] ->
+      prtFail "found empty table in type" typ
+    T _ cs -> case typ of 
+      Table arg val -> do 
+        case allParamValues env arg of
+          Ok vs -> do
+            let ps0 = map fst cs
+            ps <- checkErr $ testOvershadow ps0 vs
+            if null ps 
+              then return () 
+              else checkWarn $ "WARNING: patterns never reached:" +++ 
+                               concat (intersperse ", " (map prt ps))
+
+          _ -> return () -- happens with variable types
+        cs' <- mapM (checkCase arg val) cs
+        return (T (TTyped arg) cs', typ)
+      _ -> raise $ "table type expected for table instead of" +++ prtType env typ
+
+    R r -> case typ of --- why needed? because inference may be too difficult
+       RecType rr -> do
+         let (ls,_) = unzip rr        -- labels of expected type
+         fsts <- mapM (checkM r) rr   -- check that they are found in the record
+         return $ (R fsts, typ)       -- normalize record
+
+       _ -> prtFail "record type expected in type checking instead of" typ
+
+    ExtR r s -> case typ of
+       _ | typ == typeType -> do
+         trm' <- comp trm
+         case trm' of
+           RecType _ -> termWith trm $ return typeType
+           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType 
+                                      -- ext t = t ** ...
+           _ -> prtFail "invalid record type extension" trm
+       RecType rr -> do
+         (r',ty,s') <- checks [
+            do (r',ty) <- infer r
+               return (r',ty,s)
+           ,
+            do (s',ty) <- infer s
+               return (s',ty,r)
+            ]
+         case ty of
+           RecType rr1 -> do
+                let (rr0,rr2) = recParts rr rr1
+                r2 <- justCheck r' rr0
+                s2 <- justCheck s' rr2
+                return $ (ExtR r2 s2, typ) 
+           _ -> raise ("record type expected in extension of" +++ prt r +++ 
+                       "but found" +++ prt ty)
+
+       ExtR ty ex -> do
+         r' <- justCheck r ty
+         s' <- justCheck s ex
+         return $ (ExtR r' s', typ) --- is this all?
+
+       _ -> prtFail "record extension not meaningful for" typ
+
+    FV vs -> do
+      ttys <- mapM (flip check typ) vs
+---      checkIfComplexVariantType trm typ
+      return (FV (map fst ttys), typ) --- typ' ?
+
+    S tab arg -> checks [ do
+      (tab',ty) <- infer tab
+      ty'       <- comp ty
+      case ty' of
+        Table p t -> do
+          (arg',val) <- check arg p
+          checkEq typ t trm
+          return (S tab' arg', t)
+        _ -> raise $ "table type expected for applied table instead of" +++ 
+                   prtType env ty'
+     , do
+      (arg',ty) <- infer arg
+      ty'       <- comp ty
+      (tab',_)  <- check tab (Table ty' typ)
+      return (S tab' arg', typ)
+      ]
+    Let (x,(mty,def)) body -> case mty of
+      Just ty -> do
+        (def',ty') <- check def ty
+        checkUpdate (x,ty')
+        body' <- justCheck body typ
+        checkReset
+        return (Let (x,(Just ty',def')) body', typ)
+      _ -> do
+        (def',ty) <- infer def  -- tries to infer type of local constant
+        check (Let (x,(Just ty,def')) body) typ
+
+    _ -> do
+      (trm',ty') <- infer trm
+      termWith trm' $ checkEq typ ty' trm'
+ where
+   cnc = env
+   infer = inferLType env
+   comp = computeLType env 
+
+   check = checkLType env
+   
+   justCheck ty te = check ty te >>= return . fst
+
+   checkEq = checkEqLType env
+
+   recParts rr t = (RecType rr1,RecType rr2) where 
+     (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
+
+   checkM rms (l,ty) = case lookup l rms of
+     Just (Just ty0,t) -> do
+       checkEq ty ty0 t
+       (t',ty') <- check t ty
+       return (l,(Just ty',t'))
+     Just (_,t) -> do
+       (t',ty') <- check t ty
+       return (l,(Just ty',t'))
+     _ -> prtFail "cannot find value for label" l
+
+   checkCase arg val (p,t) = do
+     cont <- pattContext env arg p
+     i    <- checkUpdates cont
+     t'   <- justCheck t val
+     checkResets i
+     return (p,t')
+
+pattContext :: LTEnv -> Type -> Patt -> Check Context
+pattContext env typ p = case p of
+  PV x | not (isWildIdent x) -> return [(x,typ)]
+  PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
+    t <- checkErr $ lookupResType cnc q c
+    (cont,v) <- checkErr $ typeFormCnc t
+    checkCond ("wrong number of arguments for constructor in" +++ prt p) 
+              (length cont == length ps)
+    checkEqLType env typ v (patt2term p)
+    mapM (uncurry (pattContext env)) (zip (map snd cont) ps) >>= return . concat
+  PR r -> do
+    typ' <- computeLType env typ
+    case typ' of
+      RecType t -> do
+        let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
+        ----- checkWarn $ prt p ++++ show pts ----- debug
+        mapM (uncurry (pattContext env)) pts >>= return . concat
+      _ -> prtFail "record type expected for pattern instead of" typ'
+  PT t p' -> do
+    checkEqLType env typ t (patt2term p')
+    pattContext env typ p'
+
+  PAs x p -> do
+    g <- pattContext env typ p
+    return $ (x,typ):g
+
+  PAlt p' q -> do
+    g1 <- pattContext env typ p'
+    g2 <- pattContext env typ q
+    let pts = [pt | pt <- g1, notElem pt g2] ++ [pt | pt <- g2, notElem pt g1]
+    checkCond 
+      ("incompatible bindings of" +++ 
+       unwords (nub (map (prt . fst) pts))+++ 
+       "in pattern alterantives" +++ prt p) (null pts) 
+    return g1 -- must be g1 == g2
+  PSeq p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ g1 ++ g2
+  PRep p' -> noBind typeStr p'
+  PNeg p' -> noBind typ p'
+
+  _ -> return [] ---- check types!
+ where 
+   cnc = env
+   noBind typ p' = do
+    co <- pattContext env typ p'
+    if not (null co)
+      then checkWarn ("no variable bound inside pattern" +++ prt p) 
+           >> return []
+      else return []
+
+-- auxiliaries
+
+type LTEnv = SourceGrammar
+
+termWith :: Term -> Check Type -> Check (Term, Type)
+termWith t ct = do
+  ty <- ct
+  return (t,ty)
+
+-- | light-weight substitution for dep. types
+substituteLType :: Context -> Type -> Check Type
+substituteLType g t = case t of
+  Vr x -> return $ maybe t id $ lookup x g
+  _ -> composOp (substituteLType g) t
+
+-- | compositional check\/infer of binary operations
+check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> 
+          Term -> Term -> Type -> Check (Term,Type)
+check2 chk con a b t = do
+  a' <- chk a
+  b' <- chk b
+  return (con a' b', t)
+
+checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type
+checkEqLType env t u trm = do
+  (b,t',u',s) <- checkIfEqLType env t u trm
+  case b of
+    True  -> return t'
+    False -> raise $ s +++ "type of" +++ prt trm +++ 
+                        ": expected:" +++ prtType env t ++++ 
+                        "inferred:" +++ prtType env u
+
+checkIfEqLType :: LTEnv -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
+checkIfEqLType env t u trm = do
+  t' <- comp t 
+  u' <- comp u
+  case t' == u' || alpha [] t' u' of
+    True -> return (True,t',u',[])
+    -- forgive missing lock fields by only generating a warning.
+    --- better: use a flag to forgive? (AR 31/1/2006)
+    _ -> case missingLock [] t' u' of
+      Ok lo -> do
+        checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo)
+        return (True,t',u',[])
+      Bad s -> return (False,t',u',s)
+
+  where
+
+   -- t is a subtype of u 
+   --- quick hack version of TC.eqVal
+   alpha g t u = case (t,u) of  
+
+     -- error (the empty type!) is subtype of any other type
+     (_,Q (IC "Predef") (IC "Error")) -> True
+
+     -- contravariance
+     (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
+                              
+     -- record subtyping
+     (RecType rs, RecType ts) -> all (\ (l,a) -> 
+                                   any (\ (k,b) -> alpha g a b && l == k) ts) rs
+     (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
+     (ExtR r s, t) -> alpha g r t || alpha g s t
+
+     -- the following say that Ints n is a subset of Int and of Ints m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
+     
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
+     ---- this should be made in Rename
+     (Q  m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+                               || m == n --- for Predef
+     (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (QC m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+
+     (Table a b,  Table c d)  -> alpha g a c && alpha g b d
+     (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
+     _                        -> t == u 
+     --- the following should be one-way coercions only. AR 4/1/2001
+                                  || elem t sTypes && elem u sTypes
+                                  || (t == typeType && u == typePType) 
+                                  || (u == typeType && t == typePType) 
+
+   missingLock g t u = case (t,u) of  
+     (RecType rs, RecType ts) -> 
+       let 
+         ls = [l | (l,a) <- rs, 
+                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
+         (locks,others) = partition isLockLabel ls
+       in case others of
+         _:_ -> Bad $ "missing record fields" +++ unwords (map prt others)
+         _ -> return locks
+     -- contravariance
+     (Prod x a b, Prod y c d) -> do
+        ls1 <- missingLock g c a
+        ls2 <- missingLock g b d
+        return $ ls1 ++ ls2
+
+     _ -> Bad ""
+
+   sTypes = [typeStr, typeTok, typeString]
+   comp = computeLType env
+
+-- printing a type with a lock field lock_C as C
+prtType :: LTEnv -> Type -> String
+prtType env ty = case ty of
+  RecType fs -> case filter isLockLabel $ map fst fs of
+    [lock] -> (drop 5 $ prt lock) --- ++++ "Full form" +++ prt ty
+    _ -> prtt ty
+  Prod x a b -> prtType env a +++ "->" +++ prtType env b
+  _ -> prtt ty
+ where
+   prtt t = prt t
+   ---- use computeLType gr to check if really equal to the cat with lock
+
+
+-- | linearization types and defaults
+linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type)
+linTypeOfType cnc m typ = do
+  (cont,cat) <- checkErr $ typeSkeleton typ
+  val  <- lookLin cat
+  args <- mapM mkLinArg (zip [0..] cont)
+  return (args, val)
+ where
+   mkLinArg (i,(n,mc@(m,cat))) = do
+     val  <- lookLin mc
+     let vars = mkRecType varLabel $ replicate n typeStr
+	 symb = argIdent n cat i
+     rec <- if n==0 then return val else
+            checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $
+            plusRecType vars val
+     return (symb,rec)
+   lookLin (_,c) = checks [ --- rather: update with defLinType ?
+      checkErr (lookupLincat cnc m c) >>= computeLType cnc
+     ,return defLinType
+     ]
+
+-- | dependency check, detecting circularities and returning topo-sorted list
+
+allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])]
+allOperDependencies m = allDependencies (==m)
+
+allDependencies :: (Ident -> Bool) -> BinTree Ident Info -> [(Ident,[Ident])]
+allDependencies ism b = 
+  [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b]
+  where
+    opersIn t = case t of
+      Q n c | ism n -> [c]
+      QC n c | ism n -> [c]
+      _ -> collectOp opersIn t
+    opty (Yes ty) = opersIn ty
+    opty _ = []
+    pts i = case i of
+      ResOper pty pt -> [pty,pt]
+      ResParam (Yes (ps,_)) -> [Yes t | (_,cont) <- ps, (_,t) <- cont]
+      CncCat pty _ _ -> [pty]
+      CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
+      AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual
+      AbsCat (Yes co) _ -> [Yes ty | (_,ty) <- co]
+      _              -> []
+
+topoSortOpers :: [(Ident,[Ident])] -> Err [Ident]
+topoSortOpers st = do
+  let eops = topoTest st
+  either 
+    return 
+    (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops))))
+    eops
diff --git a/src-3.0/GF/Devel/CheckM.hs b/src-3.0/GF/Devel/CheckM.hs
new file mode 100644
index 000000000..d26dbc07c
--- /dev/null
+++ b/src-3.0/GF/Devel/CheckM.hs
@@ -0,0 +1,89 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CheckM
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:33 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Devel.CheckM (Check,
+	       checkError, checkCond, checkWarn, checkUpdate, checkInContext,
+	       checkUpdates, checkReset, checkResets, checkGetContext, 
+	       checkLookup, checkStart, checkErr, checkVal, checkIn, 
+	       prtFail
+	      ) where
+
+import GF.Data.Operations
+import GF.Devel.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Devel.Grammar.PrGF
+
+-- | the strings are non-fatal warnings
+type Check a = STM (Context,[String]) a
+
+checkError :: String -> Check a
+checkError = raise
+
+checkCond :: String -> Bool -> Check ()
+checkCond s b = if b then return () else checkError s
+
+-- | warnings should be reversed in the end
+checkWarn :: String -> Check ()
+checkWarn s = updateSTM (\ (cont,msg) -> (cont, s:msg))
+
+checkUpdate :: Decl -> Check ()
+checkUpdate d = updateSTM (\ (cont,msg) -> (d:cont, msg))
+
+checkInContext :: [Decl] -> Check r -> Check r
+checkInContext g ch = do
+  i <- checkUpdates g
+  r <- ch
+  checkResets i
+  return r
+
+checkUpdates :: [Decl] -> Check Int
+checkUpdates ds = mapM checkUpdate ds >> return (length ds)
+
+checkReset :: Check ()
+checkReset = checkResets 1
+
+checkResets :: Int -> Check ()
+checkResets i = updateSTM (\ (cont,msg) -> (drop i cont, msg))
+
+checkGetContext :: Check Context
+checkGetContext = do
+  (co,_) <- readSTM
+  return co
+
+checkLookup :: Ident -> Check Type
+checkLookup x = do
+  co <- checkGetContext
+  checkErr $ maybe (prtBad "unknown variable" x) return $ lookup x co
+
+checkStart :: Check a -> Err (a,(Context,[String]))
+checkStart c = appSTM c ([],[])
+
+checkErr :: Err a -> Check a
+checkErr e = stm (\s -> do
+  v <- e
+  return (v,s)
+  )
+
+checkVal :: a -> Check a
+checkVal v = return v
+
+prtFail :: Print a => String -> a -> Check b
+prtFail s t = checkErr $ prtBad s t
+
+checkIn :: String -> Check a -> Check a
+checkIn msg c = stm $ \s@(g,ws) -> case appSTM c s of
+  Bad e -> Bad $ msg ++++ e
+  Ok (v,(g',ws')) -> Ok (v,(g',ws2)) where
+    new = take (length ws' - length ws) ws'
+    ws2 = [msg ++++ w | w <- new] ++ ws
diff --git a/src-3.0/GF/Devel/Compile.hs b/src-3.0/GF/Devel/Compile.hs
new file mode 100644
index 000000000..0655913e1
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile.hs
@@ -0,0 +1,203 @@
+module GF.Devel.Compile (batchCompile) where
+
+-- the main compiler passes
+import GF.Devel.GetGrammar
+import GF.Compile.Extend
+import GF.Compile.Rebuild
+import GF.Compile.Rename
+import GF.Grammar.Refresh
+import GF.Devel.CheckGrammar
+import GF.Devel.Optimize
+--import GF.Compile.Evaluate ----
+import GF.Devel.OptimizeGF
+--import GF.Canon.Share
+--import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Infra.CompactPrint
+import GF.Devel.PrGrammar
+import GF.Compile.Update
+import GF.Grammar.Lookup
+import GF.Infra.Modules
+import GF.Devel.ReadFiles
+
+import GF.Source.GrammarToSource
+import qualified GF.Source.AbsGF as A
+import qualified GF.Source.PrintGF as P
+
+import GF.Data.Operations
+import GF.Devel.UseIO
+import GF.Devel.Arch
+
+import Control.Monad
+import System.Directory
+import System.FilePath
+import System.Time
+import qualified Data.Map as Map
+
+batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
+batchCompile opts files = do
+  (_,gr,_) <- foldM (compileModule defOpts) emptyCompileEnv files
+  return gr
+  where
+    defOpts = addOptions opts (options [emitCode])
+
+-- to output an intermediate stage
+intermOut :: Options -> Option -> String -> IOE ()
+intermOut opts opt s = if oElem opt opts then 
+  ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) 
+  else return ()
+
+prMod :: SourceModule -> String
+prMod = compactPrint . prModule
+
+
+-- | the environment
+type CompileEnv = (Int,SourceGrammar,ModEnv)
+
+-- | compile with one module as starting point
+-- command-line options override options (marked by --#) in the file
+-- As for path: if it is read from file, the file path is prepended to each name.
+-- If from command line, it is used as it is.
+
+compileModule :: Options -> CompileEnv -> FilePath -> IOE CompileEnv
+compileModule opts1 env file = do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (ps0 ++ map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
+  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
+  let (_,sgr,rfs) = env
+  let file' = if useFileOpt then takeFileName file else file -- to find file itself
+  files <- getAllFiles opts ps rfs file'
+  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
+  let names = map justModuleName files
+  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
+  foldM (compileOne opts) (0,sgr,rfs) files
+
+
+compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
+compileOne opts env@(_,srcgr,_) file = do
+
+  let putp s = putPointE opts s
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush m) >> act
+
+  let gf   = takeExtensions file
+  let path = dropFileName file
+  let name = dropExtension file
+  let mos  = modules srcgr
+
+  case gf of
+
+    -- for compiled gf, read the file and update environment
+    -- also undo common subexp optimization, to enable normal computations
+    ".gfo" -> do
+       sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
+       let sm1 = unsubexpModule sm0
+       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
+       
+       extendCompileEnv env file sm
+
+    -- for gf source, do full compilation and generate code
+    _ -> do
+
+      let gfo = gfoFile (dropExtension file)
+      b1 <- ioeIO $ doesFileExist file
+      if not b1
+        then compileOne opts env $ gfo
+        else do
+
+       sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
+                                           getSourceModule opts file
+       (k',sm)  <- compileSourceModule opts env sm0
+       let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
+       cm  <- putpp "  generating code... " $ generateModuleCode opts gfo sm1
+          -- sm is optimized before generation, but not in the env
+       extendCompileEnvInt env k' gfo sm1
+  where
+   isConcr (_,mi) = case mi of
+     ModMod m -> isModCnc m && mstatus m /= MSIncomplete 
+     _ -> False
+
+
+compileSourceModule :: Options -> CompileEnv -> 
+                       SourceModule -> IOE (Int,SourceModule)
+compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
+
+  let putp  = putPointE opts
+      putpp = putPointEsil opts
+      mos   = modules gr
+
+  mo1   <- ioeErr $ rebuildModule mos mo
+  intermOut opts (iOpt "show_rebuild") (prMod mo1)
+
+  mo1b  <- ioeErr $ extendModule mos mo1
+  intermOut opts (iOpt "show_extend") (prMod mo1b)
+
+  case mo1b of
+    (_,ModMod n) | not (isCompleteModule n) -> do
+      return (k,mo1b)   -- refresh would fail, since not renamed
+    _ -> do
+      mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b
+      intermOut opts (iOpt "show_rename") (prMod mo2)
+
+      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
+      if null warnings then return () else putp warnings $ return ()
+      intermOut opts (iOpt "show_typecheck") (prMod mo3)
+
+
+      (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
+      intermOut opts (iOpt "show_refresh") (prMod mo3r)
+
+      let eenv = () --- emptyEEnv
+      (mo4,eenv') <- 
+        ---- if oElem "check_only" opts 
+          putpp "  optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r
+      return (k',mo4)
+ where
+   ----   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
+   prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
+
+generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
+generateModuleCode opts file minfo = do
+  let minfo1 = subexpModule minfo
+      out    = prGrammar (MGrammar [minfo1])
+  putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
+  return minfo1
+ where
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
+
+-- auxiliaries
+
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
+
+reverseModules (MGrammar ms) = MGrammar $ reverse ms
+
+emptyCompileEnv :: CompileEnv
+emptyCompileEnv = (0,emptyMGrammar,Map.empty)
+
+extendCompileEnvInt (_,MGrammar ss,menv) k file sm = do
+  let (mod,imps) = importsOfModule (trModule sm)
+  t <- ioeIO $ getModificationTime file
+  return (k,MGrammar (sm:ss),Map.insert mod (t,imps) menv) --- reverse later
+
+extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k file sm
+
+
diff --git a/src-3.0/GF/Devel/Compile/AbsGF.hs b/src-3.0/GF/Devel/Compile/AbsGF.hs
new file mode 100644
index 000000000..d053a3fa1
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/AbsGF.hs
@@ -0,0 +1,274 @@
+module GF.Devel.Compile.AbsGF where
+
+-- Haskell module generated by the BNF converter
+
+newtype PIdent = PIdent ((Int,Int),String) deriving (Eq,Ord,Show)
+newtype LString = LString String deriving (Eq,Ord,Show)
+data Grammar =
+   Gr [ModDef]
+  deriving (Eq,Ord,Show)
+
+data ModDef =
+   MModule ComplMod ModType ModBody
+  deriving (Eq,Ord,Show)
+
+data ModType =
+   MAbstract PIdent
+ | MResource PIdent
+ | MGrammar PIdent
+ | MInterface PIdent
+ | MConcrete PIdent PIdent
+ | MInstance PIdent PIdent
+  deriving (Eq,Ord,Show)
+
+data ModBody =
+   MBody Extend Opens [TopDef]
+ | MNoBody [Included]
+ | MWith Included [Open]
+ | MWithBody Included [Open] Opens [TopDef]
+ | MWithE [Included] Included [Open]
+ | MWithEBody [Included] Included [Open] Opens [TopDef]
+ | MReuse PIdent
+ | MUnion [Included]
+  deriving (Eq,Ord,Show)
+
+data Extend =
+   Ext [Included]
+ | NoExt
+  deriving (Eq,Ord,Show)
+
+data Opens =
+   NoOpens
+ | OpenIn [Open]
+  deriving (Eq,Ord,Show)
+
+data Open =
+   OName PIdent
+ | OQual PIdent PIdent
+  deriving (Eq,Ord,Show)
+
+data ComplMod =
+   CMCompl
+ | CMIncompl
+  deriving (Eq,Ord,Show)
+
+data Included =
+   IAll PIdent
+ | ISome PIdent [PIdent]
+ | IMinus PIdent [PIdent]
+  deriving (Eq,Ord,Show)
+
+data TopDef =
+   DefCat [CatDef]
+ | DefFun [FunDef]
+ | DefFunData [FunDef]
+ | DefDef [Def]
+ | DefData [DataDef]
+ | DefPar [ParDef]
+ | DefOper [Def]
+ | DefLincat [Def]
+ | DefLindef [Def]
+ | DefLin [Def]
+ | DefPrintCat [Def]
+ | DefPrintFun [Def]
+ | DefFlag [Def]
+ | DefPrintOld [Def]
+ | DefLintype [Def]
+ | DefPattern [Def]
+ | DefPackage PIdent [TopDef]
+ | DefVars [Def]
+ | DefTokenizer PIdent
+  deriving (Eq,Ord,Show)
+
+data Def =
+   DDecl [Name] Exp
+ | DDef [Name] Exp
+ | DPatt Name [Patt] Exp
+ | DFull [Name] Exp Exp
+  deriving (Eq,Ord,Show)
+
+data FunDef =
+   FDecl [Name] Exp
+  deriving (Eq,Ord,Show)
+
+data CatDef =
+   SimpleCatDef PIdent [DDecl]
+ | ListCatDef PIdent [DDecl]
+ | ListSizeCatDef PIdent [DDecl] Integer
+  deriving (Eq,Ord,Show)
+
+data DataDef =
+   DataDef Name [DataConstr]
+  deriving (Eq,Ord,Show)
+
+data DataConstr =
+   DataId PIdent
+ | DataQId PIdent PIdent
+  deriving (Eq,Ord,Show)
+
+data ParDef =
+   ParDefDir PIdent [ParConstr]
+ | ParDefAbs PIdent
+  deriving (Eq,Ord,Show)
+
+data ParConstr =
+   ParConstr PIdent [DDecl]
+  deriving (Eq,Ord,Show)
+
+data Name =
+   PIdentName PIdent
+ | ListName PIdent
+  deriving (Eq,Ord,Show)
+
+data LocDef =
+   LDDecl [PIdent] Exp
+ | LDDef [PIdent] Exp
+ | LDFull [PIdent] Exp Exp
+  deriving (Eq,Ord,Show)
+
+data Exp =
+   EPIdent PIdent
+ | EConstr PIdent
+ | ECons PIdent
+ | ESort Sort
+ | EString String
+ | EInt Integer
+ | EFloat Double
+ | EMeta
+ | EEmpty
+ | EData
+ | EList PIdent Exps
+ | EStrings String
+ | ERecord [LocDef]
+ | ETuple [TupleComp]
+ | EIndir PIdent
+ | ETyped Exp Exp
+ | EProj Exp Label
+ | EQConstr PIdent PIdent
+ | EQCons PIdent PIdent
+ | EApp Exp Exp
+ | ETable [Case]
+ | ETTable Exp [Case]
+ | EVTable Exp [Exp]
+ | ECase Exp [Case]
+ | EVariants [Exp]
+ | EPre Exp [Altern]
+ | EStrs [Exp]
+ | EPatt Patt
+ | EPattType Exp
+ | ESelect Exp Exp
+ | ETupTyp Exp Exp
+ | EExtend Exp Exp
+ | EGlue Exp Exp
+ | EConcat Exp Exp
+ | EAbstr [Bind] Exp
+ | ECTable [Bind] Exp
+ | EProd Decl Exp
+ | ETType Exp Exp
+ | ELet [LocDef] Exp
+ | ELetb [LocDef] Exp
+ | EWhere Exp [LocDef]
+ | EEqs [Equation]
+ | EExample Exp String
+ | ELString LString
+ | ELin PIdent
+  deriving (Eq,Ord,Show)
+
+data Exps =
+   NilExp
+ | ConsExp Exp Exps
+  deriving (Eq,Ord,Show)
+
+data Patt =
+   PChar
+ | PChars String
+ | PMacro PIdent
+ | PM PIdent PIdent
+ | PW
+ | PV PIdent
+ | PCon PIdent
+ | PQ PIdent PIdent
+ | PInt Integer
+ | PFloat Double
+ | PStr String
+ | PR [PattAss]
+ | PTup [PattTupleComp]
+ | PC PIdent [Patt]
+ | PQC PIdent PIdent [Patt]
+ | PDisj Patt Patt
+ | PSeq Patt Patt
+ | PRep Patt
+ | PAs PIdent Patt
+ | PNeg Patt
+  deriving (Eq,Ord,Show)
+
+data PattAss =
+   PA [PIdent] Patt
+  deriving (Eq,Ord,Show)
+
+data Label =
+   LPIdent PIdent
+ | LVar Integer
+  deriving (Eq,Ord,Show)
+
+data Sort =
+   Sort_Type
+ | Sort_PType
+ | Sort_Tok
+ | Sort_Str
+ | Sort_Strs
+  deriving (Eq,Ord,Show)
+
+data Bind =
+   BPIdent PIdent
+ | 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 Patt 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
+ | FPIdent PIdent
+ | FSlash FileName
+ | FDot FileName
+ | FMinus FileName
+ | FAddId PIdent FileName
+  deriving (Eq,Ord,Show)
+
diff --git a/src-3.0/GF/Devel/Compile/CheckGrammar.hs b/src-3.0/GF/Devel/Compile/CheckGrammar.hs
new file mode 100644
index 000000000..30ea0a70e
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/CheckGrammar.hs
@@ -0,0 +1,1089 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CheckGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:33 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.31 $
+--
+-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003 -- 6/12/2007
+--
+-- type checking also does the following modifications:
+--
+--  - types of operations and local constants are inferred and put in place
+--
+--  - both these types and linearization types are computed
+--
+--  - tables are type-annotated
+--
+--  - overloading is resolved
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.CheckGrammar (
+  showCheckModule, 
+  justCheckLTerm, 
+  allOperDependencies, 
+  topoSortOpers
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Lookup
+
+import GF.Infra.Ident
+
+--import GF.Grammar.Refresh ----
+
+--import GF.Grammar.TypeCheck
+--import GF.Grammar.Values (cPredefAbs) ---
+
+
+--import GF.Grammar.LookAbs
+--import GF.Grammar.ReservedWords ----
+import GF.Devel.Grammar.PatternMatch (testOvershadow)
+import GF.Devel.Grammar.AppPredefined
+--import GF.Grammar.Lockfield (isLockLabel)
+
+import GF.Devel.CheckM
+
+import GF.Data.Operations
+
+import Data.List
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Control.Monad
+import Debug.Trace ---
+
+
+showCheckModule :: GF -> SourceModule -> Err (SourceModule,String)
+showCheckModule mos m = do
+  (st,(_,msg)) <- checkStart $ checkModule mos m
+  return (st, unlines $ reverse msg)
+
+checkModule :: GF -> SourceModule -> Check SourceModule
+checkModule gf0 (name,mo) = checkIn ("checking module" +++ prt name) $ do
+  let gr = gf0 {gfmodules = Map.insert name mo (gfmodules gf0)}
+  ----  checkRestrictedInheritance gr (name, mo)
+  mo1 <- case mtype mo of
+    MTAbstract -> judgementOpModule (checkAbsInfo gr name) mo
+    MTGrammar -> entryOpModule (checkResInfo gr name) mo
+
+    MTConcrete aname -> do
+      checkErr $ topoSortOpers $ allOperDependencies name $ mjments mo
+      abs <- checkErr $ lookupModule gr aname
+      mo1 <- checkCompleteGrammar abs mo
+      entryOpModule (checkCncInfo gr name (aname,abs)) mo1
+
+    MTInterface -> entryOpModule (checkResInfo gr name) mo
+
+    MTInstance iname -> do
+      intf <- checkErr $ lookupModule gr iname
+      entryOpModule  (checkResInfo gr name) mo
+
+  return $ (name, mo1)
+
+{- ----
+-- check if restricted inheritance modules are still coherent
+-- i.e. that the defs of remaining names don't depend on omitted names
+---checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check ()
+checkRestrictedInheritance mos (name,mo) = do
+  let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll]  -- names with restr. inh.
+  let mrs = [((i,m),mi) | (i,ModMod m) <- mos, Just mi <- [lookup i irs]] 
+                             -- the restr. modules themself, with restr. infos
+  mapM_ checkRem mrs
+ where
+   checkRem ((i,m),mi) = do
+     let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
+     let incld c   = Set.member c (Set.fromList incl)
+     let illegal c = Set.member c (Set.fromList excl)
+     let illegals = [(f,is) | 
+           (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
+     case illegals of 
+       [] -> return ()
+       cs -> fail $ "In inherited module" +++ prt i ++
+               ", dependence of excluded constants:" ++++
+               unlines ["  " ++ prt f +++ "on" +++ unwords (map prt is) | 
+                              (f,is) <- cs]
+   allDeps = ---- transClosure $ Map.fromList $ 
+             concatMap (allDependencies (const True)) 
+                              [jments m | (_,ModMod m) <- mos]
+   transClosure ds = ds ---- TODO: check in deeper modules
+-}
+
+
+-- | check if a term is typable
+justCheckLTerm :: GF -> Term -> Err Term
+justCheckLTerm src t = do
+  ((t',_),_) <- checkStart (inferLType src t)
+  return t'
+
+checkAbsInfo :: GF -> Ident -> Judgement -> Check Judgement
+checkAbsInfo st m info = return info ----
+
+{-
+checkAbsInfo st m (c,info) = do
+---- checkReservedId c
+ case info of
+   AbsCat (Yes cont) _ -> mkCheck "category" $ 
+     checkContext st cont ---- also cstrs
+   AbsFun (Yes typ0) md -> do
+    typ <- compAbsTyp [] typ0   -- to calculate let definitions
+    mkCheck "type of function" $ checkTyp st typ 
+    md' <- case md of
+       Yes d -> do
+         let d' = elimTables d
+         mkCheckWarn "definition of function" $ checkEquation st (m,c) d'
+         return $ Yes d'
+       _ -> return md
+    return $ (c,AbsFun (Yes typ) md')
+   _ -> return (c,info)
+ where
+   mkCheck cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkErr $ prtBad (unlines ss ++++ "in" +++ cat) c
+   ---- temporary solution when tc of defs is incomplete
+   mkCheckWarn cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
+   compAbsTyp g t = case t of
+     Vr x -> maybe (fail ("no value given to variable" +++ prt x)) return $ lookup x g
+     Let (x,(_,a)) b -> do
+       a' <- compAbsTyp g a
+       compAbsTyp ((x, a'):g) b
+     Prod x a b -> do
+       a' <- compAbsTyp g a
+       b' <- compAbsTyp ((x,Vr x):g) b
+       return $ Prod x a' b'
+     Abs _ _ -> return t
+     _ -> composOp (compAbsTyp g) t
+
+   elimTables e = case e of
+     S t a  -> elimSel (elimTables t) (elimTables a)
+     T _ cs -> Eqs [(elimPatt p, elimTables t) | (p,t) <- cs]
+     _ -> composSafeOp elimTables e
+   elimPatt p = case p of
+     PR lps -> map snd lps
+     _ -> [p]
+   elimSel t a = case a of
+     R fs -> mkApp t (map (snd . snd) fs)
+     _ -> mkApp t [a]
+-}
+
+
+checkCompleteGrammar :: Module -> Module -> Check Module
+checkCompleteGrammar abs cnc = do
+  let js = mjments cnc
+  let fs = Map.assocs $ mjments abs
+  js' <- foldM checkOne js fs
+  return $ cnc {mjments = js'}
+ where
+   checkOne js i@(c, ju) = case jform ju of
+     JFun -> case Map.lookup c js of
+       Just j | jform j == JLin -> return js
+       _ -> do
+         checkWarn $ "WARNING: no linearization of" +++ prt c
+         return js
+     JCat -> case Map.lookup c js of
+       Just j | jform ju == JLincat -> return js  
+       _ -> do        ---- TODO: other things to check here
+         checkWarn $ 
+           "Warning: no linearization type for" +++ prt c ++ 
+           ", inserting default {s : Str}" 
+         return $ Map.insert c (cncCat defLinType) js
+     _ -> return js
+
+checkResInfo :: GF -> Ident -> Ident -> Judgement -> Check Judgement
+checkResInfo gr mo c info = do
+  ----  checkReservedId c
+  trace (show info) (return ())
+  case jform info of
+    JOper -> chIn "operation" $ case (jtype info, jdef info) of
+      _ | isConstructor info -> return info
+      (_,Meta _) -> do
+        checkWarn "No definition given to oper"
+        return info
+      (Meta _,de) -> do
+        (de',ty') <- infer de
+        ---- trace ("inferred" +++ prt de' +++ ":" +++ prt ty') $ 
+        return (resOper ty' de')
+      (ty, de) -> do
+        ty'     <- check ty typeType >>= comp . fst
+        (de',_) <- check de ty'
+        return (resOper ty' de')
+{- ----
+    ResOverload tysts -> chIn "overloading" $ do
+      tysts' <- mapM (uncurry $ flip check) tysts
+      let tysts2 = [(y,x) | (x,y) <- tysts']
+      --- this can only be a partial guarantee, since matching
+      --- with value type is only possible if expected type is given
+      checkUniq $ 
+        sort [t : map snd xs | (x,_) <- tysts2, let (xs,t) = prodForm x]
+      return (c,ResOverload tysts2)
+-}
+{- ----
+    ResParam (Yes (pcs,_)) -> chIn "parameter type" $ do
+----      mapM ((mapM (computeLType gr . snd)) . snd) pcs
+      mapM_ ((mapM_ (checkIfParType gr . snd)) . snd) pcs
+      ts <- checkErr $ lookupParamValues gr mo c
+      return (c,ResParam (Yes (pcs, Just ts)))
+-}
+    _ ->  return info
+ where
+   infer = inferLType gr
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+   comp = computeLType gr
+
+   checkUniq xss = case xss of
+     x:y:xs 
+      | x == y -> raise $ "ambiguous for argument list" +++ 
+                         unwords (map (prtType gr) x)  
+      | otherwise -> checkUniq $ y:xs
+     _ -> return ()
+
+
+checkCncInfo :: GF -> Ident -> SourceModule -> 
+                Ident -> Judgement -> Check Judgement
+checkCncInfo gr cnc (a,abs) c info = do
+  ----  checkReservedId c
+  case jform info of
+    JFun -> chIn "linearization of" $ do
+      typ        <- checkErr $ lookupFunType gr a c
+      cat0       <- checkErr $ valCat typ
+      (cont,val) <- linTypeOfType gr cnc typ     -- creates arg vars
+      let lintyp = mkFunType (map snd cont) val
+      (trm',_)   <- check (jdef info) lintyp     -- erases arg vars
+      checkPrintname gr (jprintname info)
+      cat        <- return $ snd cat0
+      return (info {jdef = trm'})
+      ---- return (c, CncFun (Just (cat,(cont,val))) (Yes trm') mpr)
+                                                   -- cat for cf, typ for pe
+
+    JCat -> chIn "linearization type of" $ do
+      checkErr $ lookupCatContext gr a c
+      typ'  <- checkIfLinType gr (jtype info)
+    {- ----
+      mdef' <- case mdef of
+        Yes def -> do
+          (def',_) <- checkLType gr def (mkFunType [typeStr] typ)
+          return $ Yes def'
+        _ -> return mdef
+    -}
+      checkPrintname gr (jprintname info)
+      return (info {jtype = typ'})
+
+    _ -> checkResInfo gr cnc c info
+
+ where
+   env = gr
+   infer = inferLType gr
+   comp = computeLType gr 
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+
+
+checkIfParType :: GF -> Type -> Check ()
+checkIfParType st typ = checkCond ("Not parameter type" +++ prt typ) (isParType typ)
+  where
+   isParType ty = True ----
+{- case ty of
+     Cn typ -> case lookupConcrete st typ of
+       Ok (CncParType _ _ _) -> True
+       Ok (CncOper _ ty' _) -> isParType ty'
+       _ -> False
+     Q p t -> case lookupInPackage st (p,t) of
+       Ok (CncParType _ _ _) -> True
+       _ -> False
+     RecType r -> all (isParType . snd) r
+     _ -> False
+-}
+
+{- ----
+checkIfStrType :: SourceGrammar -> Type -> Check ()
+checkIfStrType st typ = case typ of
+  Table arg val -> do
+    checkIfParType st arg 
+    checkIfStrType st val
+  _ | typ == typeStr -> return ()
+  _ -> prtFail "not a string type" typ
+-}
+
+checkIfLinType :: GF -> Type -> Check Type
+checkIfLinType st typ0 = do
+  typ <- computeLType st typ0
+  case typ of
+    RecType r -> return ()
+    _ -> prtFail "a linearization type must be a record type instead of" typ
+  return typ
+
+computeLType :: GF -> Type -> Check Type
+computeLType gr t = do
+  g0 <- checkGetContext
+  let g = [(x, Vr x) | (x,_) <- g0]
+  checkInContext g $ comp t
+ where
+  comp ty = case ty of
+
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
+
+    Q m c | elem c [cPredef,cPredefAbs] -> return ty
+    Q m c | elem c [identC "Int"] -> 
+      return $ defLinType
+----      let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in
+----      RecType [
+----        (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)]
+    Q m c | elem c [identC "Float",identC "String"] -> return defLinType ----
+
+    Q m ident -> checkIn ("module" +++ prt m) $ do
+      ty' <- checkErr (lookupOperDef gr m ident) 
+      if ty' == ty then return ty else comp ty' --- is this necessary to test?
+
+    Vr ident  -> checkLookup ident -- never needed to compute!
+
+    App f a -> do
+      f' <- comp f
+      a' <- comp a
+      case f' of
+        Abs x b -> checkInContext [(x,a')] $ comp b
+        _ -> return $ App f' a'
+
+    Prod x a b -> do
+      a' <- comp a
+      b' <- checkInContext [(x,Vr x)] $ comp b
+      return $ Prod x a' b'
+
+    Abs x b -> do
+      b' <- checkInContext [(x,Vr x)] $ comp b
+      return $ Abs x b'
+
+    ExtR r s -> do
+      r' <- comp r
+      s' <- comp s
+      case (r',s') of
+        (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp
+        _ -> return $ ExtR r' s'
+
+    RecType fs -> do
+      let fs' = sortBy (\x y -> compare (fst x) (fst y)) fs
+      liftM RecType $ mapPairsM comp fs'
+
+    _ | ty == typeTok -> return typeStr  ---- deprecated
+    _ | isPredefConstant ty -> return ty
+
+    _ -> composOp comp ty
+
+checkPrintname :: GF -> Term -> Check ()
+---- checkPrintname st (Yes t) = checkLType st t typeStr >> return ()
+checkPrintname _ _ = return ()
+
+{- ----
+-- | for grammars obtained otherwise than by parsing ---- update!!
+checkReservedId :: Ident -> Check ()
+checkReservedId x = let c = prt x in
+         if isResWord c 
+            then checkWarn ("Warning: reserved word used as identifier:" +++ c)
+            else return ()
+-}
+
+-- to normalize records and record types
+labelIndex :: Type -> Label -> Int
+labelIndex ty lab = case ty of
+  RecType ts -> maybe (error ("label index"+++ prt lab)) id $ lookup lab $ labs ts
+  _ -> error $ "label index" +++ prt ty
+ where 
+  labs ts = zip (map fst (sortBy (\ x y -> compare (fst x) (fst y)) ts)) [0..]
+
+-- the underlying algorithms
+
+inferLType :: GF -> Term -> Check (Term, Type)
+inferLType gr trm = case trm of
+
+   Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
+
+   Q m ident -> checks [
+     termWith trm $ checkErr (lookupOperType gr m ident) >>= comp
+     ,
+     checkErr (lookupOperDef gr m ident) >>= infer
+     ,
+{-
+     do
+       over <- getOverload gr Nothing trm
+       case over of
+         Just trty -> return trty
+         _ -> prtFail "not overloaded" trm
+     ,
+-}
+     prtFail "cannot infer type of constant" trm
+     ]
+
+   QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
+
+   QC m ident -> checks [
+       termWith trm $ checkErr (lookupOperType gr m ident) >>= comp
+--       ,checkErr (lookupOperDef gr m ident) >>= infer
+--       ,prtFail "cannot infer type of canonical constant" trm
+       ]
+
+   Val ty i -> termWith trm $ return ty
+
+   Vr ident -> termWith trm $ checkLookup ident
+
+   Typed e t -> do
+     t' <- comp t
+     check e t'
+     return (e,t')
+
+   App f a -> do
+     over <- getOverload gr Nothing trm
+     case over of
+       Just trty -> return trty
+       _ -> do
+         (f',fty) <- infer f
+         fty' <- comp fty
+         case fty' of
+           Prod z arg val -> do 
+             a' <- justCheck a arg
+             ty <- if isWildIdent z 
+                      then return val
+                      else substituteLType [(z,a')] val
+             return (App f' a',ty) 
+           _ -> raise ("function type expected for"+++ 
+                      prt f +++"instead of" +++ prtType env fty)
+
+   S f x -> do
+     (f', fty) <- infer f
+     case fty of
+       Table arg val -> do
+         x'<- justCheck x arg
+         return (S f' x', val)
+       _ -> prtFail "table lintype expected for the table in" trm
+
+   P t i -> do
+     (t',ty) <- infer t   --- ??
+     ty' <- comp ty
+-----     let tr2 = PI t' i (labelIndex ty' i)
+     let tr2 = P t' i
+     termWith tr2 $ checkErr $ case ty' of
+       RecType ts -> maybeErr ("unknown label" +++ prt i +++ "in" +++ prt ty') $ 
+                     lookup i ts
+       _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty'
+   PI t i _ -> infer $ P t i
+
+   R r -> do
+     let (ls,fs) = unzip r
+     fsts <- mapM inferM fs
+     let ts = [ty | (Just ty,_) <- fsts]
+     checkCond ("cannot infer type of record"+++ prt trm) (length ts == length fsts)
+     return $ (R (zip ls fsts), RecType (zip ls ts))
+
+   T (TTyped arg) pts -> do
+     (_,val) <- checks $ map (inferCase (Just arg)) pts
+     check trm (Table arg val)
+   T (TComp arg) pts -> do
+     (_,val) <- checks $ map (inferCase (Just arg)) pts
+     check trm (Table arg val)
+   T ti pts -> do  -- tries to guess: good in oper type inference
+     let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
+     case pts' of 
+       [] -> prtFail "cannot infer table type of" trm
+----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
+       _  -> do 
+         (arg,val) <- checks $ map (inferCase Nothing) pts'
+         check trm (Table arg val)
+   V arg pts -> do
+     (_,val) <- checks $ map infer pts
+     return (trm, Table arg val)
+
+   K s  -> do
+     if elem ' ' s
+        then checkWarn ("WARNING: space in token \"" ++ s ++ 
+                        "\". Lexical analysis may fail.")
+        else return ()
+     return (trm, typeStr)
+
+   EInt i -> return (trm, typeInt)
+
+   EFloat i -> return (trm, typeFloat)
+
+   Empty -> return (trm, typeStr)
+
+   EParam _ cos -> return (trm, typePType) ---- check cos
+
+   C s1 s2 -> 
+     check2 (flip justCheck typeStr) C s1 s2 typeStr
+
+   Glue s1 s2 -> 
+     check2 (flip justCheck typeStr) Glue s1 s2 typeStr
+
+---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
+----   Strs (Cn (IC "#conflict") : ts) -> do
+----     trace ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts)) (infer $ head ts)
+--     checkWarn ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts))
+--     infer $ head ts
+
+
+   Alts (t,aa) -> do
+     t'  <- justCheck t typeStr
+     aa' <- flip mapM aa (\ (c,v) -> do
+        c' <- justCheck c typeStr 
+        v' <- justCheck v typeStr
+        return (c',v'))
+     return (Alts (t',aa'), typeStr)
+
+   RecType r -> do
+     let (ls,ts) = unzip r
+     ts' <- mapM (flip justCheck typeType) ts 
+     return (RecType (zip ls ts'), typeType)
+
+   ExtR r s -> do
+     (r',rT) <- infer r 
+     rT'     <- comp rT
+     (s',sT) <- infer s
+     sT'     <- comp sT
+
+     let trm' = ExtR r' s'
+     ---- trm'    <- checkErr $ plusRecord r' s'
+     case (rT', sT') of
+       (RecType rs, RecType ss) -> do
+         rt <- checkErr $ plusRecType rT' sT'
+         check trm' rt ---- return (trm', rt)
+       _ | rT' == typeType && sT' == typeType -> return (trm', typeType)
+       _ -> prtFail "records or record types expected in" trm
+
+   Sort _     -> 
+     termWith trm $ return typeType
+
+   Prod x a b -> do
+     a' <- justCheck a typeType
+     b' <- checkInContext [(x,a')] $ justCheck b typeType
+     return (Prod x a' b', typeType)
+
+   Table p t  -> do
+     p' <- justCheck p typeType --- check p partype! 
+     t' <- justCheck t typeType
+     return $ (Table p' t', typeType)
+
+   FV vs -> do
+     (_,ty) <- checks $ map infer vs
+---     checkIfComplexVariantType trm ty
+     check trm ty
+
+   EPattType ty -> do
+     ty' <- justCheck ty typeType
+     return (ty',typeType)
+   EPatt p -> do
+     ty <- inferPatt p
+     return (trm, EPattType ty)
+   _ -> prtFail "cannot infer lintype of" trm
+
+ where
+   env = gr
+   infer = inferLType env
+   comp = computeLType env 
+
+   check = checkLType env
+   
+   isPredef m = elem m [cPredef,cPredefAbs]
+
+   justCheck ty te = check ty te >>= return . fst
+
+   -- for record fields, which may be typed
+   inferM (mty, t) = do
+     (t', ty') <- case mty of
+       Just ty -> check ty t
+       _ -> infer t
+     return (Just ty',t')
+
+   inferCase mty (patt,term) = do
+     arg  <- maybe (inferPatt patt) return mty
+     cont <- pattContext env arg patt
+     i    <- checkUpdates cont
+     (_,val) <- infer term
+     checkResets i
+     return (arg,val)
+   isConstPatt p = case p of
+     PC _ ps -> True --- all isConstPatt ps
+     PP _ _ ps -> True --- all isConstPatt ps
+     PR ps -> all (isConstPatt . snd) ps
+     PT _ p -> isConstPatt p
+     PString _ -> True
+     PInt _ -> True
+     PFloat _ -> True
+     PSeq p q -> isConstPatt p || isConstPatt q
+     PAlt p q -> isConstPatt p || isConstPatt q
+     PRep p -> isConstPatt p
+     PNeg p -> isConstPatt p
+     PAs _ p -> isConstPatt p
+     PChar -> True
+     PChars _ -> True
+     _ -> False
+
+   inferPatt p = case p of
+     PP q c ps | q /= cPredef -> 
+       checkErr $ lookupOperType gr q c >>= return . snd . prodForm
+     PAs _ p  -> inferPatt p
+     PNeg p   -> inferPatt p
+     PAlt p q -> checks [inferPatt p, inferPatt q]
+     PSeq _ _ -> return $ typeStr
+     PRep _   -> return $ typeStr
+     PChar    -> return $ typeStr
+     PChars _ -> return $ typeStr
+     _ -> infer (patt2term p) >>= return . snd
+
+
+-- type inference: Nothing, type checking: Just t
+-- the latter permits matching with value type
+getOverload :: GF -> Maybe Type -> Term -> Check (Maybe (Term,Type))
+getOverload env@gr mt t = case appForm t of
+     (f@(Q m c), ts) -> case lookupOverload gr m c of
+       Ok typs -> do
+         ttys <- mapM infer ts
+         v <- matchOverload f typs ttys
+         return $ Just v
+       _ -> return Nothing
+     _ -> return Nothing
+ where
+   infer = inferLType env
+   matchOverload f typs ttys = do
+     let (tts,tys) = unzip ttys
+     let vfs = lookupOverloadInstance tys typs
+
+     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
+       [(val,fun)] -> return (mkApp fun tts, val)
+       [] -> raise $ "no overload instance of" +++ prt f +++ 
+         "for" +++ unwords (map (prtType env) tys) +++ "among" ++++ 
+         unlines ["  " ++ unwords (map (prtType env) ty) | (ty,_) <- typs] ++
+         maybe [] (("with value type" +++) . prtType env) mt
+
+      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
+      ----  ++++ unlines (map (show . fst) typs) ----
+
+       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
+         [(val,fun)] -> do
+           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
+             "resolved by excluding partial applications:" ++++
+             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+           return (mkApp fun tts, val)
+
+         _ -> raise $ "ambiguous overloading of" +++ prt f +++
+           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
+           unlines [prtType env ty | (ty,_) <- vfs']
+
+   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
+     unlocked = case v of
+       RecType fs -> [Just $ RecType $ fs] ---- filter (not . isLockLabel . fst) fs]
+       _ -> []
+   ---- TODO: accept subtypes
+   ---- TODO: use a trie
+   lookupOverloadInstance tys typs = 
+     [(mkFunType rest val, t) | 
+       let lt = length tys,
+       (ty,(val,t)) <- typs, length ty >= lt,
+       let (pre,rest) = splitAt lt ty, 
+       pre == tys
+     ]
+
+   noProd ty = case ty of
+     Prod _ _ _ -> False
+     _ -> True
+
+checkLType :: GF -> Term -> Type -> Check (Term, Type)
+checkLType env trm typ0 = do
+  trace (show trm) (return ())
+
+  typ <- comp typ0
+
+  case trm of
+
+    Abs x c -> do
+      case typ of
+        Prod z a b -> do 
+          checkUpdate (x,a)
+          (c',b') <- if isWildIdent z
+                        then check c b
+                        else do
+                          b' <- checkIn "abs" $ substituteLType [(z,Vr x)] b
+                          check c b'
+          checkReset
+          return $ (Abs x c', Prod x a b')
+        _ -> raise $ "product expected instead of" +++ prtType env typ
+
+    App f a -> do
+       over <- getOverload env (Just typ) trm
+       case over of
+         Just trty -> return trty
+         _ -> do
+          (trm',ty') <- infer trm
+          termWith trm' $ checkEq typ ty' trm'
+
+    Q _ _ -> do
+       over <- getOverload env (Just typ) trm
+       case over of
+         Just trty -> return trty
+         _ -> do
+          (trm',ty') <- infer trm
+          termWith trm' $ checkEq typ ty' trm'
+
+    EData -> return (trm,typ)
+
+    T _ [] ->
+      prtFail "found empty table in type" typ
+    T _ cs -> case typ of 
+      Table arg val -> do 
+        case allParamValues env arg of
+          Ok vs -> do
+            let ps0 = map fst cs
+            ps <- return [] ---- checkErr $ testOvershadow ps0 vs
+            if null ps 
+              then return () 
+              else checkWarn $ "WARNING: patterns never reached:"
+                               ---- +++ concat (intersperse ", " (map prt ps))
+
+          _ -> return () -- happens with variable types
+        cs' <- mapM (checkCase arg val) cs
+        return (T (TTyped arg) cs', typ)
+      _ -> raise $ "table type expected for table instead of" +++ prtType env typ
+
+    R r -> case typ of --- why needed? because inference may be too difficult
+       RecType rr -> do
+         let (ls,_) = unzip rr        -- labels of expected type
+         fsts <- mapM (checkM r) rr   -- check that they are found in the record
+         return $ (R fsts, typ)       -- normalize record
+
+       _ -> prtFail "record type expected in type checking instead of" typ
+
+    ExtR r s -> case typ of
+       _ | typ == typeType -> do
+         trm' <- comp trm
+         case trm' of
+           RecType _ -> termWith trm $ return typeType
+           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType 
+                                      -- ext t = t ** ...
+           _ -> prtFail "invalid record type extension" trm
+       RecType rr -> do
+         (r',ty,s') <- checks [
+            do (r',ty) <- infer r
+               return (r',ty,s)
+           ,
+            do (s',ty) <- infer s
+               return (s',ty,r)
+            ]
+         case ty of
+           RecType rr1 -> do
+                let (rr0,rr2) = recParts rr rr1
+                r2 <- justCheck r' rr0
+                s2 <- justCheck s' rr2
+                return $ (ExtR r2 s2, typ) 
+           _ -> raise ("record type expected in extension of" +++ prt r +++ 
+                       "but found" +++ prt ty)
+
+       ExtR ty ex -> do
+         r' <- justCheck r ty
+         s' <- justCheck s ex
+         return $ (ExtR r' s', typ) --- is this all?
+
+       _ -> prtFail "record extension not meaningful for" typ
+
+    FV vs -> do
+      ttys <- mapM (flip check typ) vs
+---      checkIfComplexVariantType trm typ
+      return (FV (map fst ttys), typ) --- typ' ?
+
+    S tab arg -> checks [ do
+      (tab',ty) <- infer tab
+      ty'       <- comp ty
+      case ty' of
+        Table p t -> do
+          (arg',val) <- check arg p
+          checkEq typ t trm
+          return (S tab' arg', t)
+        _ -> raise $ "table type expected for applied table instead of" +++ 
+                   prtType env ty'
+     , do
+      (arg',ty) <- infer arg
+      ty'       <- comp ty
+      (tab',_)  <- check tab (Table ty' typ)
+      return (S tab' arg', typ)
+      ]
+    Let (x,(mty,def)) body -> case mty of
+      Just ty -> do
+        (def',ty') <- check def ty
+        checkUpdate (x,ty')
+        body' <- justCheck body typ
+        checkReset
+        return (Let (x,(Just ty',def')) body', typ)
+      _ -> do
+        (def',ty) <- infer def  -- tries to infer type of local constant
+        check (Let (x,(Just ty,def')) body) typ
+
+    _ -> do
+      (trm',ty') <- infer trm
+      termWith trm' $ checkEq typ ty' trm'
+ where
+   cnc = env
+   infer = inferLType env
+   comp = computeLType env 
+
+   check = checkLType env
+   
+   justCheck ty te = check ty te >>= return . fst
+
+   checkEq = checkEqLType env
+
+   recParts rr t = (RecType rr1,RecType rr2) where 
+     (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
+
+   checkM rms (l,ty) = case lookup l rms of
+     Just (Just ty0,t) -> do
+       checkEq ty ty0 t
+       (t',ty') <- check t ty
+       return (l,(Just ty',t'))
+     Just (_,t) -> do
+       (t',ty') <- check t ty
+       return (l,(Just ty',t'))
+     _ -> prtFail "cannot find value for label" l
+
+   checkCase arg val (p,t) = do
+     cont <- pattContext env arg p
+     i    <- checkUpdates cont
+     t'   <- justCheck t val
+     checkResets i
+     return (p,t')
+
+pattContext :: LTEnv -> Type -> Patt -> Check Context
+pattContext env typ p = case p of
+  PV x | not (isWildIdent x) -> return [(x,typ)]
+  PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
+    t <- checkErr $ lookupOperType cnc q c
+    let (cont,v) = prodForm t
+    checkCond ("wrong number of arguments for constructor in" +++ prt p) 
+              (length cont == length ps)
+    checkEqLType env typ v (patt2term p)
+    mapM (uncurry (pattContext env)) (zip (map snd cont) ps) >>= return . concat
+  PR r -> do
+    typ' <- computeLType env typ
+    case typ' of
+      RecType t -> do
+        let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
+        ----- checkWarn $ prt p ++++ show pts ----- debug
+        mapM (uncurry (pattContext env)) pts >>= return . concat
+      _ -> prtFail "record type expected for pattern instead of" typ'
+  PT t p' -> do
+    checkEqLType env typ t (patt2term p')
+    pattContext env typ p'
+
+  PAs x p -> do
+    g <- pattContext env typ p
+    return $ (x,typ):g
+
+  PAlt p' q -> do
+    g1 <- pattContext env typ p'
+    g2 <- pattContext env typ q
+    let pts = [pt | pt <- g1, notElem pt g2] ++ [pt | pt <- g2, notElem pt g1]
+    checkCond 
+      ("incompatible bindings of" +++ 
+       unwords (nub (map (prt . fst) pts))+++ 
+       "in pattern alterantives" +++ prt p) (null pts) 
+    return g1 -- must be g1 == g2
+  PSeq p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ g1 ++ g2
+  PRep p' -> noBind typeStr p'
+  PNeg p' -> noBind typ p'
+
+  _ -> return [] ---- check types!
+ where 
+   cnc = env
+   noBind typ p' = do
+    co <- pattContext env typ p'
+    if not (null co)
+      then checkWarn ("no variable bound inside pattern" +++ prt p) 
+           >> return []
+      else return []
+
+-- auxiliaries
+
+type LTEnv = GF
+
+termWith :: Term -> Check Type -> Check (Term, Type)
+termWith t ct = do
+  ty <- ct
+  return (t,ty)
+
+-- | light-weight substitution for dep. types
+substituteLType :: Context -> Type -> Check Type
+substituteLType g t = case t of
+  Vr x -> return $ maybe t id $ lookup x g
+  _ -> composOp (substituteLType g) t
+
+-- | compositional check\/infer of binary operations
+check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> 
+          Term -> Term -> Type -> Check (Term,Type)
+check2 chk con a b t = do
+  a' <- chk a
+  b' <- chk b
+  return (con a' b', t)
+
+checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type
+checkEqLType env t u trm = do
+  (b,t',u',s) <- checkIfEqLType env t u trm
+  case b of
+    True  -> return t'
+    False -> raise $ s +++ "type of" +++ prt trm +++ 
+                        ": expected:" +++ prtType env t ++++ 
+                        "inferred:" +++ prtType env u
+
+checkIfEqLType :: LTEnv -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
+checkIfEqLType env t u trm = do
+  t' <- comp t 
+  u' <- comp u
+  case t' == u' || alpha [] t' u' of
+    True -> return (True,t',u',[])
+    -- forgive missing lock fields by only generating a warning.
+    --- better: use a flag to forgive? (AR 31/1/2006)
+    _ -> case missingLock [] t' u' of
+      Ok lo -> do
+        checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo)
+        return (True,t',u',[])
+      Bad s -> return (False,t',u',s)
+
+  where
+
+   -- t is a subtype of u 
+   --- quick hack version of TC.eqVal
+   alpha g t u = case (t,u) of  
+
+     -- error (the empty type!) is subtype of any other type
+     (_,Q (IC "Predef") (IC "Error")) -> True
+
+     -- unknown type unifies with any type ----
+     (_,Meta _) -> True
+
+     -- contravariance
+     (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
+                              
+     -- record subtyping
+     (RecType rs, RecType ts) -> all (\ (l,a) -> 
+                                   any (\ (k,b) -> alpha g a b && l == k) ts) rs
+     (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
+     (ExtR r s, t) -> alpha g r t || alpha g s t
+
+     -- the following say that Ints n is a subset of Int and of Ints m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
+     
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
+     ---- this should be made in Rename
+     (Q  m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+                               || m == n --- for Predef
+     (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (QC m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+
+     (Table a b,  Table c d)  -> alpha g a c && alpha g b d
+     (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
+     _                        -> t == u 
+     --- the following should be one-way coercions only. AR 4/1/2001
+                                  || elem t sTypes && elem u sTypes
+                                  || (t == typeType && u == typePType) 
+                                  || (u == typeType && t == typePType) 
+
+   missingLock g t u = case (t,u) of  
+     (RecType rs, RecType ts) -> 
+       let 
+         ls = [l | (l,a) <- rs, 
+                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
+         (locks,others) = partition (const False) ls ---- isLockLabel ls
+       in case others of
+         _:_ -> Bad $ "missing record fields" +++ unwords (map prt others)
+         _ -> return locks
+     -- contravariance
+     (Prod x a b, Prod y c d) -> do
+        ls1 <- missingLock g c a
+        ls2 <- missingLock g b d
+        return $ ls1 ++ ls2
+
+     _ -> Bad ""
+
+   ---- to revise
+   allExtendsPlus _ n = [n]
+
+   sTypes = [typeStr, typeString, typeTok] ---- Tok deprecated
+   comp = computeLType env
+
+-- printing a type with a lock field lock_C as C
+prtType :: LTEnv -> Type -> String
+prtType env ty = case ty of
+  RecType fs -> ---- case filter isLockLabel $ map fst fs of
+   ---- [lock] -> (drop 5 $ prt lock) --- ++++ "Full form" +++ prt ty
+   ---- _ -> 
+   prtt ty
+  Prod x a b -> prtType env a +++ "->" +++ prtType env b
+  _ -> prtt ty
+ where
+   prtt t = prt t
+   ---- use computeLType gr to check if really equal to the cat with lock
+
+
+-- | linearization types and defaults
+linTypeOfType :: GF -> Ident -> Type -> Check (Context,Type)
+linTypeOfType cnc m typ = do
+  (cont,cat) <- checkErr $ typeSkeleton typ
+  val  <- lookLin cat
+  args <- mapM mkLinArg (zip [0..] cont)
+  return (args, val)
+ where
+   mkLinArg (i,(n,mc@(m,cat))) = do
+     val  <- lookLin mc
+     let vars = mkRecType varLabel $ replicate n typeStr
+	 symb = argIdent n cat i
+     rec <- checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $
+            plusRecType vars val
+     return (symb,rec)
+   lookLin (_,c) = checks [ --- rather: update with defLinType ?
+      checkErr (lookupLincat cnc m c) >>= computeLType cnc
+     ,return defLinType
+     ]
+
+-- | dependency check, detecting circularities and returning topo-sorted list
+
+allOperDependencies :: Ident -> Map.Map Ident Judgement -> [(Ident,[Ident])]
+allOperDependencies m = allDependencies (==m)
+
+allDependencies :: (Ident -> Bool) -> Map.Map Ident Judgement -> [(Ident,[Ident])]
+allDependencies ism b = 
+  [(f, nub (concatMap opersIn (pts i))) | (f,i) <- Map.assocs b]
+  where
+    opersIn t = case t of
+      Q n c | ism n -> [c]
+      QC n c | ism n -> [c]
+      _ -> collectOp opersIn t
+    pts i = [jtype i, jdef i]
+    ----  AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual
+ 
+topoSortOpers :: [(Ident,[Ident])] -> Err [Ident]
+topoSortOpers st = do
+  let eops = topoTest st
+  either 
+    return 
+    (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops))))
+    eops
diff --git a/src-3.0/GF/Devel/Compile/Compile.hs b/src-3.0/GF/Devel/Compile/Compile.hs
new file mode 100644
index 000000000..07e059ed4
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Compile.hs
@@ -0,0 +1,205 @@
+module GF.Devel.Compile.Compile (batchCompile) where
+
+-- the main compiler passes
+import GF.Devel.Compile.GetGrammar
+import GF.Devel.Compile.Extend
+import GF.Devel.Compile.Rename
+import GF.Devel.Compile.CheckGrammar
+import GF.Devel.Compile.Refresh
+import GF.Devel.Compile.Optimize
+import GF.Devel.Compile.Factorize
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Infra.Ident
+import GF.Devel.Grammar.PrGF
+----import GF.Devel.Grammar.Lookup
+import GF.Devel.Infra.ReadFiles
+
+import GF.Infra.Option ----
+import GF.Data.Operations
+import GF.Devel.UseIO
+import GF.Devel.Arch
+
+import Control.Monad
+import System.Directory
+
+batchCompile :: Options -> [FilePath] -> IO GF
+batchCompile opts files = do
+  let defOpts = addOptions opts (options [emitCode])
+  egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files 
+  case egr of
+    Ok (_,gr) -> return gr
+    Bad s -> error s
+
+-- to output an intermediate stage
+intermOut :: Options -> Option -> String -> IOE ()
+intermOut opts opt s = 
+  if oElem opt opts || oElem (iOpt "show_all") opts
+  then 
+    ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) 
+  else 
+    return ()
+
+prMod :: SourceModule -> String
+prMod = prModule
+
+-- | the environment
+type CompileEnv = (Int,GF)
+
+-- | compile with one module as starting point
+-- command-line options override options (marked by --#) in the file
+-- As for path: if it is read from file, the file path is prepended to each name.
+-- If from command line, it is used as it is.
+
+compileModule :: Options -> CompileEnv -> FilePath -> IOE CompileEnv
+compileModule opts1 env file = do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (ps0 ++ map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
+  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
+  let sgr = snd env
+  let rfs = [] ---- files already in memory and their read times
+  let file' = if useFileOpt then takeFileName file else file -- find file itself
+  files <- getAllFiles opts ps rfs file'
+  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
+  let names = map justModuleName files
+  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
+  let sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr, 
+                     ----      notElem (prt i) $ map dropExtension names]
+  let env0 = (0,sgr2)
+  (e,mm) <- foldIOE (compileOne opts) env0 files
+  maybe (return ()) putStrLnE mm
+  return e
+
+
+compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
+compileOne opts env@(_,srcgr) file = do
+
+  let putp s = putPointE opts ("\n" ++ s) 
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
+
+  let gf   = takeExtensions file
+  let path = dropFileName file
+  let name = dropExtension file
+  let mos  = gfmodules srcgr
+
+  case gf of
+
+    -- for compiled gf, read the file and update environment
+    -- also undo common subexp optimization, to enable normal computations
+
+    ".gfn" -> do
+       sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
+       let sm1 = unsubexpModule sm0
+       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
+       extendCompileEnv env sm
+
+    -- for gf source, do full compilation and generate code
+    _ -> do
+
+      let modu = dropExtension file
+      b1 <- ioeIO $ doesFileExist file
+      if not b1
+        then compileOne opts env $ gfoFile $ modu 
+        else do
+
+       sm0 <- 
+         putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
+                                                      getSourceModule opts file
+       (k',sm) <- compileSourceModule opts env sm0
+       let sm1 = sm ---- 
+----             if isConcr sm then shareModule sm else sm -- cannot expand Str
+       if oElem (iOpt "doemit") opts 
+         then putpp "  generating code... " $ generateModuleCode opts path sm1
+         else return ()
+----          -- sm is optimized before generation, but not in the env
+----       let cm2 = unsubexpModule cm
+       extendCompileEnvInt env (k',sm) ---- sm1
+  where
+   isConcr (_,mi) = case mi of
+----     ModMod m -> isModCnc m && mstatus m /= MSIncomplete 
+     _ -> False
+
+
+
+compileSourceModule :: Options -> CompileEnv -> 
+                       SourceModule -> IOE (Int,SourceModule)
+compileSourceModule opts env@(k,gr) mo@(i,mi) = do
+
+  intermOut opts (iOpt "show_gf") (prMod mo)
+
+  let putp  = putPointE opts
+      putpp = putPointEsil opts
+      stopIf n comp m = 
+        if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return m else comp m
+      stopIfV v n comp m = 
+        if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return (m,v) else comp m
+
+  moe <- stopIf 1 (putpp "  extending" . ioeErr . extendModule gr) mo
+  intermOut opts (iOpt "show_extend") (prMod moe)
+
+  mor <- stopIf 2 (putpp "  renaming" . ioeErr . renameModule gr) moe
+  intermOut opts (iOpt "show_rename") (prMod mor)
+
+  (moc,warnings) <- 
+    stopIfV [] 3 (putpp "  type checking" . ioeErr . showCheckModule gr) mor
+  if null warnings then return () else putp warnings $ return ()
+  intermOut opts (iOpt "show_typecheck") (prMod moc)
+
+  (mox,k') <- stopIfV k 4 (putpp "  refreshing " . ioeErr . refreshModule k) moc
+  intermOut opts (iOpt "show_refresh") (prMod mox)
+
+  moo <- stopIf 5 (putpp "  optimizing " . ioeErr . optimizeModule opts gr) mox
+  intermOut opts (iOpt "show_optimize") (prMod moo)
+
+  mof <- stopIf 6 (putpp "  factorizing " . ioeErr . optimizeModule opts gr) moo
+  intermOut opts (iOpt "show_factorize") (prMod mof)
+
+  return (k',moo) ----
+
+
+generateModuleCode :: Options -> InitPath -> SourceModule -> IOE ()
+generateModuleCode opts path minfo@(name,info) = do
+
+  let pname  = combine path (prt name)
+  let minfo0 = minfo 
+  let minfo1 = subexpModule minfo0
+  let minfo2 = minfo1
+
+  let (file,out) = (gfoFile pname, prGF (gfModules [minfo2]))
+  putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ out
+
+  return () ----- minfo2
+ where 
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
+-- auxiliaries
+
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
+
+----reverseModules (MGrammar ms) = MGrammar $ reverse ms
+
+emptyCompileEnv :: CompileEnv
+emptyCompileEnv = (0,emptyGF)
+
+extendCompileEnvInt (_,gf) (k,(s,m)) = return (k, addModule s m gf)
+
+extendCompileEnv e@(k,_) sm = extendCompileEnvInt e (k,sm)
+
+
diff --git a/src-3.0/GF/Devel/Compile/ErrM.hs b/src-3.0/GF/Devel/Compile/ErrM.hs
new file mode 100644
index 000000000..9cad4e252
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/ErrM.hs
@@ -0,0 +1,26 @@
+-- BNF Converter: Error Monad
+-- Copyright (C) 2004  Author:  Aarne Ranta
+
+-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
+module GF.Devel.Compile.ErrM where
+
+-- the Error monad: like Maybe type with error msgs
+
+import Control.Monad (MonadPlus(..), liftM)
+
+data Err a = Ok a | Bad String
+  deriving (Read, Show, Eq, Ord)
+
+instance Monad Err where
+  return      = Ok
+  fail        = Bad
+  Ok a  >>= f = f a
+  Bad s >>= f = Bad s
+
+instance Functor Err where
+  fmap = liftM
+
+instance MonadPlus Err where
+  mzero = Bad "Err.mzero"
+  mplus (Bad _) y = y
+  mplus x       _ = x
diff --git a/src-3.0/GF/Devel/Compile/Extend.hs b/src-3.0/GF/Devel/Compile/Extend.hs
new file mode 100644
index 000000000..2f1aae65b
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Extend.hs
@@ -0,0 +1,154 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Extend
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/30 21:08:14 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.18 $
+--
+-- AR 14\/5\/2003 -- 11\/11
+-- 4/12/2007 this module is still very very messy... ----
+--
+-- The top-level function 'extendModule'
+-- extends a module symbol table by indirections to the module it extends
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Extend (
+  extendModule
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Lookup
+import GF.Devel.Grammar.Macros
+
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Data.List (nub)
+import Data.Map
+import Control.Monad
+
+extendModule :: GF -> SourceModule -> Err SourceModule
+extendModule gf nmo0 = do
+  (name,mo) <- rebuildModule gf nmo0
+  case mtype mo of
+
+  ---- Just to allow inheritance in incomplete concrete (which are not
+  ---- compiled anyway), extensions are not built for them.
+  ---- Should be replaced by real control. AR 4/2/2005
+    MTConcrete _ | not (isCompleteModule mo) -> return (name,mo)
+    _  -> do
+      mo' <- foldM (extOne name) mo (mextends mo) 
+      return (name, mo') 
+ where
+   extOne name mo (n,cond) = do
+     mo0 <- lookupModule gf n
+
+     -- test that the module types match
+     testErr True ---- (legalExtension mo mo0) 
+                    ("illegal extension type to module" +++ prt name)
+
+     -- find out if the old is complete
+     let isCompl = isCompleteModule mo0
+
+     -- if incomplete, remove it from extension list --- because??
+     let me' = (if isCompl then id else (Prelude.filter ((/=n) . fst))) 
+                 (mextends mo) 
+
+     -- build extension depending on whether the old module is complete
+     js0 <- extendMod isCompl n (isInherited cond) name (mjments mo0) (mjments mo)
+
+     return $ mo {mextends = me', mjments = js0}
+
+-- | When extending a complete module: new information is inserted,
+-- and the process is interrupted if unification fails.
+-- If the extended module is incomplete, its judgements are just copied.
+extendMod :: Bool -> Ident -> (Ident -> Bool) -> Ident -> 
+             Map Ident Judgement -> Map Ident Judgement -> 
+             Err (Map Ident Judgement)
+extendMod isCompl name cond base old new = foldM try new $ assocs old where
+  try t i@(c,_) | not (cond c) = return t
+  try t i@(c,_) = errIn ("constant" +++ prt c) $
+                  tryInsert (extendAnyInfo isCompl name base) indirIf t i
+  indirIf = if isCompl then indirInfo name else id
+
+indirInfo :: Ident -> Judgement -> Judgement
+indirInfo n ju = case jform ju of
+  JLink -> ju -- original link is passed
+  _     -> linkInherited (isConstructor ju) n
+
+extendAnyInfo :: Bool -> Ident -> Ident -> Judgement -> Judgement -> Err Judgement
+extendAnyInfo isc n o i j = 
+  errIn ("building extension for" +++ prt n +++ "in" +++ prt o) $ 
+  unifyJudgement i j
+
+tryInsert :: Ord a => (b -> b -> Err b) -> (b -> b) ->
+             Map a b -> (a,b) -> Err (Map a b)
+tryInsert unif indir tree z@(x, info) = case Data.Map.lookup x tree of
+  Just info0 -> do
+    info1 <- unif info info0
+    return $ insert x info1 tree 
+  _ -> return $ insert x (indir info) tree
+
+-- | rebuilding instance + interface, and "with" modules, prior to renaming. 
+-- AR 24/10/2003
+rebuildModule :: GF -> SourceModule -> Err SourceModule
+rebuildModule gr mo@(i,mi) = case mtype mi of
+
+  -- copy interface contents to instance
+  MTInstance i0 -> do
+    m0 <- lookupModule gr i0
+    testErr (isInterface m0) ("not an interface:" +++ prt i0)
+    js1 <- extendMod False i0 (const True) i (mjments m0) (mjments mi)
+
+    --- to avoid double inclusions, in instance J of I0 = J0 ** ...
+    case mextends mi of
+      [] -> return $ (i,mi {mjments = js1})
+      es -> do 
+        mes <- mapM (lookupModule gr . fst) es ---- restricted?? 12/2007
+        let notInExts c _  = all (notMember c . mjments) mes
+        let js2 = filterWithKey notInExts js1
+        return $ (i,mi {
+          mjments = js2
+          })
+
+  -- copy functor contents to instantiation, and also add opens
+  _ -> case minstances mi of
+    [((ext,incl),ops)] -> do
+      let interfs  = Prelude.map fst ops
+
+      -- test that all interfaces are instantiated
+      let isCompl = Prelude.null [i | (_,i) <- minterfaces mi, notElem i interfs]
+      testErr isCompl ("module" +++ prt i +++ "remains incomplete")
+
+      -- look up the functor and build new opens set
+      mi0 <- lookupModule gr ext
+      let 
+        ops1 = nub $
+             mopens mi   -- own opens; N.B. mi0 has been name-resolved already
+          ++ ops         -- instantiating opens
+          ++ [(n,o) | 
+               (n,o) <- mopens mi0, notElem o interfs] -- ftor's non-if opens
+          ++ [(i,i) | i <- Prelude.map snd ops] ----   -- insts w. real names
+
+      -- combine flags; new flags have priority
+      let fs1 = union (mflags mi) (mflags mi0)  
+      
+      -- copy inherited functor judgements
+      let js0 = [ci | ci@(c,_) <- assocs (mjments mi0), isInherited incl c]
+      let js1 = fromList (assocs (mjments mi) ++ js0)
+
+      return $ (i,mi {
+          mflags = fs1, 
+          mextends = mextends mi,  -- extends of instantiation
+          mopens = ops1,
+          mjments = js1
+          })
+    _ -> return (i,mi)
+
diff --git a/src-3.0/GF/Devel/Compile/Factorize.hs b/src-3.0/GF/Devel/Compile/Factorize.hs
new file mode 100644
index 000000000..7386f3ed5
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Factorize.hs
@@ -0,0 +1,251 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : OptimizeGF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:33 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- Optimizations on GF source code: sharing, parametrization, value sets.
+--
+-- optimization: sharing branches in tables. AR 25\/4\/2003.
+-- following advice of Josef Svenningsson
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Factorize (
+  optModule,
+  unshareModule,
+  unsubexpModule,
+  unoptModule,
+  subexpModule,
+  shareModule
+  ) where 
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.PrGF (prt)
+import qualified GF.Devel.Grammar.Macros as C
+
+import GF.Devel.Grammar.Lookup
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List
+
+optModule :: SourceModule -> SourceModule
+optModule = subexpModule . shareModule
+
+shareModule = processModule optim
+
+unoptModule :: GF -> SourceModule -> SourceModule
+unoptModule gr = unshareModule gr . unsubexpModule
+
+unshareModule :: GF -> SourceModule -> SourceModule
+unshareModule gr = processModule (const (unoptim gr))
+
+processModule :: (Ident -> Term -> Term) -> SourceModule -> SourceModule
+processModule opt (i,mo) = 
+  (i, mo {mjments = Map.map (shareInfo (opt i)) (mjments mo)})
+
+shareInfo :: (Term -> Term) -> Judgement -> Judgement
+shareInfo opt ju = ju {jdef = opt (jdef ju)}
+
+-- the function putting together optimizations
+optim :: Ident -> Term -> Term
+optim c = values . factor c 0
+
+-- we need no counter to create new variable names, since variables are 
+-- local to tables ----
+-- factor parametric branches
+
+factor :: Ident -> Int -> Term -> Term
+factor c i t = case t of
+  T _ [_] -> t
+  T _ []  -> t
+  T (TComp ty) cs -> 
+    T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs]
+  _ -> C.composSafeOp (factor c i) t
+ where
+
+   factors i psvs =   -- we know psvs has at least 2 elements
+     let p   = qqIdent c i
+         vs' = map (mkFun p) psvs
+     in if   allEqs vs'
+        then mkCase p vs' 
+        else psvs
+
+   mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val
+
+   allEqs (v:vs) = all (==v) vs
+
+   mkCase p (v:_) = [(PV p, v)]
+
+--- we hope this will be fresh and don't check... 
+
+qqIdent c i = identC ("_q_" ++ prt c ++ "__" ++ show i)
+
+
+--  we need to replace subterms
+
+replace :: Term -> Term -> Term -> Term
+replace old new trm = case trm of
+  
+  -- these are the important cases, since they can correspond to patterns  
+  QC _ _   | trm == old -> new
+  App t ts | trm == old -> new
+  App t ts              -> App (repl t) (repl ts)
+  R _ | isRec && trm == old -> new
+  _ -> C.composSafeOp repl trm
+ where
+   repl = replace old new
+   isRec = case trm of
+     R _ -> True
+     _ -> False
+
+-- It is very important that this is performed only after case
+-- expansion since otherwise the order and number of values can
+-- be incorrect. Guaranteed by the TComp flag.
+
+values :: Term -> Term
+values t = case t of
+  T ty [(ps,t)]    -> T ty [(ps,values t)] -- don't destroy parametrization
+  T (TComp ty)  cs -> V ty [values t | (_, t) <- cs]
+  T (TTyped ty) cs -> V ty [values t | (_, t) <- cs] 
+        ---- why are these left?
+        ---- printing with GrammarToSource does not preserve the distinction
+  _ -> C.composSafeOp values t
+
+
+-- to undo the effect of factorization
+
+unoptim :: GF -> Term -> Term
+unoptim gr = unfactor gr
+
+unfactor :: GF -> Term -> Term
+unfactor gr t = case t of
+  T (TTyped ty) [(PV x,u)] -> V ty [restore x v (unfac u) | v <- vals ty]
+  _ -> C.composSafeOp unfac t
+ where
+   unfac = unfactor gr
+   vals  = err error id . allParamValues gr
+   restore x u t = case t of
+     Vr y | y == x -> u
+     _ -> C.composSafeOp (restore x u) t
+
+
+----------------------------------------------------------------------
+
+{-
+This module implements a simple common subexpression elimination
+ for gfc grammars, to factor out shared subterms in lin rules.
+It works in three phases: 
+
+  (1) collectSubterms collects recursively all subterms of forms table and (P x..y)
+      from lin definitions (experience shows that only these forms
+      tend to get shared) and counts how many times they occur
+  (2) addSubexpConsts takes those subterms t that occur more than once
+      and creates definitions of form "oper A''n = t" where n is a
+      fresh number; notice that we assume no ids of this form are in
+      scope otherwise
+  (3) elimSubtermsMod goes through lins and the created opers by replacing largest
+      possible subterms by the newly created identifiers
+
+The optimization is invoked in gf by the flag i -subs.
+
+If an application does not support GFC opers, the effect of this
+optimization can be undone by the function unSubelimCanon.
+
+The function unSubelimCanon can be used to diagnostisize how much
+cse is possible in the grammar. It is used by the flag pg -printer=subs.
+
+-}
+
+subexpModule :: SourceModule -> SourceModule
+subexpModule (m,mo) = errVal (m,mo) $ case mtype mo of
+  MTAbstract -> return (m,mo)
+  _ -> do
+    let js = listJudgements mo
+    (tree,_) <- appSTM (getSubtermsMod m js) (Map.empty,0)
+    js2 <- addSubexpConsts m tree js
+    return (m, mo{mjments = Map.fromList js2})
+
+unsubexpModule :: SourceModule -> SourceModule
+unsubexpModule (m,mo) = (m, mo{mjments = rebuild (mjments mo)})
+  where
+    unparInfo (c, ju) = case jtype ju of
+      EInt 8 -> [] -- subexp-generated opers
+      _ -> [(c, ju {jdef = unparTerm (jdef ju)})]
+    unparTerm t = case t of
+      Q _ c@(IC ('_':'A':_)) -> --- name convention of subexp opers
+        maybe t (unparTerm . jdef) $ Map.lookup c (mjments mo)
+      _ -> C.composSafeOp unparTerm t
+    rebuild = Map.fromList . concat . map unparInfo . Map.assocs
+
+-- implementation
+
+type TermList = Map Term (Int,Int) -- number of occs, id
+type TermM a = STM (TermList,Int) a
+
+addSubexpConsts :: 
+  Ident -> Map Term (Int,Int) -> [(Ident,Judgement)] -> Err [(Ident,Judgement)]
+addSubexpConsts mo tree lins = do
+  let opers = [oper id trm | (trm,(_,id)) <- list]
+  mapM mkOne $ opers ++ lins
+ where
+
+   mkOne (f, def) = return (f, def {jdef = recomp f (jdef def)})
+   recomp f t = case Map.lookup t tree of
+     Just (_,id) | ident id /= f -> Q mo (ident id)
+     _ -> C.composSafeOp (recomp f) t
+
+   list = Map.toList tree
+
+   oper id trm = (ident id, resOper (EInt 8) trm)
+   --- impossible type encoding generated opers
+
+getSubtermsMod :: Ident -> [(Ident,Judgement)] -> TermM (Map Term (Int,Int))
+getSubtermsMod mo js = do
+  mapM (getInfo (collectSubterms mo)) js
+  (tree0,_) <- readSTM
+  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
+ where
+   getInfo get fi@(_,i) = do
+     get (jdef i)    
+     return $ fi
+
+collectSubterms :: Ident -> Term -> TermM Term
+collectSubterms mo t = case t of
+  App f a -> do
+    collect f
+    collect a
+    add t 
+  T ty cs -> do
+    let (_,ts) = unzip cs
+    mapM collect ts
+    add t
+  V ty ts -> do
+    mapM collect ts
+    add t
+----  K (KP _ _)  -> add t
+  _ -> C.composOp (collectSubterms mo) t
+ where
+   collect = collectSubterms mo
+   add t = do
+     (ts,i) <- readSTM
+     let 
+       ((count,id),next) = case Map.lookup t ts of
+         Just (nu,id) -> ((nu+1,id), i)
+         _ ->            ((1,   i ), i+1)
+     writeSTM (Map.insert t (count,id) ts, next)
+     return t --- only because of composOp
+
+ident :: Int -> Ident
+ident i = identC ("_A" ++ show i) ---
+
diff --git a/src-3.0/GF/Devel/Compile/GF.cf b/src-3.0/GF/Devel/Compile/GF.cf
new file mode 100644
index 000000000..3edbdf347
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/GF.cf
@@ -0,0 +1,326 @@
+-- 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] "}" ; --%
+
+EPatt.     Exp4 ::= "pattern" Patt2 ;
+EPattType. Exp4 ::= "pattern" "type" Exp5 ;
+
+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
+
+PChar.  Patt2  ::= "?" ;
+PChars. Patt2  ::= "[" String "]" ;
+PMacro. Patt2  ::= "#" PIdent ;
+PM.     Patt2  ::= "#" PIdent "." PIdent ;
+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-3.0/GF/Devel/Compile/GFC.hs b/src-3.0/GF/Devel/Compile/GFC.hs
new file mode 100644
index 000000000..f60ec9380
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/GFC.hs
@@ -0,0 +1,72 @@
+module GF.Devel.Compile.GFC (mainGFC) where
+-- module Main where
+
+import GF.Devel.Compile.Compile
+import GF.Devel.Compile.GFtoGFCC
+import GF.Devel.PrintGFCC
+import GF.GFCC.OptimizeGFCC
+import GF.GFCC.CheckGFCC
+import GF.GFCC.DataGFCC
+import GF.GFCC.Raw.ParGFCCRaw
+import GF.GFCC.Raw.ConvertGFCC
+import GF.Devel.UseIO
+import GF.Infra.Option
+import GF.GFCC.API
+import GF.Data.ErrM
+
+mainGFC :: [String] -> IO ()
+mainGFC xx = do
+  let (opts,fs) = getOptions "-" xx
+  case opts of
+    _ | oElem (iOpt "help") opts -> putStrLn usageMsg
+    _ | oElem (iOpt "-make") opts -> do
+      gr <- batchCompile opts fs
+      let name = justModuleName (last fs)
+      let (abs,gc0) = mkCanon2gfcc opts name gr
+      gc1 <- checkGFCCio gc0
+      let gc = if oElem (iOpt "noopt") opts then gc1 else optGFCC gc1
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gc) printOptions
+
+    -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
+    _ | all ((==".gfcc") . takeExtensions) fs -> do
+      gfccs <- mapM file2gfcc fs
+      let gfcc = foldl1 unionGFCC gfccs
+      let abs = printCId $ absname gfcc
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gfcc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gfcc) printOptions
+      
+    _ -> do
+      mapM_ (batchCompile opts) (map return fs)
+      putStrLn "Done."
+
+targetName opts abs = case getOptVal opts (aOpt "target") of
+  Just n -> n
+  _ -> abs
+
+---- TODO: nicer and richer print options
+
+alsoPrint opts abs gr (opt,name) = do
+  if oElem (iOpt opt) opts 
+    then do
+      let outfile = name
+      let output = prGFCC opt gr
+      writeFile outfile output
+      putStrLn $ "wrote file " ++ outfile
+    else return ()
+
+printOptions = [
+  ("haskell","GSyntax.hs"),
+  ("haskell_gadt","GSyntax.hs"),
+  ("js","grammar.js"),
+  ("jsref","grammarReference.js")
+  ]
+
+usageMsg = 
+  "usage: gfc (-h | --make (-noopt) (-target=PREFIX) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES"
diff --git a/src-3.0/GF/Devel/Compile/GFtoGFCC.hs b/src-3.0/GF/Devel/Compile/GFtoGFCC.hs
new file mode 100644
index 000000000..81f33e11a
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/GFtoGFCC.hs
@@ -0,0 +1,542 @@
+module GF.Devel.Compile.GFtoGFCC (prGrammar2gfcc,mkCanon2gfcc) where
+
+import GF.Devel.Compile.Factorize (unshareModule)
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import qualified GF.Devel.Grammar.Lookup as Look
+
+import qualified GF.Devel.Grammar.Grammar as A ----
+import qualified GF.Devel.Grammar.Grammar as M ----
+import qualified GF.Devel.Grammar.Macros as GM
+--import qualified GF.Grammar.Compute as Compute
+
+import GF.Devel.Grammar.PrGF
+--import GF.Devel.ModDeps
+import GF.Infra.Ident
+
+import GF.Devel.PrintGFCC
+import qualified GF.GFCC.Macros as CM
+import qualified GF.GFCC.DataGFCC as C
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+import GF.Infra.Option ----
+import GF.Data.Operations
+import GF.Text.UTF8
+
+import Data.List
+import Data.Char (isDigit,isSpace)
+import qualified Data.Map as Map
+import Debug.Trace ----
+
+-- the main function: generate GFCC from GF.
+
+prGrammar2gfcc :: Options -> String -> GF -> (String,String)
+prGrammar2gfcc opts cnc gr = (abs, printGFCC gc) where
+  (abs,gc) = mkCanon2gfcc opts cnc gr 
+
+mkCanon2gfcc :: Options -> String -> GF -> (String,D.GFCC)
+mkCanon2gfcc opts cnc gr = 
+  (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
+  where
+    abs = err error id $ Look.abstractOfConcrete gr (identC cnc)
+    pars = mkParamLincat gr
+
+-- Generate GFCC from GFCM.
+-- this assumes a grammar translated by canon2canon
+
+canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> GF -> D.GFCC
+canon2gfcc opts pars cgr =  
+  (if (oElem (iOpt "show_canon") opts) then trace (prt cgr) else id) $
+     D.GFCC an cns gflags abs cncs 
+ where
+  -- recognize abstract and concretes
+  ([(a,abm)],cms) = 
+    partition ((== MTAbstract) . mtype . snd) (Map.toList (gfmodules cgr))
+
+  -- abstract
+  an  = (i2i a)
+  cns = map (i2i . fst) cms
+  abs = D.Abstr aflags funs cats catfuns
+  gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] 
+                                          where fg = "firstlang"
+  aflags = Map.fromList [(CId f,x) | (IC f,x) <- Map.toList (M.mflags abm)]
+  mkDef pty = case pty of
+    Meta _ -> CM.primNotion
+    t -> mkExp t
+
+  funs = Map.fromAscList lfuns
+  cats = Map.fromAscList lcats
+
+  lfuns = [(i2i f, (mkType (jtype ju), mkDef (jdef ju))) | 
+                      (f,ju) <- listJudgements abm, jform ju == JFun]
+  lcats = [(i2i c, mkContext (GM.contextOfType (jtype ju))) |
+                      (c,ju) <- listJudgements abm, jform ju == JCat]
+  catfuns = Map.fromList 
+    [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
+
+  -- concretes
+  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,mo) <- cms]
+  mkConcr lang0 lang mo = 
+      (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
+    where
+      js = listJudgements mo
+      flags = Map.fromList [(CId f,x) | (IC f,x) <- Map.toList (M.mflags mo)]
+      opers = Map.fromAscList [] -- opers will be created as optimization
+      utf   = if elem (IC "coding","utf8") (Map.assocs (M.mflags mo)) ---- 
+                  then D.convertStringsInTerm decodeUTF8 else id
+      lins    = Map.fromAscList 
+        [(i2i f, utf (mkTerm (jdef ju))) | (f,ju) <- js, jform ju == JLin]
+      lincats = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jtype ju))) | (c,ju) <- js, jform ju == JLincat]
+      lindefs = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jdef ju))) | (c,ju) <- js, jform ju == JLincat]
+      printnames = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jprintname ju))) | 
+                     (c,ju) <- js, elem (jform ju) [JLincat,JLin]]
+      params = Map.fromAscList 
+        [(i2i c, pars lang0 c) | (c,ju) <- js, jform ju == JLincat] ---- c ??
+      fcfg = Nothing
+
+i2i :: Ident -> CId
+i2i = CId . prIdent
+
+mkType :: A.Type -> C.Type
+mkType t = case GM.typeForm t of
+  (hyps,(Q _ cat),args) -> C.DTyp (mkContext hyps) (i2i cat) (map mkExp args)
+
+mkExp :: A.Term -> C.Exp
+mkExp t = case t of
+  A.Eqs eqs -> C.EEq [C.Equ (map mkPatt ps) (mkExp e) | (ps,e) <- eqs]
+  _ -> case GM.termForm t of
+    (xx,c,args) -> C.DTr [i2i x | x <- xx] (mkAt c) (map mkExp args) 
+ where
+  mkAt c = case c of 
+    Q _ c  -> C.AC $ i2i c
+    QC _ c -> C.AC $ i2i c
+    Vr x   -> C.AV $ i2i x
+    EInt i -> C.AI i
+    EFloat f -> C.AF f
+    K s    -> C.AS s
+    Meta i -> C.AM $ toInteger i
+    _ -> C.AM 0
+  mkPatt p = uncurry CM.tree $ case p of
+    A.PP _ c ps -> (C.AC (i2i c), map mkPatt ps)
+    A.PV x      -> (C.AV (i2i x), [])
+    A.PW        -> (C.AV CM.wildCId, [])
+    A.PInt i    -> (C.AI i, [])
+
+mkContext :: A.Context -> [C.Hypo]
+mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps]
+
+mkTerm :: Term -> C.Term
+mkTerm tr = case tr of
+  Vr (IA (_,i)) -> C.V i
+  Vr (IC s) | isDigit (last s) -> 
+    C.V (read (reverse (takeWhile (/='_') (reverse s)))) 
+    ---- from gf parser of gfc
+  EInt i      -> C.C $ fromInteger i
+  R rs     -> C.R [mkTerm t | (_, (_,t)) <- rs]
+  P t l    -> C.P (mkTerm t) (C.C (mkLab l))
+  T _ cs   -> C.R [mkTerm t | (_,t) <- cs] ------
+  V _ cs   -> C.R [mkTerm t | t <- cs]
+  S t p    -> C.P (mkTerm t) (mkTerm p)
+  C s t    -> C.S $ concatMap flats [mkTerm x | x <- [s,t]]
+  FV ts    -> C.FV [mkTerm t | t <- ts]
+  K s      -> C.K (C.KS s)
+-----  K (KP ss _) -> C.K (C.KP ss []) ---- TODO: prefix variants
+  Empty    -> C.S []
+  App _ _  -> prtTrace tr $ C.C 66661          ---- for debugging
+  Abs _ t  -> mkTerm t ---- only on toplevel
+  Alts (td,tvs) -> 
+    C.K (C.KP (strings td) [C.Var (strings u) (strings v) | (u,v) <- tvs])
+  _ -> prtTrace tr $ C.S [C.K (C.KS (prt tr +++ "66662"))] ---- for debugging
+ where
+   mkLab (LIdent l) = case l of
+     '_':ds -> (read ds) :: Int
+     _ -> prtTrace tr $ 66663
+   strings t = case t of
+     K s -> [s]
+     C u v -> strings u ++ strings v
+     FV ss -> concatMap strings ss
+     _ -> prtTrace tr $ ["66660"]
+   flats t = case t of
+     C.S ts -> concatMap flats ts
+     _ -> [t]
+
+-- encoding GFCC-internal lincats as terms
+mkCType :: Type -> C.Term
+mkCType t = case t of
+  EInt i      -> C.C $ fromInteger i
+  RecType rs  -> C.R [mkCType t | (_, t) <- rs]
+  Table pt vt -> case pt of
+    EInt i -> C.R $ replicate (1 + fromInteger i) $ mkCType vt
+    RecType rs -> mkCType $ foldr Table vt (map snd rs) 
+  Sort "Str"        -> C.S [] --- Str only
+  App (Q (IC "Predef") (IC "Ints")) (EInt i) -> C.C $ fromInteger i
+  _ -> error  $ "mkCType " ++ show t
+
+-- encoding showable lincats (as in source gf) as terms
+mkParamLincat :: GF -> Ident -> Ident -> C.Term
+mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do 
+  typ <- Look.lookupLincat sgr lang cat
+  mkPType typ
+ where
+  mkPType typ = case typ of
+    RecType lts -> do
+      ts <- mapM (mkPType . snd) lts
+      return $ C.R [ C.P (kks $ prt_ l) t | ((l,_),t) <- zip lts ts]
+    Table (RecType lts) v -> do
+      ps <- mapM (mkPType . snd) lts
+      v' <- mkPType v
+      return $ foldr (\p v -> C.S [p,v]) v' ps
+    Table p v -> do
+      p' <- mkPType p
+      v' <- mkPType v
+      return $ C.S [p',v']
+    Sort "Str" -> return $ C.S []
+    _ -> return $ 
+      C.FV $ map (kks . filter showable . prt_) $ 
+             errVal [] $ Look.allParamValues sgr typ
+  showable c = not (isSpace c) ---- || (c == ' ')  -- to eliminate \n in records
+  kks = C.K . C.KS
+
+-- return just one module per language
+
+reorder :: Ident -> GF -> GF
+reorder abs cg = emptyGF {
+  gfabsname = Just abs,
+  gfcncnames = (map fst cncs),
+  gfmodules = Map.fromList ((abs,absm) : map mkCnc cncs)
+  } 
+ where
+    absm = emptyModule {
+      mtype = MTAbstract,
+      mflags = aflags,
+      mjments = adefs
+      }
+    mkCnc (c,cnc) = (c,emptyModule {
+      mtype = MTConcrete abs,
+      mflags = fst cnc,
+      mjments = snd cnc
+      })
+       
+    mos = Map.toList $ gfmodules cg
+       
+    adefs = Map.fromAscList $ sortIds $
+                 predefADefs ++ Look.allOrigJudgements cg abs
+    predefADefs = 
+      [(IC c, absCat []) | c <- ["Float","Int","String"]]
+    aflags = Map.fromList $ nubByFst $ concat 
+      [Map.toList (M.mflags mo) | (_,mo) <- mos, mtype mo == MTAbstract] ----toom
+
+    cncs = sortIds [(lang, concr lang) | lang <- Look.allConcretes cg abs]
+    concr la = (
+      Map.fromList (nubByFst flags), 
+      Map.fromList (sortIds (predefCDefs ++ jments))
+      ) where 
+        jments = Look.allOrigJudgements cg la
+        flags  = Look.lookupFlags cg la
+                  ----concat [M.mflags mo | 
+                  ----  (i,mo) <- mos, M.isModCnc mo, 
+                  ----  Just r <- [lookup i (M.allExtendSpecs cg la)]]
+
+    predefCDefs = [(IC c, cncCat GM.defLinType) | 
+                       ---- lindef,printname 
+                         c <- ["Float","Int","String"]]
+
+    sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
+    
+nubByFst = nubBy (\ (f,_) (g,_) -> f == g)
+
+
+-- one grammar per language - needed for symtab generation
+repartition :: Ident -> GF -> [GF]
+repartition abs cg = [Look.partOfGrammar cg (lang,mo) | 
+  let mos = gfmodules cg,
+  lang   <- Look.allConcretes cg abs,
+  let mo = errVal 
+       (error ("no module found for " ++ prt lang)) $ Look.lookupModule cg lang
+  ]
+ 
+
+-- translate tables and records to arrays, parameters and labels to indices
+
+canon2canon :: Ident -> GF -> GF
+canon2canon abs gf = errVal gf $ GM.termOpGF t2t gf where
+  t2t = return . term2term gf pv
+  ty2ty = type2type gf pv
+  pv@(labels,untyps,typs) = paramValues gf
+  ---- should be done lang for lang
+  ---- ty2ty should be used for types, t2t only in concrete
+
+{- ----
+  gfModules . nubModules . map cl2cl . repartition abs . purgeGrammar abs  
+ where    
+  nubModules = Map.fromList . nubByFst . concatMap (Map.toList . gfmodules)
+
+  cl2cl gf = errVal gf $ GM.moduleOpGF (js2js . map (GM.judgementOpModule p2p)) gf
+    
+  js2js ms = map (GM.judgementOpModule (j2j (gfModules ms))) ms
+
+  j2j cg (f,j) = case jform j of
+    JLin -> (f, j{jdef = t2t (jdef j)})
+    JLincat -> (f, j{jdef = t2t (jdef j), jtype = ty2ty (jtype j)})
+    _ -> (f,j)
+   where
+      t2t = term2term cg pv
+      ty2ty = type2type cg pv
+      pv@(labels,untyps,typs) = paramValues cg ---trs $ paramValues cg
+
+    -- flatten record arguments of param constructors
+  p2p (f,j) = case jform j of
+    ---- JParam ->
+      ----ResParam (Yes (ps,v)) -> 
+      ----(f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)))
+    _ -> (f,j)
+  unRec (x,ty) = case ty of
+      RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)] 
+      _ -> [(x,ty)]
+
+----
+  trs v = trace (tr v) v
+
+  tr (labels,untyps,typs) =
+     ("labels:" ++++
+       unlines [prt c ++ "." ++ unwords (map prt l) +++ "=" +++ show i  | 
+       ((c,l),i) <- Map.toList labels]) ++
+     ("untyps:" ++++ unlines [prt t +++ "=" +++ show i  | 
+       (t,i) <- Map.toList untyps]) ++
+     ("typs:" ++++ unlines [prt t | 
+       (t,_) <- Map.toList typs])
+----
+-}
+
+purgeGrammar :: Ident -> GF -> GF
+purgeGrammar abstr gr = gr {
+  gfmodules = treat gr
+  }
+ where
+  treat = 
+    Map.fromList . map unopt . filter complete . purge . Map.toList . gfmodules
+  purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+  needed = 
+     nub $ concatMap (Look.allDepsModule gr) $ 
+           ---- (requiredCanModules True gr) $
+           [mo | m <- abstr : Look.allConcretes gr abstr, 
+                 Ok mo <- [Look.lookupModule gr m]]
+
+  complete (i,mo) = isCompleteModule mo
+  unopt = unshareModule gr -- subexp elim undone when compiled
+
+type ParamEnv =
+  (Map.Map (Ident,[Label]) (Type,Integer), -- numbered labels
+   Map.Map Term Integer,                   -- untyped terms to values
+   Map.Map Type (Map.Map Term Integer))    -- types to their terms to values
+
+--- gathers those param types that are actually used in lincats and lin terms
+paramValues :: GF -> ParamEnv
+paramValues cgr = (labels,untyps,typs) where
+
+  jments = [(m,j) | 
+    (m,mo) <- Map.toList (gfmodules cgr), 
+    j <- Map.toList (mjments mo)]
+
+  partyps = nub $ [ty | 
+    (_,(_,ju)) <- jments,
+    jform ju == JLincat,
+    RecType ls <- [jtype ju],
+    ty0 <- [ty | (_, ty) <- unlockTyp ls],
+    ty  <- typsFrom ty0
+   ] ++ [Q m ty | 
+    (m,(ty,ju)) <- jments,
+    jform ju == JParam
+   ] ++ [ty | 
+    (_,(_,ju)) <- jments,
+    jform ju == JLin,
+    ty  <- err (const []) snd $ appSTM (typsFromTrm (jdef ju)) []
+   ]
+  params = [(ty, errVal [] $ Look.allParamValues cgr ty) | ty <- partyps]
+  typsFrom ty = case ty of
+    Table p t  -> typsFrom p ++ typsFrom t
+    RecType ls -> RecType (sort (unlockTyp ls)) : concat [typsFrom t | (_, t) <- ls]
+    _ -> [ty]
+ 
+  typsFromTrm :: Term -> STM [Type] Term
+  typsFromTrm tr = case tr of
+    R fs -> mapM_ (typsFromField . snd) fs >> return tr 
+      where
+        typsFromField (mty, t) = case mty of
+          Just x -> updateSTM (x:) >> typsFromTrm t
+          _ -> typsFromTrm t
+    V ty ts -> updateSTM (ty:) >> mapM_ typsFromTrm ts >> return tr
+    T (TTyped ty) cs -> 
+      updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr
+    T (TComp ty) cs -> 
+      updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr
+    _ -> GM.composOp typsFromTrm tr
+
+  typs = 
+    Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
+  untyps = 
+    Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
+  lincats = 
+    [(IC cat,[(LIdent "s",typeStr)]) | cat <- ["Int", "Float", "String"]] ++
+    reverse ---- TODO: really those lincats that are reached
+            ---- reverse is enough to expel overshadowed ones... 
+      [(cat,(unlockTyp ls)) |
+        (_,(cat,ju)) <- jments,
+        jform ju == JLincat,
+        RecType ls <- [jtype ju]
+       ] 
+  labels = Map.fromList $ concat 
+    [((cat,[lab]),(typ,i)): 
+      [((cat,[lab,lab2]),(ty,j)) | 
+        rs <- getRec typ, ((lab2, ty),j) <- zip rs [0..]] 
+      | 
+        (cat,ls) <- lincats, ((lab, typ),i) <- zip ls [0..]]
+    -- go to tables recursively
+    ---- TODO: even go to deeper records
+   where
+     getRec typ = case typ of
+       RecType rs -> [rs]
+       Table _ t  -> getRec t
+       _ -> []
+
+type2type :: GF -> ParamEnv -> Type -> Type
+type2type cgr env@(labels,untyps,typs) ty = case ty of
+  RecType rs ->
+    RecType [(mkLab i, t2t t) | (i,(l, t)) <- zip [0..] (unlockTyp rs)]
+  Table pt vt -> Table (t2t pt) (t2t vt)
+  QC _ _ -> look ty
+  _ -> ty
+ where
+   t2t = type2type cgr env
+   look ty = EInt $ (+ (-1)) $ toInteger $ case Map.lookup ty typs of
+     Just vs -> length $ Map.assocs vs
+     _ -> trace ("unknown partype " ++ show ty) 66669
+
+term2term :: GF -> ParamEnv -> Term -> Term
+term2term cgr env@(labels,untyps,typs) tr = case tr of
+  App _ _ -> mkValCase (unrec tr)
+  QC  _ _ -> mkValCase tr 
+  R rs    -> R [(mkLab i, (Nothing, t2t t)) | 
+                 (i,(l,(_,t))) <- zip [0..] (sort (unlock rs))]
+  P  t l   -> r2r tr
+  PI t l i -> EInt $ toInteger i
+  T (TComp  ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
+  T (TTyped ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
+  V ty ts  -> mkCurry $ V ty [t2t t | t <- ts]
+  S t p    -> mkCurrySel (t2t t) (t2t p)
+  _ -> GM.composSafeOp t2t tr
+ where
+   t2t = term2term cgr env
+
+   unrec t = case t of
+     App f (R fs) -> GM.mkApp (unrec f) [unrec u | (_,(_,u)) <- fs]
+     _ -> GM.composSafeOp unrec t
+
+   mkValCase tr = case appSTM (doVar tr) [] of
+     Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st
+     _ -> valNum $ comp tr
+
+   --- this is mainly needed for parameter record projections
+   ---- was: errVal t $ Compute.computeConcreteRec cgr t
+   comp t = case t of
+     T (TComp typ) ts  -> comp $ V typ (map (comp . snd) ts)  ---- should...
+     T (TTyped typ) ts -> comp $ V typ (map (comp . snd) ts)  ---- should
+     V typ ts -> V typ (map comp ts)
+     S (V typ ts) v0 -> err error id $ do
+       let v = comp v0 
+       return $ maybe t (comp . (ts !!) . fromInteger) $ Map.lookup v untyps
+     R r -> R [(l,(ty,comp t)) | (l,(ty,t)) <- r]
+     P (R r) l -> maybe t (comp . snd) $ lookup l r
+     _ -> GM.composSafeOp comp t
+
+   doVar :: Term -> STM [((Type,[Term]),(Term,Term))] Term
+   doVar tr = case getLab tr of
+     Ok (cat, lab) -> do
+       k <- readSTM >>= return . length
+       let tr' = Vr $ identC $ show k -----
+
+       let tyvs = case Map.lookup (cat,lab) labels of
+             Just (ty,_) -> case Map.lookup ty typs of
+               Just vs -> (ty,[t | 
+                            (t,_) <- sortBy (\x y -> compare (snd x) (snd y)) 
+                                            (Map.assocs vs)])
+               _ -> error $ prt ty
+             _ -> error $ prt tr
+       updateSTM ((tyvs, (tr', tr)):) 
+       return tr'
+     _ -> GM.composOp doVar tr
+
+   r2r tr@(P (S (V ty ts) v) l) = t2t $ S (V ty [comp (P t l) | t <- ts]) v
+
+   r2r tr@(P p _) = case getLab tr of
+     Ok (cat,labs) -> P (t2t p) . mkLab $ maybe (prtTrace tr $ 66664) snd $ 
+          Map.lookup (cat,labs) labels
+     _ -> K ((prt tr +++ prtTrace tr "66665"))
+
+   -- this goes recursively into tables (ignored) and records (accumulated)
+   getLab tr = case tr of
+     Vr (IA (cat, _)) -> return (identC cat,[])
+     Vr (IC s) -> return (identC cat,[]) where
+       cat = init (reverse (dropWhile (/='_') (reverse s))) ---- from gf parser
+----     Vr _ -> error $ "getLab " ++ show tr
+     P p lab2 -> do
+       (cat,labs) <- getLab p
+       return (cat,labs++[lab2]) 
+     S p _ -> getLab p
+     _ -> Bad "getLab"
+
+
+   mkCase ((ty,vs),(x,p)) tr = 
+     S (V ty [mkBranch x v tr | v <- vs]) p
+   mkBranch x t tr = case tr of
+     _ | tr == x -> t
+     _ -> GM.composSafeOp (mkBranch x t) tr     
+
+   valNum tr = maybe (valNumFV $ tryFV tr) EInt $ Map.lookup tr untyps
+    where
+      tryFV tr = case GM.appForm tr of
+        (c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryFV ts)]
+        (FV ts,_) -> ts
+        _ -> [tr]
+      valNumFV ts = case ts of
+        [tr] -> trace (unwords (map prt (Map.keys typs))) $ 
+                  prtTrace tr $ K "66667"
+        _ -> FV $ map valNum ts
+
+   mkCurry trm = case trm of
+     V (RecType [(_,ty)]) ts -> V ty ts 
+     V (RecType ((_,ty):ltys)) ts -> 
+       V ty [mkCurry (V (RecType ltys) cs) | 
+         cs <- chop (product (map (lengthtyp . snd) ltys)) ts] 
+     _ -> trm
+   lengthtyp ty = case Map.lookup ty typs of
+     Just m -> length (Map.assocs m)
+     _ -> error $ "length of type " ++ show ty
+   chop i xs = case splitAt i xs of 
+     (xs1,[])  -> [xs1]
+     (xs1,xs2) -> xs1:chop i xs2
+
+
+   mkCurrySel t p = S t p -- done properly in CheckGFCC
+
+
+mkLab k = LIdent (("_" ++ show k))
+
+-- remove lock fields; in fact, any empty records and record types
+unlock = filter notlock where
+  notlock (l,(_, t)) = case t of --- need not look at l
+     R [] -> False
+     _ -> True
+unlockTyp = filter notlock where
+  notlock (l, t) = case t of --- need not look at l
+     RecType [] -> False
+     _ -> True
+
+prtTrace tr n = 
+  trace ("-- INTERNAL COMPILER ERROR" +++ prt tr ++++ show n) n
+prTrace  tr n = trace ("-- OBSERVE" +++ prt tr +++ show n +++ show tr) n
+
diff --git a/src-3.0/GF/Devel/Compile/GetGrammar.hs b/src-3.0/GF/Devel/Compile/GetGrammar.hs
new file mode 100644
index 000000000..b90bd912c
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/GetGrammar.hs
@@ -0,0 +1,56 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GetGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/15 17:56:13 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- this module builds the internal GF grammar that is sent to the type checker
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.GetGrammar where
+
+import GF.Devel.UseIO
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+----import GF.Devel.PrGrammar
+import GF.Devel.Compile.SourceToGF
+---- import Macros
+---- import Rename
+--- import Custom
+import GF.Devel.Compile.ParGF
+import qualified GF.Devel.Compile.LexGF as L
+
+import GF.Data.Operations
+import qualified GF.Devel.Compile.ErrM as E ----
+import GF.Infra.Option ----
+import GF.Devel.ReadFiles ----
+
+import Data.Char (toUpper)
+import Data.List (nub)
+import Control.Monad (foldM)
+import System (system)
+
+getSourceModule :: Options -> FilePath -> IOE SourceModule
+getSourceModule opts file0 = do
+  file <- case getOptVal opts usePreprocessor of
+    Just p -> do
+      let tmp = "_gf_preproc.tmp"
+          cmd = p +++ file0 ++ ">" ++ tmp
+      ioeIO $ system cmd
+      -- ioeIO $ putStrLn $ "preproc" +++ cmd
+      return tmp
+    _ -> return file0
+  string    <- readFileIOE file
+  let tokens = myLexer string
+  mo1  <- ioeErr $ err2err $ pModDef tokens
+  ioeErr $ transModDef mo1
+
+err2err e = case e of
+  E.Ok v -> Ok v
+  E.Bad s -> Bad s
+
diff --git a/src-3.0/GF/Devel/Compile/LexGF.hs b/src-3.0/GF/Devel/Compile/LexGF.hs
new file mode 100644
index 000000000..ff8386f49
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/LexGF.hs
@@ -0,0 +1,343 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "GF/Devel/Compile/LexGF.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Devel.Compile.LexGF where
+
+
+
+#if __GLASGOW_HASKELL__ >= 603
+#include "ghcconfig.h"
+#else
+#include "config.h"
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+import Data.Char (ord)
+import Data.Array.Base (unsafeAt)
+#else
+import Array
+import Char (ord)
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+alex_base :: AlexAddr
+alex_base = AlexA# "\x01\x00\x00\x00\x15\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x27\x00\x00\x00\x13\x00\x00\x00\x9c\x00\x00\x00\x6c\x01\x00\x00\x3c\x02\x00\x00\x0c\x03\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xe7\x01\x00\x00\xd5\x00\x00\x00\x35\x00\x00\x00\xe7\x00\x00\x00\xf2\x00\x00\x00\x1d\x01\x00\x00\xc2\x01\x00\x00\xcc\x01\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x1a\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x17\x00\x0e\x00\x0e\x00\x0f\x00\x10\x00\x0e\x00\x05\x00\x0e\x00\x0e\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x0e\x00\x0e\x00\x0e\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x04\x00\xff\xff\xff\xff\x02\x00\x02\x00\x09\x00\x09\x00\x09\x00\x0a\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0e\x00\x0e\x00\x16\x00\x16\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x12\x00\xff\xff\x0d\x00\x20\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x09\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0e\x00\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x06\x00\x07\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1b\x00\xff\xff\x00\x00\x00\x00\x14\x00\x1b\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x21\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1c\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x1c\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2d\x00\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x3e\x00\x2b\x00\x27\x00\x27\x00\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x7d\x00\x7d\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x22\x00\xf7\x00\xff\xff\xff\xff\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x65\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\x13\x00\xff\xff\x03\x00\x03\x00\xff\xff\xff\xff\x0b\x00\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x18\x00\xff\xff\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,34) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[(AlexAcc (alex_action_7))],[],[],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[],[],[]]
+{-# LINE 36 "GF/Devel/Compile/LexGF.x" #-}
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String     -- reserved words and symbols
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_PIdent !String
+ | T_LString !String
+
+ deriving (Eq,Show,Ord)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+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
+  PT _ (T_PIdent s) -> s
+  PT _ (T_LString s) -> s
+
+  _ -> show t
+
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
+
+resWords = b "lin" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "let" N N)))) (b "resource" (b "oper" (b "lintype" (b "lindef" (b "lincat" N N) N) (b "open" (b "of" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "type" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
+   where b s = B s (TS s)
+
+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
+    _         -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+      deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
+alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
+
+type AlexInput = (Posn, -- current position,
+               Char,     -- previous char
+               String)   -- current input string
+
+tokens :: String -> [Token]
+tokens str = go (alexStartPos, '\n', str)
+    where
+      go :: (Posn, Char, String) -> [Token]
+      go inp@(pos, _, str) =
+               case alexScan inp 0 of
+                AlexEOF                -> []
+                AlexError (pos, _, _)  -> [Err pos]
+                AlexSkip  inp' len     -> go inp'
+                AlexToken inp' len act -> act pos (take len str) : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p, c, [])    = Nothing
+alexGetChar (p, _, (c:s)) =
+    let p' = alexMove p c
+     in p' `seq` Just (c, (p', c, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, s) = c
+
+alex_action_3 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) 
+alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) 
+alex_action_6 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_7 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_8 = tok (\p s -> PT p (TI $ share s))    
+alex_action_9 = tok (\p s -> PT p (TD $ share s)) 
+{-# LINE 1 "GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command line>" #-}
+{-# LINE 1 "GenericTemplate.hs" #-}
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+{-# LINE 35 "GenericTemplate.hs" #-}
+
+{-# LINE 45 "GenericTemplate.hs" #-}
+
+
+data AlexAddr = AlexA# Addr#
+
+#if __GLASGOW_HASKELL__ < 503
+uncheckedShiftL# = shiftL#
+#endif
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+  narrow16Int# i
+  where
+	i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+	off' = off *# 2#
+#else
+  indexInt16OffAddr# arr off
+#endif
+
+
+
+
+
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr (AlexA# arr) off = 
+#ifdef WORDS_BIGENDIAN
+  narrow32Int# i
+  where
+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
+		     (b2 `uncheckedShiftL#` 16#) `or#`
+		     (b1 `uncheckedShiftL#` 8#) `or#` b0)
+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
+   off' = off *# 4#
+#else
+  indexInt32OffAddr# arr off
+#endif
+
+
+
+
+
+#if __GLASGOW_HASKELL__ < 503
+quickIndex arr i = arr ! i
+#else
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+quickIndex = unsafeAt
+#endif
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+  = AlexEOF
+  | AlexError  !AlexInput
+  | AlexSkip   !AlexInput !Int
+  | AlexToken  !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan input (I# (sc))
+  = alexScanUser undefined input (I# (sc))
+
+alexScanUser user input (I# (sc))
+  = case alex_scan_tkn user input 0# input sc AlexNone of
+	(AlexNone, input') ->
+		case alexGetChar input of
+			Nothing -> 
+
+
+
+				   AlexEOF
+			Just _ ->
+
+
+
+				   AlexError input'
+
+	(AlexLastSkip input len, _) ->
+
+
+
+		AlexSkip input len
+
+	(AlexLastAcc k input len, _) ->
+
+
+
+		AlexToken input len k
+
+
+-- Push the input through the DFA, remembering the most recent accepting
+-- state it encountered.
+
+alex_scan_tkn user orig_input len input s last_acc =
+  input `seq` -- strict in the input
+  let 
+	new_acc = check_accs (alex_accept `quickIndex` (I# (s)))
+  in
+  new_acc `seq`
+  case alexGetChar input of
+     Nothing -> (new_acc, input)
+     Just (c, new_input) -> 
+
+
+
+	let
+		base   = alexIndexInt32OffAddr alex_base s
+		(I# (ord_c)) = ord c
+		offset = (base +# ord_c)
+		check  = alexIndexInt16OffAddr alex_check offset
+		
+		new_s = if (offset >=# 0#) && (check ==# ord_c)
+			  then alexIndexInt16OffAddr alex_table offset
+			  else alexIndexInt16OffAddr alex_deflt s
+	in
+	case new_s of 
+	    -1# -> (new_acc, input)
+		-- on an error, we want to keep the input *before* the
+		-- character that failed, not after.
+    	    _ -> alex_scan_tkn user orig_input (len +# 1#) 
+			new_input new_s new_acc
+
+  where
+	check_accs [] = last_acc
+	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
+	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))
+	check_accs (AlexAccPred a pred : rest)
+	   | pred user orig_input (I# (len)) input
+	   = AlexLastAcc a input (I# (len))
+	check_accs (AlexAccSkipPred pred : rest)
+	   | pred user orig_input (I# (len)) input
+	   = AlexLastSkip input (I# (len))
+	check_accs (_ : rest) = check_accs rest
+
+data AlexLastAcc a
+  = AlexNone
+  | AlexLastAcc a !AlexInput !Int
+  | AlexLastSkip  !AlexInput !Int
+
+data AlexAcc a user
+  = AlexAcc a
+  | AlexAccSkip
+  | AlexAccPred a (AlexAccPred user)
+  | AlexAccSkipPred (AlexAccPred user)
+
+type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
+
+-- -----------------------------------------------------------------------------
+-- Predicates on a rule
+
+alexAndPred p1 p2 user in1 len in2
+  = p1 user in1 len in2 && p2 user in1 len in2
+
+--alexPrevCharIsPred :: Char -> AlexAccPred _ 
+alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
+
+--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ 
+alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
+
+--alexRightContext :: Int -> AlexAccPred _
+alexRightContext (I# (sc)) user _ _ input = 
+     case alex_scan_tkn user input 0# input sc AlexNone of
+	  (AlexNone, _) -> False
+	  _ -> True
+	-- TODO: there's no need to find the longest
+	-- match when checking the right context, just
+	-- the first match will do.
+
+-- used by wrappers
+iUnbox (I# (i)) = i
diff --git a/src-3.0/GF/Devel/Compile/Optimize.hs b/src-3.0/GF/Devel/Compile/Optimize.hs
new file mode 100644
index 000000000..746b47b90
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Optimize.hs
@@ -0,0 +1,333 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Optimize
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/16 13:56:13 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.18 $
+--
+-- Top-level partial evaluation for GF source modules.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Optimize (optimizeModule) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+--import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Compute
+
+--import GF.Infra.Ident
+
+import GF.Devel.Grammar.Lookup
+--import GF.Grammar.Refresh
+
+--import GF.Compile.BackOpt
+import GF.Devel.Compile.CheckGrammar
+--import GF.Compile.Update
+
+
+--import GF.Infra.CheckM
+import GF.Infra.Option ----
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.List
+import qualified Data.Map as Map
+
+import Debug.Trace
+
+
+optimizeModule :: Options -> GF -> SourceModule -> Err SourceModule
+optimizeModule opts gf0 sm@(m,mo) = case mtype mo of
+  MTConcrete _ -> opt sm 
+  MTInstance _ -> optr sm
+  MTGrammar   -> optr sm
+  _ -> return sm
+ where
+   gf = gf0 {gfmodules = Map.insert m mo (gfmodules gf0)}
+   opt (m,mo) = do
+     mo' <- termOpModule (computeTerm gf) mo
+     return (m,mo')
+
+   optr (m,mo)= do
+     let deps = allOperDependencies m $ mjments mo
+     ids <- topoSortOpers deps
+     gf' <- foldM evalOp gf ids
+     mo' <- lookupModule gf' m
+     return $ (m,mo')
+    where
+     evalOp gf i = do
+       ju   <- lookupJudgement gf m i
+       def' <- computeTerm gf (jdef ju)
+       updateJudgement m i (ju {jdef = def'}) gf
+
+
+
+
+{-
+
+-- conditional trace
+
+prtIf :: (Print a) => Bool -> a -> a
+prtIf b t = if b then trace (" " ++ prt t) t else t
+
+-- | partial evaluation of concrete syntax. 
+-- AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005 -- 7/12/2007
+
+type EEnv = () --- not used
+
+-- only do this for resource: concrete is optimized in gfc form
+
+
+
+ =mse@(ms,eenv) mo@(_,mi) = case mi of
+  ModMod m0@(Module mt st fs me ops js) | 
+    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+      (mo1,_) <- evalModule oopts mse mo
+      let 
+       mo2 = case optim of
+        "parametrize" -> shareModule paramOpt mo1  -- parametrization and sharing
+        "values"      -> shareModule valOpt mo1    -- tables as courses-of-values
+        "share"       -> shareModule shareOpt mo1  -- sharing of branches
+        "all"         -> shareModule allOpt mo1    -- first parametrize then values
+        "none"        -> mo1                       -- no optimization
+        _             -> mo1                       -- none; default for src
+      return (mo2,eenv)
+  _ -> evalModule oopts mse mo
+ where
+   oopts = addOptions opts (iOpts (flagsModule mo))
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+
+evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 && not (oElem oEval oopts) -> do
+      let deps = allOperDependencies name js
+      ids <- topoSortOpers deps
+      MGrammar (mod' : _) <- foldM evalOp gr ids
+      return $ (mod',eenv)
+
+    MTConcrete a -> do
+      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      return $ ((name, ModMod (Module mt st fs me ops js')),eenv)
+
+    _ -> return $ ((name,mod),eenv)
+  _ -> return $ ((name,mod),eenv)
+ where
+   gr0 = MGrammar $ ms
+   gr  = MGrammar $ (name,mod) : ms
+
+   evalOp g@(MGrammar ((_, ModMod m) : _)) i = do
+     info  <- lookupTree prt i $ jments m
+     info' <- evalResInfo oopts gr (i,info)
+     return $ updateRes g name i info'
+
+-- | only operations need be compiled in a resource, and this is local to each
+-- definition since the module is traversed in topological order
+evalResInfo :: Options -> SourceGrammar -> (Ident,Info) -> Err Info
+evalResInfo oopts gr (c,info) = case info of
+
+  ResOper pty pde -> eIn "operation" $ do
+    pde' <- case pde of
+       Yes de | optres -> liftM yes $ comp de 
+       _ -> return pde
+    return $ ResOper pty pde'
+
+  _ ->  return info
+ where
+   comp = if optres then computeConcrete gr else computeConcreteRec gr
+   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+   optres = case optim of
+     "noexpand" -> False
+     _ -> True
+
+
+evalCncInfo :: 
+  Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
+evalCncInfo opts gr cnc abs (c,info) = do
+
+ seq (prtIf (oElem beVerbose opts) c) $ return ()
+
+ errIn ("optimizing" +++ prt c) $ case info of
+
+  CncCat ptyp pde ppr -> do
+    pde' <- case (ptyp,pde) of
+      (Yes typ, Yes de) -> 
+        liftM yes $ pEval ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, typeStr)],typ)
+      (May b, Nope) ->
+        return $ May b
+      _ -> return pde   -- indirection
+
+    ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c)
+
+    return (c, CncCat ptyp pde' ppr')
+
+  CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> 
+       eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
+    pde' <- case pde of
+      Yes de | notNewEval -> do
+        liftM yes $ pEval ty de
+
+      _ -> return pde
+    ppr' <-  liftM yes $ evalPrintname gr c ppr pde'
+    return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed
+
+  _ ->  return (c,info)
+ where
+   pEval = partEval opts gr
+   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
+   notNewEval = not (oElem oEval opts)
+
+-- | the main function for compiling linearizations
+partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
+partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do
+  let vars  = map fst context
+      args  = map Vr vars
+      subst = [(v, Vr v) | v <- vars]
+      trm1  = mkApp trm args
+  trm3 <- if globalTable 
+             then etaExpand subst trm1 >>= outCase subst
+             else etaExpand subst trm1
+  return $ mkAbs vars trm3
+
+ where 
+
+   globalTable = oElem showAll opts --- i -all
+
+   comp g t = ---- refreshTerm t >>= 
+              computeTerm gr g t
+
+   etaExpand su t = do
+     t' <- comp su t 
+     case t' of
+       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
+       _ -> recordExpand val t' >>= comp su
+   -- don't eta expand records of right length (correct by type checking)
+   rightType t = case (t,val) of
+     (R rs, RecType ts) -> length rs == length ts
+     _ -> False
+
+   outCase subst t = do
+     pts <- getParams context
+     let (args,ptyps) = unzip $ filter (flip occur t . fst) pts
+     if null args 
+       then return t 
+       else do 
+         let argtyp = RecType $ tuple2recordType ptyps
+         let pvars = map (Vr . zIdent . prt) args -- gets eliminated
+         patt <- term2patt $ R $ tuple2record $ pvars
+         let t' = replace (zip args pvars) t
+         t1 <- comp subst $ T (TTyped argtyp) [(patt, t')]
+         return $ S t1 $ R $ tuple2record args
+
+   --- notice: this assumes that all lin types follow the "old JFP style" 
+   getParams = liftM concat . mapM getParam 
+   getParam (argv,RecType rs) = return 
+     [(P (Vr argv) lab, ptyp) | (lab,ptyp) <- rs,  not (isLinLabel lab)] 
+   ---getParam (_,ty) | ty==typeStr = return [] --- in lindef 
+   getParam (av,ty) = 
+     Bad ("record type expected not" +++ prt ty +++ "for" +++ prt av) 
+     --- all lin types are rec types
+
+   replace :: [(Term,Term)] -> Term -> Term
+   replace reps trm = case trm of  
+     -- this is the important case
+     P _ _ -> maybe trm id $ lookup trm reps
+     _ -> composSafeOp (replace reps) trm
+
+   occur t trm = case trm of
+
+     -- this is the important case
+     P _ _   -> t == trm
+     S x y   -> occur t y || occur t x
+     App f x -> occur t x || occur t f
+     Abs _ f -> occur t f
+     R rs    -> any (occur t) (map (snd . snd) rs)
+     T _ cs  -> any (occur t) (map snd cs)
+     C x y   -> occur t x || occur t y
+     Glue x y -> occur t x || occur t y
+     ExtR x y -> occur t x || occur t y
+     FV ts   -> any (occur t) ts
+     V _ ts   -> any (occur t) ts
+     Let (_,(_,x)) y -> occur t x || occur t y
+     _ -> False
+
+
+-- here we must be careful not to reduce
+--   variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}
+--   {s  = variants {"Auto" ; "Wagen"} ; g  = variants {N ; M}} ;
+
+recordExpand :: Type -> Term -> Err Term
+recordExpand typ trm = case unComputed typ of
+  RecType tys -> case trm of
+    FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs]
+    _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
+  _ -> return trm
+
+
+-- | auxiliaries for compiling the resource
+
+mkLinDefault :: SourceGrammar -> Type -> Err Term
+mkLinDefault gr typ = do
+  case unComputed typ of
+    RecType lts -> mapPairsM mkDefField lts >>= (return . Abs strVar . R . mkAssign)
+    _ -> prtBad "linearization type must be a record type, not" typ
+ where
+   mkDefField typ = case unComputed typ of
+     Table p t  -> do
+       t' <- mkDefField t
+       let T _ cs = mkWildCases t'
+       return $ T (TWild p) cs 
+     Sort "Str" -> return $ Vr strVar
+     QC q p     -> lookupFirstTag gr q p
+     RecType r  -> do
+       let (ls,ts) = unzip r
+       ts' <- mapM mkDefField ts
+       return $ R $ [assign l t | (l,t) <- zip ls ts']
+     _ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val
+     _ -> prtBad "linearization type field cannot be" typ
+
+-- | Form the printname: if given, compute. If not, use the computed
+-- lin for functions, cat name for cats (dispatch made in evalCncDef above).
+--- We cannot use linearization at this stage, since we do not know the
+--- defaults we would need for question marks - and we're not yet in canon.
+evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term
+evalPrintname gr c ppr lin =
+  case ppr of
+    Yes pr -> comp pr
+    _ -> case lin of
+      Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm
+      _ -> return $ K $ prt c ----
+ where
+   comp = computeConcrete gr
+
+   oneBranch t = case t of
+     Abs _ b   -> oneBranch b
+     R   (r:_) -> oneBranch $ snd $ snd r
+     T _ (c:_) -> oneBranch $ snd c
+     V _ (c:_) -> oneBranch c
+     FV  (t:_) -> oneBranch t
+     C x y     -> C (oneBranch x) (oneBranch y)
+     S x _     -> oneBranch x
+     P x _     -> oneBranch x
+     Alts (d,_) -> oneBranch d
+     _ -> t
+
+  --- very unclean cleaner
+   clean s = case s of
+     '+':'+':' ':cs -> clean cs
+     '"':cs -> clean cs
+     c:cs -> c: clean cs
+     _ -> s
+
+-}
diff --git a/src-3.0/GF/Devel/Compile/ParGF.hs b/src-3.0/GF/Devel/Compile/ParGF.hs
new file mode 100644
index 000000000..ce474e418
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/ParGF.hs
@@ -0,0 +1,3210 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module GF.Devel.Compile.ParGF where
+import GF.Devel.Compile.AbsGF
+import GF.Devel.Compile.LexGF
+import GF.Devel.Compile.ErrM
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+#else
+import Array
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+
+-- parser produced by Happy Version 1.16
+
+newtype HappyAbsSyn  = HappyAbsSyn (() -> ())
+happyIn7 :: (Integer) -> (HappyAbsSyn )
+happyIn7 x = unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (Integer)
+happyOut7 x = unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: (String) -> (HappyAbsSyn )
+happyIn8 x = unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> (String)
+happyOut8 x = unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Double) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Double)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: (PIdent) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> (PIdent)
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (LString) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (LString)
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (Grammar) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (Grammar)
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: ([ModDef]) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> ([ModDef])
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (ModDef) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (ModDef)
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (ModType) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (ModType)
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (ModBody) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (ModBody)
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: ([TopDef]) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> ([TopDef])
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Extend) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Extend)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: ([Open]) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> ([Open])
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Opens) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Opens)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: (Open) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> (Open)
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (ComplMod) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (ComplMod)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: ([Included]) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> ([Included])
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (Included) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (Included)
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (TopDef) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (TopDef)
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Def) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Def)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: (FunDef) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> (FunDef)
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: (CatDef) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> (CatDef)
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (DataDef) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (DataDef)
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: (DataConstr) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> (DataConstr)
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: ([DataConstr]) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> ([DataConstr])
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: (ParDef) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> (ParDef)
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (ParConstr) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (ParConstr)
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: ([Def]) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> ([Def])
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: ([FunDef]) -> (HappyAbsSyn )
+happyIn35 x = unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> ([FunDef])
+happyOut35 x = unsafeCoerce# x
+{-# INLINE happyOut35 #-}
+happyIn36 :: ([CatDef]) -> (HappyAbsSyn )
+happyIn36 x = unsafeCoerce# x
+{-# INLINE happyIn36 #-}
+happyOut36 :: (HappyAbsSyn ) -> ([CatDef])
+happyOut36 x = unsafeCoerce# x
+{-# INLINE happyOut36 #-}
+happyIn37 :: ([DataDef]) -> (HappyAbsSyn )
+happyIn37 x = unsafeCoerce# x
+{-# INLINE happyIn37 #-}
+happyOut37 :: (HappyAbsSyn ) -> ([DataDef])
+happyOut37 x = unsafeCoerce# x
+{-# INLINE happyOut37 #-}
+happyIn38 :: ([ParDef]) -> (HappyAbsSyn )
+happyIn38 x = unsafeCoerce# x
+{-# INLINE happyIn38 #-}
+happyOut38 :: (HappyAbsSyn ) -> ([ParDef])
+happyOut38 x = unsafeCoerce# x
+{-# INLINE happyOut38 #-}
+happyIn39 :: ([ParConstr]) -> (HappyAbsSyn )
+happyIn39 x = unsafeCoerce# x
+{-# INLINE happyIn39 #-}
+happyOut39 :: (HappyAbsSyn ) -> ([ParConstr])
+happyOut39 x = unsafeCoerce# x
+{-# INLINE happyOut39 #-}
+happyIn40 :: ([PIdent]) -> (HappyAbsSyn )
+happyIn40 x = unsafeCoerce# x
+{-# INLINE happyIn40 #-}
+happyOut40 :: (HappyAbsSyn ) -> ([PIdent])
+happyOut40 x = unsafeCoerce# x
+{-# INLINE happyOut40 #-}
+happyIn41 :: (Name) -> (HappyAbsSyn )
+happyIn41 x = unsafeCoerce# x
+{-# INLINE happyIn41 #-}
+happyOut41 :: (HappyAbsSyn ) -> (Name)
+happyOut41 x = unsafeCoerce# x
+{-# INLINE happyOut41 #-}
+happyIn42 :: ([Name]) -> (HappyAbsSyn )
+happyIn42 x = unsafeCoerce# x
+{-# INLINE happyIn42 #-}
+happyOut42 :: (HappyAbsSyn ) -> ([Name])
+happyOut42 x = unsafeCoerce# x
+{-# INLINE happyOut42 #-}
+happyIn43 :: (LocDef) -> (HappyAbsSyn )
+happyIn43 x = unsafeCoerce# x
+{-# INLINE happyIn43 #-}
+happyOut43 :: (HappyAbsSyn ) -> (LocDef)
+happyOut43 x = unsafeCoerce# x
+{-# INLINE happyOut43 #-}
+happyIn44 :: ([LocDef]) -> (HappyAbsSyn )
+happyIn44 x = unsafeCoerce# x
+{-# INLINE happyIn44 #-}
+happyOut44 :: (HappyAbsSyn ) -> ([LocDef])
+happyOut44 x = unsafeCoerce# x
+{-# INLINE happyOut44 #-}
+happyIn45 :: (Exp) -> (HappyAbsSyn )
+happyIn45 x = unsafeCoerce# x
+{-# INLINE happyIn45 #-}
+happyOut45 :: (HappyAbsSyn ) -> (Exp)
+happyOut45 x = unsafeCoerce# x
+{-# INLINE happyOut45 #-}
+happyIn46 :: (Exp) -> (HappyAbsSyn )
+happyIn46 x = unsafeCoerce# x
+{-# INLINE happyIn46 #-}
+happyOut46 :: (HappyAbsSyn ) -> (Exp)
+happyOut46 x = unsafeCoerce# x
+{-# INLINE happyOut46 #-}
+happyIn47 :: (Exp) -> (HappyAbsSyn )
+happyIn47 x = unsafeCoerce# x
+{-# INLINE happyIn47 #-}
+happyOut47 :: (HappyAbsSyn ) -> (Exp)
+happyOut47 x = unsafeCoerce# x
+{-# INLINE happyOut47 #-}
+happyIn48 :: (Exp) -> (HappyAbsSyn )
+happyIn48 x = unsafeCoerce# x
+{-# INLINE happyIn48 #-}
+happyOut48 :: (HappyAbsSyn ) -> (Exp)
+happyOut48 x = unsafeCoerce# x
+{-# INLINE happyOut48 #-}
+happyIn49 :: (Exp) -> (HappyAbsSyn )
+happyIn49 x = unsafeCoerce# x
+{-# INLINE happyIn49 #-}
+happyOut49 :: (HappyAbsSyn ) -> (Exp)
+happyOut49 x = unsafeCoerce# x
+{-# INLINE happyOut49 #-}
+happyIn50 :: (Exp) -> (HappyAbsSyn )
+happyIn50 x = unsafeCoerce# x
+{-# INLINE happyIn50 #-}
+happyOut50 :: (HappyAbsSyn ) -> (Exp)
+happyOut50 x = unsafeCoerce# x
+{-# INLINE happyOut50 #-}
+happyIn51 :: (Exp) -> (HappyAbsSyn )
+happyIn51 x = unsafeCoerce# x
+{-# INLINE happyIn51 #-}
+happyOut51 :: (HappyAbsSyn ) -> (Exp)
+happyOut51 x = unsafeCoerce# x
+{-# INLINE happyOut51 #-}
+happyIn52 :: ([Exp]) -> (HappyAbsSyn )
+happyIn52 x = unsafeCoerce# x
+{-# INLINE happyIn52 #-}
+happyOut52 :: (HappyAbsSyn ) -> ([Exp])
+happyOut52 x = unsafeCoerce# x
+{-# INLINE happyOut52 #-}
+happyIn53 :: (Exps) -> (HappyAbsSyn )
+happyIn53 x = unsafeCoerce# x
+{-# INLINE happyIn53 #-}
+happyOut53 :: (HappyAbsSyn ) -> (Exps)
+happyOut53 x = unsafeCoerce# x
+{-# INLINE happyOut53 #-}
+happyIn54 :: (Patt) -> (HappyAbsSyn )
+happyIn54 x = unsafeCoerce# x
+{-# INLINE happyIn54 #-}
+happyOut54 :: (HappyAbsSyn ) -> (Patt)
+happyOut54 x = unsafeCoerce# x
+{-# INLINE happyOut54 #-}
+happyIn55 :: (Patt) -> (HappyAbsSyn )
+happyIn55 x = unsafeCoerce# x
+{-# INLINE happyIn55 #-}
+happyOut55 :: (HappyAbsSyn ) -> (Patt)
+happyOut55 x = unsafeCoerce# x
+{-# INLINE happyOut55 #-}
+happyIn56 :: (Patt) -> (HappyAbsSyn )
+happyIn56 x = unsafeCoerce# x
+{-# INLINE happyIn56 #-}
+happyOut56 :: (HappyAbsSyn ) -> (Patt)
+happyOut56 x = unsafeCoerce# x
+{-# INLINE happyOut56 #-}
+happyIn57 :: (PattAss) -> (HappyAbsSyn )
+happyIn57 x = unsafeCoerce# x
+{-# INLINE happyIn57 #-}
+happyOut57 :: (HappyAbsSyn ) -> (PattAss)
+happyOut57 x = unsafeCoerce# x
+{-# INLINE happyOut57 #-}
+happyIn58 :: (Label) -> (HappyAbsSyn )
+happyIn58 x = unsafeCoerce# x
+{-# INLINE happyIn58 #-}
+happyOut58 :: (HappyAbsSyn ) -> (Label)
+happyOut58 x = unsafeCoerce# x
+{-# INLINE happyOut58 #-}
+happyIn59 :: (Sort) -> (HappyAbsSyn )
+happyIn59 x = unsafeCoerce# x
+{-# INLINE happyIn59 #-}
+happyOut59 :: (HappyAbsSyn ) -> (Sort)
+happyOut59 x = unsafeCoerce# x
+{-# INLINE happyOut59 #-}
+happyIn60 :: ([PattAss]) -> (HappyAbsSyn )
+happyIn60 x = unsafeCoerce# x
+{-# INLINE happyIn60 #-}
+happyOut60 :: (HappyAbsSyn ) -> ([PattAss])
+happyOut60 x = unsafeCoerce# x
+{-# INLINE happyOut60 #-}
+happyIn61 :: ([Patt]) -> (HappyAbsSyn )
+happyIn61 x = unsafeCoerce# x
+{-# INLINE happyIn61 #-}
+happyOut61 :: (HappyAbsSyn ) -> ([Patt])
+happyOut61 x = unsafeCoerce# x
+{-# INLINE happyOut61 #-}
+happyIn62 :: (Bind) -> (HappyAbsSyn )
+happyIn62 x = unsafeCoerce# x
+{-# INLINE happyIn62 #-}
+happyOut62 :: (HappyAbsSyn ) -> (Bind)
+happyOut62 x = unsafeCoerce# x
+{-# INLINE happyOut62 #-}
+happyIn63 :: ([Bind]) -> (HappyAbsSyn )
+happyIn63 x = unsafeCoerce# x
+{-# INLINE happyIn63 #-}
+happyOut63 :: (HappyAbsSyn ) -> ([Bind])
+happyOut63 x = unsafeCoerce# x
+{-# INLINE happyOut63 #-}
+happyIn64 :: (Decl) -> (HappyAbsSyn )
+happyIn64 x = unsafeCoerce# x
+{-# INLINE happyIn64 #-}
+happyOut64 :: (HappyAbsSyn ) -> (Decl)
+happyOut64 x = unsafeCoerce# x
+{-# INLINE happyOut64 #-}
+happyIn65 :: (TupleComp) -> (HappyAbsSyn )
+happyIn65 x = unsafeCoerce# x
+{-# INLINE happyIn65 #-}
+happyOut65 :: (HappyAbsSyn ) -> (TupleComp)
+happyOut65 x = unsafeCoerce# x
+{-# INLINE happyOut65 #-}
+happyIn66 :: (PattTupleComp) -> (HappyAbsSyn )
+happyIn66 x = unsafeCoerce# x
+{-# INLINE happyIn66 #-}
+happyOut66 :: (HappyAbsSyn ) -> (PattTupleComp)
+happyOut66 x = unsafeCoerce# x
+{-# INLINE happyOut66 #-}
+happyIn67 :: ([TupleComp]) -> (HappyAbsSyn )
+happyIn67 x = unsafeCoerce# x
+{-# INLINE happyIn67 #-}
+happyOut67 :: (HappyAbsSyn ) -> ([TupleComp])
+happyOut67 x = unsafeCoerce# x
+{-# INLINE happyOut67 #-}
+happyIn68 :: ([PattTupleComp]) -> (HappyAbsSyn )
+happyIn68 x = unsafeCoerce# x
+{-# INLINE happyIn68 #-}
+happyOut68 :: (HappyAbsSyn ) -> ([PattTupleComp])
+happyOut68 x = unsafeCoerce# x
+{-# INLINE happyOut68 #-}
+happyIn69 :: (Case) -> (HappyAbsSyn )
+happyIn69 x = unsafeCoerce# x
+{-# INLINE happyIn69 #-}
+happyOut69 :: (HappyAbsSyn ) -> (Case)
+happyOut69 x = unsafeCoerce# x
+{-# INLINE happyOut69 #-}
+happyIn70 :: ([Case]) -> (HappyAbsSyn )
+happyIn70 x = unsafeCoerce# x
+{-# INLINE happyIn70 #-}
+happyOut70 :: (HappyAbsSyn ) -> ([Case])
+happyOut70 x = unsafeCoerce# x
+{-# INLINE happyOut70 #-}
+happyIn71 :: (Equation) -> (HappyAbsSyn )
+happyIn71 x = unsafeCoerce# x
+{-# INLINE happyIn71 #-}
+happyOut71 :: (HappyAbsSyn ) -> (Equation)
+happyOut71 x = unsafeCoerce# x
+{-# INLINE happyOut71 #-}
+happyIn72 :: ([Equation]) -> (HappyAbsSyn )
+happyIn72 x = unsafeCoerce# x
+{-# INLINE happyIn72 #-}
+happyOut72 :: (HappyAbsSyn ) -> ([Equation])
+happyOut72 x = unsafeCoerce# x
+{-# INLINE happyOut72 #-}
+happyIn73 :: (Altern) -> (HappyAbsSyn )
+happyIn73 x = unsafeCoerce# x
+{-# INLINE happyIn73 #-}
+happyOut73 :: (HappyAbsSyn ) -> (Altern)
+happyOut73 x = unsafeCoerce# x
+{-# INLINE happyOut73 #-}
+happyIn74 :: ([Altern]) -> (HappyAbsSyn )
+happyIn74 x = unsafeCoerce# x
+{-# INLINE happyIn74 #-}
+happyOut74 :: (HappyAbsSyn ) -> ([Altern])
+happyOut74 x = unsafeCoerce# x
+{-# INLINE happyOut74 #-}
+happyIn75 :: (DDecl) -> (HappyAbsSyn )
+happyIn75 x = unsafeCoerce# x
+{-# INLINE happyIn75 #-}
+happyOut75 :: (HappyAbsSyn ) -> (DDecl)
+happyOut75 x = unsafeCoerce# x
+{-# INLINE happyOut75 #-}
+happyIn76 :: ([DDecl]) -> (HappyAbsSyn )
+happyIn76 x = unsafeCoerce# x
+{-# INLINE happyIn76 #-}
+happyOut76 :: (HappyAbsSyn ) -> ([DDecl])
+happyOut76 x = unsafeCoerce# x
+{-# INLINE happyOut76 #-}
+happyIn77 :: (OldGrammar) -> (HappyAbsSyn )
+happyIn77 x = unsafeCoerce# x
+{-# INLINE happyIn77 #-}
+happyOut77 :: (HappyAbsSyn ) -> (OldGrammar)
+happyOut77 x = unsafeCoerce# x
+{-# INLINE happyOut77 #-}
+happyIn78 :: (Include) -> (HappyAbsSyn )
+happyIn78 x = unsafeCoerce# x
+{-# INLINE happyIn78 #-}
+happyOut78 :: (HappyAbsSyn ) -> (Include)
+happyOut78 x = unsafeCoerce# x
+{-# INLINE happyOut78 #-}
+happyIn79 :: (FileName) -> (HappyAbsSyn )
+happyIn79 x = unsafeCoerce# x
+{-# INLINE happyIn79 #-}
+happyOut79 :: (HappyAbsSyn ) -> (FileName)
+happyOut79 x = unsafeCoerce# x
+{-# INLINE happyOut79 #-}
+happyIn80 :: ([FileName]) -> (HappyAbsSyn )
+happyIn80 x = unsafeCoerce# x
+{-# INLINE happyIn80 #-}
+happyOut80 :: (HappyAbsSyn ) -> ([FileName])
+happyOut80 x = unsafeCoerce# x
+{-# INLINE happyOut80 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x00\x00\x34\x04\x2a\x04\xe9\x00\x0d\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x04\x90\x01\x6f\x00\x37\x04\xfa\x03\x35\x04\x00\x00\x31\x04\xe7\x03\xfe\xff\x1c\x00\xe7\x03\x00\x00\xe9\x00\x29\x00\xe7\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x30\x04\x63\x02\x06\x00\x00\x03\x2f\x04\x2e\x04\x58\x02\x2d\x04\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x03\x00\x00\xf9\xff\x01\x00\x6e\x08\x00\x00\xdc\x03\x4e\x00\x2c\x04\x1c\x04\xc6\x03\xc6\x03\xc6\x03\xc6\x03\xc6\x03\xc6\x03\x00\x00\x00\x00\xf9\xff\x13\x04\x00\x00\xf9\xff\xf9\xff\xf9\xff\xf6\x07\xe9\x00\x17\x01\xeb\x02\x9b\x00\xc4\x03\x4d\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x03\x04\x00\x00\xc3\x03\xeb\x02\xc1\x03\x00\x00\xeb\x02\xc0\x03\x00\x00\x0a\x02\x06\x04\x39\x00\x0a\x04\xdb\x03\xb1\x03\x1b\x00\x16\x03\xd4\x03\x00\x00\x00\x00\xf3\x03\xdf\x03\x77\x00\x00\x00\xee\x03\xf0\x03\xe2\x03\x43\x02\xeb\x03\xff\x01\x00\x00\xd6\x00\xea\x03\xe5\x03\xf4\x01\x8d\x02\xe8\x03\x4d\x00\x37\x01\x4d\x00\x37\x01\x37\x01\x37\x01\x4d\x00\xe1\x03\xd6\x03\xef\xff\x00\x00\x00\x00\x96\x03\x8d\x03\x00\x00\xf4\x01\xf4\x01\xf4\x01\x00\x00\xf4\x01\x7b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x03\x8d\x03\xd3\x03\x4d\x00\x00\x00\xa6\x01\xd0\x03\x89\x03\x00\x00\x89\x03\x00\x00\x00\x00\x4d\x00\x4d\x00\xbe\x03\x4d\x00\x77\x00\xd2\x03\x16\x03\xbc\x03\xd1\x03\xcc\x03\x00\x00\xc7\x03\x4d\x00\x84\x03\x4d\x00\x4d\x00\xbd\x03\xa7\x03\xb1\x02\xa3\x03\x00\x00\xf9\x00\xad\x03\x99\x03\x16\x03\xa8\x03\x7a\x02\xe8\x01\xae\x03\xa9\x03\xa0\x03\x54\x03\xa1\x03\x9e\x03\x93\x03\x83\x03\x87\x02\x5f\x01\x8a\x03\x86\x03\xeb\x02\x4d\x00\x81\x03\x00\x00\x2b\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x34\x03\x34\x03\x28\x00\x02\x00\x34\x03\x28\x00\x00\x00\x00\x00\x00\x00\xf9\xff\x00\x00\x00\x00\x00\x00\x4b\x03\x00\x00\x49\x03\x00\x00\x18\x00\x2f\x02\x00\x00\x46\x03\x78\x03\x30\x00\x32\x03\x32\x03\x32\x03\x32\x03\x00\x00\x00\x00\x76\x03\x00\x00\xd6\x02\x33\x00\x25\x03\x72\x03\x00\x00\x28\x00\x28\x00\x00\x00\x6e\x03\x6a\x03\x00\x00\x57\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x03\x00\x00\x64\x03\x4a\x03\x00\x00\x00\x00\x53\x03\x00\x00\x00\x00\x87\x00\x00\x00\x4f\x03\x00\x00\xfc\x02\x00\x00\x40\x03\x44\x03\x00\x00\xc7\x02\xc7\x02\xc7\x02\x4d\x00\x00\x00\xf6\x02\x16\x03\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\xf6\x02\xc7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x02\x00\x00\xf6\x02\x42\x03\x00\x00\x00\x00\x00\x00\x14\x03\x00\x00\x16\x03\x4d\x00\x00\x00\xc7\x02\x00\x00\x00\x00\x4d\x00\x24\x03\x00\x00\x00\x00\x00\x00\xb4\x01\x00\x00\x00\x00\x38\x03\x00\x00\x30\x03\x00\x00\x2e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x03\x00\x00\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\xf9\x00\x00\x00\x0b\x03\x20\x03\x1a\x03\x00\x00\x00\x00\x16\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x9b\x01\xe4\x02\xfa\xff\xfa\xff\x4d\x00\xfa\xff\x19\x03\xd9\x02\xd9\x02\x00\x00\x00\x00\x00\x00\x0e\x03\x4d\x00\x4d\x00\x10\x03\xfa\xff\x00\x00\x00\x00\x00\x00\x11\x03\x00\x00\xbc\x02\x0a\x00\xbc\x02\x07\x03\x0a\x00\xb9\x02\xfb\x02\xb3\x02\xf7\x02\x00\x00\xcb\x02\xf3\x02\xa9\x02\x00\x00\xaa\x02\xee\x02\x00\x00\x00\x00\x4d\x00\xe3\x02\x00\x00\x00\x00\x00\x00\xda\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x02\x00\x00\xd7\x02\xd2\x02\x00\x00\x00\x00\x00\x00\xfe\xff\x00\x00\x42\x01\x00\x00\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x02\xcf\x02\x82\x02\x82\x02\x91\x03\x82\x02\x9b\x01\x4d\x00\x00\x00\xa0\x02\x0a\x00\x71\x03\xcd\x02\x0a\x00\x00\x00\x00\x00\xbe\x02\x00\x00\x00\x00\x6e\x02\x00\x00\xc4\x02\xb8\x02\x00\x00\x00\x00\xb5\x02\x00\x00\x00\x00\x4d\x00\x69\x02\xa7\x02\xa2\x02\x00\x00\x00\x00\x6f\x02\x97\x02\x00\x00\x9a\x02\x51\x03\x00\x00\x00\x00\x00\x00\x00\x00\x31\x03\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x78\x00\x22\x02\x8b\x01\x9e\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x03\x54\x04\x3c\x01\x96\x02\x00\x00\x17\x04\xca\x00\x93\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x07\x00\x00\x00\x00\xf2\x07\x6f\x03\x3c\x02\x00\x00\x00\x00\xd3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x19\x00\x00\x00\x81\x02\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x6d\x02\x6b\x02\x6a\x02\x5f\x02\x5d\x02\x5b\x02\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x22\x00\x13\x00\x07\x00\x4b\x02\xc8\x04\x00\x00\x4d\x01\x64\x07\x59\x02\xac\x04\x46\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x46\x02\x50\x02\x00\x00\x0c\x03\x47\x02\x00\x00\xe7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x03\x44\x02\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x07\x00\x00\x00\x00\x00\x00\x00\x00\x44\x04\x00\x00\x00\x00\x2a\x07\xc3\x02\x0c\x07\xbc\x07\xad\x07\x2b\x03\xf0\x06\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x1c\x02\x1d\x03\x00\x00\x28\x04\x28\x04\x28\x04\x00\x00\x28\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x00\x08\x02\x00\x00\xd2\x06\x00\x00\xcb\x07\x00\x00\x9b\x02\x00\x00\x07\x02\x00\x00\x00\x00\xfb\x03\xb6\x06\x00\x00\x98\x06\x5d\x00\x00\x00\xcb\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x06\x00\x01\x5e\x06\x42\x06\x00\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\xc0\x01\x8e\x04\x00\x00\x00\x00\x91\x01\xf4\x07\x77\x08\x75\x08\x69\x08\x64\x08\x5e\x08\x53\x08\x50\x08\x47\x08\xea\x01\x69\x01\x42\x08\x3d\x08\xdf\x01\x39\x08\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x01\x00\x00\x00\x00\xd4\x01\x00\x00\x00\x00\xd5\x01\x8a\x01\xc2\x01\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x41\x01\x00\x00\x95\x01\x00\x00\x00\x00\x2c\x08\xa0\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x01\x00\x00\x00\x00\x87\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x00\xed\x03\x7d\x02\x24\x06\x00\x00\x7c\x01\x37\x00\x00\x00\x72\x04\xdd\x03\x00\x00\x00\x00\xd7\x01\x24\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x02\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x08\x06\x00\x00\x84\x00\x00\x00\x00\x00\xea\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x05\xb0\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x6c\x01\xad\x00\x47\x01\xa6\x00\x0d\x01\x94\x05\x26\x08\x00\x00\xb3\x00\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x76\x05\x5a\x05\x00\x00\xa2\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x01\xab\x02\x90\x00\x00\x00\x2d\x02\xcd\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x01\x26\x01\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x05\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x11\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x04\x00\x00\xad\x00\x00\x00\x00\x00\xbf\x03\x20\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xf4\x00\xdb\x00\xfc\x00\xad\x00\x02\x05\x00\x00\xd3\x00\xcd\x01\xbc\x00\x00\x00\x99\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x04\xcb\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x53\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xf5\xff\xd8\xff\x17\xff\x00\x00\x00\x00\xfb\xff\x8e\xff\x8f\xff\x8d\xff\x93\xff\x82\xff\x7e\xff\x73\xff\x6e\xff\x60\xff\x61\xff\x00\x00\x6c\xff\x90\xff\x00\x00\x96\xff\x34\xff\x00\x00\x00\x00\x8c\xff\x2d\xff\x34\xff\x00\x00\x3f\xff\x3d\xff\x3c\xff\x3e\xff\x40\xff\x00\x00\x8a\xff\x00\x00\x00\x00\x96\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xf9\xff\xf8\xff\xf7\xff\x00\x00\xe3\xff\x00\x00\x00\x00\x00\x00\xd7\xff\x00\x00\xd8\xff\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x15\xff\x14\xff\x00\x00\x16\xff\x00\x00\x00\x00\x00\x00\x18\xff\x5f\xff\x00\x00\x96\xff\x00\x00\x00\x00\x5f\xff\x00\x00\x52\xff\x50\xff\x51\xff\x55\xff\x75\xff\x3b\xff\x00\x00\x00\x00\x5a\xff\x2a\xff\x00\x00\x56\xff\x00\x00\x9f\xff\x00\x00\x95\xff\x00\x00\x96\xff\x00\x00\x23\xff\x00\x00\x72\xff\x36\xff\x33\xff\x00\x00\x34\xff\x35\xff\x2f\xff\x2c\xff\x00\x00\x00\x00\x00\x00\x5c\xff\x8b\xff\x93\xff\x00\x00\x00\x00\x00\x00\x9f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\xff\x00\x00\x42\xff\x81\xff\x00\x00\x96\xff\x67\xff\x70\xff\x71\xff\x6f\xff\x6b\xff\x6e\xff\x60\xff\x6d\xff\x68\xff\x87\xff\x92\xff\x00\x00\x00\x00\x93\xff\x00\x00\x83\xff\x5c\xff\x00\x00\x96\xff\x88\xff\x00\x00\x91\xff\x86\xff\x2d\xff\x00\x00\x00\x00\x00\x00\x34\xff\x00\x00\x38\xff\x00\x00\x22\xff\x00\x00\x62\xff\x00\x00\x00\x00\x96\xff\x00\x00\x00\x00\x74\xff\x58\xff\x55\xff\x47\xff\x44\xff\x2e\xff\x29\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9f\xff\x00\x00\x3a\xff\x00\x00\x00\x00\x00\x00\x5e\xff\x00\x00\x00\x00\x9f\xff\x00\x00\x26\xff\x00\x00\x00\x00\x5f\xff\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\xff\x12\xff\x11\xff\x0f\xff\x10\xff\xf0\xff\xee\xff\x00\x00\xef\xff\x00\x00\xf1\xff\xd6\xff\xd3\xff\xf2\xff\xdc\xff\xea\xff\xd5\xff\x00\x00\xd6\xff\x00\x00\x00\x00\x0e\xff\x9d\xff\x00\x00\xbf\xff\x9b\xff\x00\x00\x00\x00\x00\x00\xc3\xff\x00\x00\x00\x00\xc1\xff\xae\xff\x00\x00\xcb\xff\x00\x00\xca\xff\xc2\xff\xc8\xff\xc9\xff\xc7\xff\x00\x00\xcf\xff\x9b\xff\x00\x00\xc4\xff\xcd\xff\x00\x00\xce\xff\xcc\xff\x9b\xff\x1a\xff\x00\x00\xd0\xff\x00\x00\x78\xff\x00\x00\x00\x00\x7c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x4c\xff\x00\x00\x00\x00\x76\xff\x5f\xff\x1f\xff\x53\xff\x4f\xff\x3b\xff\x00\x00\x54\xff\x4d\xff\x59\xff\x48\xff\x4e\xff\x2a\xff\x4a\xff\x00\x00\x99\xff\x98\xff\x94\xff\x65\xff\x00\x00\x63\xff\x23\xff\x00\x00\x37\xff\x00\x00\x32\xff\x6a\xff\x00\x00\x00\x00\x2f\xff\x2b\xff\x7f\xff\x9f\xff\x89\xff\x5b\xff\x00\x00\x85\xff\x00\x00\x9e\xff\x00\x00\x41\xff\x64\xff\x80\xff\x31\xff\x84\xff\x69\xff\x00\x00\x24\xff\x21\xff\x00\x00\x00\x00\x57\xff\x28\xff\x43\xff\x39\xff\x00\x00\x1e\xff\x00\x00\x5d\xff\x49\xff\x53\xff\x27\xff\x45\xff\x46\xff\x25\xff\x7b\xff\x7a\xff\x1a\xff\xa8\xff\xb8\xff\xb2\xff\x00\x00\xa6\xff\x00\x00\xaa\xff\x00\x00\xa4\xff\xa2\xff\xc5\xff\xc6\xff\xbe\xff\x00\x00\x00\x00\x00\x00\x00\x00\xac\xff\xec\xff\xed\xff\xe4\xff\xd5\xff\xe5\xff\xd6\xff\xdf\xff\xe1\xff\x00\x00\xdf\xff\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x00\x00\xde\xff\x00\x00\xe3\xff\x00\x00\xe9\xff\xd4\xff\xab\xff\x00\x00\xbd\xff\xbc\xff\x9c\xff\x1a\xff\xa1\xff\xaf\xff\xa3\xff\xe3\xff\xa9\xff\xb9\xff\xa5\xff\x00\x00\x9a\xff\xb4\xff\xb1\xff\xb5\xff\x1b\xff\x19\xff\x34\xff\xa7\xff\x00\x00\x4b\xff\x77\xff\x1f\xff\x00\x00\x97\xff\x66\xff\x79\xff\x20\xff\x1d\xff\xb7\xff\x00\x00\xb2\xff\x00\x00\x00\x00\xa2\xff\xad\xff\x00\x00\xbb\xff\xdc\xff\xdf\xff\x00\x00\x00\x00\xdf\xff\xdb\xff\xd2\xff\x00\x00\xd1\xff\xdd\xff\x00\x00\xeb\xff\xe7\xff\x00\x00\xba\xff\xa0\xff\x00\x00\xb3\xff\xb0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xff\xe3\xff\xdc\xff\x00\x00\xd9\xff\x00\x00\x00\x00\x1c\xff\xb6\xff\xe8\xff\xe3\xff\x00\x00\xe6\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x09\x00\x0b\x00\x07\x00\x0d\x00\x09\x00\x01\x00\x03\x00\x03\x00\x09\x00\x1d\x00\x0f\x00\x10\x00\x11\x00\x01\x00\x07\x00\x03\x00\x03\x00\x01\x00\x17\x00\x03\x00\x1e\x00\x0a\x00\x1b\x00\x01\x00\x03\x00\x03\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x01\x00\x26\x00\x03\x00\x0a\x00\x29\x00\x0d\x00\x27\x00\x2c\x00\x07\x00\x09\x00\x2f\x00\x01\x00\x2d\x00\x03\x00\x09\x00\x34\x00\x0f\x00\x09\x00\x02\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x3e\x00\x3f\x00\x4f\x00\x0c\x00\x17\x00\x43\x00\x44\x00\x33\x00\x1b\x00\x0c\x00\x4d\x00\x49\x00\x4f\x00\x4f\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x48\x00\x03\x00\x4f\x00\x3a\x00\x52\x00\x07\x00\x4f\x00\x09\x00\x48\x00\x49\x00\x4f\x00\x42\x00\x48\x00\x0f\x00\x10\x00\x11\x00\x47\x00\x03\x00\x48\x00\x49\x00\x03\x00\x17\x00\x12\x00\x2f\x00\x4f\x00\x4d\x00\x4d\x00\x48\x00\x4f\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x4f\x00\x26\x00\x05\x00\x48\x00\x29\x00\x4f\x00\x4f\x00\x2c\x00\x4f\x00\x4b\x00\x2f\x00\x05\x00\x06\x00\x31\x00\x05\x00\x34\x00\x13\x00\x14\x00\x00\x00\x01\x00\x02\x00\x03\x00\x19\x00\x02\x00\x0d\x00\x3e\x00\x3f\x00\x06\x00\x13\x00\x14\x00\x43\x00\x44\x00\x1b\x00\x03\x00\x37\x00\x38\x00\x49\x00\x37\x00\x38\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x12\x00\x52\x00\x11\x00\x07\x00\x03\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x17\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x17\x00\x18\x00\x4a\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0a\x00\x26\x00\x3e\x00\x3f\x00\x29\x00\x03\x00\x4f\x00\x2c\x00\x22\x00\x23\x00\x2f\x00\x00\x00\x19\x00\x03\x00\x12\x00\x34\x00\x03\x00\x03\x00\x1f\x00\x26\x00\x2f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x3e\x00\x3f\x00\x36\x00\x06\x00\x03\x00\x43\x00\x44\x00\x0d\x00\x34\x00\x0c\x00\x21\x00\x49\x00\x40\x00\x41\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x12\x00\x21\x00\x21\x00\x07\x00\x44\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x17\x00\x37\x00\x38\x00\x03\x00\x2f\x00\x30\x00\x31\x00\x0e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x15\x00\x26\x00\x03\x00\x03\x00\x29\x00\x3e\x00\x3f\x00\x2c\x00\x1a\x00\x09\x00\x2f\x00\x0b\x00\x03\x00\x0a\x00\x20\x00\x34\x00\x10\x00\x11\x00\x09\x00\x21\x00\x2f\x00\x16\x00\x24\x00\x25\x00\x45\x00\x3e\x00\x3f\x00\x36\x00\x2f\x00\x1e\x00\x43\x00\x44\x00\x03\x00\x22\x00\x0a\x00\x36\x00\x49\x00\x40\x00\x41\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x10\x00\x11\x00\x01\x00\x07\x00\x03\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x03\x00\x09\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x03\x00\x45\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x03\x00\x26\x00\x17\x00\x18\x00\x29\x00\x03\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x0e\x00\x21\x00\x03\x00\x2f\x00\x24\x00\x25\x00\x1a\x00\x15\x00\x3e\x00\x3f\x00\x36\x00\x19\x00\x20\x00\x43\x00\x44\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x49\x00\x15\x00\x19\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1f\x00\x1d\x00\x03\x00\x3e\x00\x3f\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x03\x00\x45\x00\x2f\x00\x07\x00\x03\x00\x09\x00\x10\x00\x11\x00\x03\x00\x36\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x03\x00\x09\x00\x0c\x00\x15\x00\x0e\x00\x18\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x1d\x00\x09\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x10\x00\x11\x00\x04\x00\x29\x00\x06\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x46\x00\x47\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\x0c\x00\x03\x00\x0e\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x0d\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x04\x00\x03\x00\x06\x00\x2f\x00\x30\x00\x31\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x21\x00\x26\x00\x2f\x00\x07\x00\x03\x00\x09\x00\x3e\x00\x3f\x00\x03\x00\x36\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x34\x00\x09\x00\x32\x00\x03\x00\x03\x00\x35\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x2f\x00\x09\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x29\x00\x21\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x07\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x32\x00\x03\x00\x0f\x00\x35\x00\x29\x00\x00\x00\x01\x00\x02\x00\x03\x00\x09\x00\x0c\x00\x0b\x00\x0e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x01\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x0d\x00\x01\x00\x0f\x00\x2f\x00\x30\x00\x31\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x03\x00\x12\x00\x03\x00\x07\x00\x03\x00\x09\x00\x03\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x2f\x00\x09\x00\x03\x00\x03\x00\x3b\x00\x03\x00\x3d\x00\x0f\x00\x10\x00\x11\x00\x2f\x00\x30\x00\x31\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x08\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0e\x00\x08\x00\x03\x00\x04\x00\x29\x00\x06\x00\x07\x00\x15\x00\x09\x00\x04\x00\x0a\x00\x06\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x11\x00\x03\x00\x0d\x00\x14\x00\x15\x00\x03\x00\x03\x00\x08\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x3a\x00\x08\x00\x04\x00\x2f\x00\x30\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x4c\x00\x01\x00\x0c\x00\x07\x00\x0e\x00\x09\x00\x03\x00\x21\x00\x4f\x00\x0d\x00\x24\x00\x25\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0a\x00\x05\x00\x03\x00\x1a\x00\x1b\x00\x1c\x00\x07\x00\x02\x00\x09\x00\x4f\x00\x0b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x10\x00\x11\x00\x03\x00\x3a\x00\x0c\x00\x06\x00\x07\x00\x03\x00\x09\x00\x0e\x00\x1a\x00\x1b\x00\x02\x00\x0d\x00\x02\x00\x10\x00\x11\x00\x0e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x03\x00\x2c\x00\x1a\x00\x1b\x00\x07\x00\x05\x00\x09\x00\x4b\x00\x0b\x00\x34\x00\x4f\x00\x06\x00\x2f\x00\x10\x00\x11\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x0a\x00\x4f\x00\x03\x00\x09\x00\x1a\x00\x1b\x00\x07\x00\x4f\x00\x09\x00\x03\x00\x4f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x10\x00\x11\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x06\x00\x0a\x00\x03\x00\x1a\x00\x1b\x00\x03\x00\x07\x00\x04\x00\x09\x00\x03\x00\x01\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x10\x00\x11\x00\x4f\x00\x1e\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x04\x00\x4f\x00\x04\x00\x04\x00\x12\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x2f\x00\x30\x00\x31\x00\x21\x00\x03\x00\x08\x00\x24\x00\x25\x00\x2f\x00\x02\x00\x4f\x00\x46\x00\x3b\x00\x04\x00\x3d\x00\x0a\x00\x4f\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x01\x00\x26\x00\x27\x00\x28\x00\x01\x00\x04\x00\x0c\x00\x01\x00\x27\x00\x02\x00\x29\x00\x2a\x00\x2b\x00\x21\x00\x2d\x00\x34\x00\x24\x00\x25\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x35\x00\x36\x00\x37\x00\x38\x00\x06\x00\x01\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x02\x00\x40\x00\x03\x00\x01\x00\x4f\x00\x04\x00\x45\x00\x01\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x05\x00\x2d\x00\x03\x00\x3a\x00\x4f\x00\x39\x00\x4f\x00\x39\x00\x04\x00\x35\x00\x36\x00\x37\x00\x38\x00\x04\x00\x01\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x21\x00\x40\x00\x0f\x00\x24\x00\x25\x00\x04\x00\x45\x00\x04\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x21\x00\x2d\x00\x01\x00\x24\x00\x25\x00\x01\x00\x4f\x00\x04\x00\x03\x00\x35\x00\x36\x00\x37\x00\x38\x00\x01\x00\x12\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x02\x00\x40\x00\x0a\x00\x06\x00\x0d\x00\x13\x00\x45\x00\x14\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x1b\x00\x2d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x22\x00\x23\x00\x35\x00\x36\x00\x37\x00\x38\x00\x0d\x00\x04\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x04\x00\x40\x00\x01\x00\x4f\x00\x18\x00\x03\x00\x45\x00\x19\x00\x4f\x00\x48\x00\x0a\x00\x08\x00\x4f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4c\x00\x0d\x00\x03\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0c\x00\x08\x00\x34\x00\x12\x00\x0a\x00\x06\x00\x18\x00\x39\x00\x06\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4f\x00\x42\x00\x43\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2f\x00\x01\x00\x06\x00\x39\x00\x4d\x00\x4f\x00\x0d\x00\x34\x00\x4f\x00\x4f\x00\x01\x00\x4f\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2f\x00\x30\x00\x02\x00\x42\x00\x43\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x52\x00\x34\x00\x03\x00\x03\x00\x03\x00\x03\x00\x39\x00\x3a\x00\x4f\x00\x3c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x18\x00\x15\x00\x34\x00\x52\x00\x16\x00\x26\x00\x27\x00\x39\x00\x3a\x00\x0d\x00\x3c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4c\x00\x30\x00\xff\xff\x34\x00\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x34\x00\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x13\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\xff\xff\x1b\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x22\x00\x23\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x28\x00\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\x26\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x34\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2e\x00\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x34\x00\x26\x00\x27\x00\xff\xff\x1c\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\x26\x00\x27\x00\xff\xff\x34\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x03\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x03\x00\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x34\x00\x40\x00\xff\xff\xff\xff\xff\xff\x14\x00\x45\x00\x03\x00\xff\xff\x48\x00\x13\x00\x03\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x03\x00\xff\xff\x1b\x00\x22\x00\x23\x00\x03\x00\xff\xff\x13\x00\xff\xff\x22\x00\x23\x00\x13\x00\xff\xff\xff\xff\x03\x00\x1b\x00\x13\x00\x03\x00\xff\xff\x1b\x00\xff\xff\x13\x00\x22\x00\x23\x00\x1b\x00\xff\xff\x22\x00\x23\x00\x03\x00\x1b\x00\x13\x00\x22\x00\x23\x00\x13\x00\x03\x00\xff\xff\x22\x00\x23\x00\x1b\x00\x03\x00\xff\xff\x1b\x00\xff\xff\xff\xff\x13\x00\x22\x00\x23\x00\xff\xff\x22\x00\x23\x00\x13\x00\x03\x00\x1b\x00\x03\x00\xff\xff\xff\xff\x14\x00\xff\xff\x1b\x00\x22\x00\x23\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x22\x00\x23\x00\x13\x00\xff\xff\x13\x00\x22\x00\x23\x00\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\x1b\x00\x25\x00\xff\xff\xff\xff\x28\x00\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\x32\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x15\x00\x40\x00\xf4\x00\x45\x00\x16\x00\x46\x00\x17\x00\x40\x00\x61\x00\x41\x00\xf4\x00\x84\x00\x18\x00\x19\x00\x1a\x00\x40\x00\x83\x01\x41\x00\x81\x00\x40\x00\x1b\x00\x41\x00\x47\x00\xd2\x01\x6a\x00\x40\x00\xe0\xff\x41\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x40\x00\x22\x00\x41\x00\x71\x00\x23\x00\x81\x00\xf7\x00\x24\x00\x37\x00\x10\x01\x75\x00\x40\x00\xf8\x00\x41\x00\xf4\x00\x26\x00\x33\x00\x10\x01\x6e\x01\x77\x01\x4f\x00\x50\x00\x51\x00\x52\x00\xab\x00\x27\x00\x28\x00\x2e\x00\x6f\x01\x69\x00\x29\x00\x2a\x00\x82\x00\x6a\x00\xac\x00\x2c\x00\x2b\x00\x2e\x00\x2e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xd8\x00\x15\x00\x2e\x00\xe0\xff\xff\xff\x16\x00\x2e\x00\x17\x00\x42\x00\xed\x00\x2e\x00\xea\x00\xd9\x00\x18\x00\x19\x00\x1a\x00\xeb\x00\x65\x00\x42\x00\x43\x00\x65\x00\x1b\x00\xc7\x00\x56\x01\x2e\x00\x2c\x00\x2c\x00\xda\x00\x2e\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x2e\x00\x22\x00\x7b\x00\xdc\x00\x23\x00\x2e\x00\x2e\x00\x24\x00\x2e\x00\x78\x01\x25\x00\x35\x00\x36\x00\x35\x00\x7b\x00\x26\x00\x7c\x00\x7d\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x7e\x00\x62\x01\xcc\x01\x27\x00\x28\x00\x63\x01\x7c\x00\x7d\x00\x29\x00\x2a\x00\x6a\x00\xe4\x00\x66\x00\x34\x01\x2b\x00\x66\x00\x9e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xc7\x00\xf6\xff\x84\x01\x16\x00\x96\x01\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xee\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x1b\x00\xaf\x00\xb0\x00\xc1\x00\xf9\x00\x97\x01\xc2\x01\x7f\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xcd\x01\x22\x00\xc2\x00\x49\x01\x23\x00\x5c\x00\x2e\x00\x24\x00\x04\x01\x95\x01\x75\x00\xc5\x01\xfa\x00\x65\x00\xc7\x00\x26\x00\x5c\x00\x5c\x00\x8f\x01\x99\x01\xa2\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x27\x00\x28\x00\xa3\x00\x36\xff\xca\x01\x29\x00\x2a\x00\xbd\x01\x12\x00\x36\xff\xb7\x01\x2b\x00\xa4\x00\x4b\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xc7\x00\x7e\x01\x41\x01\x16\x00\x9a\x01\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xc1\x01\x18\x00\x19\x00\x1a\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x8c\x01\x1b\x00\x66\x00\x67\x00\x5c\x00\xaf\x00\xb0\x00\xc1\x00\x16\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x17\x01\x22\x00\xee\x00\xe4\x00\x23\x00\xc2\x00\x5b\x01\x24\x00\x8d\x01\xe5\x00\x25\x00\xe6\x00\xc5\x00\xab\x01\xbf\x01\x26\x00\xe7\x00\xe8\x00\xc6\x00\x5d\x00\xa2\x00\x08\x01\x5e\x00\x2c\x01\xad\x01\x27\x00\x28\x00\xa3\x00\xa2\x00\x93\x01\x29\x00\x2a\x00\xe4\x00\x94\x01\xb2\x01\x9e\x01\x2b\x00\xa4\x00\xa5\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\x86\x01\x74\x01\x6e\x00\x4c\x00\x6f\x00\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x98\x00\x18\x00\x19\x00\x1a\x00\x9c\x01\x96\x01\x17\x00\xa8\x01\x4f\x00\x50\x00\x51\x00\xc0\x00\x4d\x00\x19\x00\x1a\x00\xb3\x01\x9d\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x8c\x01\x22\x00\x97\x01\x98\x01\x23\x00\x4e\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x23\x00\xf9\x00\x16\x01\x5d\x00\x0c\x01\xa2\x00\x5e\x00\x76\x00\x8d\x01\x17\x01\x27\x00\x28\x00\x6f\x01\x18\x01\x8e\x01\x29\x00\x2a\x00\xaf\x00\xb0\x00\xc1\x00\x57\x01\x2b\x00\x0d\x01\xfa\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xfb\x00\x9c\x01\x5e\x01\xc2\x00\xc3\x00\xe4\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\x0c\x01\x60\x01\xa2\x00\x4c\x00\x6c\x01\x17\x00\x73\x01\x74\x01\x7f\x01\x18\x01\x98\x00\x18\x00\x19\x00\x1a\x00\x9c\x01\x71\x01\x17\x00\xb9\x01\x0d\x01\x81\x01\x30\xff\x98\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x0e\x01\x17\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4d\x00\x19\x00\x1a\x00\x90\x00\x23\x00\x91\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x72\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x23\x00\x7f\x01\x2f\x00\x30\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x75\x01\xbc\x01\x5c\x00\x81\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x79\x01\xf4\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x23\x01\xfc\x00\x91\x00\xaf\x00\xb0\x00\xc1\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xb8\x00\x49\x00\xa2\x00\x4c\x00\x1e\x01\x17\x00\xc2\x00\x12\x01\xb7\x00\x32\x01\x98\x00\x18\x00\x19\x00\x1a\x00\x4c\x00\x12\x00\x17\x00\xb9\x00\x3a\x01\x40\x01\x51\x01\x15\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x25\x01\x17\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x18\x00\x19\x00\x1a\x00\x43\x01\x23\x00\xb8\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x32\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xb9\x00\x7f\x01\x33\x00\xba\x00\x23\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x7c\x01\x80\x01\x7d\x01\x81\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xa6\x00\x4f\x00\x50\x00\x51\x00\xae\x00\xad\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x9a\x00\xb5\x00\x9b\x00\xaf\x00\xb0\x00\x50\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x4b\x00\xbf\x00\xc7\x00\xdd\x00\x4c\x00\xde\x00\x17\x00\xdf\x00\xaf\x00\xb0\x00\xb1\x00\x15\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x53\x00\x17\x00\xe0\x00\xe1\x00\xb2\x00\xe2\x00\x4f\x01\x18\x00\x19\x00\x1a\x00\xaf\x00\xb0\x00\xb6\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x24\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x16\x01\x38\x00\x55\x00\x90\x00\x23\x00\x91\x00\x56\x00\x17\x01\x57\x00\x90\x00\x47\x00\x91\x00\x1a\x01\x55\xff\x64\x00\x58\x00\x59\x00\x6d\x00\x92\x00\x55\xff\x55\xff\xd2\x01\x3b\x01\xcc\x01\x55\xff\x5a\x00\x5b\x00\x1b\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x7b\x01\xcf\x01\xd0\x01\xaf\x00\x59\x01\x7f\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x55\x00\x06\x00\xc8\x01\x85\x01\x56\x00\x81\x01\x57\x00\xc9\x01\x5d\x00\x2e\x00\x1a\x01\x5e\x00\x76\x00\x58\x00\x59\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xb9\x01\xca\x01\x55\x00\x5a\x00\x5b\x00\x1b\x01\x56\x00\xbb\x01\x57\x00\x2e\x00\xb5\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x58\x00\x59\x00\x55\x00\x7b\x01\xc4\x01\x63\x01\x56\x00\xc5\x01\x57\x00\xaa\x01\x5a\x00\x5b\x00\x62\x01\xab\x01\xaf\x01\x58\x00\x59\x00\xad\x01\x0b\x00\x0c\x00\x8a\x00\x8b\x00\x8c\x00\x55\x00\x11\x00\x5a\x00\x5b\x00\x56\x00\xb1\x01\x57\x00\xb2\x01\xb5\x00\x12\x00\x2e\x00\xb5\x01\xb6\x01\x58\x00\x59\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\xb7\x01\x2e\x00\x55\x00\x7e\x01\x5a\x00\x5b\x00\x56\x00\x2e\x00\x57\x00\x84\x01\x2e\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x58\x00\x59\x00\x89\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x77\x01\x8c\x01\x55\x00\x5a\x00\x5b\x00\x91\x01\x56\x00\xa0\x01\x57\x00\x5c\x00\xa1\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x58\x00\x59\x00\x2e\x00\xa2\x01\xa5\x01\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x5a\x00\x5b\x00\x45\x01\x2e\x00\x46\x01\xd4\x01\x48\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\xaf\x00\xb0\x00\xb1\x00\x5d\x00\x5c\x00\x47\x01\x5e\x00\x42\x01\x4d\x01\x4e\x01\x2e\x00\x5c\x00\xb2\x00\x5d\x01\xb3\x00\x5e\x01\x2e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x60\x01\x0b\x00\x0c\x00\x86\x00\x64\x01\xd1\x01\x65\x01\x66\x01\xc9\x00\x67\x01\xca\x00\xcb\x00\xcc\x00\x5d\x00\xcd\x00\x12\x00\x5e\x00\xa7\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x63\x01\x68\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x69\x01\xd6\x00\x5c\x00\x6c\x01\x2e\x00\xbc\x01\xd7\x00\x71\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x79\x01\xcd\x00\x75\x00\x7b\x01\x2e\x00\xec\x00\x2e\x00\xed\x00\x11\x01\xce\x00\xcf\x00\xd0\x00\xd1\x00\x14\x01\x15\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x5d\x00\xd6\x00\x9b\x00\x5e\x00\x5f\x00\xc1\x01\xd7\x00\x1c\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x5d\x00\xcd\x00\x1d\x01\x5e\x00\x76\x00\x1e\x01\x2e\x00\x20\x01\xee\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x21\x01\x27\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x22\x01\xd6\x00\x25\x01\x28\x01\x2a\x01\xef\x00\xd7\x00\x29\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x87\x01\xcd\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xf1\x00\xf2\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x81\x00\x2f\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x30\x01\xd6\x00\x31\x01\x2e\x00\x32\x01\x34\x01\xd7\x00\x37\x01\x2e\x00\xd8\x00\x3d\x01\x40\x01\x2e\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x06\x00\x81\x00\x85\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x52\x01\x11\x00\x8f\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x94\x00\x95\x00\x12\x00\x9c\x00\x99\x00\x9d\x00\xa0\x00\x13\x00\xa1\x00\x9e\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x2e\x00\x53\x01\xa6\x01\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x52\x01\x11\x00\xa9\x00\xaa\x00\x91\x00\xa2\x00\x2c\x00\x2e\x00\xbc\x00\x12\x00\x2e\x00\x2e\x00\xdc\x00\x2e\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xaf\x00\x5a\x01\xe4\x00\x53\x01\x54\x01\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x38\x01\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x40\x00\xff\xff\x12\x00\x49\x00\x4e\x00\x4f\x00\x63\x00\x13\x00\x6b\x00\x2e\x00\x39\x01\x06\x00\x07\x00\x08\x00\x71\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x6a\x00\x11\x00\x06\x00\x07\x00\x08\x00\x92\x00\x0a\x00\x78\x00\x79\x00\x12\x00\xff\xff\x7a\x00\x0b\x00\x7f\x00\x13\x00\x6b\x00\x81\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x71\x00\x0a\x00\x06\x00\x32\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x61\x00\x12\x00\x00\x00\x00\x00\x66\x00\xa8\x01\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x66\x00\x73\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\x55\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\x11\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\xbe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xc6\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbe\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa5\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xaf\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x89\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x8a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x92\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa2\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa3\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x48\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x4a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x58\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2b\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2d\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x35\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x37\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x3e\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x85\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x89\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x8d\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbc\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xee\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x63\x00\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\xef\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x69\x01\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\xf1\x00\xf2\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x0c\x00\x87\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x0c\x00\x88\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x95\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xee\x00\x00\x00\x3d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x95\x00\x12\x00\x00\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x96\x00\x00\x00\x02\x01\x00\x00\x08\x01\x00\x00\x12\x00\x0b\x00\xac\x00\x00\x00\x09\x01\x00\x00\x0a\x01\x00\x00\x00\x00\x00\x00\x0b\x01\x05\x01\x0b\x00\x61\x00\x00\x00\x12\x00\x00\x00\xc9\x00\x00\x00\xca\x00\xcb\x00\xcc\x00\x00\x00\xcd\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x7f\x00\xee\x00\x00\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xee\x00\x00\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x12\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x02\x01\xd7\x00\xee\x00\x00\x00\xd8\x00\xef\x00\xee\x00\x00\x00\x91\x01\x00\x00\x00\x00\xee\x00\x00\x00\x6a\x01\x04\x01\x05\x01\xee\x00\x00\x00\xef\x00\x00\x00\xf1\x00\xf2\x00\xef\x00\x00\x00\x00\x00\xee\x00\xf0\x00\xef\x00\xee\x00\x00\x00\xf5\x00\x00\x00\xef\x00\xf1\x00\xf2\x00\xf8\x00\x00\x00\xf1\x00\xf2\x00\xee\x00\xfd\x00\xef\x00\xf1\x00\xf2\x00\xef\x00\xee\x00\x00\x00\xf1\x00\xf2\x00\xfe\x00\xee\x00\x00\x00\xff\x00\x00\x00\x00\x00\xef\x00\xf1\x00\xf2\x00\x00\x00\xf1\x00\xf2\x00\xef\x00\xee\x00\x00\x01\xee\x00\x00\x00\x00\x00\x02\x01\x00\x00\x01\x01\xf1\x00\xf2\x00\x00\x00\x00\x00\x00\x00\x03\x01\xf1\x00\xf2\x00\xef\x00\x00\x00\xef\x00\x04\x01\x05\x01\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x07\x01\x3a\x00\x00\x00\x00\x00\x3b\x00\xf1\x00\xf2\x00\xf1\x00\xf2\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = array (4, 241) [
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50),
+	(51 , happyReduce_51),
+	(52 , happyReduce_52),
+	(53 , happyReduce_53),
+	(54 , happyReduce_54),
+	(55 , happyReduce_55),
+	(56 , happyReduce_56),
+	(57 , happyReduce_57),
+	(58 , happyReduce_58),
+	(59 , happyReduce_59),
+	(60 , happyReduce_60),
+	(61 , happyReduce_61),
+	(62 , happyReduce_62),
+	(63 , happyReduce_63),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68),
+	(69 , happyReduce_69),
+	(70 , happyReduce_70),
+	(71 , happyReduce_71),
+	(72 , happyReduce_72),
+	(73 , happyReduce_73),
+	(74 , happyReduce_74),
+	(75 , happyReduce_75),
+	(76 , happyReduce_76),
+	(77 , happyReduce_77),
+	(78 , happyReduce_78),
+	(79 , happyReduce_79),
+	(80 , happyReduce_80),
+	(81 , happyReduce_81),
+	(82 , happyReduce_82),
+	(83 , happyReduce_83),
+	(84 , happyReduce_84),
+	(85 , happyReduce_85),
+	(86 , happyReduce_86),
+	(87 , happyReduce_87),
+	(88 , happyReduce_88),
+	(89 , happyReduce_89),
+	(90 , happyReduce_90),
+	(91 , happyReduce_91),
+	(92 , happyReduce_92),
+	(93 , happyReduce_93),
+	(94 , happyReduce_94),
+	(95 , happyReduce_95),
+	(96 , happyReduce_96),
+	(97 , happyReduce_97),
+	(98 , happyReduce_98),
+	(99 , happyReduce_99),
+	(100 , happyReduce_100),
+	(101 , happyReduce_101),
+	(102 , happyReduce_102),
+	(103 , happyReduce_103),
+	(104 , happyReduce_104),
+	(105 , happyReduce_105),
+	(106 , happyReduce_106),
+	(107 , happyReduce_107),
+	(108 , happyReduce_108),
+	(109 , happyReduce_109),
+	(110 , happyReduce_110),
+	(111 , happyReduce_111),
+	(112 , happyReduce_112),
+	(113 , happyReduce_113),
+	(114 , happyReduce_114),
+	(115 , happyReduce_115),
+	(116 , happyReduce_116),
+	(117 , happyReduce_117),
+	(118 , happyReduce_118),
+	(119 , happyReduce_119),
+	(120 , happyReduce_120),
+	(121 , happyReduce_121),
+	(122 , happyReduce_122),
+	(123 , happyReduce_123),
+	(124 , happyReduce_124),
+	(125 , happyReduce_125),
+	(126 , happyReduce_126),
+	(127 , happyReduce_127),
+	(128 , happyReduce_128),
+	(129 , happyReduce_129),
+	(130 , happyReduce_130),
+	(131 , happyReduce_131),
+	(132 , happyReduce_132),
+	(133 , happyReduce_133),
+	(134 , happyReduce_134),
+	(135 , happyReduce_135),
+	(136 , happyReduce_136),
+	(137 , happyReduce_137),
+	(138 , happyReduce_138),
+	(139 , happyReduce_139),
+	(140 , happyReduce_140),
+	(141 , happyReduce_141),
+	(142 , happyReduce_142),
+	(143 , happyReduce_143),
+	(144 , happyReduce_144),
+	(145 , happyReduce_145),
+	(146 , happyReduce_146),
+	(147 , happyReduce_147),
+	(148 , happyReduce_148),
+	(149 , happyReduce_149),
+	(150 , happyReduce_150),
+	(151 , happyReduce_151),
+	(152 , happyReduce_152),
+	(153 , happyReduce_153),
+	(154 , happyReduce_154),
+	(155 , happyReduce_155),
+	(156 , happyReduce_156),
+	(157 , happyReduce_157),
+	(158 , happyReduce_158),
+	(159 , happyReduce_159),
+	(160 , happyReduce_160),
+	(161 , happyReduce_161),
+	(162 , happyReduce_162),
+	(163 , happyReduce_163),
+	(164 , happyReduce_164),
+	(165 , happyReduce_165),
+	(166 , happyReduce_166),
+	(167 , happyReduce_167),
+	(168 , happyReduce_168),
+	(169 , happyReduce_169),
+	(170 , happyReduce_170),
+	(171 , happyReduce_171),
+	(172 , happyReduce_172),
+	(173 , happyReduce_173),
+	(174 , happyReduce_174),
+	(175 , happyReduce_175),
+	(176 , happyReduce_176),
+	(177 , happyReduce_177),
+	(178 , happyReduce_178),
+	(179 , happyReduce_179),
+	(180 , happyReduce_180),
+	(181 , happyReduce_181),
+	(182 , happyReduce_182),
+	(183 , happyReduce_183),
+	(184 , happyReduce_184),
+	(185 , happyReduce_185),
+	(186 , happyReduce_186),
+	(187 , happyReduce_187),
+	(188 , happyReduce_188),
+	(189 , happyReduce_189),
+	(190 , happyReduce_190),
+	(191 , happyReduce_191),
+	(192 , happyReduce_192),
+	(193 , happyReduce_193),
+	(194 , happyReduce_194),
+	(195 , happyReduce_195),
+	(196 , happyReduce_196),
+	(197 , happyReduce_197),
+	(198 , happyReduce_198),
+	(199 , happyReduce_199),
+	(200 , happyReduce_200),
+	(201 , happyReduce_201),
+	(202 , happyReduce_202),
+	(203 , happyReduce_203),
+	(204 , happyReduce_204),
+	(205 , happyReduce_205),
+	(206 , happyReduce_206),
+	(207 , happyReduce_207),
+	(208 , happyReduce_208),
+	(209 , happyReduce_209),
+	(210 , happyReduce_210),
+	(211 , happyReduce_211),
+	(212 , happyReduce_212),
+	(213 , happyReduce_213),
+	(214 , happyReduce_214),
+	(215 , happyReduce_215),
+	(216 , happyReduce_216),
+	(217 , happyReduce_217),
+	(218 , happyReduce_218),
+	(219 , happyReduce_219),
+	(220 , happyReduce_220),
+	(221 , happyReduce_221),
+	(222 , happyReduce_222),
+	(223 , happyReduce_223),
+	(224 , happyReduce_224),
+	(225 , happyReduce_225),
+	(226 , happyReduce_226),
+	(227 , happyReduce_227),
+	(228 , happyReduce_228),
+	(229 , happyReduce_229),
+	(230 , happyReduce_230),
+	(231 , happyReduce_231),
+	(232 , happyReduce_232),
+	(233 , happyReduce_233),
+	(234 , happyReduce_234),
+	(235 , happyReduce_235),
+	(236 , happyReduce_236),
+	(237 , happyReduce_237),
+	(238 , happyReduce_238),
+	(239 , happyReduce_239),
+	(240 , happyReduce_240),
+	(241 , happyReduce_241)
+	]
+
+happy_n_terms = 83 :: Int
+happy_n_nonterms = 74 :: Int
+
+happyReduce_4 = happySpecReduce_1  0# happyReduction_4
+happyReduction_4 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> 
+	happyIn7
+		 ((read happy_var_1) :: Integer
+	)}
+
+happyReduce_5 = happySpecReduce_1  1# happyReduction_5
+happyReduction_5 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> 
+	happyIn8
+		 (happy_var_1
+	)}
+
+happyReduce_6 = happySpecReduce_1  2# happyReduction_6
+happyReduction_6 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> 
+	happyIn9
+		 ((read happy_var_1) :: Double
+	)}
+
+happyReduce_7 = happySpecReduce_1  3# happyReduction_7
+happyReduction_7 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (PIdent (mkPosToken happy_var_1)
+	)}
+
+happyReduce_8 = happySpecReduce_1  4# happyReduction_8
+happyReduction_8 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (T_LString happy_var_1)) -> 
+	happyIn11
+		 (LString (happy_var_1)
+	)}
+
+happyReduce_9 = happySpecReduce_1  5# happyReduction_9
+happyReduction_9 happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	happyIn12
+		 (Gr (reverse happy_var_1)
+	)}
+
+happyReduce_10 = happySpecReduce_0  6# happyReduction_10
+happyReduction_10  =  happyIn13
+		 ([]
+	)
+
+happyReduce_11 = happySpecReduce_2  6# happyReduction_11
+happyReduction_11 happy_x_2
+	happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	case happyOut14 happy_x_2 of { happy_var_2 -> 
+	happyIn13
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_12 = happySpecReduce_2  7# happyReduction_12
+happyReduction_12 happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	happyIn14
+		 (happy_var_1
+	)}
+
+happyReduce_13 = happyReduce 4# 7# happyReduction_13
+happyReduction_13 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut22 happy_x_1 of { happy_var_1 -> 
+	case happyOut15 happy_x_2 of { happy_var_2 -> 
+	case happyOut16 happy_x_4 of { happy_var_4 -> 
+	happyIn14
+		 (MModule happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_14 = happySpecReduce_2  8# happyReduction_14
+happyReduction_14 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MAbstract happy_var_2
+	)}
+
+happyReduce_15 = happySpecReduce_2  8# happyReduction_15
+happyReduction_15 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MResource happy_var_2
+	)}
+
+happyReduce_16 = happySpecReduce_2  8# happyReduction_16
+happyReduction_16 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MGrammar happy_var_2
+	)}
+
+happyReduce_17 = happySpecReduce_2  8# happyReduction_17
+happyReduction_17 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MInterface happy_var_2
+	)}
+
+happyReduce_18 = happyReduce 4# 8# happyReduction_18
+happyReduction_18 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn15
+		 (MConcrete happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_19 = happyReduce 4# 8# happyReduction_19
+happyReduction_19 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn15
+		 (MInstance happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_20 = happyReduce 5# 9# happyReduction_20
+happyReduction_20 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut18 happy_x_1 of { happy_var_1 -> 
+	case happyOut20 happy_x_2 of { happy_var_2 -> 
+	case happyOut17 happy_x_4 of { happy_var_4 -> 
+	happyIn16
+		 (MBody happy_var_1 happy_var_2 (reverse happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_21 = happySpecReduce_1  9# happyReduction_21
+happyReduction_21 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn16
+		 (MNoBody happy_var_1
+	)}
+
+happyReduce_22 = happySpecReduce_3  9# happyReduction_22
+happyReduction_22 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn16
+		 (MWith happy_var_1 happy_var_3
+	)}}
+
+happyReduce_23 = happyReduce 8# 9# happyReduction_23
+happyReduction_23 (happy_x_8 `HappyStk`
+	happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	case happyOut20 happy_x_5 of { happy_var_5 -> 
+	case happyOut17 happy_x_7 of { happy_var_7 -> 
+	happyIn16
+		 (MWithBody happy_var_1 happy_var_3 happy_var_5 (reverse happy_var_7)
+	) `HappyStk` happyRest}}}}
+
+happyReduce_24 = happyReduce 5# 9# happyReduction_24
+happyReduction_24 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_3 of { happy_var_3 -> 
+	case happyOut19 happy_x_5 of { happy_var_5 -> 
+	happyIn16
+		 (MWithE happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_25 = happyReduce 10# 9# happyReduction_25
+happyReduction_25 (happy_x_10 `HappyStk`
+	happy_x_9 `HappyStk`
+	happy_x_8 `HappyStk`
+	happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_3 of { happy_var_3 -> 
+	case happyOut19 happy_x_5 of { happy_var_5 -> 
+	case happyOut20 happy_x_7 of { happy_var_7 -> 
+	case happyOut17 happy_x_9 of { happy_var_9 -> 
+	happyIn16
+		 (MWithEBody happy_var_1 happy_var_3 happy_var_5 happy_var_7 (reverse happy_var_9)
+	) `HappyStk` happyRest}}}}}
+
+happyReduce_26 = happySpecReduce_2  9# happyReduction_26
+happyReduction_26 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (MReuse happy_var_2
+	)}
+
+happyReduce_27 = happySpecReduce_2  9# happyReduction_27
+happyReduction_27 happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (MUnion happy_var_2
+	)}
+
+happyReduce_28 = happySpecReduce_0  10# happyReduction_28
+happyReduction_28  =  happyIn17
+		 ([]
+	)
+
+happyReduce_29 = happySpecReduce_2  10# happyReduction_29
+happyReduction_29 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut25 happy_x_2 of { happy_var_2 -> 
+	happyIn17
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_30 = happySpecReduce_2  11# happyReduction_30
+happyReduction_30 happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 (Ext happy_var_1
+	)}
+
+happyReduce_31 = happySpecReduce_0  11# happyReduction_31
+happyReduction_31  =  happyIn18
+		 (NoExt
+	)
+
+happyReduce_32 = happySpecReduce_0  12# happyReduction_32
+happyReduction_32  =  happyIn19
+		 ([]
+	)
+
+happyReduce_33 = happySpecReduce_1  12# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_34 = happySpecReduce_3  12# happyReduction_34
+happyReduction_34 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_35 = happySpecReduce_0  13# happyReduction_35
+happyReduction_35  =  happyIn20
+		 (NoOpens
+	)
+
+happyReduce_36 = happySpecReduce_3  13# happyReduction_36
+happyReduction_36 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (OpenIn happy_var_2
+	)}
+
+happyReduce_37 = happySpecReduce_1  14# happyReduction_37
+happyReduction_37 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (OName happy_var_1
+	)}
+
+happyReduce_38 = happyReduce 5# 14# happyReduction_38
+happyReduction_38 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn21
+		 (OQual happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_39 = happySpecReduce_0  15# happyReduction_39
+happyReduction_39  =  happyIn22
+		 (CMCompl
+	)
+
+happyReduce_40 = happySpecReduce_1  15# happyReduction_40
+happyReduction_40 happy_x_1
+	 =  happyIn22
+		 (CMIncompl
+	)
+
+happyReduce_41 = happySpecReduce_0  16# happyReduction_41
+happyReduction_41  =  happyIn23
+		 ([]
+	)
+
+happyReduce_42 = happySpecReduce_1  16# happyReduction_42
+happyReduction_42 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_43 = happySpecReduce_3  16# happyReduction_43
+happyReduction_43 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut23 happy_x_3 of { happy_var_3 -> 
+	happyIn23
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_44 = happySpecReduce_1  17# happyReduction_44
+happyReduction_44 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn24
+		 (IAll happy_var_1
+	)}
+
+happyReduce_45 = happyReduce 4# 17# happyReduction_45
+happyReduction_45 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn24
+		 (ISome happy_var_1 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_46 = happyReduce 5# 17# happyReduction_46
+happyReduction_46 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_4 of { happy_var_4 -> 
+	happyIn24
+		 (IMinus happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_47 = happySpecReduce_2  18# happyReduction_47
+happyReduction_47 happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefCat happy_var_2
+	)}
+
+happyReduce_48 = happySpecReduce_2  18# happyReduction_48
+happyReduction_48 happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFun happy_var_2
+	)}
+
+happyReduce_49 = happySpecReduce_2  18# happyReduction_49
+happyReduction_49 happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFunData happy_var_2
+	)}
+
+happyReduce_50 = happySpecReduce_2  18# happyReduction_50
+happyReduction_50 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefDef happy_var_2
+	)}
+
+happyReduce_51 = happySpecReduce_2  18# happyReduction_51
+happyReduction_51 happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefData happy_var_2
+	)}
+
+happyReduce_52 = happySpecReduce_2  18# happyReduction_52
+happyReduction_52 happy_x_2
+	happy_x_1
+	 =  case happyOut38 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPar happy_var_2
+	)}
+
+happyReduce_53 = happySpecReduce_2  18# happyReduction_53
+happyReduction_53 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefOper happy_var_2
+	)}
+
+happyReduce_54 = happySpecReduce_2  18# happyReduction_54
+happyReduction_54 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLincat happy_var_2
+	)}
+
+happyReduce_55 = happySpecReduce_2  18# happyReduction_55
+happyReduction_55 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLindef happy_var_2
+	)}
+
+happyReduce_56 = happySpecReduce_2  18# happyReduction_56
+happyReduction_56 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLin happy_var_2
+	)}
+
+happyReduce_57 = happySpecReduce_3  18# happyReduction_57
+happyReduction_57 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (DefPrintCat happy_var_3
+	)}
+
+happyReduce_58 = happySpecReduce_3  18# happyReduction_58
+happyReduction_58 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (DefPrintFun happy_var_3
+	)}
+
+happyReduce_59 = happySpecReduce_2  18# happyReduction_59
+happyReduction_59 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFlag happy_var_2
+	)}
+
+happyReduce_60 = happySpecReduce_2  18# happyReduction_60
+happyReduction_60 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPrintOld happy_var_2
+	)}
+
+happyReduce_61 = happySpecReduce_2  18# happyReduction_61
+happyReduction_61 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLintype happy_var_2
+	)}
+
+happyReduce_62 = happySpecReduce_2  18# happyReduction_62
+happyReduction_62 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPattern happy_var_2
+	)}
+
+happyReduce_63 = happyReduce 7# 18# happyReduction_63
+happyReduction_63 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut17 happy_x_5 of { happy_var_5 -> 
+	happyIn25
+		 (DefPackage happy_var_2 (reverse happy_var_5)
+	) `HappyStk` happyRest}}
+
+happyReduce_64 = happySpecReduce_2  18# happyReduction_64
+happyReduction_64 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefVars happy_var_2
+	)}
+
+happyReduce_65 = happySpecReduce_3  18# happyReduction_65
+happyReduction_65 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefTokenizer happy_var_2
+	)}
+
+happyReduce_66 = happySpecReduce_3  19# happyReduction_66
+happyReduction_66 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (DDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_67 = happySpecReduce_3  19# happyReduction_67
+happyReduction_67 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (DDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_68 = happyReduce 4# 19# happyReduction_68
+happyReduction_68 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn26
+		 (DPatt happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_69 = happyReduce 5# 19# happyReduction_69
+happyReduction_69 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn26
+		 (DFull happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_70 = happySpecReduce_3  20# happyReduction_70
+happyReduction_70 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn27
+		 (FDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_71 = happySpecReduce_2  21# happyReduction_71
+happyReduction_71 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut76 happy_x_2 of { happy_var_2 -> 
+	happyIn28
+		 (SimpleCatDef happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_72 = happyReduce 4# 21# happyReduction_72
+happyReduction_72 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut76 happy_x_3 of { happy_var_3 -> 
+	happyIn28
+		 (ListCatDef happy_var_2 (reverse happy_var_3)
+	) `HappyStk` happyRest}}
+
+happyReduce_73 = happyReduce 7# 21# happyReduction_73
+happyReduction_73 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut76 happy_x_3 of { happy_var_3 -> 
+	case happyOut7 happy_x_6 of { happy_var_6 -> 
+	happyIn28
+		 (ListSizeCatDef happy_var_2 (reverse happy_var_3) happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_74 = happySpecReduce_3  22# happyReduction_74
+happyReduction_74 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn29
+		 (DataDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_75 = happySpecReduce_1  23# happyReduction_75
+happyReduction_75 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (DataId happy_var_1
+	)}
+
+happyReduce_76 = happySpecReduce_3  23# happyReduction_76
+happyReduction_76 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn30
+		 (DataQId happy_var_1 happy_var_3
+	)}}
+
+happyReduce_77 = happySpecReduce_0  24# happyReduction_77
+happyReduction_77  =  happyIn31
+		 ([]
+	)
+
+happyReduce_78 = happySpecReduce_1  24# happyReduction_78
+happyReduction_78 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn31
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_79 = happySpecReduce_3  24# happyReduction_79
+happyReduction_79 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_80 = happySpecReduce_3  25# happyReduction_80
+happyReduction_80 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_3 of { happy_var_3 -> 
+	happyIn32
+		 (ParDefDir happy_var_1 happy_var_3
+	)}}
+
+happyReduce_81 = happySpecReduce_1  25# happyReduction_81
+happyReduction_81 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 (ParDefAbs happy_var_1
+	)}
+
+happyReduce_82 = happySpecReduce_2  26# happyReduction_82
+happyReduction_82 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut76 happy_x_2 of { happy_var_2 -> 
+	happyIn33
+		 (ParConstr happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_83 = happySpecReduce_2  27# happyReduction_83
+happyReduction_83 happy_x_2
+	happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_84 = happySpecReduce_3  27# happyReduction_84
+happyReduction_84 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_85 = happySpecReduce_2  28# happyReduction_85
+happyReduction_85 happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	happyIn35
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_86 = happySpecReduce_3  28# happyReduction_86
+happyReduction_86 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_87 = happySpecReduce_2  29# happyReduction_87
+happyReduction_87 happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn36
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_88 = happySpecReduce_3  29# happyReduction_88
+happyReduction_88 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut36 happy_x_3 of { happy_var_3 -> 
+	happyIn36
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_89 = happySpecReduce_2  30# happyReduction_89
+happyReduction_89 happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_90 = happySpecReduce_3  30# happyReduction_90
+happyReduction_90 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn37
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_91 = happySpecReduce_2  31# happyReduction_91
+happyReduction_91 happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	happyIn38
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_92 = happySpecReduce_3  31# happyReduction_92
+happyReduction_92 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn38
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_93 = happySpecReduce_0  32# happyReduction_93
+happyReduction_93  =  happyIn39
+		 ([]
+	)
+
+happyReduce_94 = happySpecReduce_1  32# happyReduction_94
+happyReduction_94 happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	happyIn39
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_95 = happySpecReduce_3  32# happyReduction_95
+happyReduction_95 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_3 of { happy_var_3 -> 
+	happyIn39
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_96 = happySpecReduce_1  33# happyReduction_96
+happyReduction_96 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_97 = happySpecReduce_3  33# happyReduction_97
+happyReduction_97 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn40
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_98 = happySpecReduce_1  34# happyReduction_98
+happyReduction_98 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (PIdentName happy_var_1
+	)}
+
+happyReduce_99 = happySpecReduce_3  34# happyReduction_99
+happyReduction_99 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (ListName happy_var_2
+	)}
+
+happyReduce_100 = happySpecReduce_1  35# happyReduction_100
+happyReduction_100 happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	happyIn42
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_101 = happySpecReduce_3  35# happyReduction_101
+happyReduction_101 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut42 happy_x_3 of { happy_var_3 -> 
+	happyIn42
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_102 = happySpecReduce_3  36# happyReduction_102
+happyReduction_102 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (LDDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_103 = happySpecReduce_3  36# happyReduction_103
+happyReduction_103 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (LDDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_104 = happyReduce 5# 36# happyReduction_104
+happyReduction_104 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn43
+		 (LDFull happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_105 = happySpecReduce_0  37# happyReduction_105
+happyReduction_105  =  happyIn44
+		 ([]
+	)
+
+happyReduce_106 = happySpecReduce_1  37# happyReduction_106
+happyReduction_106 happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	happyIn44
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_107 = happySpecReduce_3  37# happyReduction_107
+happyReduction_107 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_3 of { happy_var_3 -> 
+	happyIn44
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_108 = happySpecReduce_1  38# happyReduction_108
+happyReduction_108 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EPIdent happy_var_1
+	)}
+
+happyReduce_109 = happySpecReduce_3  38# happyReduction_109
+happyReduction_109 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (EConstr happy_var_2
+	)}
+
+happyReduce_110 = happySpecReduce_3  38# happyReduction_110
+happyReduction_110 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ECons happy_var_2
+	)}
+
+happyReduce_111 = happySpecReduce_1  38# happyReduction_111
+happyReduction_111 happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (ESort happy_var_1
+	)}
+
+happyReduce_112 = happySpecReduce_1  38# happyReduction_112
+happyReduction_112 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EString happy_var_1
+	)}
+
+happyReduce_113 = happySpecReduce_1  38# happyReduction_113
+happyReduction_113 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EInt happy_var_1
+	)}
+
+happyReduce_114 = happySpecReduce_1  38# happyReduction_114
+happyReduction_114 happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EFloat happy_var_1
+	)}
+
+happyReduce_115 = happySpecReduce_1  38# happyReduction_115
+happyReduction_115 happy_x_1
+	 =  happyIn45
+		 (EMeta
+	)
+
+happyReduce_116 = happySpecReduce_2  38# happyReduction_116
+happyReduction_116 happy_x_2
+	happy_x_1
+	 =  happyIn45
+		 (EEmpty
+	)
+
+happyReduce_117 = happySpecReduce_1  38# happyReduction_117
+happyReduction_117 happy_x_1
+	 =  happyIn45
+		 (EData
+	)
+
+happyReduce_118 = happyReduce 4# 38# happyReduction_118
+happyReduction_118 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut53 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (EList happy_var_2 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_119 = happySpecReduce_3  38# happyReduction_119
+happyReduction_119 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut8 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (EStrings happy_var_2
+	)}
+
+happyReduce_120 = happySpecReduce_3  38# happyReduction_120
+happyReduction_120 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut44 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ERecord happy_var_2
+	)}
+
+happyReduce_121 = happySpecReduce_3  38# happyReduction_121
+happyReduction_121 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut67 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ETuple happy_var_2
+	)}
+
+happyReduce_122 = happyReduce 4# 38# happyReduction_122
+happyReduction_122 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (EIndir happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_123 = happyReduce 5# 38# happyReduction_123
+happyReduction_123 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut50 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn45
+		 (ETyped happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_124 = happySpecReduce_3  38# happyReduction_124
+happyReduction_124 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (happy_var_2
+	)}
+
+happyReduce_125 = happySpecReduce_1  38# happyReduction_125
+happyReduction_125 happy_x_1
+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (ELString happy_var_1
+	)}
+
+happyReduce_126 = happySpecReduce_3  39# happyReduction_126
+happyReduction_126 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	case happyOut58 happy_x_3 of { happy_var_3 -> 
+	happyIn46
+		 (EProj happy_var_1 happy_var_3
+	)}}
+
+happyReduce_127 = happyReduce 5# 39# happyReduction_127
+happyReduction_127 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn46
+		 (EQConstr happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_128 = happyReduce 4# 39# happyReduction_128
+happyReduction_128 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn46
+		 (EQCons happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_129 = happySpecReduce_1  39# happyReduction_129
+happyReduction_129 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn46
+		 (happy_var_1
+	)}
+
+happyReduce_130 = happySpecReduce_2  40# happyReduction_130
+happyReduction_130 happy_x_2
+	happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (EApp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_131 = happyReduce 4# 40# happyReduction_131
+happyReduction_131 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut70 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (ETable happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_132 = happyReduce 5# 40# happyReduction_132
+happyReduction_132 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut45 happy_x_2 of { happy_var_2 -> 
+	case happyOut70 happy_x_4 of { happy_var_4 -> 
+	happyIn47
+		 (ETTable happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_133 = happyReduce 5# 40# happyReduction_133
+happyReduction_133 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut45 happy_x_2 of { happy_var_2 -> 
+	case happyOut52 happy_x_4 of { happy_var_4 -> 
+	happyIn47
+		 (EVTable happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_134 = happyReduce 6# 40# happyReduction_134
+happyReduction_134 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut50 happy_x_2 of { happy_var_2 -> 
+	case happyOut70 happy_x_5 of { happy_var_5 -> 
+	happyIn47
+		 (ECase happy_var_2 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_135 = happyReduce 4# 40# happyReduction_135
+happyReduction_135 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EVariants happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_136 = happyReduce 6# 40# happyReduction_136
+happyReduction_136 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut74 happy_x_5 of { happy_var_5 -> 
+	happyIn47
+		 (EPre happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_137 = happyReduce 4# 40# happyReduction_137
+happyReduction_137 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EStrs happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_138 = happySpecReduce_2  40# happyReduction_138
+happyReduction_138 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (EPatt happy_var_2
+	)}
+
+happyReduce_139 = happySpecReduce_3  40# happyReduction_139
+happyReduction_139 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EPattType happy_var_3
+	)}
+
+happyReduce_140 = happySpecReduce_1  40# happyReduction_140
+happyReduction_140 happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	happyIn47
+		 (happy_var_1
+	)}
+
+happyReduce_141 = happySpecReduce_2  40# happyReduction_141
+happyReduction_141 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (ELin happy_var_2
+	)}
+
+happyReduce_142 = happySpecReduce_3  41# happyReduction_142
+happyReduction_142 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (ESelect happy_var_1 happy_var_3
+	)}}
+
+happyReduce_143 = happySpecReduce_3  41# happyReduction_143
+happyReduction_143 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (ETupTyp happy_var_1 happy_var_3
+	)}}
+
+happyReduce_144 = happySpecReduce_3  41# happyReduction_144
+happyReduction_144 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (EExtend happy_var_1 happy_var_3
+	)}}
+
+happyReduce_145 = happySpecReduce_1  41# happyReduction_145
+happyReduction_145 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn48
+		 (happy_var_1
+	)}
+
+happyReduce_146 = happySpecReduce_3  42# happyReduction_146
+happyReduction_146 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	case happyOut49 happy_x_3 of { happy_var_3 -> 
+	happyIn49
+		 (EGlue happy_var_1 happy_var_3
+	)}}
+
+happyReduce_147 = happySpecReduce_1  42# happyReduction_147
+happyReduction_147 happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (happy_var_1
+	)}
+
+happyReduce_148 = happySpecReduce_3  43# happyReduction_148
+happyReduction_148 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EConcat happy_var_1 happy_var_3
+	)}}
+
+happyReduce_149 = happyReduce 4# 43# happyReduction_149
+happyReduction_149 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (EAbstr happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_150 = happyReduce 5# 43# happyReduction_150
+happyReduction_150 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn50
+		 (ECTable happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_151 = happySpecReduce_3  43# happyReduction_151
+happyReduction_151 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EProd happy_var_1 happy_var_3
+	)}}
+
+happyReduce_152 = happySpecReduce_3  43# happyReduction_152
+happyReduction_152 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (ETType happy_var_1 happy_var_3
+	)}}
+
+happyReduce_153 = happyReduce 6# 43# happyReduction_153
+happyReduction_153 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut44 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_6 of { happy_var_6 -> 
+	happyIn50
+		 (ELet happy_var_3 happy_var_6
+	) `HappyStk` happyRest}}
+
+happyReduce_154 = happyReduce 4# 43# happyReduction_154
+happyReduction_154 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut44 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (ELetb happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_155 = happyReduce 5# 43# happyReduction_155
+happyReduction_155 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (EWhere happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_156 = happyReduce 4# 43# happyReduction_156
+happyReduction_156 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut72 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EEqs happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_157 = happySpecReduce_3  43# happyReduction_157
+happyReduction_157 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_2 of { happy_var_2 -> 
+	case happyOut8 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EExample happy_var_2 happy_var_3
+	)}}
+
+happyReduce_158 = happySpecReduce_1  43# happyReduction_158
+happyReduction_158 happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 (happy_var_1
+	)}
+
+happyReduce_159 = happySpecReduce_1  44# happyReduction_159
+happyReduction_159 happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 (happy_var_1
+	)}
+
+happyReduce_160 = happySpecReduce_0  45# happyReduction_160
+happyReduction_160  =  happyIn52
+		 ([]
+	)
+
+happyReduce_161 = happySpecReduce_1  45# happyReduction_161
+happyReduction_161 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn52
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_162 = happySpecReduce_3  45# happyReduction_162
+happyReduction_162 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn52
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_163 = happySpecReduce_0  46# happyReduction_163
+happyReduction_163  =  happyIn53
+		 (NilExp
+	)
+
+happyReduce_164 = happySpecReduce_2  46# happyReduction_164
+happyReduction_164 happy_x_2
+	happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	case happyOut53 happy_x_2 of { happy_var_2 -> 
+	happyIn53
+		 (ConsExp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_165 = happySpecReduce_1  47# happyReduction_165
+happyReduction_165 happy_x_1
+	 =  happyIn54
+		 (PChar
+	)
+
+happyReduce_166 = happySpecReduce_3  47# happyReduction_166
+happyReduction_166 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut8 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PChars happy_var_2
+	)}
+
+happyReduce_167 = happySpecReduce_2  47# happyReduction_167
+happyReduction_167 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PMacro happy_var_2
+	)}
+
+happyReduce_168 = happyReduce 4# 47# happyReduction_168
+happyReduction_168 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn54
+		 (PM happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_169 = happySpecReduce_1  47# happyReduction_169
+happyReduction_169 happy_x_1
+	 =  happyIn54
+		 (PW
+	)
+
+happyReduce_170 = happySpecReduce_1  47# happyReduction_170
+happyReduction_170 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PV happy_var_1
+	)}
+
+happyReduce_171 = happySpecReduce_3  47# happyReduction_171
+happyReduction_171 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PCon happy_var_2
+	)}
+
+happyReduce_172 = happySpecReduce_3  47# happyReduction_172
+happyReduction_172 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn54
+		 (PQ happy_var_1 happy_var_3
+	)}}
+
+happyReduce_173 = happySpecReduce_1  47# happyReduction_173
+happyReduction_173 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PInt happy_var_1
+	)}
+
+happyReduce_174 = happySpecReduce_1  47# happyReduction_174
+happyReduction_174 happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PFloat happy_var_1
+	)}
+
+happyReduce_175 = happySpecReduce_1  47# happyReduction_175
+happyReduction_175 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PStr happy_var_1
+	)}
+
+happyReduce_176 = happySpecReduce_3  47# happyReduction_176
+happyReduction_176 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut60 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PR happy_var_2
+	)}
+
+happyReduce_177 = happySpecReduce_3  47# happyReduction_177
+happyReduction_177 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut68 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PTup happy_var_2
+	)}
+
+happyReduce_178 = happySpecReduce_3  47# happyReduction_178
+happyReduction_178 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (happy_var_2
+	)}
+
+happyReduce_179 = happySpecReduce_2  48# happyReduction_179
+happyReduction_179 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (PC happy_var_1 happy_var_2
+	)}}
+
+happyReduce_180 = happyReduce 4# 48# happyReduction_180
+happyReduction_180 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	case happyOut61 happy_x_4 of { happy_var_4 -> 
+	happyIn55
+		 (PQC happy_var_1 happy_var_3 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_181 = happySpecReduce_2  48# happyReduction_181
+happyReduction_181 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (PRep happy_var_1
+	)}
+
+happyReduce_182 = happySpecReduce_3  48# happyReduction_182
+happyReduction_182 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (PAs happy_var_1 happy_var_3
+	)}}
+
+happyReduce_183 = happySpecReduce_2  48# happyReduction_183
+happyReduction_183 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (PNeg happy_var_2
+	)}
+
+happyReduce_184 = happySpecReduce_1  48# happyReduction_184
+happyReduction_184 happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (happy_var_1
+	)}
+
+happyReduce_185 = happySpecReduce_3  49# happyReduction_185
+happyReduction_185 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 (PDisj happy_var_1 happy_var_3
+	)}}
+
+happyReduce_186 = happySpecReduce_3  49# happyReduction_186
+happyReduction_186 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 (PSeq happy_var_1 happy_var_3
+	)}}
+
+happyReduce_187 = happySpecReduce_1  49# happyReduction_187
+happyReduction_187 happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	happyIn56
+		 (happy_var_1
+	)}
+
+happyReduce_188 = happySpecReduce_3  50# happyReduction_188
+happyReduction_188 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn57
+		 (PA happy_var_1 happy_var_3
+	)}}
+
+happyReduce_189 = happySpecReduce_1  51# happyReduction_189
+happyReduction_189 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn58
+		 (LPIdent happy_var_1
+	)}
+
+happyReduce_190 = happySpecReduce_2  51# happyReduction_190
+happyReduction_190 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn58
+		 (LVar happy_var_2
+	)}
+
+happyReduce_191 = happySpecReduce_1  52# happyReduction_191
+happyReduction_191 happy_x_1
+	 =  happyIn59
+		 (Sort_Type
+	)
+
+happyReduce_192 = happySpecReduce_1  52# happyReduction_192
+happyReduction_192 happy_x_1
+	 =  happyIn59
+		 (Sort_PType
+	)
+
+happyReduce_193 = happySpecReduce_1  52# happyReduction_193
+happyReduction_193 happy_x_1
+	 =  happyIn59
+		 (Sort_Tok
+	)
+
+happyReduce_194 = happySpecReduce_1  52# happyReduction_194
+happyReduction_194 happy_x_1
+	 =  happyIn59
+		 (Sort_Str
+	)
+
+happyReduce_195 = happySpecReduce_1  52# happyReduction_195
+happyReduction_195 happy_x_1
+	 =  happyIn59
+		 (Sort_Strs
+	)
+
+happyReduce_196 = happySpecReduce_0  53# happyReduction_196
+happyReduction_196  =  happyIn60
+		 ([]
+	)
+
+happyReduce_197 = happySpecReduce_1  53# happyReduction_197
+happyReduction_197 happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_198 = happySpecReduce_3  53# happyReduction_198
+happyReduction_198 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	case happyOut60 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_199 = happySpecReduce_1  54# happyReduction_199
+happyReduction_199 happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn61
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_200 = happySpecReduce_2  54# happyReduction_200
+happyReduction_200 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	happyIn61
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_201 = happySpecReduce_1  55# happyReduction_201
+happyReduction_201 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn62
+		 (BPIdent happy_var_1
+	)}
+
+happyReduce_202 = happySpecReduce_1  55# happyReduction_202
+happyReduction_202 happy_x_1
+	 =  happyIn62
+		 (BWild
+	)
+
+happyReduce_203 = happySpecReduce_0  56# happyReduction_203
+happyReduction_203  =  happyIn63
+		 ([]
+	)
+
+happyReduce_204 = happySpecReduce_1  56# happyReduction_204
+happyReduction_204 happy_x_1
+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> 
+	happyIn63
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_205 = happySpecReduce_3  56# happyReduction_205
+happyReduction_205 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> 
+	case happyOut63 happy_x_3 of { happy_var_3 -> 
+	happyIn63
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_206 = happyReduce 5# 57# happyReduction_206
+happyReduction_206 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn64
+		 (DDec happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_207 = happySpecReduce_1  57# happyReduction_207
+happyReduction_207 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn64
+		 (DExp happy_var_1
+	)}
+
+happyReduce_208 = happySpecReduce_1  58# happyReduction_208
+happyReduction_208 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn65
+		 (TComp happy_var_1
+	)}
+
+happyReduce_209 = happySpecReduce_1  59# happyReduction_209
+happyReduction_209 happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	happyIn66
+		 (PTComp happy_var_1
+	)}
+
+happyReduce_210 = happySpecReduce_0  60# happyReduction_210
+happyReduction_210  =  happyIn67
+		 ([]
+	)
+
+happyReduce_211 = happySpecReduce_1  60# happyReduction_211
+happyReduction_211 happy_x_1
+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
+	happyIn67
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_212 = happySpecReduce_3  60# happyReduction_212
+happyReduction_212 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
+	case happyOut67 happy_x_3 of { happy_var_3 -> 
+	happyIn67
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_213 = happySpecReduce_0  61# happyReduction_213
+happyReduction_213  =  happyIn68
+		 ([]
+	)
+
+happyReduce_214 = happySpecReduce_1  61# happyReduction_214
+happyReduction_214 happy_x_1
+	 =  case happyOut66 happy_x_1 of { happy_var_1 -> 
+	happyIn68
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_215 = happySpecReduce_3  61# happyReduction_215
+happyReduction_215 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut66 happy_x_1 of { happy_var_1 -> 
+	case happyOut68 happy_x_3 of { happy_var_3 -> 
+	happyIn68
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_216 = happySpecReduce_3  62# happyReduction_216
+happyReduction_216 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn69
+		 (Case happy_var_1 happy_var_3
+	)}}
+
+happyReduce_217 = happySpecReduce_1  63# happyReduction_217
+happyReduction_217 happy_x_1
+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
+	happyIn70
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_218 = happySpecReduce_3  63# happyReduction_218
+happyReduction_218 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
+	case happyOut70 happy_x_3 of { happy_var_3 -> 
+	happyIn70
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_219 = happySpecReduce_3  64# happyReduction_219
+happyReduction_219 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn71
+		 (Equ happy_var_1 happy_var_3
+	)}}
+
+happyReduce_220 = happySpecReduce_0  65# happyReduction_220
+happyReduction_220  =  happyIn72
+		 ([]
+	)
+
+happyReduce_221 = happySpecReduce_1  65# happyReduction_221
+happyReduction_221 happy_x_1
+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> 
+	happyIn72
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_222 = happySpecReduce_3  65# happyReduction_222
+happyReduction_222 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> 
+	case happyOut72 happy_x_3 of { happy_var_3 -> 
+	happyIn72
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_223 = happySpecReduce_3  66# happyReduction_223
+happyReduction_223 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn73
+		 (Alt happy_var_1 happy_var_3
+	)}}
+
+happyReduce_224 = happySpecReduce_0  67# happyReduction_224
+happyReduction_224  =  happyIn74
+		 ([]
+	)
+
+happyReduce_225 = happySpecReduce_1  67# happyReduction_225
+happyReduction_225 happy_x_1
+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> 
+	happyIn74
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_226 = happySpecReduce_3  67# happyReduction_226
+happyReduction_226 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> 
+	case happyOut74 happy_x_3 of { happy_var_3 -> 
+	happyIn74
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_227 = happyReduce 5# 68# happyReduction_227
+happyReduction_227 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn75
+		 (DDDec happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_228 = happySpecReduce_1  68# happyReduction_228
+happyReduction_228 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn75
+		 (DDExp happy_var_1
+	)}
+
+happyReduce_229 = happySpecReduce_0  69# happyReduction_229
+happyReduction_229  =  happyIn76
+		 ([]
+	)
+
+happyReduce_230 = happySpecReduce_2  69# happyReduction_230
+happyReduction_230 happy_x_2
+	happy_x_1
+	 =  case happyOut76 happy_x_1 of { happy_var_1 -> 
+	case happyOut75 happy_x_2 of { happy_var_2 -> 
+	happyIn76
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_231 = happySpecReduce_2  70# happyReduction_231
+happyReduction_231 happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_1 of { happy_var_1 -> 
+	case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn77
+		 (OldGr happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_232 = happySpecReduce_0  71# happyReduction_232
+happyReduction_232  =  happyIn78
+		 (NoIncl
+	)
+
+happyReduce_233 = happySpecReduce_2  71# happyReduction_233
+happyReduction_233 happy_x_2
+	happy_x_1
+	 =  case happyOut80 happy_x_2 of { happy_var_2 -> 
+	happyIn78
+		 (Incl happy_var_2
+	)}
+
+happyReduce_234 = happySpecReduce_1  72# happyReduction_234
+happyReduction_234 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn79
+		 (FString happy_var_1
+	)}
+
+happyReduce_235 = happySpecReduce_1  72# happyReduction_235
+happyReduction_235 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn79
+		 (FPIdent happy_var_1
+	)}
+
+happyReduce_236 = happySpecReduce_2  72# happyReduction_236
+happyReduction_236 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FSlash happy_var_2
+	)}
+
+happyReduce_237 = happySpecReduce_2  72# happyReduction_237
+happyReduction_237 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FDot happy_var_2
+	)}
+
+happyReduce_238 = happySpecReduce_2  72# happyReduction_238
+happyReduction_238 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FMinus happy_var_2
+	)}
+
+happyReduce_239 = happySpecReduce_2  72# happyReduction_239
+happyReduction_239 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FAddId happy_var_1 happy_var_2
+	)}}
+
+happyReduce_240 = happySpecReduce_2  73# happyReduction_240
+happyReduction_240 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_1 of { happy_var_1 -> 
+	happyIn80
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_241 = happySpecReduce_3  73# happyReduction_241
+happyReduction_241 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_1 of { happy_var_1 -> 
+	case happyOut80 happy_x_3 of { happy_var_3 -> 
+	happyIn80
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyNewToken action sts stk [] =
+	happyDoAction 82# notHappyAtAll action sts stk []
+
+happyNewToken action sts stk (tk:tks) =
+	let cont i = happyDoAction i tk action sts stk tks in
+	case tk of {
+	PT _ (TS ";") -> cont 1#;
+	PT _ (TS "=") -> cont 2#;
+	PT _ (TS "{") -> cont 3#;
+	PT _ (TS "}") -> cont 4#;
+	PT _ (TS "**") -> cont 5#;
+	PT _ (TS ",") -> cont 6#;
+	PT _ (TS "(") -> cont 7#;
+	PT _ (TS ")") -> cont 8#;
+	PT _ (TS "[") -> cont 9#;
+	PT _ (TS "]") -> cont 10#;
+	PT _ (TS "-") -> cont 11#;
+	PT _ (TS ":") -> cont 12#;
+	PT _ (TS ".") -> cont 13#;
+	PT _ (TS "|") -> cont 14#;
+	PT _ (TS "%") -> cont 15#;
+	PT _ (TS "?") -> cont 16#;
+	PT _ (TS "<") -> cont 17#;
+	PT _ (TS ">") -> cont 18#;
+	PT _ (TS "!") -> cont 19#;
+	PT _ (TS "*") -> cont 20#;
+	PT _ (TS "+") -> cont 21#;
+	PT _ (TS "++") -> cont 22#;
+	PT _ (TS "\\") -> cont 23#;
+	PT _ (TS "->") -> cont 24#;
+	PT _ (TS "=>") -> cont 25#;
+	PT _ (TS "#") -> cont 26#;
+	PT _ (TS "_") -> cont 27#;
+	PT _ (TS "@") -> cont 28#;
+	PT _ (TS "$") -> cont 29#;
+	PT _ (TS "/") -> cont 30#;
+	PT _ (TS "Lin") -> cont 31#;
+	PT _ (TS "PType") -> cont 32#;
+	PT _ (TS "Str") -> cont 33#;
+	PT _ (TS "Strs") -> cont 34#;
+	PT _ (TS "Tok") -> cont 35#;
+	PT _ (TS "Type") -> cont 36#;
+	PT _ (TS "abstract") -> cont 37#;
+	PT _ (TS "case") -> cont 38#;
+	PT _ (TS "cat") -> cont 39#;
+	PT _ (TS "concrete") -> cont 40#;
+	PT _ (TS "data") -> cont 41#;
+	PT _ (TS "def") -> cont 42#;
+	PT _ (TS "flags") -> cont 43#;
+	PT _ (TS "fn") -> cont 44#;
+	PT _ (TS "fun") -> cont 45#;
+	PT _ (TS "grammar") -> cont 46#;
+	PT _ (TS "in") -> cont 47#;
+	PT _ (TS "include") -> cont 48#;
+	PT _ (TS "incomplete") -> cont 49#;
+	PT _ (TS "instance") -> cont 50#;
+	PT _ (TS "interface") -> cont 51#;
+	PT _ (TS "let") -> cont 52#;
+	PT _ (TS "lin") -> cont 53#;
+	PT _ (TS "lincat") -> cont 54#;
+	PT _ (TS "lindef") -> cont 55#;
+	PT _ (TS "lintype") -> cont 56#;
+	PT _ (TS "of") -> cont 57#;
+	PT _ (TS "open") -> cont 58#;
+	PT _ (TS "oper") -> cont 59#;
+	PT _ (TS "package") -> cont 60#;
+	PT _ (TS "param") -> cont 61#;
+	PT _ (TS "pattern") -> cont 62#;
+	PT _ (TS "pre") -> cont 63#;
+	PT _ (TS "printname") -> cont 64#;
+	PT _ (TS "resource") -> cont 65#;
+	PT _ (TS "reuse") -> cont 66#;
+	PT _ (TS "strs") -> cont 67#;
+	PT _ (TS "table") -> cont 68#;
+	PT _ (TS "tokenizer") -> cont 69#;
+	PT _ (TS "type") -> cont 70#;
+	PT _ (TS "union") -> cont 71#;
+	PT _ (TS "var") -> cont 72#;
+	PT _ (TS "variants") -> cont 73#;
+	PT _ (TS "where") -> cont 74#;
+	PT _ (TS "with") -> cont 75#;
+	PT _ (TI happy_dollar_dollar) -> cont 76#;
+	PT _ (TL happy_dollar_dollar) -> cont 77#;
+	PT _ (TD happy_dollar_dollar) -> cont 78#;
+	PT _ (T_PIdent _) -> cont 79#;
+	PT _ (T_LString happy_dollar_dollar) -> cont 80#;
+	_ -> cont 81#;
+	_ -> happyError' (tk:tks)
+	}
+
+happyError_ tk tks = happyError' (tk:tks)
+
+happyThen :: () => Err a -> (a -> Err b) -> Err b
+happyThen = (thenM)
+happyReturn :: () => a -> Err a
+happyReturn = (returnM)
+happyThen1 m k tks = (thenM) m (\a -> k a tks)
+happyReturn1 :: () => a -> b -> Err a
+happyReturn1 = \a tks -> (returnM) a
+happyError' :: () => [Token] -> Err a
+happyError' = happyError
+
+pGrammar tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut12 x))
+
+pModDef tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut14 x))
+
+pOldGrammar tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut77 x))
+
+pExp tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut50 x))
+
+happySeq = happyDontSeq
+
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+happyError ts =
+  Bad $ "syntax error at " ++ tokenPos ts ++ 
+  case ts of
+    [] -> []
+    [Err _] -> " due to lexer error"
+    _ -> " before " ++ unwords (map prToken (take 4 ts))
+
+myLexer = tokens
+{-# LINE 1 "GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command line>" #-}
+{-# LINE 1 "GenericTemplate.hs" #-}
+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
+
+{-# LINE 28 "GenericTemplate.hs" #-}
+
+
+data Happy_IntList = HappyCons Int# Happy_IntList
+
+
+
+
+
+{-# LINE 49 "GenericTemplate.hs" #-}
+
+{-# LINE 59 "GenericTemplate.hs" #-}
+
+{-# LINE 68 "GenericTemplate.hs" #-}
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is 0#, it means we've just accepted a partial
+-- parse (a %partial parser).  We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+	happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) = 
+	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+
+
+happyDoAction i tk st
+	= {- nothing -}
+
+
+	  case action of
+		0#		  -> {- nothing -}
+				     happyFail i tk st
+		-1# 	  -> {- nothing -}
+				     happyAccept i tk st
+		n | (n <# (0# :: Int#)) -> {- nothing -}
+
+				     (happyReduceArr ! rule) i tk st
+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where new_state = (n -# (1# :: Int#))
+   where off    = indexShortOffAddr happyActOffsets st
+	 off_i  = (off +# i)
+	 check  = if (off_i >=# (0# :: Int#))
+			then (indexShortOffAddr happyCheck off_i ==#  i)
+			else False
+ 	 action | check     = indexShortOffAddr happyTable off_i
+		| otherwise = indexShortOffAddr happyDefActions st
+
+{-# LINE 127 "GenericTemplate.hs" #-}
+
+
+indexShortOffAddr (HappyA# arr) off =
+#if __GLASGOW_HASKELL__ > 500
+	narrow16Int# i
+#elif __GLASGOW_HASKELL__ == 500
+	intToInt16# i
+#else
+	(i `iShiftL#` 16#) `iShiftRA#` 16#
+#endif
+  where
+#if __GLASGOW_HASKELL__ >= 503
+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+#else
+	i = word2Int# ((high `shiftL#` 8#) `or#` low)
+#endif
+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+	off' = off *# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 170 "GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in
+--     trace "shifting the error token" $
+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
+
+happyShift new_state i tk st sts stk =
+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_0 nt fn j tk st@((action)) sts stk
+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
+
+happySpecReduce_1 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
+     = let r = fn v1 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_2 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
+     = let r = fn v1 v2 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_3 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
+     = let r = fn v1 v2 v3 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happyReduce k i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyReduce k nt fn j tk st sts stk
+     = case happyDrop (k -# (1# :: Int#)) sts of
+	 sts1@((HappyCons (st1@(action)) (_))) ->
+        	let r = fn stk in  -- it doesn't hurt to always seq here...
+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonadReduce k nt fn j tk st sts stk =
+        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+happyMonad2Reduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonad2Reduce k nt fn j tk st sts stk =
+       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+             off    = indexShortOffAddr happyGotoOffsets st1
+             off_i  = (off +# nt)
+             new_state = indexShortOffAddr happyTable off_i
+
+
+
+
+happyDrop 0# l = l
+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs
+
+-----------------------------------------------------------------------------
+-- Moving to a new state after a reduction
+
+
+happyGoto nt j tk st = 
+   {- nothing -}
+   happyDoAction j tk new_state
+   where off    = indexShortOffAddr happyGotoOffsets st
+	 off_i  = (off +# nt)
+ 	 new_state = indexShortOffAddr happyTable off_i
+
+
+
+
+-----------------------------------------------------------------------------
+-- Error recovery (0# is the error token)
+
+-- parse error if we are in recovery and we fail again
+happyFail  0# tk old_st _ stk =
+--	trace "failing" $ 
+    	happyError_ tk
+
+{-  We don't need state discarding for our restricted implementation of
+    "error".  In fact, it can cause some bogus parses, so I've disabled it
+    for now --SDM
+
+-- discard a state
+happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
+						(saved_tok `HappyStk` _ `HappyStk` stk) =
+--	trace ("discarding state, depth " ++ show (length stk))  $
+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+-}
+
+-- Enter error recovery: generate an error token,
+--                       save the old token and carry on.
+happyFail  i tk (action) sts stk =
+--      trace "entering error recovery" $
+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)
+
+-- Internal happy errors:
+
+notHappyAtAll = error "Internal Happy error\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+
+happyTcHack :: Int# -> a -> a
+happyTcHack x y = y
+{-# INLINE happyTcHack #-}
+
+
+-----------------------------------------------------------------------------
+-- Seq-ing.  If the --strict flag is given, then Happy emits 
+--	happySeq = happyDoSeq
+-- otherwise it emits
+-- 	happySeq = happyDontSeq
+
+happyDoSeq, happyDontSeq :: a -> b -> b
+happyDoSeq   a b = a `seq` b
+happyDontSeq a b = b
+
+-----------------------------------------------------------------------------
+-- Don't inline any functions from the template.  GHC has a nasty habit
+-- of deciding to inline happyGoto everywhere, which increases the size of
+-- the generated parser quite a bit.
+
+
+{-# NOINLINE happyDoAction #-}
+{-# NOINLINE happyTable #-}
+{-# NOINLINE happyCheck #-}
+{-# NOINLINE happyActOffsets #-}
+{-# NOINLINE happyGotoOffsets #-}
+{-# NOINLINE happyDefActions #-}
+
+{-# NOINLINE happyShift #-}
+{-# NOINLINE happySpecReduce_0 #-}
+{-# NOINLINE happySpecReduce_1 #-}
+{-# NOINLINE happySpecReduce_2 #-}
+{-# NOINLINE happySpecReduce_3 #-}
+{-# NOINLINE happyReduce #-}
+{-# NOINLINE happyMonadReduce #-}
+{-# NOINLINE happyGoto #-}
+{-# NOINLINE happyFail #-}
+
+-- end of Happy Template.
diff --git a/src-3.0/GF/Devel/Compile/PrintGF.hs b/src-3.0/GF/Devel/Compile/PrintGF.hs
new file mode 100644
index 000000000..7eb63612a
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/PrintGF.hs
@@ -0,0 +1,481 @@
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Devel.Compile.PrintGF where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Devel.Compile.AbsGF
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+
+instance Print PIdent where
+  prt _ (PIdent (_,i)) = doc (showString i)
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+
+instance Print LString where
+  prt _ (LString i) = doc (showString i)
+
+
+
+instance Print Grammar where
+  prt i e = case e of
+   Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
+
+
+instance Print ModDef where
+  prt i e = case e of
+   MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print ModType where
+  prt i e = case e of
+   MAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
+   MResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
+   MGrammar pident -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident])
+   MInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
+   MConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+   MInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+
+
+instance Print ModBody where
+  prt i e = case e of
+   MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+   MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
+   MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
+   MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+   MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
+   MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+   MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
+   MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
+
+
+instance Print Extend where
+  prt i e = case e of
+   Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
+   NoExt  -> prPrec i 0 (concatD [])
+
+
+instance Print Opens where
+  prt i e = case e of
+   NoOpens  -> prPrec i 0 (concatD [])
+   OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
+
+
+instance Print Open where
+  prt i e = case e of
+   OName pident -> prPrec i 0 (concatD [prt 0 pident])
+   OQual pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 pident0 , doc (showString "=") , prt 0 pident , doc (showString ")")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print ComplMod where
+  prt i e = case e of
+   CMCompl  -> prPrec i 0 (concatD [])
+   CMIncompl  -> prPrec i 0 (concatD [doc (showString "incomplete")])
+
+
+instance Print Included where
+  prt i e = case e of
+   IAll pident -> prPrec i 0 (concatD [prt 0 pident])
+   ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
+   IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , doc (showString "]")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print TopDef where
+  prt i e = case e of
+   DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
+   DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
+   DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
+   DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
+   DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
+   DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
+   DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
+   DefLincat defs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 defs])
+   DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
+   DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
+   DefPrintCat defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 defs])
+   DefPrintFun defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 defs])
+   DefFlag defs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 defs])
+   DefPrintOld defs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 defs])
+   DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
+   DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
+   DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
+   DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
+   DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Def where
+  prt i e = case e of
+   DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
+   DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
+   DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
+   DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print FunDef where
+  prt i e = case e of
+   FDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print CatDef where
+  prt i e = case e of
+   SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+   ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
+   ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataDef where
+  prt i e = case e of
+   DataDef name dataconstrs -> prPrec i 0 (concatD [prt 0 name , doc (showString "=") , prt 0 dataconstrs])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataConstr where
+  prt i e = case e of
+   DataId pident -> prPrec i 0 (concatD [prt 0 pident])
+   DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print ParDef where
+  prt i e = case e of
+   ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
+   ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print ParConstr where
+  prt i e = case e of
+   ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print Name where
+  prt i e = case e of
+   PIdentName pident -> prPrec i 0 (concatD [prt 0 pident])
+   ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print LocDef where
+  prt i e = case e of
+   LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
+   LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
+   LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exp where
+  prt i e = case e of
+   EPIdent pident -> prPrec i 6 (concatD [prt 0 pident])
+   EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+   ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , doc (showString "%")])
+   ESort sort -> prPrec i 6 (concatD [prt 0 sort])
+   EString str -> prPrec i 6 (concatD [prt 0 str])
+   EInt n -> prPrec i 6 (concatD [prt 0 n])
+   EFloat d -> prPrec i 6 (concatD [prt 0 d])
+   EMeta  -> prPrec i 6 (concatD [doc (showString "?")])
+   EEmpty  -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
+   EData  -> prPrec i 6 (concatD [doc (showString "data")])
+   EList pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , prt 0 exps , doc (showString "]")])
+   EStrings str -> prPrec i 6 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+   ERecord locdefs -> prPrec i 6 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+   ETuple tuplecomps -> prPrec i 6 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
+   EIndir pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
+   ETyped exp0 exp -> prPrec i 6 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
+   EProj exp label -> prPrec i 5 (concatD [prt 5 exp , doc (showString ".") , prt 0 label])
+   EQConstr pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
+   EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+   EApp exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , prt 5 exp])
+   ETable cases -> prPrec i 4 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   ETTable exp cases -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   EVTable exp exps -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
+   ECase exp cases -> prPrec i 4 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   EVariants exps -> prPrec i 4 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+   EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
+   EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+   EPatt patt -> prPrec i 4 (concatD [doc (showString "pattern") , prt 2 patt])
+   EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , doc (showString "type") , prt 5 exp])
+   ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
+   ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
+   EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])
+   EGlue exp0 exp -> prPrec i 1 (concatD [prt 2 exp0 , doc (showString "+") , prt 1 exp])
+   EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
+   EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , prt 0 exp])
+   ECTable binds exp -> prPrec i 0 (concatD [doc (showString "\\") , doc (showString "\\") , prt 0 binds , doc (showString "=>") , prt 0 exp])
+   EProd decl exp -> prPrec i 0 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
+   ETType exp0 exp -> prPrec i 0 (concatD [prt 3 exp0 , doc (showString "=>") , prt 0 exp])
+   ELet locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 locdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
+   ELetb locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
+   EWhere exp locdefs -> prPrec i 0 (concatD [prt 3 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+   EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
+   EExample exp str -> prPrec i 0 (concatD [doc (showString "in") , prt 5 exp , prt 0 str])
+   ELString lstring -> prPrec i 6 (concatD [prt 0 lstring])
+   ELin pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exps where
+  prt i e = case e of
+   NilExp  -> prPrec i 0 (concatD [])
+   ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
+
+
+instance Print Patt where
+  prt i e = case e of
+   PChar  -> prPrec i 2 (concatD [doc (showString "?")])
+   PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+   PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
+   PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+   PW  -> prPrec i 2 (concatD [doc (showString "_")])
+   PV pident -> prPrec i 2 (concatD [prt 0 pident])
+   PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+   PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+   PInt n -> prPrec i 2 (concatD [prt 0 n])
+   PFloat d -> prPrec i 2 (concatD [prt 0 d])
+   PStr str -> prPrec i 2 (concatD [prt 0 str])
+   PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
+   PTup patttuplecomps -> prPrec i 2 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
+   PC pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
+   PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
+   PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
+   PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
+   PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
+   PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
+   PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 2 x])
+   x:xs -> (concatD [prt 2 x , prt 0 xs])
+
+instance Print PattAss where
+  prt i e = case e of
+   PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Label where
+  prt i e = case e of
+   LPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+   LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
+
+
+instance Print Sort where
+  prt i e = case e of
+   Sort_Type  -> prPrec i 0 (concatD [doc (showString "Type")])
+   Sort_PType  -> prPrec i 0 (concatD [doc (showString "PType")])
+   Sort_Tok  -> prPrec i 0 (concatD [doc (showString "Tok")])
+   Sort_Str  -> prPrec i 0 (concatD [doc (showString "Str")])
+   Sort_Strs  -> prPrec i 0 (concatD [doc (showString "Strs")])
+
+
+instance Print Bind where
+  prt i e = case e of
+   BPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+   BWild  -> prPrec i 0 (concatD [doc (showString "_")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Decl where
+  prt i e = case e of
+   DDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
+   DExp exp -> prPrec i 0 (concatD [prt 4 exp])
+
+
+instance Print TupleComp where
+  prt i e = case e of
+   TComp exp -> prPrec i 0 (concatD [prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print PattTupleComp where
+  prt i e = case e of
+   PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Case where
+  prt i e = case e of
+   Case patt exp -> prPrec i 0 (concatD [prt 0 patt , doc (showString "=>") , prt 0 exp])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Equation where
+  prt i e = case e of
+   Equ patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Altern where
+  prt i e = case e of
+   Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DDecl where
+  prt i e = case e of
+   DDDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
+   DDExp exp -> prPrec i 0 (concatD [prt 6 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print OldGrammar where
+  prt i e = case e of
+   OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
+
+
+instance Print Include where
+  prt i e = case e of
+   NoIncl  -> prPrec i 0 (concatD [])
+   Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
+
+
+instance Print FileName where
+  prt i e = case e of
+   FString str -> prPrec i 0 (concatD [prt 0 str])
+   FPIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+   FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
+   FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
+   FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
+   FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x , doc (showString ";")])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+
diff --git a/src-3.0/GF/Devel/Compile/Refresh.hs b/src-3.0/GF/Devel/Compile/Refresh.hs
new file mode 100644
index 000000000..1708761fc
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Refresh.hs
@@ -0,0 +1,118 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Refresh
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:27 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- make variable names unique by adding an integer index to each
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Refresh (
+  refreshModule,
+  refreshTerm, 
+  refreshTermN
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+
+
+-- for concrete and resource in grammar, before optimizing
+
+refreshModule :: Int -> SourceModule -> Err (SourceModule,Int)
+refreshModule k (m,mo) = do
+  (mo',(_,k')) <- appSTM (termOpModule refresh mo) (initIdStateN k)
+  return ((m,mo'),k')
+
+
+refreshTerm :: Term -> Err Term
+refreshTerm = refreshTermN 0
+
+refreshTermN :: Int -> Term -> Err Term
+refreshTermN i e = liftM snd $ refreshTermKN i e
+
+refreshTermKN :: Int -> Term -> Err (Int,Term)
+refreshTermKN i e = liftM (\ (t,(_,i)) -> (i,t)) $ 
+                    appSTM (refresh e) (initIdStateN i)
+
+refresh :: Term -> STM IdState Term
+refresh e = case e of
+
+  Vr x    -> liftM  Vr  (lookVar x)
+  Abs x b -> liftM2 Abs (refVarPlus x)  (refresh b)
+
+  Prod x a b -> do
+    a'  <- refresh a
+    x'  <- refVarPlus x
+    b'  <- refresh b
+    return $ Prod x' a' b'
+
+  Let (x,(mt,a)) b -> do
+    a'  <- refresh a
+    mt' <- case mt of
+             Just t -> refresh t >>= (return . Just) 
+             _ -> return mt
+    x'  <- refVar x
+    b'  <- refresh b
+    return (Let (x',(mt',a')) b')
+
+  R r  -> liftM R $ refreshRecord r
+
+  ExtR r s -> liftM2 ExtR (refresh r)  (refresh s)
+  
+  T i cc -> liftM2 T (refreshTInfo i) (mapM refreshCase cc)
+
+  _ -> composOp refresh e
+
+refreshCase :: (Patt,Term) -> STM IdState (Patt,Term)
+refreshCase (p,t) = liftM2 (,) (refreshPatt p) (refresh t)
+
+refreshPatt p = case p of
+  PV x    -> liftM PV     (refVarPlus x)
+  PC c ps -> liftM (PC c) (mapM refreshPatt ps)
+  PP q c ps -> liftM (PP q c) (mapM refreshPatt ps)
+  PR r    -> liftM PR     (mapPairsM refreshPatt r)
+  PT t p' -> liftM2 PT    (refresh t) (refreshPatt p')
+
+  PAs x p'   -> liftM2 PAs     (refVar x) (refreshPatt p')
+
+  PSeq p' q' -> liftM2 PSeq    (refreshPatt p') (refreshPatt q')
+  PAlt p' q' -> liftM2 PAlt    (refreshPatt p') (refreshPatt q')
+  PRep p'    -> liftM  PRep    (refreshPatt p')
+  PNeg p'    -> liftM  PNeg    (refreshPatt p')
+
+  _ -> return p
+
+refreshRecord r = case r of
+  [] -> return r
+  (x,(mt,a)):b -> do
+    a'  <- refresh a
+    mt' <- case mt of
+             Just t -> refresh t >>= (return . Just) 
+             _ -> return mt
+    b'  <- refreshRecord b
+    return $ (x,(mt',a')) : b'
+
+refreshTInfo i = case i of
+  TTyped t -> liftM TTyped $ refresh t
+  TComp t -> liftM TComp $ refresh t
+  TWild t -> liftM TWild $ refresh t
+  _ -> return i
+
+-- for abstract syntax
+
+refreshEquation :: Equation -> Err ([Patt],Term)
+refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) where
+  refr (ps,t) = liftM2 (,) (mapM refreshPatt ps) (refresh t)
+
diff --git a/src-3.0/GF/Devel/Compile/Rename.hs b/src-3.0/GF/Devel/Compile/Rename.hs
new file mode 100644
index 000000000..9ba704c19
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/Rename.hs
@@ -0,0 +1,239 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Rename
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/30 18:39:44 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.19 $
+--
+-- AR 14\/5\/2003
+-- The top-level function 'renameGrammar' does several things:
+--
+--   - extends each module symbol table by indirections to extended module
+--
+--   - changes unqualified and as-qualified imports to absolutely qualified
+--
+--   - goes through the definitions and resolves names
+--
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Rename (
+  renameModule
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+import GF.Devel.Grammar.Lookup
+import GF.Data.Operations
+
+import Control.Monad
+import qualified Data.Map as Map
+import Data.List (nub)
+import Debug.Trace (trace)
+
+{-
+-- | this gives top-level access to renaming term input in the cc command
+renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
+renameSourceTerm g m t = do
+  mo     <- lookupErr m (modules g)
+  status <- buildStatus g m mo
+  renameTerm status [] t
+-}
+
+renameModule :: GF -> SourceModule -> Err SourceModule
+renameModule gf sm@(name,mo) = case mtype mo of
+  MTInterface -> return sm
+  _ | not (isCompleteModule mo) -> return sm 
+  _ -> errIn ("renaming module" +++ prt name) $ do
+    let gf1 = gf {gfmodules = Map.insert name mo (gfmodules gf)}
+    let rename = renameTerm (gf1,sm) []
+    mo1 <- termOpModule rename mo
+    let mo2 = mo1 {mopens = nub [(i,i) | (_,i) <- mopens mo1]}
+    return (name,mo2)
+
+type RenameEnv = (GF,SourceModule)
+
+renameIdentTerm :: RenameEnv -> Term -> Err Term
+renameIdentTerm (gf, (name,mo)) trm = case trm of
+  Vr i -> looks i
+  Con i -> looks i
+  Q  m i -> getQualified m >>= look i
+  QC m i -> getQualified m >>= look i
+  _ -> return trm
+ where
+   looks i = do
+     let ts = nub [t | m <- pool, Ok t <- [look i m]]
+     case ts of
+       [t] -> return t 
+       [] | elem i [IC "Int",IC "Float",IC "String"] -> ---- do this better
+            return (Q (IC "PredefAbs") i)
+       [] -> prtBad "identifier not found" i
+       t:_ -> 
+         trace (unwords $ "WARNING":"identifier":prt i:"ambiguous:" : map prt ts) 
+               (return t)
+----       _ -> fail $ unwords $ "identifier" : prt i : "ambiguous:" : map prt ts
+   look i m = do
+     ju <- lookupIdent gf m i
+     return $ case jform ju of
+       JLink -> if isConstructor ju then QC (jlink ju) i else Q (jlink ju) i
+       _     -> if isConstructor ju then QC m i else Q m i
+   pool = nub $ name :
+                maybe name id (interfaceName mo) : 
+                IC "Predef" : 
+                map fst (mextends mo) ++ 
+                map snd (mopens mo) 
+   getQualified m = case Map.lookup m qualifMap of
+     Just n -> return n
+     _ -> prtBad "unknown qualifier" m
+   qualifMap = Map.fromList $ 
+     mopens mo ++ 
+     concat [ops | (_,ops) <- minstances mo] ++ 
+     [(m,m) | m <- pool]
+     ---- TODO: check uniqueness of these names
+
+renameTerm :: RenameEnv -> [Ident] -> Term -> Err Term
+renameTerm env vars = ren vars where
+  ren vs trm = case trm of
+    Abs x b    -> liftM  (Abs x) (ren (x:vs) b)
+    Prod x a b -> liftM2 (Prod x) (ren vs a) (ren (x:vs) b)
+    Typed a b  -> liftM2 Typed (ren vs a) (ren vs b)
+    Vr x      
+      | elem x vs -> return trm
+      | otherwise -> renid trm
+    Con _  -> renid trm
+    Q _ _  -> renid trm
+    QC _ _ -> renid trm
+    Eqs eqs -> liftM Eqs $ mapM (renameEquation env vars) eqs
+    T i cs -> do
+      i' <- case i of
+        TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source
+        _ -> return i
+      liftM (T i') $ mapM (renCase vs) cs  
+
+    Let (x,(m,a)) b -> do
+      m' <- case m of
+        Just ty -> liftM Just $ ren vs ty
+        _ -> return m
+      a' <- ren vs a
+      b' <- ren (x:vs) b
+      return $ Let (x,(m',a')) b'
+
+    P t@(Vr r) l                     -- for constant t we know it is projection
+      | elem r vs -> return trm                           -- var proj first
+      | otherwise -> case renid (Q r (label2ident l)) of  -- qualif   second
+          Ok t -> return t
+          _ -> case liftM (flip P l) $ renid t of
+            Ok t -> return t                              -- const proj last
+            _ -> prtBad "unknown qualified constant" trm
+
+    EPatt p -> do
+      (p',_) <- renpatt p
+      return $ EPatt p'
+
+    _ -> composOp (ren vs) trm
+
+  renid = renameIdentTerm env
+  renCase vs (p,t) = do
+    (p',vs') <- renpatt p
+    t' <- ren (vs' ++ vs) t
+    return (p',t')
+  renpatt = renamePattern env
+
+-- | vars not needed in env, since patterns always overshadow old vars
+renamePattern :: RenameEnv -> Patt -> Err (Patt,[Ident])
+renamePattern env patt = case patt of
+
+  PMacro c -> do
+    c' <- renid $ Vr c
+    case c' of
+      Q p d -> renp $ PM p d
+      _ -> prtBad "unresolved pattern" patt
+
+  PC c ps -> do
+    c' <- renid $ Vr c
+    case c' of
+      QC p d -> renp $ PP p d ps
+      Q  p d -> renp $ PP p d ps
+      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
+
+  PP p c ps -> do
+
+    (p', c') <- case renid (QC p c) of
+      Ok (QC p' c') -> return (p',c')
+      _ -> return (p,c) --- temporarily, for bw compat
+    psvss <- mapM renp ps
+    let (ps',vs) = unzip psvss
+    return (PP p' c' ps', concat vs)
+
+  PV x -> case renid (Vr x) of
+    Ok (QC m c) -> return (PP m c [],[])
+    _    -> return (patt, [x])
+
+  PR r -> do
+    let (ls,ps) = unzip r
+    psvss <- mapM renp ps
+    let (ps',vs') = unzip psvss
+    return (PR (zip ls ps'), concat vs') 
+
+  PAlt p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PAlt p' q', vs ++ ws)
+
+  PSeq p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PSeq p' q', vs ++ ws)
+
+  PRep p -> do
+    (p',vs) <- renp p
+    return (PRep p', vs)
+
+  PNeg p -> do
+    (p',vs) <- renp p
+    return (PNeg p', vs)
+
+  PAs x p -> do
+    (p',vs) <- renp p
+    return (PAs x p', x:vs)
+
+  _ -> return (patt,[])
+
+ where 
+   renp  = renamePattern env
+   renid = renameIdentTerm env
+
+renameParam :: RenameEnv -> (Ident, Context) -> Err (Ident, Context)
+renameParam env (c,co) = do
+  co' <- renameContext env co
+  return (c,co')
+
+renameContext :: RenameEnv -> Context -> Err Context
+renameContext b = renc [] where
+  renc vs cont = case cont of
+    (x,t) : xts 
+      | isWildIdent x -> do
+          t'   <- ren vs t
+          xts' <- renc vs xts
+          return $ (x,t') : xts'
+      | otherwise -> do
+          t'   <- ren vs t
+          let vs' = x:vs
+          xts' <- renc vs' xts
+          return $ (x,t') : xts'
+    _ -> return cont
+  ren = renameTerm b
+
+-- | vars not needed in env, since patterns always overshadow old vars
+renameEquation :: RenameEnv -> [Ident] -> Equation -> Err Equation
+renameEquation b vs (ps,t) = do
+  (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
+  t'        <- renameTerm b (concat vs' ++ vs) t
+  return (ps',t')
+
diff --git a/src-3.0/GF/Devel/Compile/SourceToGF.hs b/src-3.0/GF/Devel/Compile/SourceToGF.hs
new file mode 100644
index 000000000..a62179c18
--- /dev/null
+++ b/src-3.0/GF/Devel/Compile/SourceToGF.hs
@@ -0,0 +1,679 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Compile.SourceToGF ( 
+  transGrammar,
+  transModDef,
+  transExp,
+----  transOldGrammar,
+----  transInclude,
+  newReservedWords
+  ) where
+
+import qualified GF.Devel.Grammar.Grammar as G
+import GF.Devel.Grammar.Construct
+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.Compile.AbsGF
+import GF.Devel.Compile.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 G.GF
+transGrammar x = case x of
+  Gr moddefs  -> do
+    moddefs' <- mapM transModDef moddefs
+    let mos = Map.fromList moddefs'
+    return $ emptyGF {G.gfmodules = mos}
+
+transModDef :: ModDef -> Err (Ident, G.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, G.MTAbstract, id')
+      MGrammar id -> mkModRes id G.MTGrammar body 
+      MResource id -> mkModRes id G.MTGrammar body 
+      MConcrete id open -> do
+        id'   <- transIdent id
+        open' <- transIdent open
+        return (transCncDef, G.MTConcrete open', id')
+      MInterface id -> mkModRes id G.MTInterface body
+      MInstance id open -> do
+        open' <- transIdent open
+        mkModRes id (G.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,d) | Left ds <- defs0, (i,d) <- ds]
+        let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
+        return (id', G.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,d) | Left ds <- defs0, (i,d) <- ds]
+        let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
+        return (id', G.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,G.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, G.MInclude)
+transIncludedExt x = case x of
+  IAll i       -> liftM2 (,) (transIdent i) (return G.MIAll)
+  ISome  i ids -> liftM2 (,) (transIdent i) (liftM G.MIOnly   $ mapM transIdent ids)
+  IMinus i ids -> liftM2 (,) (transIdent i) (liftM G.MIExcept $ mapM transIdent ids)
+
+transAbsDef :: TopDef -> Err (Either [(Ident,G.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, G.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 = mkProd (cont ++ genericReplicate size cd) lc
+	   nilfund = (baseId, absFun niltyp) ---- (yes niltyp) (yes G.EData))
+	   constyp = 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,G.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
+  _ -> return $ Left [] ----
+----  _ -> Bad $ "illegal definition form in resource" +++ printTree x
+ where
+
+   mkParamDefs (p,pars) =
+     if null pars 
+       then [(p,addJType M.meta0 (emptyJudgement G.JParam))]  -- in an interface
+       else (p,resParam p pars) : paramConstructors p pars
+
+   mkOverload (c,j) = case (G.jtype j, G.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,G.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]
+-}
+  _ -> return $ Left [] ----
+----  _ -> 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 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
+
+  EPattType typ -> liftM G.EPattType (transExp typ)
+  EPatt patt -> liftM G.EPatt (transPatt patt)
+
+  ELString (LString str) -> return $ G.K str 
+----  ELin id -> liftM G.LiT $ transIdent id
+
+  EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
+  EData -> return G.EData
+
+  _ -> 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
+  PChar -> return G.PChar
+  PChars s -> return $ G.PChars s
+  PMacro c -> liftM G.PMacro $ transIdent c
+  PM m c   -> liftM2 G.PM (transIdent m) (transIdent c)
+  PW  -> return wildPatt
+  PV (PIdent (_,"_"))  -> return 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 (PIdent (_,"_")) -> return identW
+  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)
diff --git a/src-3.0/GF/Devel/Compute.hs b/src-3.0/GF/Devel/Compute.hs
new file mode 100644
index 000000000..a9081c28a
--- /dev/null
+++ b/src-3.0/GF/Devel/Compute.hs
@@ -0,0 +1,455 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Compute
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 15:39:12 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.19 $
+--
+-- Computation of source terms. Used in compilation and in @cc@ command.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compute (computeConcrete, computeTerm,computeConcreteRec) where
+
+import GF.Data.Operations
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Data.Str
+import GF.Grammar.PrGrammar
+import GF.Infra.Modules
+import GF.Grammar.Macros
+import GF.Grammar.Lookup
+import GF.Grammar.Refresh
+import GF.Grammar.PatternMatch
+import GF.Grammar.Lockfield (isLockLabel) ----
+
+import GF.Grammar.AppPredefined
+
+import Data.List (nub,intersperse)
+import Control.Monad (liftM2, liftM)
+
+-- | computation of concrete syntax terms into normal form
+-- used mainly for partial evaluation
+computeConcrete :: SourceGrammar -> Term -> Err Term
+computeConcrete    g t = {- refreshTerm t >>= -} computeTerm g [] t
+computeConcreteRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t
+
+computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term
+computeTerm = computeTermOpt False
+
+-- rec=True is used if it cannot be assumed that looked-up constants
+-- have already been computed (mainly with -optimize=noexpand in .gfr)
+
+computeTermOpt :: Bool -> SourceGrammar -> Substitution -> Term -> Err Term
+computeTermOpt rec gr = comput True where
+
+   comput full g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
+              case t of
+
+     Q (IC "Predef") _ -> return t
+     Q p c -> look p c 
+
+     -- if computed do nothing
+     Computed t' -> return $ unComputed t'
+
+     Vr x -> do
+       t' <- maybe (prtBad ("no value given to variable") x) return $ lookup x g
+       case t' of 
+         _ | t == t' -> return t
+         _ -> comp g t'
+
+     -- Abs x@(IA _) b -> do 
+     Abs x b | full -> do 
+       let (xs,b1) = termFormCnc t   
+       b' <- comp ([(x,Vr x) | x <- xs] ++ g) b1
+       return $ mkAbs xs b'
+     --  b' <- comp (ext x (Vr x) g) b
+     --  return $ Abs x b'
+     Abs _ _ -> return t -- hnf
+
+     Let (x,(_,a)) b -> do
+       a' <- comp g a
+       comp (ext x a' g) b
+
+     Prod x a b -> do
+       a' <- comp g a
+       b' <- comp (ext x (Vr x) g) b
+       return $ Prod x a' b'
+
+     -- beta-convert
+     App f a -> case appForm t of
+      (h,as) | length as > 1 -> do
+        h' <- hnf g h
+        as' <- mapM (comp g) as
+        case h' of
+          _ | not (null [() | FV _ <- as']) -> compApp g (mkApp h' as')
+          c@(QC _ _) -> do
+            return $ mkApp c as'
+          Q (IC "Predef") f -> do     
+            (t',b) <- appPredefined (mkApp h' as')
+            if b then return t' else comp g t'
+
+          Abs _ _ -> do
+            let (xs,b) = termFormCnc h'
+            let g' = (zip xs as') ++ g
+            let as2 = drop (length xs) as'
+            let xs2 = drop (length as') xs
+            b' <- comp g' (mkAbs xs2 b)
+            if null as2 then return b' else comp g (mkApp b' as2)
+
+          _ -> compApp g (mkApp h' as')
+      _ -> compApp g t
+
+     P t l | isLockLabel l -> return $ R [] 
+     ---- a workaround 18/2/2005: take this away and find the reason
+     ---- why earlier compilation destroys the lock field
+
+
+     P t l  -> do
+       t' <- comp g t
+       case t' of
+         FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants
+         R r   -> maybe (prtBad "no value for label" l) (comp g . snd) $ 
+                    lookup l $ reverse r 
+
+         ExtR a (R b) ->                 
+           case comp g (P (R b) l) of
+             Ok v -> return v
+             _ -> comp g (P a l)
+
+--- { - --- this is incorrect, since b can contain the proper value
+         ExtR (R a) b ->                 -- NOT POSSIBLE both a and b records!
+           case comp g (P (R a) l) of
+             Ok v -> return v
+             _ -> comp g (P b l)
+--- - } ---
+
+         Alias _ _ r -> comp g (P r l)
+
+         S (T i cs) e -> prawitz g i (flip P l) cs e
+         S (V i cs) e -> prawitzV g i (flip P l) cs e
+
+         _   -> returnC $ P t' l
+
+     PI t l i -> comp g $ P t l -----
+
+     S t@(T ti cc) v -> do
+       v'     <- comp g v
+       case v' of
+         FV vs -> do
+           ts' <- mapM (comp g . S t) vs
+           return $ variants ts' 
+         _ -> case ti of
+{-
+           TComp _  -> do
+             case term2patt v' of
+               Ok p' -> case lookup p' cc of
+                 Just u -> comp g u
+                 _ -> do
+                   t' <- comp g t
+                   return $ S t' v' -- if v' is not canonical
+               _ -> do
+                  t' <- comp g t
+                  return $ S t' v'
+-}
+           _ -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+             _ -> do
+               t' <- comp g t
+               return $ S t' v' -- if v' is not canonical
+
+
+     S t v -> do
+
+      t'     <- case t of
+--        T _ _ -> return t
+--        V _ _ -> return t
+        _ -> comp g t
+
+      v'     <- comp g v
+
+      case v' of
+       FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants        
+       _ -> case t' of
+         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
+
+         T _ [(PV IW,c)] -> comp g c           --- an optimization
+         T _ [(PT _ (PV IW),c)] -> comp g c
+
+         T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
+         T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
+
+         -- course-of-values table: look up by index, no pattern matching needed
+         V ptyp ts -> do
+           vs <- allParamValues gr ptyp
+           case lookup v' (zip vs [0 .. length vs - 1]) of
+             Just i -> comp g $ ts !! i
+-----             _ -> prtBad "selection" $ S t' v' -- debug
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         T (TComp _) cs -> do
+           case term2patt v' of
+             Ok p' -> case lookup p' cs of
+               Just u -> comp g u
+               _ -> return $ S t' v' -- if v' is not canonical
+             _ -> return $ S t' v'
+
+         T _ cc -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         Alias _ _ d -> comp g (S d v')
+
+         S (T i cs) e -> prawitz g i (flip S v') cs e
+         S (V i cs) e -> prawitzV g i (flip S v') cs e
+         _    -> returnC $ S t' v'
+
+     -- normalize away empty tokens
+     K "" -> return Empty
+
+     -- glue if you can
+     Glue x0 y0 -> do
+       x <- comp g x0
+       y <- comp g y0
+       case (x,y) of
+         (FV ks,_)         -> do
+           kys <- mapM (comp g . flip Glue y) ks
+           return $ variants kys
+         (_,FV ks)         -> do
+           xks <- mapM (comp g . Glue x) ks
+           return $ variants xks
+
+         (Alias _ _ d, y)  -> comp g $ Glue d y
+         (x, Alias _ _ d)  -> comp g $ Glue x d
+
+         (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e
+         (s, S (T i cs) e) -> prawitz g i (Glue s) cs e
+         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e
+         (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e
+         (_,Empty)         -> return x
+         (Empty,_)         -> return y
+         (K a, K b)        -> return $ K (a ++ b)
+         (_, Alts (d,vs)) -> do
+----         (K a, Alts (d,vs)) -> do
+            let glx = Glue x
+            comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs])
+         (Alts _, ka) -> checks [do
+            y' <- strsFromTerm ka
+----         (Alts _, K a) -> checks [do
+            x' <- strsFromTerm x -- this may fail when compiling opers
+            return $ variants [
+              foldr1 C (map K (str2strings (glueStr v u))) | v <- x', u <- y']
+----              foldr1 C (map K (str2strings (glueStr v (str a)))) | v <- x']
+           ,return $ Glue x y
+           ]
+         (C u v,_) -> comp g $ C u (Glue v y)
+
+         _ -> do
+           mapM_ checkNoArgVars [x,y]
+           r <- composOp (comp g) t
+           returnC r
+
+     Alts _ -> do
+       r <- composOp (comp g) t
+       returnC r
+
+     -- remove empty
+     C a b    -> do
+       a' <- comp g a
+       b' <- comp g b
+       case (a',b') of
+         (Alts _, K a) -> checks [do
+            as <- strsFromTerm a' -- this may fail when compiling opers
+            return $ variants [
+              foldr1 C (map K (str2strings (plusStr v (str a)))) | v <- as]
+            ,
+            return $ C a' b'
+           ]
+         (Empty,_) -> returnC b'
+         (_,Empty) -> returnC a'
+         _     -> returnC $ C a' b'
+
+     -- reduce free variation as much as you can
+     FV ts -> mapM (comp g) ts >>= returnC . variants
+
+     -- merge record extensions if you can
+     ExtR r s -> do
+       r' <- comp g r
+       s' <- comp g s
+       case (r',s') of
+         (Alias _ _ d, _)  -> comp g $ ExtR d s'
+         (_, Alias _ _ d)  -> comp g $ Glue r' d
+
+         (R rs, R ss) -> plusRecord r' s'
+         (RecType rs, RecType ss) -> plusRecType r' s'
+         _ -> return $ ExtR r' s'
+
+     -- case-expand tables
+     -- if already expanded, don't expand again
+     T i@(TComp ty) cs -> do
+       -- if there are no variables, don't even go inside
+       cs' <- if (null g) then return cs else mapPairsM (comp g) cs
+----       return $ V ty (map snd cs')
+       return $ T i cs'
+     --- this means some extra work; should implement TSh directly
+     TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps]
+
+     T i cs -> do
+       pty0 <- getTableType i
+       ptyp <- comp g pty0
+       case allParamValues gr ptyp of
+         Ok vs -> do
+
+           ps0  <- mapM (compPatternMacro . fst) cs
+           cs'  <- mapM (compBranchOpt g) (zip ps0 (map snd cs))
+           sts  <- mapM (matchPattern cs') vs 
+           ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
+           ps   <- mapM term2patt vs
+           let ps' = ps --- PT ptyp (head ps) : tail ps
+----           return $ V ptyp ts -- to save space, just course of values
+           return $ T (TComp ptyp) (zip ps' ts)
+         _ -> do
+           cs' <- mapM (compBranch g) cs
+           return $ T i cs'  -- happens with variable types
+
+     Alias c a d -> do
+       d' <- comp g d
+       return $ Alias c a d'  -- alias only disappears in certain redexes
+
+     -- otherwise go ahead
+     _ -> composOp (comp g) t >>= returnC
+
+    where
+
+     compApp g (App f a) = do
+       f' <- hnf g f
+       a' <- comp g a
+       case (f',a') of
+         (Abs x b, FV as) -> 
+           mapM (\c -> comp (ext x c g) b) as >>= return . variants
+         (_, FV as)  -> mapM (\c -> comp g (App f' c)) as >>= return . variants
+         (FV fs, _)  -> mapM (\c -> comp g (App c a')) fs >>= return . variants
+         (Abs x b,_) -> comp (ext x a' g) b
+
+         (QC _ _,_)  -> returnC $ App f' a'
+
+         (Alias _ _ d, _) -> comp g (App d a')
+
+         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e
+         (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e
+
+	 _ -> do
+           (t',b) <- appPredefined (App f' a')
+           if b then return t' else comp g t'
+
+     hnf  = comput False
+     comp = comput True
+
+     look p c
+       | rec       = lookupResDef gr p c >>= comp []
+       | otherwise = lookupResDef gr p c
+
+{-
+     look p c = case lookupResDefKind gr p c of
+       Ok (t,_) | noExpand p || rec -> comp [] t
+       Ok (t,_) -> return t
+       Bad s -> raise s
+
+     noExpand p = errVal False $ do
+       mo <- lookupModMod gr p
+       return $ case getOptVal (iOpts (flags mo)) useOptimizer of
+         Just "noexpand" -> True
+         _ -> False
+-}
+
+     ext x a g = (x,a):g
+
+     returnC = return --- . computed
+
+     variants ts = case nub ts of
+       [t] -> t
+       ts  -> FV ts
+
+     isCan v = case v of
+       Con _    -> True
+       QC _ _   -> True
+       App f a  -> isCan f && isCan a
+       R rs     -> all (isCan . snd . snd) rs
+       _        -> False
+
+     compPatternMacro p = case p of
+       PM m c -> case look m c of
+         Ok (EPatt p') -> compPatternMacro p'
+         _ -> prtBad "pattern expected as value of" p ---- should be in CheckGr
+       PAs x p -> do
+         p' <- compPatternMacro p
+         return $ PAs x p'
+       PAlt p q -> do
+         p' <- compPatternMacro p
+         q' <- compPatternMacro q
+         return $ PAlt p' q'
+       PSeq p q -> do
+         p' <- compPatternMacro p
+         q' <- compPatternMacro q
+         return $ PSeq p' q'
+       PRep p -> do
+         p' <- compPatternMacro p
+         return $ PRep p'
+       PNeg p -> do
+         p' <- compPatternMacro p
+         return $ PNeg p'
+       PR rs -> do
+         rs' <- mapPairsM compPatternMacro rs
+         return $ PR rs'
+
+       _ -> return p
+
+     compBranch g (p,v) = do
+       let g' = contP p ++ g
+       v' <- comp g' v
+       return (p,v')
+
+     compBranchOpt g c@(p,v) = case contP p of
+       [] -> return c
+       _ -> err (const (return c)) return $ compBranch g c
+
+     contP p = case p of
+       PV x -> [(x,Vr x)]
+       PC _ ps -> concatMap contP ps
+       PP _ _ ps -> concatMap contP ps
+       PT _ p -> contP p
+       PR rs -> concatMap (contP . snd) rs
+
+       PAs x p -> (x,Vr x) : contP p
+
+       PSeq p q -> concatMap contP [p,q]
+       PAlt p q -> concatMap contP [p,q]
+       PRep p   -> contP p
+       PNeg p   -> contP p
+
+       _ -> []
+
+     prawitz g i f cs e = do
+       cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs]
+       return $ S (T i cs') e
+     prawitzV g i f cs e = do
+       cs' <- mapM (comp g) [(f v) | v <- cs]
+       return $ S (V i cs') e
+
+
+-- | argument variables cannot be glued
+checkNoArgVars :: Term -> Err Term
+checkNoArgVars t = case t of
+  Vr (IA _)  -> Bad $ glueErrorMsg $ prt t 
+  Vr (IAV _) -> Bad $ glueErrorMsg $ prt t 
+  _ -> composOp checkNoArgVars t
+
+glueErrorMsg s = 
+  "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++
+  "Use Prelude.bind instead."
diff --git a/src-3.0/GF/Devel/GF.hs b/src-3.0/GF/Devel/GF.hs
new file mode 100644
index 000000000..70fddcd67
--- /dev/null
+++ b/src-3.0/GF/Devel/GF.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import GF.Devel.GFC
+import GF.Devel.GFI
+
+import System (getArgs)
+
+main :: IO ()
+main = do
+  xx <- getArgs
+  case xx of
+    "--batch":args -> mainGFC args
+    _ -> mainGFI xx
+
diff --git a/src-3.0/GF/Devel/GFC.hs b/src-3.0/GF/Devel/GFC.hs
new file mode 100644
index 000000000..27e0e3ae2
--- /dev/null
+++ b/src-3.0/GF/Devel/GFC.hs
@@ -0,0 +1,67 @@
+module GF.Devel.GFC (mainGFC) where
+-- module Main where
+
+import GF.Compile.API
+import GF.Devel.PrintGFCC
+import GF.GFCC.CId
+import GF.GFCC.DataGFCC
+import GF.GFCC.Raw.ParGFCCRaw
+import GF.GFCC.Raw.ConvertGFCC
+import GF.Devel.UseIO
+import GF.Infra.Option
+import GF.GFCC.API
+import GF.Data.ErrM
+
+import System.FilePath
+
+mainGFC :: [String] -> IO ()
+mainGFC xx = do
+  let (opts,fs) = getOptions "-" xx
+  case opts of
+    _ | oElem (iOpt "help") opts -> putStrLn usageMsg
+    _ | oElem (iOpt "-make") opts -> do
+      gfcc <- appIOE (compileToGFCC opts fs) >>= err fail return
+      let gfccFile = targetNameGFCC opts (absname gfcc)
+      outputFile gfccFile (printGFCC gfcc)
+      mapM_ (alsoPrint opts gfcc) printOptions
+
+    -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
+    _ | all ((==".gfcc") . takeExtensions) fs -> do
+      gfccs <- mapM file2gfcc fs
+      let gfcc = foldl1 unionGFCC gfccs
+      let gfccFile = targetNameGFCC opts (absname gfcc)
+      outputFile gfccFile (printGFCC gfcc)
+      mapM_ (alsoPrint opts gfcc) printOptions
+      
+    _ -> do
+      appIOE (mapM_ (batchCompile opts) (map return fs)) >>= err fail return
+      putStrLn "Done."
+
+targetName :: Options -> CId -> String
+targetName opts abs = case getOptVal opts (aOpt "target") of
+  Just n -> n
+  _ -> prIdent abs
+
+targetNameGFCC :: Options -> CId -> FilePath
+targetNameGFCC opts abs = targetName opts abs ++ ".gfcc"
+
+---- TODO: nicer and richer print options
+
+alsoPrint opts gr (opt,name) = do
+  if oElem (iOpt opt) opts 
+    then outputFile name (prGFCC opt gr)
+    else return ()
+
+outputFile :: FilePath -> String -> IO ()
+outputFile outfile output = 
+      do writeFile outfile output
+         putStrLn $ "wrote file " ++ outfile
+
+printOptions = [
+  ("haskell","GSyntax.hs"),
+  ("haskell_gadt","GSyntax.hs"),
+  ("js","grammar.js")
+  ]
+
+usageMsg = 
+  "usage: gfc (-h | --make (-noopt) (-noparse) (-target=PREFIX) (-js | -haskell | -haskell_gadt)) (-src) FILES"
diff --git a/src-3.0/GF/Devel/GFC/Main.hs b/src-3.0/GF/Devel/GFC/Main.hs
new file mode 100644
index 000000000..d9ceb8e70
--- /dev/null
+++ b/src-3.0/GF/Devel/GFC/Main.hs
@@ -0,0 +1,28 @@
+module GF.Devel.GFC.Main where
+
+import GF.Devel.GFC.Options
+
+import System.Environment
+import System.Exit
+import System.IO
+
+
+version = "X.X"
+
+main :: IO ()
+main = 
+    do args <- getArgs
+       case parseOptions args of
+         Ok (opts, files) -> 
+             case optMode opts of
+               Version  -> putStrLn $ "GF, version " ++ version
+               Help     -> putStr helpMessage
+               Compiler -> gfcMain opts files
+         Errors errs -> 
+             do mapM_ (hPutStrLn stderr) errs
+                exitFailure
+
+gfcMain :: Options -> [FilePath] -> IO ()
+gfcMain opts files = return ()
+
+
diff --git a/src-3.0/GF/Devel/GFCCInterpreter.hs b/src-3.0/GF/Devel/GFCCInterpreter.hs
new file mode 100644
index 000000000..b2b17dba7
--- /dev/null
+++ b/src-3.0/GF/Devel/GFCCInterpreter.hs
@@ -0,0 +1,28 @@
+module Main where
+
+import GF.Command.Interpreter
+import GF.Command.Commands
+import GF.GFCC.API
+import System (getArgs)
+import Data.Char (isDigit)
+
+-- Simple translation application built on GFCC. AR 7/9/2006 -- 19/9/2007
+
+main :: IO ()
+main = do
+  file:_  <- getArgs
+  grammar <- file2grammar file
+  let env = CommandEnv grammar (allCommands grammar)
+  printHelp grammar
+  loop env
+
+loop :: CommandEnv -> IO ()
+loop env = do
+  s <- getLine
+  if s == "q" then return () else do
+    interpretCommandLine env s
+    loop env
+
+printHelp grammar = do
+  putStrLn $ "languages:  " ++ unwords (languages grammar)
+  putStrLn $ "categories: " ++ unwords (categories grammar)
diff --git a/src-3.0/GF/Devel/GFCCtoHaskell.hs b/src-3.0/GF/Devel/GFCCtoHaskell.hs
new file mode 100644
index 000000000..aa3eebe58
--- /dev/null
+++ b/src-3.0/GF/Devel/GFCCtoHaskell.hs
@@ -0,0 +1,213 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GFCCtoHaskell
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 12:39:07 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- to write a GF abstract grammar into a Haskell module with translations from
+-- data objects into GF trees. Example: GSyntax for Agda.
+-- AR 11/11/1999 -- 7/12/2000 -- 18/5/2004
+-----------------------------------------------------------------------------
+
+module GF.Devel.GFCCtoHaskell (grammar2haskell, grammar2haskellGADT) where
+
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+
+import GF.Data.Operations
+import GF.Text.UTF8
+
+import Data.List --(isPrefixOf, find, intersperse)
+import qualified Data.Map as Map
+
+-- | the main function
+grammar2haskell :: GFCC -> String
+grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $  
+  haskPreamble ++ [datatypes gr', gfinstances gr']
+    where gr' = hSkeleton gr
+
+grammar2haskellGADT :: GFCC -> String
+grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $  
+  ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ 
+  haskPreamble ++ [datatypesGADT gr', gfinstances gr']
+    where gr' = hSkeleton gr
+
+-- | by this you can prefix all identifiers with stg; the default is 'G'
+gId :: OIdent -> OIdent 
+gId i = 'G':i
+
+haskPreamble =
+ [
+  "module GSyntax where",
+  "",
+  "import GF.GFCC.DataGFCC",
+  "import GF.GFCC.CId",
+  "----------------------------------------------------",
+  "-- automatic translation from GF to Haskell",
+  "----------------------------------------------------",
+  "", 
+  "class Gf a where",
+  "  gf :: a -> Exp",
+  "  fg :: Exp -> a",
+  "",
+  predefInst "GString" "String" "DTr [] (AS s) []",
+  "",
+  predefInst "GInt" "Integer" "DTr [] (AI s) []",
+  "",
+  predefInst "GFloat" "Double" "DTr [] (AF s) []",
+  "",
+  "----------------------------------------------------",
+  "-- below this line machine-generated",
+  "----------------------------------------------------",
+  ""
+ ]
+
+predefInst gtyp typ patt = 
+  "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++
+  "instance Gf" +++ gtyp +++ "where" ++++
+  "  gf (" ++ gtyp +++ "s) =" +++ patt ++++
+  "  fg t =" ++++
+  "    case t of" ++++
+  "     " +++ patt +++ " ->" +++ gtyp +++ "s" ++++
+  "      _ -> error (\"no" +++ gtyp +++ "\" ++ show t)"
+
+type OIdent = String
+
+type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
+
+datatypes, gfinstances :: (String,HSkeleton) -> String
+datatypes   = (foldr (+++++) "") . (filter (/="")) . (map hDatatype) . snd
+gfinstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance m)) g
+
+hDatatype  :: (OIdent, [(OIdent, [OIdent])]) -> String
+gfInstance :: String -> (OIdent, [(OIdent, [OIdent])]) -> String
+
+hDatatype ("Cn",_) = "" ---
+hDatatype (cat,[]) = ""
+hDatatype (cat,rules) | isListCat (cat,rules) = 
+ "newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]" 
+  +++ "deriving Show"
+hDatatype (cat,rules) =
+ "data" +++ gId cat +++ "=" ++
+ (if length rules == 1 then "" else "\n  ") +++
+ foldr1 (\x y -> x ++ "\n |" +++ y) 
+        [gId f +++ foldr (+++) "" (map gId xx) | (f,xx) <- rules] ++++
+ "  deriving Show"
+
+-- GADT version of data types
+datatypesGADT :: (String,HSkeleton) -> String
+datatypesGADT (_,skel) = 
+    unlines (concatMap hCatTypeGADT skel)
+    +++++
+    "data Tree :: * -> * where" ++++ unlines (concatMap (map ("  "++) . hDatatypeGADT) skel)
+
+hCatTypeGADT :: (OIdent, [(OIdent, [OIdent])]) -> [String]
+hCatTypeGADT (cat,rules)
+    = ["type"+++gId cat+++"="+++"Tree"+++gId cat++"_",
+       "data"+++gId cat++"_"]
+
+hDatatypeGADT :: (OIdent, [(OIdent, [OIdent])]) -> [String]
+hDatatypeGADT (cat, rules) 
+    | isListCat (cat,rules) = [gId cat+++"::"+++"["++gId (elemCat cat)++"]" +++ "->" +++ t]
+    | otherwise =
+        [ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t | (f,args) <- rules ]
+  where t = "Tree" +++ gId cat ++ "_"
+
+gfInstance m crs = hInstance m crs ++++ fInstance m crs
+
+----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004
+hInstance m (cat,[]) = "" 
+hInstance m (cat,rules) 
+ | isListCat (cat,rules) =
+  "instance Gf" +++ gId cat +++ "where" ++++
+     "  gf (" ++ gId cat +++ "[" ++ concat (intersperse "," baseVars) ++ "])" 
+           +++ "=" +++ mkRHS ("Base"++ec) baseVars ++++
+     "  gf (" ++ gId cat +++ "(x:xs)) = " 
+           ++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")] 
+-- no show for GADTs
+--     ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)" 
+ | otherwise =
+  "instance Gf" +++ gId cat +++ "where\n" ++
+  unlines [mkInst f xx | (f,xx) <- rules]
+ where
+   ec = elemCat cat
+   baseVars = mkVars (baseSize (cat,rules))
+   mkInst f xx = let xx' = mkVars (length xx) in "  gf " ++
+     (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
+     "=" +++ mkRHS f xx'
+   mkVars n = ["x" ++ show i | i <- [1..n]]
+   mkRHS f vars = "DTr [] (AC (CId \"" ++ f ++ "\"))" +++ 
+		   "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
+
+
+----fInstance m ("Cn",_) = "" ---
+fInstance m (cat,[]) = ""
+fInstance m (cat,rules) =
+  "  fg t =" ++++
+  "    case t of" ++++
+  unlines [mkInst f xx | (f,xx) <- rules] ++++
+  "      _ -> error (\"no" +++ cat ++ " \" ++ show t)"
+   where
+    mkInst f xx =
+     "      DTr [] (AC (CId \"" ++ f ++ "\")) " ++
+     "[" ++ prTList "," xx' ++ "]" +++
+     "->" +++ mkRHS f xx'
+       where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
+	     mkRHS f vars 
+		 | isListCat (cat,rules) =
+		     if "Base" `isPrefixOf` f then
+			gId cat +++ "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"
+		      else
+                       let (i,t) = (init vars,last vars)
+                        in "let" +++ gId cat +++ "xs = fg " ++ t +++ "in" +++ 
+                          gId cat +++ prParenth (prTList ":" (["fg"+++v | v <- i] ++ ["xs"]))
+		 | otherwise = 
+		     gId f +++  
+		     prTList " " [prParenth ("fg" +++ x) | x <- vars]
+
+
+--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
+hSkeleton :: GFCC -> (String,HSkeleton)
+hSkeleton gr = 
+  (pr (absname gr), 
+   [(pr c, [(pr f, map pr cs) | (f, (cs,_)) <- fs]) | 
+                                        fs@((_, (_,c)):_) <- fns]
+  )
+ where
+   fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))
+   valtyps (_, (_,x)) (_, (_,y)) = compare x y
+   valtypg (_, (_,x)) (_, (_,y)) = x == y
+   pr (CId c) = c
+   jty (f,(ty,_)) = (f,catSkeleton ty)
+
+updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
+updateSkeleton cat skel rule =
+ case skel of
+   (cat0,rules):rr | cat0 == cat -> (cat0, rule:rules) : rr
+   (cat0,rules):rr               -> (cat0, rules) : updateSkeleton cat rr rule
+
+isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool
+isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
+		    && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
+    where c = elemCat cat
+	  fs = map fst rules
+
+-- | Gets the element category of a list category.
+elemCat :: OIdent -> OIdent
+elemCat = drop 4
+
+isBaseFun :: OIdent -> Bool
+isBaseFun f = "Base" `isPrefixOf` f
+
+isConsFun :: OIdent -> Bool
+isConsFun f = "Cons" `isPrefixOf` f
+
+baseSize :: (OIdent, [(OIdent, [OIdent])]) -> Int
+baseSize (_,rules) = length bs
+    where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules
diff --git a/src-3.0/GF/Devel/GFCCtoJS.hs b/src-3.0/GF/Devel/GFCCtoJS.hs
new file mode 100644
index 000000000..c61ad08d5
--- /dev/null
+++ b/src-3.0/GF/Devel/GFCCtoJS.hs
@@ -0,0 +1,132 @@
+module GF.Devel.GFCCtoJS (gfcc2js) where
+
+import qualified GF.GFCC.Macros as M
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+import qualified GF.JavaScript.AbsJS as JS
+import qualified GF.JavaScript.PrintJS as JS
+
+import GF.Formalism.FCFG
+import GF.Parsing.FCFG.PInfo
+import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
+
+import GF.Text.UTF8
+import GF.Data.ErrM
+import GF.Infra.Option
+
+import Control.Monad (mplus)
+import Data.Array (Array)
+import qualified Data.Array as Array
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map
+
+gfcc2js :: D.GFCC -> String
+gfcc2js gfcc =
+  encodeUTF8 $ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
+ where
+   n  = D.printCId $ D.absname gfcc
+   as = D.abstract gfcc
+   cs = Map.assocs (D.concretes gfcc)
+   start = M.lookStartCat gfcc
+   grammar = new "GFGrammar" [abstract, concrete]
+   abstract = abstract2js start as
+   concrete = JS.EObj $ map (concrete2js start n) cs
+
+abstract2js :: String -> D.Abstr -> JS.Expr
+abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (D.funs ds))]
+
+absdef2js :: (CId,(D.Type,D.Exp)) -> JS.Property
+absdef2js (CId f,(typ,_)) =
+  let (args,CId cat) = M.catSkeleton typ in 
+    JS.Prop (JS.StringPropName f) (new "Type" [JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat])
+
+concrete2js :: String -> String -> (CId,D.Concr) -> JS.Property
+concrete2js start n (CId c, cnc) =
+    JS.Prop l (new "GFConcrete" ([(JS.EObj $ ((map (cncdef2js n c) ds) ++ litslins))] ++
+                                 maybe [] (parser2js start) (D.parser cnc)))
+  where 
+   l  = JS.StringPropName c
+   ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.lindefs cnc]
+   litslins = [JS.Prop (JS.StringPropName    "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), 
+               JS.Prop (JS.StringPropName  "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
+               JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
+
+
+cncdef2js :: String -> String -> (CId,D.Term) -> JS.Property
+cncdef2js n l (CId f, t) = JS.Prop (JS.StringPropName f) (JS.EFun [children] [JS.SReturn (term2js n l t)])
+
+term2js :: String -> String -> D.Term -> JS.Expr
+term2js n l t = f t
+  where 
+  f t = 
+    case t of
+      D.R xs           -> new "Arr" (map f xs)
+      D.P x y          -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y]
+      D.S xs           -> mkSeq (map f xs)
+      D.K t            -> tokn2js t
+      D.V i            -> JS.EIndex (JS.EVar children) (JS.EInt i)
+      D.C i            -> new "Int" [JS.EInt i]
+      D.F (CId f)      -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
+      D.FV xs          -> new "Variants" (map f xs)
+      D.W str x        -> new "Suffix" [JS.EStr str, f x]
+      D.RP x y         -> new "Rp" [f x, f y]
+      D.TM _           -> new "Meta" []
+
+tokn2js :: D.Tokn -> JS.Expr
+tokn2js (D.KS s) = mkStr s
+tokn2js (D.KP ss vs) = mkSeq (map mkStr ss) -- FIXME
+
+mkStr :: String -> JS.Expr
+mkStr s = new "Str" [JS.EStr s]
+
+mkSeq :: [JS.Expr] -> JS.Expr
+mkSeq [x] = x
+mkSeq xs = new "Seq" xs
+
+argIdent :: Integer -> JS.Ident
+argIdent n = JS.Ident ("x" ++ show n)
+
+children :: JS.Ident
+children = JS.Ident "cs"
+
+-- Parser
+parser2js :: String -> FCFPInfo -> [JS.Expr]
+parser2js start p  = [new "Parser" [JS.EStr start,
+                                    JS.EArray $ map frule2js (Array.elems (allRules p)),
+                                    JS.EObj $ map cats (Map.assocs (startupCats p))]]
+  where 
+    cats (CId c,is) = JS.Prop (JS.StringPropName c) (JS.EArray (map JS.EInt is))
+
+frule2js :: FRule -> JS.Expr
+frule2js (FRule n args res lins) = new "Rule" [JS.EInt res, name2js n, JS.EArray (map JS.EInt args), lins2js lins]
+
+name2js :: FName -> JS.Expr
+name2js n = case n of
+              Name (CId "_") [p] -> fromProfile p
+              Name f ps          -> new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
+  where
+    fromProfile :: Profile (SyntaxForest CId) -> JS.Expr
+    fromProfile (Unify []) = new "MetaVar" []
+    fromProfile (Unify [x]) = daughter x
+    fromProfile (Unify args) = new "Unify" [JS.EArray (map daughter args)]
+    fromProfile (Constant forest) = fromSyntaxForest forest
+
+    daughter i = new "Arg" [JS.EInt i]
+
+    fromSyntaxForest :: SyntaxForest CId -> JS.Expr
+    fromSyntaxForest FMeta = new "MetaVar" []
+    -- FIXME: is there always just one element here?
+    fromSyntaxForest (FNode n [args]) = new "FunApp" $ [JS.EStr $ prCId n, JS.EArray (map fromSyntaxForest args)]
+    fromSyntaxForest (FString s) = new "Lit" $ [JS.EStr s]
+    fromSyntaxForest (FInt i) = new "Lit" $ [JS.EInt $ fromIntegral i]
+    fromSyntaxForest (FFloat f) = new "Lit" $ [JS.EDbl f]
+
+lins2js :: Array FIndex (Array FPointPos FSymbol) -> JS.Expr
+lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls]
+
+sym2js :: FSymbol -> JS.Expr
+sym2js (FSymCat _ l n) = new "ArgProj" [JS.EInt n, JS.EInt l]
+sym2js (FSymTok t) = new "Terminal" [JS.EStr t]
+
+new :: String -> [JS.Expr] -> JS.Expr
+new f xs = JS.ENew (JS.Ident f) xs
diff --git a/src-3.0/GF/Devel/GFI.hs b/src-3.0/GF/Devel/GFI.hs
new file mode 100644
index 000000000..f59bd15e6
--- /dev/null
+++ b/src-3.0/GF/Devel/GFI.hs
@@ -0,0 +1,77 @@
+module GF.Devel.GFI (mainGFI) where
+
+import GF.Command.Interpreter
+import GF.Command.Importing
+import GF.Command.Commands
+import GF.GFCC.API
+
+import GF.Devel.UseIO
+import GF.Devel.Arch
+import GF.Infra.Option ---- Haskell's option lib
+
+
+mainGFI :: [String] -> IO ()
+mainGFI xx = do
+  putStrLn welcome
+  env <- importInEnv emptyMultiGrammar xx
+  loop (GFEnv env [] 0)
+  return ()
+
+loop :: GFEnv -> IO GFEnv
+loop gfenv0 = do
+  let env = commandenv gfenv0
+  putStrFlush (prompt env)
+  s <- getLine
+  let gfenv = gfenv0 {history = s : history gfenv0}
+  case words s of
+
+  -- special commands, working on GFEnv
+    "i":args -> do
+      env1 <- importInEnv (multigrammar env) args
+      loopNewCPU $ gfenv {commandenv = env1}
+    "e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyMultiGrammar}}
+    "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv
+    "q":_  -> putStrLn "See you." >> return gfenv
+
+  -- ordinary commands, working on CommandEnv
+    _ -> do
+      interpretCommandLine env s
+      loopNewCPU gfenv
+
+loopNewCPU gfenv = do
+  cpu <- prCPU $ cputime gfenv
+  loop $ gfenv {cputime = cpu}
+
+importInEnv mgr0 xx = do
+  let (opts,files) = getOptions "-" xx
+  mgr1 <- case files of
+    [] -> return mgr0
+    _  -> importGrammar mgr0 opts files
+  let env = CommandEnv mgr1 (allCommands mgr1)
+  putStrLn $ unwords $ "\nLanguages:" : languages mgr1
+  return env
+
+welcome = unlines [
+  "                              ",
+  "         *  *  *              ",
+  "      *           *           ",
+  "    *               *         ",
+  "   *                          ",
+  "   *                          ",
+  "   *        * * * * * *       ",
+  "   *        *         *       ",
+  "    *       * * * *  *        ",
+  "      *     *      *          ",
+  "         *  *  *              ",
+  "                              ",
+  "This is GF version 3.0 alpha. ",
+  "Some things may work.         "
+  ]
+
+prompt env = abstractName (multigrammar env) ++ "> "
+
+data GFEnv = GFEnv {
+  commandenv :: CommandEnv,
+  history    :: [String],
+  cputime    :: Integer
+  }
diff --git a/src-3.0/GF/Devel/GetGrammar.hs b/src-3.0/GF/Devel/GetGrammar.hs
new file mode 100644
index 000000000..cdd275ace
--- /dev/null
+++ b/src-3.0/GF/Devel/GetGrammar.hs
@@ -0,0 +1,54 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GetGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/15 17:56:13 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- this module builds the internal GF grammar that is sent to the type checker
+-----------------------------------------------------------------------------
+
+module GF.Devel.GetGrammar where
+
+import GF.Data.Operations
+import qualified GF.Source.ErrM as E
+
+import GF.Devel.UseIO
+import GF.Grammar.Grammar
+import GF.Infra.Modules
+import GF.Devel.PrGrammar
+import qualified GF.Source.AbsGF as A
+import GF.Source.SourceToGrammar
+---- import Macros
+---- import Rename
+import GF.Infra.Option
+--- import Custom
+import GF.Source.ParGF
+import qualified GF.Source.LexGF as L
+
+import GF.Devel.ReadFiles ----
+
+import Data.Char (toUpper)
+import Data.List (nub)
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad (foldM)
+import System (system)
+
+getSourceModule :: Options -> FilePath -> IOE SourceModule
+getSourceModule opts file0 = do
+  file <- case getOptVal opts usePreprocessor of
+    Just p -> do
+      let tmp = "_gf_preproc.tmp"
+          cmd = p +++ file0 ++ ">" ++ tmp
+      ioeIO $ system cmd
+      -- ioeIO $ putStrLn $ "preproc" +++ cmd
+      return tmp
+    _ -> return file0
+  string    <- readFileIOE file
+  let tokens = myLexer string
+  mo1  <- ioeErr $ pModDef tokens
+  ioeErr $ transModDef mo1
diff --git a/src-3.0/GF/Devel/Grammar/AppPredefined.hs b/src-3.0/GF/Devel/Grammar/AppPredefined.hs
new file mode 100644
index 000000000..c8d2988fd
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/AppPredefined.hs
@@ -0,0 +1,166 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : AppPredefined
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/06 14:21:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.13 $
+--
+-- Predefined function type signatures and definitions.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Grammar.AppPredefined (
+  isInPredefined, 
+  typPredefined, 
+  appPredefined
+  ) where
+
+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
+
+import GF.Data.Operations
+
+
+-- predefined function type signatures and definitions. AR 12/3/2003.
+
+isInPredefined :: Ident -> Bool
+isInPredefined = err (const True) (const False) . typPredefined
+
+typPredefined :: Ident -> Err Type
+typPredefined c@(IC f) = case f of
+  "Int"    -> return typePType
+  "Float"  -> return typePType
+  "Error"  -> return typeType
+  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
+  "PBool"  -> return typePType
+  "error"  -> return $ mkFunType [typeStr] (cnPredef "Error")  -- non-can. of empty set
+  "PFalse" -> return $ cnPredef "PBool"
+  "PTrue"  -> return $ cnPredef "PBool"
+  "dp"     -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "drop"   -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "eqStr"  -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "length" -> return $ mkFunType [typeStr] (cnPredef "Int")
+  "occur"  -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "occurs" -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
+----  "read"   -> (P : Type) -> Tok -> P
+  "show"   -> return $ mkProds -- (P : PType) -> P -> Tok
+    ([(identC "P",typePType),(wildIdent,Vr (identC "P"))],typeStr,[]) 
+  "toStr"  -> return $ mkProds -- (L : Type)  -> L -> Str
+    ([(identC "L",typeType),(wildIdent,Vr (identC "L"))],typeStr,[]) 
+  "mapStr" -> 
+    let ty = identC "L" in
+    return $ mkProds -- (L : Type)  -> (Str -> Str) -> L -> L
+    ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) 
+  "take"   -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "tk"     -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  _        -> prtBad "unknown in Predef:" c
+
+typPredefined c = prtBad "unknown in Predef:" c
+
+mkProds (cont,t,xx) = foldr (uncurry Prod) (mkApp t xx) cont
+
+appPredefined :: Term -> Err (Term,Bool)
+appPredefined t = case t of
+
+  App f x0 -> do
+   (x,_) <- appPredefined x0
+   case f of
+    -- one-place functions
+    Q (IC "Predef") (IC f) -> case (f, x) of
+      ("length", K s) -> retb $ EInt $ toInteger $ length s
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- two-place functions
+    App (Q (IC "Predef") (IC f)) z0 -> do
+     (z,_) <- appPredefined z0
+     case (f, norm z, norm x) of
+      ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
+      ("take", EInt i, K s) -> retb $ K (take (fi i) s)
+      ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
+      ("dp",   EInt i, K s) -> retb $ K (drop (max 0 (length s - fi i)) s)
+      ("eqStr",K s,    K t) -> retb $ if s == t then predefTrue else predefFalse
+      ("occur",K s,    K t) -> retb $ if substring s t then predefTrue else predefFalse
+      ("occurs",K s,   K t) -> retb $ if any (flip elem t) s then predefTrue else predefFalse
+      ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse
+      ("lessInt",EInt i, EInt j) -> retb $ if i<j then predefTrue else predefFalse
+      ("plus", EInt i, EInt j) -> retb $ EInt $ i+j
+      ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t
+      ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags
+      ("toStr", _, t) -> trm2str t >>= retb
+
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- three-place functions
+    App (App (Q (IC "Predef") (IC f)) z0) y0 -> do
+     (y,_) <- appPredefined y0
+     (z,_) <- appPredefined z0
+     case (f, z, y, x) of
+      ("mapStr",ty,op,t) -> retf $ mapStr ty op t
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    _ -> retb t ---- prtBad "cannot compute predefined" t
+  _ -> retb t
+                  ---- should really check the absence of arg variables
+ where
+   retb t = return (t,True)  -- no further computing needed
+   retf t = return (t,False) -- must be computed further
+   norm t = case t of
+     Empty -> K []
+     _ -> t
+   fi = fromInteger
+
+-- read makes variables into constants
+
+str2tag :: String -> Term
+str2tag s = case s of
+----  '\'' : cs -> mkCn $ pTrm $ init cs
+  _ -> Con $ IC s ---
+ where
+   mkCn t = case t of
+     Vr i -> Con i
+     App c a -> App (mkCn c) (mkCn a)
+     _ -> t
+
+
+predefTrue = Q (IC "Predef") (IC "PTrue")
+predefFalse = Q (IC "Predef") (IC "PFalse")
+
+substring :: String -> String -> Bool
+substring s t = case (s,t) of
+  (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds
+  ([],_) -> True
+  _ -> False
+
+trm2str :: Term -> Err Term
+trm2str t = case t of
+  R ((_,(_,s)):_) -> trm2str s
+  T _ ((_,s):_)   -> trm2str s
+  V _ (s:_)       -> trm2str s
+  C _ _         -> return $ t
+  K _           -> return $ t
+  S c _         -> trm2str c
+  Empty         -> return $ t
+  _ -> prtBad "cannot get Str from term" t
+
+-- simultaneous recursion on type and term: type arg is essential!
+-- But simplify the task by assuming records are type-annotated
+-- (this has been done in type checking)
+mapStr :: Type -> Term -> Term -> Term
+mapStr ty f t = case (ty,t) of
+  _ | elem ty [typeStr,typeStr] -> App f t
+  (_,        R ts)    -> R [(l,mapField v)   | (l,v) <- ts]
+  (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs]
+  _    -> t 
+ where
+   mapField (mty,te) = case mty of
+     Just ty -> (mty,mapStr ty f te)
+     _ -> (mty,te)
diff --git a/src-3.0/GF/Devel/Grammar/Compute.hs b/src-3.0/GF/Devel/Grammar/Compute.hs
new file mode 100644
index 000000000..5e465c160
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/Compute.hs
@@ -0,0 +1,380 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Compute
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 15:39:12 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.19 $
+--
+-- Computation of source terms. Used in compilation and in @cc@ command.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Grammar.Compute (
+  computeTerm,
+  computeTermCont,
+  computeTermRec
+  ) where
+
+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
+import GF.Devel.Grammar.PatternMatch
+import GF.Devel.Grammar.AppPredefined
+
+import GF.Infra.Ident
+import GF.Infra.Option
+
+--import GF.Grammar.Refresh
+--import GF.Grammar.Lockfield (isLockLabel) ----
+
+import GF.Data.Str ----
+import GF.Data.Operations
+
+import Data.List (nub,intersperse)
+import Control.Monad (liftM2, liftM)
+
+-- | computation of concrete syntax terms into normal form
+-- used mainly for partial evaluation
+computeTerm :: GF -> Term -> Err Term
+computeTerm g t = {- refreshTerm t >>= -} computeTermCont g [] t
+computeTermRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t
+
+computeTermCont :: GF -> Substitution -> Term -> Err Term
+computeTermCont = computeTermOpt False
+
+-- rec=True is used if it cannot be assumed that looked-up constants
+-- have already been computed (mainly with -optimize=noexpand in .gfr)
+
+computeTermOpt :: Bool -> GF -> Substitution -> Term -> Err Term
+computeTermOpt rec gr = comp where
+
+   comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
+              case t of
+
+     Q (IC "Predef") _ -> return t
+     Q p c -> look p c 
+
+     -- if computed do nothing
+     ---- Computed t' -> return $ unComputed t'
+
+     Vr x -> do
+       t' <- maybe (prtBad ("no value for variable") x) return $ lookup x g
+       case t' of 
+         _ | t == t' -> return t
+         _ -> comp g t'
+
+     Abs x b -> do 
+       b' <- comp (ext x (Vr x) g) b
+       return $ Abs x b'
+
+     Let (x,(_,a)) b -> do
+       a' <- comp g a
+       comp (ext x a' g) b
+
+     Prod x a b -> do
+       a' <- comp g a
+       b' <- comp (ext x (Vr x) g) b
+       return $ Prod x a' b'
+
+     -- beta-convert
+     App f a -> do
+       f' <- comp g f
+       a' <- comp g a
+       case (f',a') of
+         (Abs x b, FV as) -> 
+           mapM (\c -> comp (ext x c g) b) as >>= return . variants
+         (_, FV as)  -> mapM (\c -> comp g (App f' c)) as >>= return . variants
+         (FV fs, _)  -> mapM (\c -> comp g (App c a')) fs >>= return . variants
+         (Abs x b,_) -> comp (ext x a' g) b
+         (QC _ _,_)  -> returnC $ App f' a'
+
+         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e
+         (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e
+
+	 _ -> do
+           (t',b) <- appPredefined (App f' a')
+           if b then return t' else comp g t'
+
+     P t l  -> do
+       t' <- comp g t
+       case t' of
+         FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants
+         R r   -> maybe (prtBad "no value for label" l) (comp g . snd) $ 
+                    lookup l $ reverse r 
+
+         ExtR a (R b) ->                 
+           case comp g (P (R b) l) of
+             Ok v -> return v
+             _ -> comp g (P a l)
+
+--- { - --- this is incorrect, since b can contain the proper value
+         ExtR (R a) b ->                 -- NOT POSSIBLE both a and b records!
+           case comp g (P (R a) l) of
+             Ok v -> return v
+             _ -> comp g (P b l)
+--- - } ---
+
+
+         S (T i cs) e -> prawitz g i (flip P l) cs e
+         S (V i cs) e -> prawitzV g i (flip P l) cs e
+
+         _   -> returnC $ P t' l
+
+     PI t l i -> comp g $ P t l -----
+
+     S t@(T ti cc) v -> do
+       v'     <- comp g v
+       case v' of
+         FV vs -> do
+           ts' <- mapM (comp g . S t) vs
+           return $ variants ts' 
+         _ -> case ti of
+{-
+           TComp _  -> do
+             case term2patt v' of
+               Ok p' -> case lookup p' cc of
+                 Just u -> comp g u
+                 _ -> do
+                   t' <- comp g t
+                   return $ S t' v' -- if v' is not canonical
+               _ -> do
+                  t' <- comp g t
+                  return $ S t' v'
+-}
+           _ -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+             _ -> do
+               t' <- comp g t
+               return $ S t' v' -- if v' is not canonical
+
+
+     S t v -> do
+
+      t'     <- case t of
+---- why not? ResFin.Agr "has no values"
+----        T (TComp _) _ -> return t
+----        V _ _ -> return t
+        _ -> comp g t
+
+      v'     <- comp g v
+
+      case v' of
+       FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants        
+       _ -> case t' of
+         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
+
+         T _ [(PV IW,c)] -> comp g c           --- an optimization
+         T _ [(PT _ (PV IW),c)] -> comp g c
+
+         T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
+         T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
+
+         -- course-of-values table: look up by index, no pattern matching needed
+         V ptyp ts -> do
+           vs <- allParamValues gr ptyp
+           case lookup v' (zip vs [0 .. length vs - 1]) of
+             Just i -> comp g $ ts !! i
+-----             _ -> prtBad "selection" $ S t' v' -- debug
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         T (TComp _) cs -> do
+           case term2patt v' of
+             Ok p' -> case lookup p' cs of
+               Just u -> comp g u
+               _ -> return $ S t' v' -- if v' is not canonical
+             _ -> return $ S t' v'
+
+         T _ cc -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+             _ -> return $ S t' v' -- if v' is not canonical
+
+
+         S (T i cs) e -> prawitz g i (flip S v') cs e
+         S (V i cs) e -> prawitzV g i (flip S v') cs e
+         _    -> returnC $ S t' v'
+
+     -- normalize away empty tokens
+     K "" -> return Empty
+
+     -- glue if you can
+     Glue x0 y0 -> do
+       x <- comp g x0
+       y <- comp g y0
+       case (x,y) of
+         (FV ks,_)         -> do
+           kys <- mapM (comp g . flip Glue y) ks
+           return $ variants kys
+         (_,FV ks)         -> do
+           xks <- mapM (comp g . Glue x) ks
+           return $ variants xks
+
+         (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e
+         (s, S (T i cs) e) -> prawitz g i (Glue s) cs e
+         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e
+         (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e
+         (_,Empty)         -> return x
+         (Empty,_)         -> return y
+         (K a, K b)        -> return $ K (a ++ b)
+         (_, Alts (d,vs)) -> do
+----         (K a, Alts (d,vs)) -> do
+            let glx = Glue x
+            comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs])
+         (Alts _, ka) -> checks [do
+            y' <- strsFromTerm ka
+----         (Alts _, K a) -> checks [do
+            x' <- strsFromTerm x -- this may fail when compiling opers
+            return $ variants [
+              foldr1 C (map K (str2strings (glueStr v u))) | v <- x', u <- y']
+----              foldr1 C (map K (str2strings (glueStr v (str a)))) | v <- x']
+           ,return $ Glue x y
+           ]
+         (C u v,_) -> comp g $ C u (Glue v y)
+
+         _ -> do
+           mapM_ checkNoArgVars [x,y]
+           r <- composOp (comp g) t
+           returnC r
+
+     Alts _ -> do
+       r <- composOp (comp g) t
+       returnC r
+
+     -- remove empty
+     C a b    -> do
+       a' <- comp g a
+       b' <- comp g b
+       case (a',b') of
+         (Alts _, K a) -> checks [do
+            as <- strsFromTerm a' -- this may fail when compiling opers
+            return $ variants [
+              foldr1 C (map K (str2strings (plusStr v (str a)))) | v <- as]
+            ,
+            return $ C a' b'
+           ]
+         (Empty,_) -> returnC b'
+         (_,Empty) -> returnC a'
+         _     -> returnC $ C a' b'
+
+     -- reduce free variation as much as you can
+     FV ts -> mapM (comp g) ts >>= returnC . variants
+
+     -- merge record extensions if you can
+     ExtR r s -> do
+       r' <- comp g r
+       s' <- comp g s
+       case (r',s') of
+         (R rs, R ss) -> plusRecord r' s'
+         (RecType rs, RecType ss) -> plusRecType r' s'
+         _ -> return $ ExtR r' s'
+
+     -- case-expand tables
+     -- if already expanded, don't expand again
+     T i@(TComp ty) cs -> do
+       -- if there are no variables, don't even go inside
+       cs' <- if (null g) then return cs else mapPairsM (comp g) cs
+----       return $ V ty (map snd cs')
+       return $ T i cs'
+
+     T i cs -> do
+       pty0 <- errIn (prt t) $ getTableType i
+       ptyp <- comp g pty0
+       case allParamValues gr ptyp of
+         Ok vs -> do
+
+           cs'  <- mapM (compBranchOpt g) cs  ---- why is this needed??
+           sts  <- mapM (matchPattern cs') vs 
+           ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
+           ps   <- mapM term2patt vs
+           let ps' = ps --- PT ptyp (head ps) : tail ps
+----           return $ V ptyp ts -- to save space ---- why doesn't this work??
+           return $ T (TComp ptyp) (zip ps' ts)
+         _ -> do
+           cs' <- mapM (compBranch g) cs
+           return $ T i cs'  -- happens with variable types
+
+     -- otherwise go ahead
+     _ -> composOp (comp g) t >>= returnC
+
+    where
+
+     look p c
+       | rec       = lookupOperDef gr p c >>= comp []
+       | otherwise = lookupOperDef gr p c
+
+{-
+     look p c = case lookupResDefKind gr p c of
+       Ok (t,_) | noExpand p || rec -> comp [] t
+       Ok (t,_) -> return t
+       Bad s -> raise s
+
+     noExpand p = errVal False $ do
+       mo <- lookupModMod gr p
+       return $ case getOptVal (iOpts (flags mo)) useOptimizer of
+         Just "noexpand" -> True
+         _ -> False
+-}
+
+     ext x a g = (x,a):g
+
+     returnC = return --- . computed
+
+     variants ts = case nub ts of
+       [t] -> t
+       ts  -> FV ts
+
+     isCan v = case v of
+       Con _    -> True
+       QC _ _   -> True
+       App f a  -> isCan f && isCan a
+       R rs     -> all (isCan . snd . snd) rs
+       _        -> False
+
+     compBranch g (p,v) = do
+       let g' = contP p ++ g
+       v' <- comp g' v
+       return (p,v')
+
+     compBranchOpt g c@(p,v) = case contP p of
+       [] -> return c
+       _ -> err (const (return c)) return $ compBranch g c
+
+     contP p = case p of
+       PV x -> [(x,Vr x)]
+       PC _ ps -> concatMap contP ps
+       PP _ _ ps -> concatMap contP ps
+       PT _ p -> contP p
+       PR rs -> concatMap (contP . snd) rs
+
+       PAs x p -> (x,Vr x) : contP p
+
+       PSeq p q -> concatMap contP [p,q]
+       PAlt p q -> concatMap contP [p,q]
+       PRep p   -> contP p
+       PNeg p   -> contP p
+
+       _ -> []
+
+     prawitz g i f cs e = do
+       cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs]
+       return $ S (T i cs') e
+     prawitzV g i f cs e = do
+       cs' <- mapM (comp g) [(f v) | v <- cs]
+       return $ S (V i cs') e
+
+-- | argument variables cannot be glued
+checkNoArgVars :: Term -> Err Term
+checkNoArgVars t = case t of
+  Vr (IA _)  -> Bad $ glueErrorMsg $ prt t 
+  Vr (IAV _) -> Bad $ glueErrorMsg $ prt t 
+  _ -> composOp checkNoArgVars t
+
+glueErrorMsg s = 
+  "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++
+  "Use Prelude.bind instead."
diff --git a/src-3.0/GF/Devel/Grammar/Construct.hs b/src-3.0/GF/Devel/Grammar/Construct.hs
new file mode 100644
index 000000000..5b4215843
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/Construct.hs
@@ -0,0 +1,221 @@
+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, constructing objects
+------------------
+
+-- 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)}
+
+gfModules :: [(Ident,Module)] -> GF
+gfModules ms = emptyGF {gfmodules = fromList ms}
+
+-- abstractions on Module
+
+emptyModule :: Module
+emptyModule = 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 "#") 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) -> p) -> Type
+-- we use EData instead of p to make circularity check easier  
+resParam :: Ident -> [(Ident,Context)] -> Judgement
+resParam p cos = addJDef (EParam (Con p) cos) (addJType typePType (emptyJudgement JParam))
+
+-- 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
+
+updateJudgement :: Ident -> Ident -> Judgement -> GF -> Err GF
+updateJudgement m c ju gf = do
+  mo  <- maybe (Bad (show m)) return $ Data.Map.lookup m $ gfmodules gf
+  let mo' = mo {mjments = insert c ju (mjments mo)}
+  return $ gf {gfmodules = insert m mo' (gfmodules gf)}
+
+-- 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-3.0/GF/Devel/Grammar/GFtoSource.hs b/src-3.0/GF/Devel/Grammar/GFtoSource.hs
new file mode 100644
index 000000000..292f5b826
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/GFtoSource.hs
@@ -0,0 +1,223 @@
+module GF.Devel.Grammar.GFtoSource ( 
+  trGrammar,
+  trModule,
+  trAnyDef,
+  trLabel,
+  trt, 
+  tri, 
+  trp
+  ) where
+
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros (contextOfType)
+import qualified GF.Devel.Compile.AbsGF as P
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import qualified Data.Map as Map
+
+-- From internal source syntax to BNFC-generated (used for printing).
+-- | AR 13\/5\/2003
+--
+-- translate internal to parsable and printable source
+
+trGrammar :: GF -> P.Grammar
+trGrammar = P.Gr . map trModule . listModules -- no includes
+
+trModule :: (Ident,Module) -> P.ModDef
+trModule (i,mo) = P.MModule compl typ body where
+    compl = case isCompleteModule mo of
+      False -> P.CMIncompl
+      _ -> P.CMCompl
+    i' = tri i
+    typ = case mtype mo of
+      MTGrammar -> P.MGrammar i'
+      MTAbstract -> P.MAbstract i'
+      MTConcrete a -> P.MConcrete i' (tri a)
+      MTInterface -> P.MInterface i'
+      MTInstance a -> P.MInstance i' (tri a)
+    body = P.MBody 
+             (trExtends (mextends mo)) 
+             (mkOpens (map trOpen (mopens mo)))
+             (concatMap trAnyDef [(c,j) | (c,j) <- listJudgements mo] ++ 
+                        map trFlag (Map.assocs (mflags mo)))
+
+trExtends :: [(Ident,MInclude)] -> P.Extend
+trExtends [] = P.NoExt 
+trExtends es = (P.Ext $ map tre es) where
+  tre (i,c) = case c of 
+    MIAll       -> P.IAll   (tri i)
+    MIOnly is   -> P.ISome  (tri i) (map tri is)
+    MIExcept is -> P.IMinus (tri i) (map tri is)
+
+trOpen :: (Ident,Ident) -> P.Open
+trOpen (i,j) = P.OQual (tri i) (tri j)
+
+mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
+
+trAnyDef :: (Ident,Judgement) -> [P.TopDef]
+trAnyDef (i,ju) = let 
+   i' = mkName i
+   i0 = tri i 
+ in case jform ju of
+  JCat -> [P.DefCat [P.SimpleCatDef i0 []]] ---- (map trDecl co)]]
+  JFun -> [P.DefFun [P.FDecl [i'] (trt (jtype ju))]] 
+    ---- ++ case pt of
+    ---- Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
+    ---- _ -> []
+  ----  JFun ty EData -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
+  JParam -> [P.DefPar [
+    P.ParDefDir i0 [
+      P.ParConstr (tri c) (map trDecl co) | let EParam _ cos = jdef ju, (c,co) <- cos]
+    ]] 
+  JOper -> case jdef ju of 
+    Overload tysts -> 
+      [P.DefOper [P.DDef [i'] (
+        P.EApp (P.EPIdent $ ppIdent "overload") 
+          (P.ERecord [P.LDFull [i0] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
+    tr -> [P.DefOper [trDef i (jtype ju) tr]]
+  JLincat -> [P.DefLincat [P.DDef [i'] (trt (jtype ju))]] 
+  ---- CncCat pty ptr ppr -> 
+  ----  [P.DefLindef [trDef i' pty ptr]] 
+    ---- ++ [P.DefPrintCat [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
+  JLin -> 
+    [P.DefLin [trDef i (Meta 0) (jdef ju)]] 
+    ---- ++ [P.DefPrintFun [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
+  JLink -> []
+
+trDef :: Ident -> Type -> Term -> P.Def
+trDef i pty ptr = case (pty,ptr) of
+  (Meta _, Meta _) -> P.DDef  [mkName i] (P.EMeta) ---
+  (_,      Meta _) -> P.DDecl [mkName i] (trPerh pty)
+  (Meta _,      _) -> P.DDef  [mkName i] (trPerh ptr)
+  (_,           _) -> P.DFull [mkName i] (trPerh pty) (trPerh ptr)
+
+trPerh p = case p of
+  Meta _ -> P.EMeta
+  _ -> trt p
+
+trFlag :: (Ident,String) -> P.TopDef
+trFlag (f,x) = P.DefFlag [P.DDef [mkName f] (P.EString x)]
+
+trt :: Term -> P.Exp 
+trt trm = case trm of
+    Vr s -> P.EPIdent $ tri s
+----    Cn s -> P.ECons $ tri s
+    Con s -> P.EConstr $ tri s
+    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 -> P.EEqs [P.Equ (map trp ps) (trt t) | (ps,t) <- pts]
+    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)
+
+    Example t s -> P.EExample (trt t) s
+    R [] -> P.ETuple [] --- to get correct parsing when read back
+    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)
+    PI 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)
+    V ty cc -> P.EVTable (trt ty) (map trt cc)
+
+    Typed tr ty -> P.ETyped (trt tr) (trt ty)
+    Table x v -> P.ETType (trt x) (trt v)
+    S f x -> P.ESelect  (trt f) (trt x)
+    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 i
+    EFloat i -> P.EFloat i
+
+    EPatt p -> P.EPatt (trp p)
+    EPattType t -> P.EPattType (trt t)
+
+    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
+    EData -> P.EData
+    EParam t _ -> trt t
+
+    _ -> error $ "not yet" +++ show trm ----
+
+trp :: Patt -> P.Patt
+trp p = case p of
+    PChar -> P.PChar
+    PChars s -> P.PChars s
+    PM m c -> P.PM (tri m) (tri c)
+    PW -> P.PW
+    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]
+    PString s -> P.PStr s
+    PInt i -> P.PInt i
+    PFloat i -> P.PFloat i
+    PT t p -> trp p ---- prParenth (prt p +++ ":" +++ prt t)
+
+    PAs  x p -> P.PAs (tri x) (trp p)
+
+    PAlt p q -> P.PDisj (trp p) (trp q)
+    PSeq p q -> P.PSeq (trp p) (trp q)
+    PRep p   -> P.PRep (trp p)
+    PNeg p   -> P.PNeg (trp p)
+
+
+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 (trp patt) (trt trm)
+trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
+
+trDecl (x,ty) = P.DDDec [trb x] (trt ty)
+
+tri :: Ident -> P.PIdent
+tri i = ppIdent (prIdent i)
+
+ppIdent i = P.PIdent ((0,0),i)
+  
+trb i = if isWildIdent i then P.BWild else P.BPIdent (tri i)
+
+trLabel :: Label -> P.Label
+trLabel i = case i of
+  LIdent s -> P.LPIdent $ ppIdent s
+  LVar i -> P.LVar $ toInteger i
+
+trLabelIdent i = ppIdent $ case i of
+  LIdent s -> s
+  LVar i -> "v" ++ show i --- should not happen
+
+mkName :: Ident -> P.Name
+mkName = P.PIdentName . tri
+
diff --git a/src-3.0/GF/Devel/Grammar/Grammar.hs b/src-3.0/GF/Devel/Grammar/Grammar.hs
new file mode 100644
index 000000000..df5a3907e
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/Grammar.hs
@@ -0,0 +1,172 @@
+module GF.Devel.Grammar.Grammar where
+
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+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 inst'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    PType
+  jdef  :: Term,           -- lindef   def   lindef  lin     def     constrs
+  jprintname :: Term,      -- -        -     prname  prname  -       -
+  jlink :: Ident,   -- if inherited, the supermodule name, else #
+  jposition :: Int  -- line number where def begins
+  } 
+  deriving Show
+
+data JudgementForm =
+    JCat
+  | JFun
+  | JLincat
+  | JLin
+  | JOper
+  | JParam
+  | JLink
+  deriving (Eq,Show)
+
+type Type = Term
+
+data Term =
+   Vr Ident             -- ^ variable
+ | Con Ident            -- ^ constructor
+ | EData                -- ^ to mark in definition that a fun is a constructor
+ | Sort String          -- ^ predefined type
+ | EInt Integer         -- ^ integer literal
+ | EFloat Double        -- ^ floating point literal
+ | K String             -- ^ string literal or token: @\"foo\"@
+ | Empty                -- ^ the empty string @[]@
+
+ | App Term Term        -- ^ application: @f a@
+ | Abs Ident Term       -- ^ abstraction: @\x -> b@
+ | Meta MetaSymb        -- ^ metavariable: @?i@ (only parsable: ? = ?0)
+ | Prod Ident Term Term -- ^ function type: @(x : A) -> B@
+ | Eqs [Equation]       -- ^ abstraction by cases: @fn {x y -> b ; z u -> c}@
+                        --   only used in internal representation
+ | Typed Term Term      -- ^ type-annotated term
+--
+-- /below this, the constructors are only for concrete syntax/
+ | Example Term String  -- ^ example-based term: @in M.C "foo"
+ | RecType [Labelling]  -- ^ record type: @{ p : A ; ...}@
+ | R [Assign]           -- ^ record:      @{ p = a ; ...}@
+ | P Term Label         -- ^ projection:  @r.p@
+ | PI Term Label Int    -- ^ index-annotated projection
+ | ExtR Term Term       -- ^ extension:   @R ** {x : A}@ (both types and terms)
+ 
+ | Table Term Term      -- ^ table type:  @P => A@
+ | T TInfo [Case]       -- ^ table:       @table {p => c ; ...}@
+ | V Type [Term]        -- ^ course of values: @table T [c1 ; ... ; cn]@
+ | S Term Term          -- ^ selection:   @t ! p@
+ | Val Type Int         -- ^ parameter value number: @T # i#
+
+ | Let LocalDef Term    -- ^ local definition: @let {t : T = a} in b@
+
+ | Q  Ident Ident       -- ^ qualified constant from a module
+ | QC Ident Ident       -- ^ qualified constructor from a module
+
+ | C Term Term          -- ^ concatenation: @s ++ t@
+ | Glue Term Term       -- ^ agglutination: @s + t@
+
+ | EPatt Patt
+ | EPattType Term
+
+ | EParam Term [(Ident,Context)] -- to encode parameter constructor sets
+
+ | FV [Term]            -- ^ free variation: @variants { s ; ... }@
+
+ | Alts (Term, [(Term, Term)]) -- ^ prefix-dependent: @pre {t ; s\/c ; ...}@
+
+ | Overload [(Type,Term)]
+
+  deriving (Read, Show, Eq, Ord)
+
+data Patt =
+   PC Ident [Patt]        -- ^ constructor pattern: @C p1 ... pn@    @C@ 
+ | PP Ident Ident [Patt]  -- ^ qualified constr patt: @P.C p1 ... pn@    @P.C@ 
+ | PV Ident               -- ^ variable pattern: @x@
+ | PW                     -- ^ wild card pattern: @_@
+ | PR [(Label,Patt)]      -- ^ record pattern: @{r = p ; ...}@
+ | PString String         -- ^ string literal pattern: @\"foo\"@
+ | PInt    Integer        -- ^ integer literal pattern: @12@
+ | PFloat Double          -- ^ float literal pattern: @1.2@
+ | PT Type Patt           -- ^ type-annotated pattern
+ | PAs Ident Patt         -- ^ as-pattern: x@p
+
+ -- regular expression patterns
+ | PNeg Patt              -- ^ negated pattern: -p
+ | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
+ | PSeq Patt Patt         -- ^ sequence of token parts: p + q
+ | PRep Patt              -- ^ repetition of token part: p*
+ | PChar                  -- ^ string of length one: ? 
+ | PChars String          -- ^ list of characters: ["aeiou"]
+
+ | PMacro Ident           -- #p
+ | PM Ident Ident         -- #m.p
+
+  deriving (Read, Show, Eq, Ord)
+
+-- | to guide computation and type checking of tables
+data TInfo = 
+   TRaw         -- ^ received from parser; can be anything
+ | TTyped Type  -- ^ type annotated, but can be anything
+ | TComp Type   -- ^ expanded
+ | TWild Type   -- ^ just one wild card pattern, no need to expand 
+  deriving (Read, Show, Eq, Ord)
+
+-- | record label
+data Label = 
+    LIdent String
+  | LVar Int
+   deriving (Read, Show, Eq, Ord)
+
+type MetaSymb = Int
+
+type Decl         = (Ident,Term)  -- (x:A)  (_:A)  A
+type Context      = [Decl]        -- (x:A)(y:B)   (x,y:A)   (_,_:A)
+type Substitution = [(Ident, Term)]
+type Equation     = ([Patt],Term) 
+
+type Labelling = (Label, Term) 
+type Assign    = (Label, (Maybe Type, Term)) 
+type Case      = (Patt, Term) 
+type LocalDef  = (Ident, (Maybe Type, Term))
+
diff --git a/src-3.0/GF/Devel/Grammar/Lookup.hs b/src-3.0/GF/Devel/Grammar/Lookup.hs
new file mode 100644
index 000000000..689996760
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/Lookup.hs
@@ -0,0 +1,168 @@
+module GF.Devel.Grammar.Lookup where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad (liftM)
+import Data.Map
+import Data.List (sortBy) ----
+
+-- look up fields for a constant in a grammar
+
+lookupJField :: (Judgement -> a) -> GF -> Ident -> Ident -> Err a
+lookupJField field gf m c = do
+  j <- lookupJudgement gf m c
+  return $ field j
+
+lookupJForm :: GF -> Ident -> Ident -> Err JudgementForm
+lookupJForm = lookupJField jform
+
+-- the following don't (need to) check that the jment form is adequate
+ 
+lookupCatContext :: GF -> Ident -> Ident -> Err Context
+lookupCatContext gf m c = do
+  ty <- lookupJField jtype gf m c
+  return $ contextOfType ty
+
+lookupFunType :: GF -> Ident -> Ident -> Err Term
+lookupFunType = lookupJField jtype 
+
+lookupLin :: GF -> Ident -> Ident -> Err Term
+lookupLin = lookupJField jdef
+
+lookupLincat :: GF -> Ident -> Ident -> Err Term
+lookupLincat = lookupJField jtype
+
+lookupOperType :: GF -> Ident -> Ident -> Err Term
+lookupOperType gr m c = do
+  ju <- lookupJudgement gr m c
+  case jform ju of
+    JParam -> return typePType
+    _ -> case jtype ju of
+      Meta _ -> fail ("no type given to " ++ prIdent m ++ "." ++ prIdent c)
+      ty -> return ty
+---- can't be just lookupJField jtype 
+
+lookupOperDef :: GF -> Ident -> Ident -> Err Term
+lookupOperDef = lookupJField jdef
+
+lookupOverload :: GF -> Ident -> Ident -> Err [([Type],(Type,Term))]
+lookupOverload gr m c = do
+  tr <- lookupJField jdef gr m c
+  case tr of
+    Overload tysts -> return 
+      [(lmap snd args,(val,tr)) | (ty,tr) <- tysts, let (args,val) = prodForm ty]
+    _   -> Bad $ prt c +++ "is not an overloaded operation"
+
+lookupParams :: GF -> Ident -> Ident -> Err [(Ident,Context)]
+lookupParams gf m c = do
+  EParam _ ty <- lookupJField jdef gf m c
+  return ty
+
+lookupParamConstructor :: GF -> Ident -> Ident -> Err Type
+lookupParamConstructor = lookupJField jtype
+
+lookupParamValues :: GF -> Ident -> Ident -> Err [Term]
+lookupParamValues gf m c = do
+  ps <- lookupParams gf m c
+  liftM concat $ mapM mkPar ps
+ where
+   mkPar (f,co) = do
+     vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gf ty) co
+     return $ lmap (mkApp (QC m f)) vs
+
+lookupFlags :: GF -> Ident -> [(Ident,String)]
+lookupFlags gf m = errVal [] $ do
+  mo <- lookupModule gf m
+  return $ toList $ mflags mo
+
+allParamValues :: GF -> Type -> Err [Term]
+allParamValues cnc ptyp = case ptyp of
+     App (Q (IC "Predef") (IC "Ints")) (EInt n) -> 
+       return [EInt i | i <- [0..n]]
+     QC p c -> lookupParamValues cnc p c
+     Q  p c -> lookupParamValues cnc p c ----
+
+     RecType r -> do
+       let (ls,tys) = unzip $ sortByFst r
+       tss <- mapM allPV tys
+       return [R (zipAssign ls ts) | ts <- combinations tss]
+     _ -> prtBad "cannot find parameter values for" ptyp
+  where
+    allPV = allParamValues cnc
+    -- to normalize records and record types
+    sortByFst = sortBy (\ x y -> compare (fst x) (fst y))
+
+abstractOfConcrete :: GF -> Ident -> Err Ident
+abstractOfConcrete gf m = do
+  mo <- lookupModule gf m
+  case mtype mo of
+    MTConcrete a -> return a
+    MTInstance a -> return a
+    MTGrammar -> return m
+    _ -> prtBad "not concrete module" m
+
+allOrigJudgements :: GF -> Ident -> [(Ident,Judgement)]
+allOrigJudgements gf m = errVal [] $ do
+  mo <- lookupModule gf m
+  return [ju | ju@(_,j) <- listJudgements mo, jform j /= JLink]
+
+allConcretes :: GF -> Ident -> [Ident]
+allConcretes gf m = 
+  [c | (c,mo) <- toList (gfmodules gf), mtype mo == MTConcrete m]
+
+-- | select just those modules that a given one depends on, including itself
+partOfGrammar :: GF -> (Ident,Module) -> GF
+partOfGrammar gr (i,mo) = gr {
+  gfmodules = fromList [m | m@(j,_) <- mos, elem j modsFor]
+  } 
+  where
+    mos = toList $ gfmodules gr
+    modsFor = i : allDepsModule gr mo
+
+allDepsModule :: GF -> Module -> [Ident]
+allDepsModule gr m = iterFix add os0 where
+  os0 = depPathModule m
+  add os = [m | o <- os, Just n <- [llookup o mods], m <- depPathModule n]
+  mods = toList $ gfmodules gr
+
+-- | initial dependency list
+depPathModule :: Module -> [Ident]
+depPathModule mo = fors ++ lmap fst (mextends mo) ++ lmap snd (mopens mo) where
+  fors = case mtype mo of
+    MTConcrete i   -> [i]
+    MTInstance i   -> [i]
+    _              -> []
+
+-- infrastructure for lookup
+    
+lookupModule :: GF -> Ident -> Err Module
+lookupModule gf m = do
+  maybe (raiseIdent "module not found:" m) return $ mlookup m (gfmodules gf)
+
+-- 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)
+
+-- this follows the link
+lookupJudgement :: GF -> Ident -> Ident -> Err Judgement
+lookupJudgement gf m c = do
+  ju <- lookupIdent gf m c
+  case jform ju of
+    JLink -> lookupJudgement gf (jlink ju) c
+    _ -> return ju
+
+mlookup = Data.Map.lookup
+
+raiseIdent msg i = raise (msg +++ prIdent i)
+
+lmap = Prelude.map
+llookup = Prelude.lookup
+
diff --git a/src-3.0/GF/Devel/Grammar/Macros.hs b/src-3.0/GF/Devel/Grammar/Macros.hs
new file mode 100644
index 000000000..1a7a3582c
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/Macros.hs
@@ -0,0 +1,434 @@
+module GF.Devel.Grammar.Macros where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Infra.Ident
+
+import GF.Data.Str
+import GF.Data.Operations
+
+import qualified Data.Map as Map
+import Control.Monad (liftM,liftM2)
+
+
+-- analyse types and terms
+
+contextOfType :: Type -> Context
+contextOfType ty = co where (co,_,_) = typeForm ty
+
+typeForm :: Type -> (Context,Term,[Term])
+typeForm t = (co,f,a) where
+  (co,t2) = prodForm t
+  (f,a) = appForm t2
+
+termForm :: Term -> ([Ident],Term,[Term])
+termForm t = (co,f,a) where
+  (co,t2) = absForm t
+  (f,a) = appForm t2
+
+prodForm :: Type -> (Context,Term)
+prodForm t = case t of
+  Prod x ty val -> ((x,ty):co,t2) where (co,t2) = prodForm val
+  _ -> ([],t)
+
+absForm :: Term -> ([Ident],Term)
+absForm t = case t of
+  Abs x val -> (x:co,t2) where (co,t2) = absForm val
+  _ -> ([],t)
+
+
+appForm :: Term -> (Term,[Term])
+appForm tr = (f,reverse xs) where 
+  (f,xs) = apps tr
+  apps t = case t of
+    App f a -> (f2,a:a2) where (f2,a2) = appForm f
+    _ -> (t,[])
+
+valCat :: Type -> Err (Ident,Ident)
+valCat typ = case typeForm typ of
+  (_,Q m c,_) -> return (m,c)
+
+typeRawSkeleton :: Type -> Err ([(Int,Type)],Type)
+typeRawSkeleton typ = do
+  let (cont,typ) = prodForm typ
+  args <- mapM (typeRawSkeleton . snd) cont
+  return ([(length c, v) | (c,v) <- args], typ)
+
+type MCat = (Ident,Ident)
+
+sortMCat :: String -> MCat
+sortMCat s = (identC "_", identC s)
+
+--- hack for Editing.actCat in empty state
+errorCat :: MCat
+errorCat = (identC "?", identC "?")
+
+getMCat :: Term -> Err MCat
+getMCat t = case t of
+  Q  m c -> return (m,c)
+  QC m c -> return (m,c)
+  Sort s -> return $ sortMCat s
+  App f _ -> getMCat f
+  _ -> error $ "no qualified constant" +++ show t
+
+typeSkeleton :: Type -> Err ([(Int,MCat)],MCat)
+typeSkeleton typ = do
+  (cont,val) <- typeRawSkeleton typ
+  cont' <- mapPairsM getMCat cont
+  val'  <- getMCat val
+  return (cont',val')
+
+-- construct types and terms
+
+mkFunType :: [Type] -> Type -> Type
+mkFunType tt t = mkProd ([(wildIdent, ty) | ty <- tt]) t -- nondep prod
+
+mkApp :: Term -> [Term] -> Term
+mkApp = foldl App
+
+mkAbs :: [Ident] -> Term -> Term
+mkAbs xs t = foldr Abs t xs
+
+mkCTable :: [Ident] -> Term -> Term
+mkCTable ids v = foldr ccase v ids where 
+  ccase x t = T TRaw [(PV x,t)]
+
+appCons :: Ident -> [Term] -> Term
+appCons = mkApp . Con
+
+appc :: String -> [Term] -> Term
+appc = appCons . identC
+
+tuple2record :: [Term] -> [Assign]
+tuple2record ts = [assign (tupleLabel i) t | (i,t) <- zip [1..] ts]
+
+tuple2recordType :: [Term] -> [Labelling]
+tuple2recordType ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]
+
+tuple2recordPatt :: [Patt] -> [(Label,Patt)]
+tuple2recordPatt ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]
+
+tupleLabel :: Int -> Label
+tupleLabel i = LIdent $ "p" ++ show i
+
+assign :: Label -> Term -> Assign
+assign l t = (l,(Nothing,t))
+
+assignT :: Label -> Type -> Term -> Assign
+assignT l a t = (l,(Just a,t))
+
+unzipR :: [Assign] -> ([Label],[Term])
+unzipR r = (ls, map snd ts) where (ls,ts) = unzip r
+
+mkDecl :: Term -> Decl
+mkDecl typ = (wildIdent, typ)
+
+mkLet :: [LocalDef] -> Term -> Term
+mkLet defs t = foldr Let t defs
+
+mkRecTypeN :: Int -> (Int -> Label) -> [Type] -> Type
+mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]
+
+mkRecType :: (Int -> Label) -> [Type] -> Type
+mkRecType = mkRecTypeN 0
+
+plusRecType :: Type -> Type -> Err Type
+plusRecType t1 t2 = case (t1, t2) of
+  (RecType r1, RecType r2) -> case
+    filter (`elem` (map fst r1)) (map fst r2) of
+      [] -> return (RecType (r1 ++ r2))
+      ls -> Bad $ "clashing labels" +++ unwords (map show ls)
+  _ -> Bad ("cannot add record types" +++ show t1 +++ "and" +++ show t2) 
+
+plusRecord :: Term -> Term -> Err Term
+plusRecord t1 t2 =
+ case (t1,t2) of
+   (R r1, R r2 ) -> return (R ([(l,v) | -- overshadowing of old fields
+                              (l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))
+   (_,    FV rs) -> mapM (plusRecord t1) rs >>= return . FV
+   (FV rs,_    ) -> mapM (`plusRecord` t2) rs >>= return . FV
+   _ -> Bad ("cannot add records" +++ show t1 +++ "and" +++ show t2)
+
+zipAssign :: [Label] -> [Term] -> [Assign]
+zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
+
+
+defLinType :: Type
+defLinType = RecType [(LIdent "s",  typeStr)]
+
+meta0 :: Term
+meta0 = Meta 0
+
+ident2label :: Ident -> Label
+ident2label c = LIdent (prIdent c)
+
+label2ident :: Label -> Ident
+label2ident (LIdent c) = identC c
+
+----label2ident :: Label -> Ident
+----label2ident = identC . prLabel
+
+-- to apply a term operation to every term in a judgement, module, grammar
+
+termOpGF :: Monad m => (Term -> m Term) -> GF -> m GF
+termOpGF f = moduleOpGF (termOpModule f) 
+
+moduleOpGF :: Monad m => (Module -> m Module) -> GF -> m GF
+moduleOpGF f g = do 
+  ms <- mapMapM f (gfmodules g)
+  return g {gfmodules = ms}
+
+termOpModule :: Monad m => (Term -> m Term) -> Module -> m Module
+termOpModule f = judgementOpModule fj where
+  fj = termOpJudgement f
+   
+judgementOpModule :: Monad m => (Judgement -> m Judgement) -> Module -> m Module
+judgementOpModule f m = do 
+  mjs <- mapMapM f (mjments m)
+  return m {mjments = mjs}
+
+entryOpModule :: Monad m => 
+                 (Ident -> Judgement -> m Judgement) -> Module -> m Module
+entryOpModule f m = do 
+  mjs <- liftM Map.fromAscList $ mapm $ Map.assocs $ mjments m
+  return $ m {mjments = mjs}
+ where
+  mapm = mapM (\ (i,j) -> liftM ((,) i) (f i j)) 
+   
+termOpJudgement :: Monad m => (Term -> m Term) -> Judgement -> m Judgement
+termOpJudgement f j = do 
+  jtyp <- f (jtype j)
+  jde <- f (jdef j)
+  jpri <- f (jprintname j)
+  return $ j {
+    jtype = jtyp,
+    jdef = jde,
+    jprintname = jpri
+    }
+
+-- | to define compositional term functions
+composSafeOp :: (Term -> Term) -> Term -> Term
+composSafeOp op trm = case composOp (mkMonadic op) trm of
+  Ok t -> t
+  _ -> error "the operation is safe isn't it ?"
+ where
+ mkMonadic f = return . f
+
+-- | to define compositional monadic term functions
+composOp :: Monad m => (Term -> m Term) -> Term -> m Term
+composOp co trm = case trm of
+   App c a -> 
+     do c' <- co c
+        a' <- co a
+        return (App c' a')
+   Abs x b ->
+     do b' <- co b
+        return (Abs x b')
+   Prod x a b -> 
+     do a' <- co a
+        b' <- co b
+        return (Prod x a' b')
+   S c a -> 
+     do c' <- co c
+        a' <- co a
+        return (S c' a')
+   Table a c -> 
+     do a' <- co a
+        c' <- co c
+        return (Table a' c')
+   R r -> 
+     do r' <- mapAssignM co r
+        return (R r')
+   RecType r -> 
+     do r' <- mapPairListM (co . snd) r
+        return (RecType r')
+   P t i ->
+     do t' <- co t
+        return (P t' i)
+   PI t i j ->
+     do t' <- co t
+        return (PI t' i j)
+   ExtR a c -> 
+     do a' <- co a
+        c' <- co c
+        return (ExtR a' c')
+   T i cc -> 
+     do cc' <- mapPairListM (co . snd) cc
+        i'  <- changeTableType co i
+        return (T i' cc')
+   Eqs cc -> 
+     do cc' <- mapPairListM (co . snd) cc
+        return (Eqs cc')
+   EParam ty cos -> 
+     do ty' <- co ty
+        cos' <- mapPairListM (mapPairListM (co . snd) . snd) cos
+        return (EParam ty' cos')
+   V ty vs ->
+     do ty' <- co ty
+        vs' <- mapM co vs
+        return (V ty' vs')
+   Let (x,(mt,a)) b -> 
+     do a'  <- co a
+        mt' <- case mt of
+                 Just t -> co t >>= (return . Just) 
+                 _ -> return mt
+        b'  <- co b
+        return (Let (x,(mt',a')) b')
+   C s1 s2 -> 
+     do v1 <- co s1 
+        v2 <- co s2
+        return (C v1 v2)
+   Glue s1 s2 -> 
+     do v1 <- co s1
+        v2 <- co s2
+        return (Glue v1 v2)
+   Alts (t,aa) ->
+     do t' <- co t
+        aa' <- mapM (pairM co) aa
+        return (Alts (t',aa'))
+   FV ts -> mapM co ts >>= return . FV
+   Overload tts -> do
+     tts' <- mapM (pairM co) tts
+     return $ Overload tts'
+
+   EPattType ty -> 
+     do ty' <- co ty
+        return (EPattType ty')
+
+   _ -> return trm -- covers K, Vr, Cn, Sort
+
+
+---- should redefine using composOp
+collectOp :: (Term -> [a]) -> Term -> [a]
+collectOp co trm = case trm of
+  App c a    -> co c ++ co a 
+  Abs _ b    -> co b
+  Prod _ a b -> co a ++ co b 
+  S c a      -> co c ++ co a
+  Table a c  -> co a ++ co c
+  ExtR a c   -> co a ++ co c
+  R r        -> concatMap (\ (_,(mt,a)) -> maybe [] co mt ++ co a) r 
+  RecType r  -> concatMap (co . snd) r 
+  P t i      -> co t
+  T _ cc     -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
+  V _ cc     -> concatMap co         cc --- nor from type annot
+  Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b
+  C s1 s2    -> co s1 ++ co s2 
+  Glue s1 s2 -> co s1 ++ co s2 
+  Alts (t,aa) -> let (x,y) = unzip aa in co t ++ concatMap co (x ++ y)
+  FV ts      -> concatMap co ts
+  _ -> [] -- covers K, Vr, Cn, Sort, Ready
+
+--- just aux to composOp?
+
+mapAssignM :: Monad m => (Term -> m c) -> [Assign] -> m [(Label,(Maybe c,c))]
+mapAssignM f = mapM (\ (ls,tv) -> liftM ((,) ls) (g tv))
+  where g (t,v) = liftM2 (,) (maybe (return Nothing) (liftM Just . f) t) (f v)
+
+changeTableType :: Monad m => (Type -> m Type) -> TInfo -> m TInfo
+changeTableType co i = case i of
+    TTyped ty -> co ty >>= return . TTyped
+    TComp ty  -> co ty >>= return . TComp
+    TWild ty  -> co ty >>= return . TWild
+    _ -> return i
+
+
+patt2term :: Patt -> Term
+patt2term pt = case pt of
+  PV x      -> Vr x
+  PW        -> Vr wildIdent             --- not parsable, should not occur
+  PC c pp   -> mkApp (Con c) (map patt2term pp)
+  PP p c pp -> mkApp (QC p c) (map patt2term pp)
+  PR r      -> R [assign l (patt2term p) | (l,p) <- r] 
+  PT _ p    -> patt2term p
+  PInt i    -> EInt i
+  PFloat i  -> EFloat i
+  PString s -> K s 
+
+  PAs x p   -> appc "@" [Vr x, patt2term p]            --- an encoding
+  PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
+  PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
+  PRep a    -> appc "*" [(patt2term a)]                --- an encoding
+  PNeg a    -> appc "-" [(patt2term a)]                --- an encoding
+
+
+term2patt :: Term -> Err Patt
+term2patt trm = case Ok (termForm trm) of
+  Ok ([], Vr x, []) -> return (PV x)
+  Ok ([], QC p c, aa) -> do
+    aa' <- mapM term2patt aa
+    return (PP p c aa')
+  Ok ([], R r, []) -> do
+    let (ll,aa) = unzipR r
+    aa' <- mapM term2patt aa
+    return (PR (zip ll aa'))
+  Ok ([],EInt i,[]) -> return $ PInt i
+  Ok ([],EFloat i,[]) -> return $ PFloat i
+  Ok ([],K s,   []) -> return $ PString s
+
+--- encodings due to excessive use of term-patt convs. AR 7/1/2005
+  Ok ([], Con (IC "@"), [Vr a,b]) -> do
+    b' <- term2patt b
+    return (PAs a b')
+  Ok ([], Con (IC "-"), [a]) -> do
+    a' <- term2patt a
+    return (PNeg a')
+  Ok ([], Con (IC "*"), [a]) -> do
+    a' <- term2patt a
+    return (PRep a')
+  Ok ([], Con (IC "+"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PSeq a' b')
+  Ok ([], Con (IC "|"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PAlt a' b')
+
+  Ok ([], Con c, aa) -> do
+    aa' <- mapM term2patt aa
+    return (PC c aa')
+
+  _ -> Bad $ "no pattern corresponds to term" +++ show trm
+
+getTableType :: TInfo -> Err Type
+getTableType i = case i of
+  TTyped ty -> return ty
+  TComp ty  -> return ty
+  TWild ty  -> return ty
+  _ -> Bad "the table is untyped"
+
+-- | to get a string from a term that represents a sequence of terminals
+strsFromTerm :: Term -> Err [Str]
+strsFromTerm t = case t of
+  K s   -> return [str s]
+  Empty -> return [str []]
+  C s t -> do
+    s' <- strsFromTerm s
+    t' <- strsFromTerm t
+    return [plusStr x y | x <- s', y <- t']
+  Glue s t -> do
+    s' <- strsFromTerm s
+    t' <- strsFromTerm t
+    return [glueStr x y | x <- s', y <- t']
+  Alts (d,vs) -> do
+    d0 <- strsFromTerm d
+    v0 <- mapM (strsFromTerm . fst) vs
+    c0 <- mapM (strsFromTerm . snd) vs
+    let vs' = zip v0 c0
+    return [strTok (str2strings def) vars | 
+              def  <- d0,
+              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
+                                                          vv <- combinations v0]
+           ]
+  FV ts -> mapM strsFromTerm ts >>= return . concat
+  _ -> Bad $ "cannot get Str from term" +++ show t
+
+
+
+---- given in lib?
+
+mapMapM :: (Monad m, Ord k) => (v -> m v) -> Map.Map k v -> m (Map.Map k v)
+mapMapM f = 
+  liftM Map.fromAscList . mapM (\ (x,y) -> liftM ((,) x) $ f y) . Map.assocs 
+
diff --git a/src-3.0/GF/Devel/Grammar/PatternMatch.hs b/src-3.0/GF/Devel/Grammar/PatternMatch.hs
new file mode 100644
index 000000000..ec64d7802
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/PatternMatch.hs
@@ -0,0 +1,146 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PatternMatch
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/12 12:38:29 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.7 $
+--
+-- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
+-----------------------------------------------------------------------------
+
+module GF.Devel.Grammar.PatternMatch (matchPattern,
+		     testOvershadow, 
+		     findMatch
+		    ) where
+
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Data.List
+import Control.Monad
+
+
+matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution)
+matchPattern pts term = 
+  if not (isInConstantForm term)
+    then prtBad "variables occur in" term
+  else 
+    errIn ("trying patterns" +++ unwords (intersperse "," (map (prt . fst) pts))) $
+    findMatch [([p],t) | (p,t) <- pts] [term]
+
+testOvershadow :: [Patt] -> [Term] -> Err [Patt]
+testOvershadow pts vs = do
+  let numpts = zip pts [0..]
+  let cases  = [(p,EInt i) | (p,i) <- numpts]
+  ts <- mapM (liftM fst . matchPattern cases) vs
+  return $ [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ]
+
+findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)
+findMatch cases terms = case cases of
+   [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms))
+   (patts,_):_ | length patts /= length terms -> 
+       Bad ("wrong number of args for patterns :" +++ 
+            unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms))
+   (patts,val):cc -> case mapM tryMatch (zip patts terms) of
+       Ok substs -> return (val, concat substs)
+       _         -> findMatch cc terms
+
+tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
+tryMatch (p,t) = do 
+  let t' = termForm t
+  trym p t'
+ where
+  isInConstantFormt = True -- tested already
+  trym p t' =
+    case (p,t') of
+      (_,(x,Empty,y)) -> trym p (x,K [],y)   -- because "" = [""] = []
+      (PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard
+      (PV x,  _) | isInConstantFormt -> return [(x,t)]
+      (PString s, ([],K i,[])) | s==i -> return []
+      (PInt s, ([],EInt i,[])) | s==i -> return []
+      (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
+      (PC p pp, ([], Con f, tt)) | 
+            p `eqStrIdent` f && length pp == length tt ->
+         do matches <- mapM tryMatch (zip pp tt)
+            return (concat matches)
+
+      (PP q p pp, ([], QC r f, tt)) | 
+            -- q `eqStrIdent` r &&  --- not for inherited AR 10/10/2005
+            p `eqStrIdent` f && length pp == length tt ->
+         do matches <- mapM tryMatch (zip pp tt)
+            return (concat matches)
+      ---- hack for AppPredef bug
+      (PP q p pp, ([], Q r f, tt)) | 
+            -- q `eqStrIdent` r && --- 
+            p `eqStrIdent` f && length pp == length tt ->
+         do matches <- mapM tryMatch (zip pp tt)
+            return (concat matches)
+
+      (PR r, ([],R r',[])) |
+            all (`elem` map fst r') (map fst r) ->
+         do matches <- mapM tryMatch 
+                            [(p,snd a) | (l,p) <- r, let Just a = lookup l r']
+            return (concat matches)
+      (PT _ p',_) -> trym p' t'
+
+--      (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
+
+      (PAs x p',_) -> do
+         subst <- trym p' t'
+         return $ (x,t) : subst
+
+      (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
+
+      (PNeg p',_) -> case tryMatch (p',t) of
+        Bad _ -> return []
+        _ -> prtBad "no match with negative pattern" p
+
+      (PSeq p1 p2, ([],K s, [])) -> do
+         let cuts = [splitAt n s | n <- [0 .. length s]] 
+         matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
+         return (concat matches)
+
+      (PRep p1, ([],K s, [])) -> checks [
+         trym (foldr (const (PSeq p1)) (PString "") 
+           [1..n]) t' | n <- [0 .. length s]
+        ] >>
+        return []
+
+      (PChar,  ([],K [_], [])) -> return []
+      (PChars cs, ([],K [c], [])) | elem c cs -> return []
+
+      _ -> prtBad "no match in case expr for" t
+
+eqStrIdent = (==) ----  
+
+isInConstantForm :: Term -> Bool
+isInConstantForm trm = case trm of
+    Con _    -> True
+    Q _ _    -> True
+    QC _ _   -> True
+    Abs _ _  -> True
+    App c a  -> isInConstantForm c && isInConstantForm a
+    R r      -> all (isInConstantForm . snd . snd) r
+    K _      -> True
+    Empty    -> True
+    EInt _   -> True
+    _       -> False ---- isInArgVarForm trm
+
+varsOfPatt :: Patt -> [Ident]
+varsOfPatt p = case p of
+  PV x -> [x | not (isWildIdent x)]
+  PC _ ps -> concat $ map varsOfPatt ps
+  PP _ _ ps -> concat $ map varsOfPatt ps
+  PR r    -> concat $ map (varsOfPatt . snd) r
+  PT _ q -> varsOfPatt q
+  _ -> []
+
diff --git a/src-3.0/GF/Devel/Grammar/PrGF.hs b/src-3.0/GF/Devel/Grammar/PrGF.hs
new file mode 100644
index 000000000..221a0ac61
--- /dev/null
+++ b/src-3.0/GF/Devel/Grammar/PrGF.hs
@@ -0,0 +1,246 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/04 11:45:38 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003 - 4/12/2007
+--
+-- printing and prettyprinting class for source grammar
+--
+-- 8\/1\/2004:
+-- Usually followed principle: 'prt_' for displaying in the editor, 'prt'
+-- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree',
+-- only the former is ever needed.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Grammar.PrGF where
+
+import qualified GF.Devel.Compile.PrintGF as P
+import GF.Devel.Grammar.GFtoSource
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+----import GF.Grammar.Values
+
+----import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Infra.CompactPrint
+----import GF.Data.Str
+
+import GF.Data.Operations
+----import GF.Data.Zipper
+
+import Data.List (intersperse)
+
+class Print a where
+  prt  :: a -> String
+  -- | printing with parentheses, if needed
+  prt2 :: a -> String
+  -- | pretty printing
+  prpr :: a -> [String]
+  -- | printing without ident qualifications
+  prt_ :: a -> String 
+  prt2 = prt
+  prt_ = prt
+  prpr = return . prt
+
+-- 8/1/2004
+--- Usually followed principle: prt_ for displaying in the editor, prt
+--- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
+--- only the former is ever needed.
+
+cprintTree :: P.Print a => a -> String
+cprintTree = compactPrint . P.printTree
+
+-- | to show terms etc in error messages
+prtBad :: Print a => String -> a -> Err b
+prtBad s a = Bad (s +++ prt a)
+
+prGF :: GF -> String
+prGF = cprintTree . trGrammar
+
+instance Print GF where
+  prt = cprintTree . trGrammar
+
+prModule :: SourceModule -> String
+prModule = cprintTree . trModule
+
+instance Print Judgement where
+  prt j = cprintTree $ trAnyDef (wildIdent, j)
+----  prt_ = prExp
+
+instance Print Term where
+  prt = cprintTree . trt
+----  prt_ = prExp
+
+instance Print Ident where
+  prt = cprintTree . tri
+
+instance Print Patt where
+  prt = P.printTree . trp
+
+instance Print Label where
+  prt = P.printTree . trLabel
+
+{-
+instance Print MetaSymb where
+  prt (MetaSymb i) = "?" ++ show i
+
+prParam :: Param -> String
+prParam (c,co) = prt c +++ prContext co
+
+prContext :: Context -> String
+prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
+
+
+-- printing values and trees in editing
+
+instance Print a => Print (Tr a) where
+  prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
+  prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
+
+-- | we cannot define the method prt_ in this way 
+prt_Tree :: Tree -> String
+prt_Tree = prt_ . tree2exp
+
+instance Print TrNode where
+  prt (N (bi,at,vt,(cs,ms),_)) = 
+    prBinds bi ++ 
+    prt at +++ ":" +++ prt vt 
+    +++ prConstraints cs +++ prMetaSubst ms
+  prt_ (N (bi,at,vt,(cs,ms),_)) = 
+    prBinds bi ++ 
+    prt_ at +++ ":" +++ prt_ vt 
+    +++ prConstraints cs +++ prMetaSubst ms
+
+prMarkedTree :: Tr (TrNode,Bool) -> [String]
+prMarkedTree = prf 1 where
+  prf ind t@(Tr (node, trees)) = 
+    prNode ind node : concatMap (prf (ind + 2)) trees
+  prNode ind node = case node of
+    (n, False) -> indent ind (prt_ n)
+    (n, _)     -> '*' : indent (ind - 1) (prt_ n)
+
+prTree :: Tree -> [String]
+prTree = prMarkedTree . mapTr (\n -> (n,False))
+
+-- | a pretty-printer for parsable output
+tree2string :: Tree -> String
+tree2string = unlines . prprTree
+
+prprTree :: Tree -> [String]
+prprTree = prf False where
+  prf par t@(Tr (node, trees)) = 
+    parIf par (prn node : concat [prf (ifPar t) t | t <- trees])
+  prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at
+  prb [] = ""
+  prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
+  parIf par (s:ss) = map (indent 2) $
+                         if par 
+                            then ('(':s) : ss ++ [")"] 
+                            else s:ss
+  ifPar (Tr (N ([],_,_,_,_), [])) = False
+  ifPar _ = True
+
+
+-- auxiliaries
+
+prConstraints :: Constraints -> String
+prConstraints = concat . prConstrs
+
+prMetaSubst :: MetaSubst -> String
+prMetaSubst = concat . prMSubst
+  
+prEnv :: Env -> String
+---- prEnv [] = prCurly "" ---- for debugging
+prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
+
+prConstrs :: Constraints -> [String]
+prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w))
+
+prMSubst :: MetaSubst -> [String]
+prMSubst = map (\ (m,e) -> prCurly ("?" ++ show m ++ "=" ++ prt e))
+
+prBinds bi = if null bi 
+                then [] 
+                else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
+ where
+   prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
+
+instance Print Val where
+  prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging
+  prt (VApp u v) = prt u +++ prv1 v
+  prt (VCn mc) = prQIdent_ mc
+  prt (VClos env e) = case e of
+    Meta _ -> prt_ e ++ prEnv env
+    _      -> prt_ e ---- ++ prEnv env ---- for debugging
+  prt VType = "Type"
+ 
+prv1 v = case v of
+  VApp _ _  -> prParenth $ prt v
+  VClos _ _ -> prParenth $ prt v
+  _ -> prt v
+
+instance Print Atom where
+  prt (AtC f) = prQIdent f
+  prt (AtM i) = prt i
+  prt (AtV i) = prt i
+  prt (AtL s) = prQuotedString s
+  prt (AtI i) = show i
+  prt (AtF i) = show i
+  prt_ (AtC (_,f)) = prt f 
+  prt_ a = prt a
+
+prQIdent :: QIdent -> String
+prQIdent (m,f) = prt m ++ "." ++ prt f
+
+prQIdent_ :: QIdent -> String
+prQIdent_ (_,f) = prt f
+
+-- | print terms without qualifications
+prExp :: Term -> String
+prExp e = case e of
+  App f a    -> pr1 f +++ pr2 a
+  Abs x b    -> "\\" ++ prt x +++ "->" +++ prExp b
+  Prod x a b -> "(\\" ++ prt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b
+  Q _ c      -> prt c
+  QC _ c     -> prt c  
+  _ -> prt e
+ where
+   pr1 e = case e of
+     Abs _ _    -> prParenth $ prExp e
+     Prod _ _ _ -> prParenth $ prExp e
+     _ -> prExp e
+   pr2 e = case e of
+     App _ _ -> prParenth $ prExp e
+     _ -> pr1 e
+
+-- | option @-strip@ strips qualifications
+prTermOpt :: Options -> Term -> String
+prTermOpt opts = if oElem nostripQualif opts then prt else prExp
+
+-- | to get rid of brackets in the editor
+prRefinement :: Term -> String
+prRefinement t = case t of
+    Q m c  -> prQIdent (m,c)
+    QC m c -> prQIdent (m,c)
+    _ -> prt t
+
+prOperSignature :: (QIdent,Type) -> String
+prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t
+
+-- to look up a constant etc in a search tree
+
+lookupIdent :: Ident -> BinTree Ident b -> Err b
+lookupIdent c t = case lookupTree prt c t of
+  Ok v -> return v
+  _ -> prtBad "unknown identifier" c
+
+lookupIdentInfo :: Module Ident f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)
+-}
diff --git a/src-3.0/GF/Devel/GrammarToGFCC.hs b/src-3.0/GF/Devel/GrammarToGFCC.hs
new file mode 100644
index 000000000..2c1bbc169
--- /dev/null
+++ b/src-3.0/GF/Devel/GrammarToGFCC.hs
@@ -0,0 +1,545 @@
+module GF.Devel.GrammarToGFCC (prGrammar2gfcc,mkCanon2gfcc,addParsers) where
+
+import GF.Devel.OptimizeGF (unshareModule)
+
+import GF.Grammar.Grammar
+import qualified GF.Grammar.Lookup as Look
+
+import qualified GF.GFCC.Macros as CM
+import qualified GF.GFCC.DataGFCC as C
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+import qualified GF.Grammar.Abstract as A
+import qualified GF.Grammar.Macros as GM
+--import qualified GF.Grammar.Compute as Compute
+import qualified GF.Infra.Modules as M
+import qualified GF.Infra.Option as O
+
+import GF.Conversion.SimpleToFCFG (convertConcrete)
+import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
+import GF.Devel.PrGrammar
+import GF.Devel.PrintGFCC
+import GF.Devel.ModDeps
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Text.UTF8
+
+import Data.List
+import Data.Char (isDigit,isSpace)
+import qualified Data.Map as Map
+import Debug.Trace ----
+
+-- when developing, swap commenting
+
+--traceD s t = trace s t 
+traceD s t = t 
+
+
+-- the main function: generate GFCC from GF.
+
+prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String)
+prGrammar2gfcc opts cnc gr = (abs,printGFCC gc) where
+  (abs,gc) = mkCanon2gfcc opts cnc gr 
+
+mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.GFCC)
+mkCanon2gfcc opts cnc gr = 
+  (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
+  where
+    abs = err error id $ M.abstractOfConcrete gr (identC cnc)
+    pars = mkParamLincat gr
+
+-- Adds parsers for all concretes
+addParsers :: D.GFCC -> D.GFCC
+addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) }
+  where
+    conv cnc = cnc { D.parser = Just (buildFCFPInfo (convertConcrete (D.abstract gfcc) cnc)) }
+
+-- Generate GFCC from GFCM.
+-- this assumes a grammar translated by canon2canon
+
+canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.GFCC
+canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
+  (if (oElem (iOpt "show_canon") opts) then trace (prGrammar cgr) else id) $
+     D.GFCC an cns gflags abs cncs 
+ where
+  -- abstract
+  an  = (i2i a)
+  cns = map (i2i . fst) cms
+  abs = D.Abstr aflags funs cats catfuns
+  gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] 
+                                          where fg = "firstlang"
+  aflags = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags abm]
+  mkDef pty = case pty of
+    Yes t -> mkExp t
+    _ -> CM.primNotion
+
+  -- concretes
+  lfuns = [(f', (mkType ty, mkDef pty)) | 
+             (f,AbsFun (Yes ty) pty) <- tree2list (M.jments abm), let f' = i2i f]
+  funs = Map.fromAscList lfuns
+  lcats = [(i2i c, mkContext cont) |
+                (c,AbsCat (Yes cont) _) <- tree2list (M.jments abm)]
+  cats = Map.fromAscList lcats
+  catfuns = Map.fromList 
+    [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
+
+  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,M.ModMod mo) <- cms]
+  mkConcr lang0 lang mo = 
+      (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
+    where
+      js = tree2list (M.jments mo)
+      flags   = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags mo]
+      opers   = Map.fromAscList [] -- opers will be created as optimization
+      utf     = if elem (Opt ("coding",["utf8"])) (M.flags mo) 
+                  then D.convertStringsInTerm decodeUTF8 else id
+      lins    = Map.fromAscList 
+        [(i2i f, utf (mkTerm tr))  | (f,CncFun _ (Yes tr) _) <- js]
+      lincats = Map.fromAscList 
+        [(i2i c, mkCType ty) | (c,CncCat (Yes ty) _ _) <- js]
+      lindefs = Map.fromAscList 
+        [(i2i c, mkTerm tr)  | (c,CncCat _ (Yes tr) _) <- js]
+      printnames = Map.union 
+        (Map.fromAscList [(i2i f, mkTerm tr) | (f,CncFun _ _ (Yes tr)) <- js])
+        (Map.fromAscList [(i2i f, mkTerm tr) | (f,CncCat _ _ (Yes tr)) <- js])
+      params = Map.fromAscList 
+        [(i2i c, pars lang0 c) | (c,CncCat (Yes ty) _ _) <- js]
+      fcfg = Nothing
+
+i2i :: Ident -> CId
+i2i = CId . prIdent
+
+mkType :: A.Type -> C.Type
+mkType t = case GM.typeForm t of
+  Ok (hyps,(_,cat),args) -> C.DTyp (mkContext hyps) (i2i cat) (map mkExp args)
+
+mkExp :: A.Term -> C.Exp
+mkExp t = case t of
+  A.Eqs eqs -> C.EEq [C.Equ (map mkPatt ps) (mkExp e) | (ps,e) <- eqs]
+  _ -> case GM.termForm t of
+    Ok (xx,c,args) -> C.DTr [i2i x | x <- xx] (mkAt c) (map mkExp args) 
+ where
+  mkAt c = case c of 
+    Q _ c  -> C.AC $ i2i c
+    QC _ c -> C.AC $ i2i c
+    Vr x   -> C.AV $ i2i x
+    EInt i -> C.AI i
+    EFloat f -> C.AF f
+    K s    -> C.AS s
+    Meta (MetaSymb i) -> C.AM $ toInteger i
+    _ -> C.AM 0
+  mkPatt p = uncurry CM.tree $ case p of
+    A.PP _ c ps -> (C.AC (i2i c), map mkPatt ps)
+    A.PV x      -> (C.AV (i2i x), [])
+    A.PW        -> (C.AV CM.wildCId, [])
+    A.PInt i    -> (C.AI i, [])
+
+mkContext :: A.Context -> [C.Hypo]
+mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps]
+
+mkTerm :: Term -> C.Term
+mkTerm tr = case tr of
+  Vr (IA (_,i)) -> C.V i
+  Vr (IAV (_,_,i)) -> C.V i
+  Vr (IC s) | isDigit (last s) -> 
+    C.V (read (reverse (takeWhile (/='_') (reverse s)))) 
+    ---- from gf parser of gfc
+  EInt i      -> C.C $ fromInteger i
+  R rs     -> C.R [mkTerm t | (_, (_,t)) <- rs]
+  P t l    -> C.P (mkTerm t) (C.C (mkLab l))
+  TSh _ _    -> error $ show tr
+  T _ cs   -> C.R [mkTerm t | (_,t) <- cs] ------
+  V _ cs   -> C.R [mkTerm t | t <- cs]
+  S t p    -> C.P (mkTerm t) (mkTerm p)
+  C s t    -> C.S $ concatMap flats [mkTerm x | x <- [s,t]]
+  FV ts    -> C.FV [mkTerm t | t <- ts]
+  K s      -> C.K (C.KS s)
+-----  K (KP ss _) -> C.K (C.KP ss []) ---- TODO: prefix variants
+  Empty    -> C.S []
+  App _ _  -> prtTrace tr $ C.C 66661          ---- for debugging
+  Abs _ t  -> mkTerm t ---- only on toplevel
+  Alts (td,tvs) -> 
+    C.K (C.KP (strings td) [C.Var (strings u) (strings v) | (u,v) <- tvs])
+  _ -> prtTrace tr $ C.S [C.K (C.KS (A.prt tr +++ "66662"))] ---- for debugging
+ where
+   mkLab (LIdent l) = case l of
+     '_':ds -> (read ds) :: Int
+     _ -> prtTrace tr $ 66663
+   strings t = case t of
+     K s -> [s]
+     C u v -> strings u ++ strings v
+     Strs ss -> concatMap strings ss
+     _ -> prtTrace tr $ ["66660"]
+   flats t = case t of
+     C.S ts -> concatMap flats ts
+     _ -> [t]
+
+-- encoding GFCC-internal lincats as terms
+mkCType :: Type -> C.Term
+mkCType t = case t of
+  EInt i      -> C.C $ fromInteger i
+  RecType rs  -> C.R [mkCType t | (_, t) <- rs]
+  Table pt vt -> case pt of
+    EInt i -> C.R $ replicate (1 + fromInteger i) $ mkCType vt
+    RecType rs -> mkCType $ foldr Table vt (map snd rs) 
+  Sort "Str"        -> C.S [] --- Str only
+  App (Q (IC "Predef") (IC "Ints")) (EInt i) -> C.C $ fromInteger i
+  _ -> error  $ "mkCType " ++ show t
+
+-- encoding showable lincats (as in source gf) as terms
+mkParamLincat :: SourceGrammar -> Ident -> Ident -> C.Term
+mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do 
+  typ <- Look.lookupLincat sgr lang cat
+  mkPType typ
+ where
+  mkPType typ = case typ of
+    RecType lts -> do
+      ts <- mapM (mkPType . snd) lts
+      return $ C.R [ C.P (kks $ prt_ l) t | ((l,_),t) <- zip lts ts]
+    Table (RecType lts) v -> do
+      ps <- mapM (mkPType . snd) lts
+      v' <- mkPType v
+      return $ foldr (\p v -> C.S [p,v]) v' ps
+    Table p v -> do
+      p' <- mkPType p
+      v' <- mkPType v
+      return $ C.S [p',v']
+    Sort "Str" -> return $ C.S []
+    _ -> return $ 
+      C.FV $ map (kks . filter showable . prt_) $ 
+             errVal [] $ Look.allParamValues sgr typ
+  showable c = not (isSpace c) ---- || (c == ' ')  -- to eliminate \n in records
+  kks = C.K . C.KS
+
+-- return just one module per language
+
+reorder :: Ident -> SourceGrammar -> SourceGrammar
+reorder abs cg = M.MGrammar $ 
+    (abs, M.ModMod $ 
+          M.Module M.MTAbstract M.MSComplete aflags [] [] adefs):
+      [(c, M.ModMod $ 
+          M.Module (M.MTConcrete abs) M.MSComplete fs [] [] (sorted2tree js)) 
+            | (c,(fs,js)) <- cncs] 
+     where
+       mos = M.allModMod cg
+       adefs = sorted2tree $ sortIds $
+                 predefADefs ++ Look.allOrigInfos cg abs
+       predefADefs = 
+         [(IC c, AbsCat (Yes []) Nope) | c <- ["Float","Int","String"]]
+       aflags = nubFlags $ 
+         concat [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo]
+
+       cncs = sortIds [(lang, concr lang) | lang <- M.allConcretes cg abs]
+       concr la = (nubFlags flags, 
+                   sortIds (predefCDefs ++ jments)) where 
+         jments = Look.allOrigInfos cg la
+         flags  = concat [M.flags mo | 
+                     (i,mo) <- mos, M.isModCnc mo, 
+                     Just r <- [lookup i (M.allExtendSpecs cg la)]]
+
+         predefCDefs = 
+           (IC "Int", CncCat (Yes Look.linTypeInt) Nope Nope) : 
+           [(IC c, CncCat (Yes GM.defLinType) Nope Nope) | 
+                                    ---- lindef,printname 
+                         c <- ["Float","String"]]
+
+       sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
+       nubFlags = nubBy (\ (Opt (f,_)) (Opt (g,_)) -> f == g)
+
+
+-- one grammar per language - needed for symtab generation
+repartition :: Ident -> SourceGrammar -> [SourceGrammar]
+repartition abs cg = [M.partOfGrammar cg (lang,mo) | 
+  let mos = M.allModMod cg,
+  lang <- M.allConcretes cg abs,
+  let mo = errVal 
+       (error ("no module found for " ++ A.prt lang)) $ M.lookupModule cg lang
+  ]
+ 
+
+-- translate tables and records to arrays, parameters and labels to indices
+
+canon2canon :: Ident -> SourceGrammar -> SourceGrammar
+canon2canon abs = 
+   recollect . map cl2cl . repartition abs . purgeGrammar abs 
+ where
+  recollect = M.MGrammar . nubBy (\ (i,_) (j,_) -> i==j) . concatMap M.modules
+  cl2cl = M.MGrammar . js2js . map (c2c p2p) . M.modules
+    
+  js2js ms = map (c2c (j2j (M.MGrammar ms))) ms
+
+  c2c f2 (c,m) = case m of
+      M.ModMod mo@(M.Module _ _ _ _ _ js) ->
+        (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 js)
+      _ -> (c,m)    
+  j2j cg (f,j) = case j of
+      CncFun x (Yes tr) z -> (f,CncFun x (Yes (t2t tr)) z)
+      CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y)
+      _ -> (f,j)
+   where
+      t2t = term2term cg pv
+      ty2ty = type2type cg pv
+      pv@(labels,untyps,typs) = trs $ paramValues cg
+
+    -- flatten record arguments of param constructors
+  p2p (f,j) = case j of
+      ResParam (Yes (ps,v)) -> 
+        (f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing)))
+      _ -> (f,j)
+  unRec (x,ty) = case ty of
+      RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)] 
+      _ -> [(x,ty)]
+
+----
+  trs v = traceD (tr v) v
+
+  tr (labels,untyps,typs) =
+     ("LABELS:" ++++
+       unlines [A.prt c ++ "." ++ unwords (map A.prt l) +++ "=" +++ show i  | 
+       ((c,l),i) <- Map.toList labels]) ++++
+     ("UNTYPS:" ++++ unlines [A.prt t +++ "=" +++ show i | 
+       (t,i) <- Map.toList untyps]) ++++
+     ("TYPS:" ++++ unlines [A.prt t +++ "=" +++ show (Map.assocs i) | 
+       (t,i) <- Map.toList typs])
+----
+
+purgeGrammar :: Ident -> SourceGrammar -> SourceGrammar
+purgeGrammar abstr gr = 
+  (M.MGrammar . list . map unopt . filter complete . purge . M.modules) gr 
+ where
+  list ms = traceD ("MODULES" +++ unwords (map (prt . fst) ms)) ms
+  purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+  needed = nub $ concatMap (requiredCanModules isSingle gr) acncs
+  acncs = abstr : M.allConcretes gr abstr
+  isSingle = True
+  complete (i,M.ModMod m) = M.isCompleteModule m --- not . isIncompleteCanon
+  unopt = unshareModule gr -- subexp elim undone when compiled
+
+type ParamEnv =
+  (Map.Map (Ident,[Label]) (Type,Integer), -- numbered labels
+   Map.Map Term Integer,                   -- untyped terms to values
+   Map.Map Type (Map.Map Term Integer))    -- types to their terms to values
+
+--- gathers those param types that are actually used in lincats and lin terms
+paramValues :: SourceGrammar -> ParamEnv
+paramValues cgr = (labels,untyps,typs) where
+  partyps = nub $ 
+            --- [App (Q (IC "Predef") (IC "Ints")) (EInt i) | i <- [1,9]] ---linTypeInt 
+{-
+            [ty | 
+              (_,(_,CncCat (Yes (RecType ls)) _ _)) <- jments,
+              ty0 <- [ty | (_, ty) <- unlockTyp ls],
+              ty  <- typsFrom ty0
+-}
+            [ty | 
+              (_,(_,CncCat (Yes ty0) _ _)) <- jments,
+              ty  <- typsFrom ty0
+            ] ++ [
+             Q m ty | 
+              (m,(ty,ResParam _)) <- jments
+            ] ++ [ty | 
+              (_,(_,CncFun _ (Yes tr) _)) <- jments,
+              ty  <- err (const []) snd $ appSTM (typsFromTrm tr) []
+            ]
+  params = [(ty, errVal (traceD ("UNKNOWN PARAM TYPE" +++ show ty) []) $ 
+                                         Look.allParamValues cgr ty) | ty <- partyps]
+  typsFrom ty = unlockTy ty : case ty of
+    Table p t  -> typsFrom p ++ typsFrom t
+    RecType ls -> concat [typsFrom t | (_, t) <- ls]
+    _ -> []
+ 
+  typsFromTrm :: Term -> STM [Type] Term
+  typsFromTrm tr = case tr of
+    R fs -> mapM_ (typsFromField . snd) fs >> return tr 
+      where
+        typsFromField (mty, t) = case mty of
+          Just x -> updateSTM (x:) >> typsFromTrm t
+          _ -> typsFromTrm t
+    V ty ts -> updateSTM (ty:) >> mapM_ typsFromTrm ts >> return tr
+    T (TTyped ty) cs -> 
+      updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr
+    T (TComp ty) cs -> 
+      updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr
+    _ -> GM.composOp typsFromTrm tr
+
+  jments = 
+    [(m,j) | (m,mo) <- M.allModMod cgr, j <- tree2list $ M.jments mo]
+  typs = 
+    Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
+  untyps = 
+    Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
+  lincats = 
+    [(IC "Int",[f | let RecType fs = Look.linTypeInt, f <- fs])] ++
+    [(IC cat,[(LIdent "s",GM.typeStr)]) | cat <- ["Float", "String"]] ++
+    reverse ---- TODO: really those lincats that are reached
+            ---- reverse is enough to expel overshadowed ones... 
+      [(cat,ls) | (_,(cat,CncCat (Yes ty) _ _)) <- jments, 
+                  RecType ls <- [unlockTy ty]]
+----      [(cat,(unlockTyp ls)) | (_,(cat,CncCat (Yes (RecType ls)) _ _)) <- jments]
+  labels = Map.fromList $ concat 
+    [((cat,[lab]),(typ,i)): 
+      [((cat,[LVar v]),(typ,toInteger (mx + v))) | v <- [0,1]] ++ ---- 1 or 2 vars 
+      [((cat,[lab,lab2]),(ty,j)) | 
+        rs <- getRec typ, ((lab2, ty),j) <- zip rs [0..]] 
+      | 
+        (cat,ls) <- lincats, ((lab, typ),i) <- zip ls [0..], let mx = length ls]
+    -- go to tables recursively
+    ---- TODO: even go to deeper records
+   where
+     getRec typ = case typ of
+       RecType rs -> [rs] ---- [unlockTyp rs]  -- (sort (unlockTyp ls))
+       Table _ t  -> getRec t
+       _ -> []
+
+type2type :: SourceGrammar -> ParamEnv -> Type -> Type
+type2type cgr env@(labels,untyps,typs) ty = case ty of
+  RecType rs ->
+    RecType [(mkLab i, t2t t) | (i,(l, t)) <- zip [0..] (unlockTyp rs)]
+  Table pt vt -> Table (t2t pt) (t2t vt)
+  QC _ _ -> look ty
+  _ -> ty
+ where
+   t2t = type2type cgr env
+   look ty = EInt $ (+ (-1)) $ toInteger $ case Map.lookup ty typs of
+     Just vs -> length $ Map.assocs vs
+     _ -> trace ("unknown partype " ++ show ty) 66669
+
+term2term :: SourceGrammar -> ParamEnv -> Term -> Term
+term2term cgr env@(labels,untyps,typs) tr = case tr of
+  App _ _ -> mkValCase (unrec tr)
+  QC  _ _ -> mkValCase tr 
+  R rs    -> R [(mkLab i, (Nothing, t2t t)) | 
+                 (i,(l,(_,t))) <- zip [0..] (sort (unlock rs))]
+  P  t l   -> r2r tr
+  PI t l i -> EInt $ toInteger i
+
+  T (TWild _) _ -> error $ "wild" +++ prt tr
+  T (TComp  ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
+  T (TTyped ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
+  V ty ts  -> mkCurry $ V ty [t2t t | t <- ts]
+  S t p    -> mkCurrySel (t2t t) (t2t p)
+
+  _ -> GM.composSafeOp t2t tr
+ where
+   t2t = term2term cgr env
+
+   unrec t = case t of
+     App f (R fs) -> GM.mkApp (unrec f) [unrec u | (_,(_,u)) <- fs]
+     _ -> GM.composSafeOp unrec t
+
+   mkValCase tr = case appSTM (doVar tr) [] of
+     Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st
+     _ -> valNum $ comp tr
+
+   --- this is mainly needed for parameter record projections
+   ---- was: errVal t $ Compute.computeConcreteRec cgr t
+   comp t = case t of
+     T (TComp typ) ts  -> comp $ V typ (map (comp . snd) ts)  ---- should...
+     T (TTyped typ) ts -> comp $ V typ (map (comp . snd) ts)  ---- should
+     V typ ts -> V typ (map comp ts)
+     S tb (FV ts) -> FV $ map (comp . S tb) ts
+     S (V typ ts) v0 -> err error id $ do
+       let v = comp v0 
+       return $ maybe t (comp . (ts !!) . fromInteger) $ Map.lookup v untyps
+     R r -> R [(l,(ty,comp t)) | (l,(ty,t)) <- r]
+     P (R r) l -> maybe t (comp . snd) $ lookup l r
+     _ -> GM.composSafeOp comp t
+
+   doVar :: Term -> STM [((Type,[Term]),(Term,Term))] Term
+   doVar tr = case getLab tr of
+     Ok (cat, lab) -> do
+       k <- readSTM >>= return . length
+       let tr' = Vr $ identC $ show k -----
+
+       let tyvs = case Map.lookup (cat,lab) labels of
+             Just (ty,_) -> case Map.lookup ty typs of
+               Just vs -> (ty,[t | 
+                            (t,_) <- sortBy (\x y -> compare (snd x) (snd y)) 
+                                            (Map.assocs vs)])
+               _ -> error $ "doVar1" +++ A.prt ty
+             _ -> error $ "doVar2" +++ A.prt tr +++ show (cat,lab) ---- debug
+       updateSTM ((tyvs, (tr', tr)):) 
+       return tr'
+     _ -> GM.composOp doVar tr
+
+   r2r tr@(P (S (V ty ts) v) l) = t2t $ S (V ty [comp (P t l) | t <- ts]) v
+
+   r2r tr@(P p _) = case getLab tr of
+     Ok (cat,labs) -> P (t2t p) . mkLab $ 
+          maybe (prtTrace tr $ 66664) snd $ 
+            Map.lookup (cat,labs) labels
+     _ -> K ((A.prt tr +++ prtTrace tr "66665"))
+
+   -- this goes recursively into tables (ignored) and records (accumulated)
+   getLab tr = case tr of
+     Vr (IA (cat, _)) -> return (identC cat,[])
+     Vr (IAV (cat,_,_)) -> return (identC cat,[])
+     Vr (IC s) -> return (identC cat,[]) where
+       cat = takeWhile (/='_') s ---- also to match IAVs; no _ in a cat tolerated
+             ---- init (reverse (dropWhile (/='_') (reverse s))) ---- from gf parser
+----     Vr _ -> error $ "getLab " ++ show tr
+     P p lab2 -> do
+       (cat,labs) <- getLab p
+       return (cat,labs++[lab2]) 
+     S p _ -> getLab p
+     _ -> Bad "getLab"
+
+
+   mkCase ((ty,vs),(x,p)) tr = 
+     S (V ty [mkBranch x v tr | v <- vs]) p
+   mkBranch x t tr = case tr of
+     _ | tr == x -> t
+     _ -> GM.composSafeOp (mkBranch x t) tr     
+
+   valNum tr = maybe (valNumFV $ tryFV tr) EInt $ Map.lookup tr untyps
+    where
+      tryFV tr = case GM.appForm tr of
+        (c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryFV ts)]
+        (FV ts,_) -> ts
+        _ -> [tr]
+      valNumFV ts = case ts of
+        [tr] -> prtTrace tr $ K "66667"
+        _ -> FV $ map valNum ts
+
+   mkCurry trm = case trm of
+     V (RecType [(_,ty)]) ts -> V ty ts 
+     V (RecType ((_,ty):ltys)) ts -> 
+       V ty [mkCurry (V (RecType ltys) cs) | 
+         cs <- chop (product (map (lengthtyp . snd) ltys)) ts] 
+     _ -> trm
+   lengthtyp ty = case Map.lookup ty typs of
+     Just m -> length (Map.assocs m)
+     _ -> error $ "length of type " ++ show ty
+   chop i xs = case splitAt i xs of 
+     (xs1,[])  -> [xs1]
+     (xs1,xs2) -> xs1:chop i xs2
+
+
+   mkCurrySel t p = S t p -- done properly in CheckGFCC
+
+
+mkLab k = LIdent (("_" ++ show k))
+
+-- remove lock fields; in fact, any empty records and record types
+unlock = filter notlock where
+  notlock (l,(_, t)) = case t of --- need not look at l
+     R [] -> False
+     RecType [] -> False
+     _ -> True
+
+unlockTyp = filter notlock
+  
+notlock (l, t) = case t of --- need not look at l
+     RecType [] -> False
+     _ -> True
+
+unlockTy ty = case ty of
+  RecType ls -> RecType $ sort [(l, unlockTy t) | (l,t) <- ls, notlock (l,t)]
+  _ -> GM.composSafeOp unlockTy ty
+
+
+prtTrace tr n = 
+  trace ("-- INTERNAL COMPILER ERROR" +++ A.prt tr ++++ show n) n
+prTrace  tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n
+
+
diff --git a/src-3.0/GF/Devel/Infra/ReadFiles.hs b/src-3.0/GF/Devel/Infra/ReadFiles.hs
new file mode 100644
index 000000000..dd8cbe5a9
--- /dev/null
+++ b/src-3.0/GF/Devel/Infra/ReadFiles.hs
@@ -0,0 +1,348 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ReadFiles
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.26 $
+--
+-- Decide what files to read as function of dependencies and time stamps.
+--
+-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
+--
+-- to find all files that have to be read, put them in dependency order, and
+-- decide which files need recompilation. Name @file.gf@ is returned for them,
+-- and @file.gfo@ otherwise.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Infra.ReadFiles (-- * Heading 1
+		  getAllFiles,fixNewlines,ModName,getOptionsFromFile,
+		  -- * Heading 2
+		  gfoFile,gfFile,isGFO,resModName,isOldFile
+		 ) where
+
+import GF.Devel.Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Devel.UseIO
+
+import System
+import Data.Char
+import Control.Monad
+import Data.List
+import System.Directory
+
+type ModName = String
+type ModEnv  = [(ModName,ModTime)]
+
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
+
+  -- read module headers from all files recursively
+  ds0  <- getImports ps file
+  let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
+  if oElem beVerbose opts 
+    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
+    else return ()
+    -- get a topological sorting of files: returns file names --- deletes paths
+  ds1 <- ioeErr $ either 
+           return 
+           (\ms -> Bad $ "circular modules" +++ 
+                     unwords (map show (head ms))) $ topoTest $ map fst ds
+
+  -- associate each file name with its path --- more optimal: save paths in ds1
+  let paths = [(f,p) | ((f,_),p) <- ds]
+  let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
+  if oElem fromSource opts 
+    then return [gfFile (p </> f) | (p,f) <- pds1]
+    else do
+
+
+    ds2 <- ioeIO $ mapM (selectFormat opts env) pds1
+
+    let ds4 = needCompile opts (map fst ds0) ds2
+    return ds4
+
+-- to decide whether to read gf or gfo, or if in env; returns full file path
+
+data CompStatus =
+   CSComp -- compile: read gf
+ | CSRead -- read gfo
+ | CSEnv  -- gfo is in env
+ | CSEnvR -- also gfr is in env
+ | CSDont -- don't read at all
+ | CSRes  -- read gfr
+  deriving (Eq,Show)
+
+-- for gfo, we also return ModTime to cope with earlier compilation of libs
+
+selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> 
+                IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
+
+selectFormat opts env (p,f) = do
+  let pf = p </> f
+  let mtenv = lookup f env   -- Nothing if f is not in env
+  let rtenv = lookup (resModName f) env
+  let fromComp = oElem isCompiled opts -- i -gfo
+  mtgfc <- getModTime $ gfoFile pf
+  mtgf  <- getModTime $ gfFile pf
+  let stat = case (rtenv,mtenv,mtgfc,mtgf) of
+        (_,Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,_)        | fromComp -> (CSRead,Just tgfc)
+        (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> (CSEnvR,Just tenv)
+        (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> (CSRead,Just tgfc)
+        (_,Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
+        (_,_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
+        _ -> (CSComp,Nothing)
+  return $ (f, (p,stat))
+
+needCompile :: Options -> 
+               [ModuleHeader] -> 
+               [(ModName,(InitPath,(CompStatus,Maybe ModTime)))] -> [FullPath]
+needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
+
+  deps = [(snd m,map fst ms) | (m,ms) <- headers]
+  typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
+  uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m]
+  stat0 m = maybe CSComp (fst . snd) $ lookup m sfiles0
+
+  allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where
+    add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
+
+  -- only treat reused, interface, or instantiation if needed
+  sfiles = sfiles0 ---- map relevant sfiles0
+  relevant fp@(f,(p,(st,_))) = 
+    let us = uses f
+        isUsed = not (null us)
+    in
+    if not (isUsed && all noComp us) then
+      fp else 
+    if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
+        || 
+        (isUsed && all isAux us)) then
+      (f,(p,(CSDont,Nothing))) else
+      fp
+
+  isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd
+  noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst
+
+  -- mark as to be compiled those whose gfo is earlier than a deeper gfo
+  sfiles1 = map compTimes sfiles
+  compTimes fp@(f,(p,(_, Just t))) =
+    if any (> t) [t' | Just fs <- [lookup f deps], 
+                       f0 <- fs,
+                       Just (_,(_,Just t')) <- [lookup f0 sfiles]]
+    then (f,(p,(CSComp, Nothing)))
+    else fp
+  compTimes fp = fp
+
+  -- start with the changed files themselves; returns [ModName]
+  changed = [f | (f,(_,(CSComp,_))) <- sfiles1] 
+
+  -- add other files that depend on some changed file; returns [ModName]
+  iter np = let new = [f | (f,fs) <- deps, 
+                           not (elem f np), any (flip elem np) fs]
+            in  if null new then np else (iter (new ++ np))
+
+  -- for each module in the full list, compile if depends on what needs compile
+  -- returns [FullPath]
+  mark cs = [(f,(path,st)) | 
+                (f,(path,(st0,_))) <- sfiles1, 
+                let st = if (elem f cs) then CSComp else st0]
+
+
+  -- Also read res if the option "retain" is present
+  -- Also, if a "with" file has to be compiled, read its mother file from source
+
+  res cs = map mkRes cs where
+    mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
+      t | (not (null [m | (m,(_,CSComp)) <- cs,
+                                   Just ms <- [lookup m allDeps], elem f ms])
+                    || oElem retainOpers opts)
+        -> if elem t [MTyResource,MTyIncResource] 
+           then (f,(path,CSRes)) else
+              if t == MTyIncomplete
+              then (f,(path,CSComp)) else
+              x
+      _ -> x
+    mkRes x = x
+
+
+
+  -- construct list of paths to read
+  paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
+
+  mkName f p st = mk (p </> f) where
+    mk = case st of
+      CSComp -> gfFile
+      CSRead -> gfoFile
+      CSRes  -> gfoFile ---- gfr
+
+isGFO :: FilePath -> Bool
+isGFO = (== ".gfn") . takeExtensions
+
+gfoFile :: FilePath -> FilePath
+gfoFile f = addExtension f "gfn"
+
+gfFile :: FilePath -> FilePath
+gfFile f = addExtension f "gf"
+
+resModName :: ModName -> ModName
+resModName = ('#':)
+
+-- to get imports without parsing the whole files
+
+getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
+getImports ps = get [] where
+  get ds file0 = do
+    let name = dropExtension file0 ---- dropExtension file0
+    (p,s) <- tryRead name
+    let ((typ,mname),imps) = importsOfFile s
+    let namebody = takeFileName name
+    ioeErr $ testErr  (mname == namebody) $ 
+             "module name" +++ mname +++ "differs from file name" +++ namebody
+    case imps of
+      _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
+      [] -> return $ (((typ,name),[]),p):ds
+      _ -> do
+        let files = map (gfFile . fst) imps 
+        foldM get ((((typ,name),imps),p):ds) files
+  tryRead name = do
+    file <- do
+      let file_gf = gfFile name
+      b <- doesFileExistPath ps file_gf                 -- try gf file first
+      if b then return file_gf else do
+          return (gfoFile name)                         -- gfo next
+
+    readFileIfPath ps $ file
+
+
+
+-- internal module dep information
+
+data ModUse =
+   MUReuse
+ | MUInstance
+ | MUComplete
+ | MUOther
+  deriving (Eq,Show)
+
+data ModTyp =
+   MTyResource
+ | MTyIncomplete
+ | MTyIncResource -- interface, incomplete resource
+ | MTyOther
+  deriving (Eq,Show)
+
+type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
+
+importsOfFile :: String -> ModuleHeader
+importsOfFile = 
+  getModuleHeader .          -- analyse into mod header
+  filter (not . spec) .      -- ignore keywords and special symbols
+  unqual .                   -- take away qualifiers
+  unrestr .                  -- take away union restrictions
+  takeWhile (not . term) .   -- read until curly or semic
+  lexs .                     -- analyse into lexical tokens
+  unComm                     -- ignore comments before the headed line
+ where
+    term = flip elem ["{",";"]
+    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
+    unqual ws = case ws of
+      "(":q:ws' -> unqual ws'
+      w:ws' -> w:unqual ws'
+      _ -> ws
+    unrestr ws = case ws of
+      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
+      w:ws' -> w:unrestr ws'
+      _ -> ws
+
+getModuleHeader :: [String] -> ModuleHeader -- with, reuse
+getModuleHeader ws = case ws of
+  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
+    case ty of
+      MTyResource -> ((MTyIncResource,name),us)
+      _ -> ((MTyIncomplete,name),us)
+  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
+    ((MTyIncResource,name),us)
+ 
+  "resource":name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
+    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
+
+  "instance":name:m:ws2 -> case ws2 of
+    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
+    n:"with":ms -> 
+      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
+    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
+
+  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
+
+    (es,_:ms) -> ((MTyOther,name),
+                  [(m,MUOther)    | m <- es] ++
+                  [(n,MUComplete) | n <- ms])
+    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
+
+  _:name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
+    ---- m:n:"with":ms -> 
+    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
+    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
+  _ -> error "the file is empty"
+
+unComm s = case s of
+      '-':'-':cs -> unComm $ dropWhile (/='\n') cs
+      '{':'-':cs -> dpComm cs
+      c:cs -> c : unComm cs
+      _ -> s
+    
+dpComm s = case s of
+      '-':'}':cs -> unComm cs
+      c:cs -> dpComm cs
+      _ -> s
+    
+lexs s = x:xs where 
+      (x,y) = head $ lex s
+      xs = if null y then [] else lexs y
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile file = do
+  s <- readFileIfStrict file
+  let ls = filter (isPrefixOf "--#") $ lines s
+  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
+
+-- | check if old GF file
+isOldFile :: FilePath -> IO Bool
+isOldFile f = do
+  s <- readFileIfStrict f
+  let s' = unComm s
+  return $ not (null s') && old (head (words s'))
+ where
+   old = flip elem $ words 
+     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
+
+
+
+-- | old GF tolerated newlines in quotes. No more supported!
+fixNewlines :: String -> String
+fixNewlines s = case s of
+     '"':cs -> '"':mk cs
+     c  :cs -> c:fixNewlines cs
+     _ -> s
+ where
+   mk s = case s of
+     '\\':'"':cs -> '\\':'"': mk cs
+     '"'     :cs -> '"' :fixNewlines cs
+     '\n'    :cs -> '\\':'n': mk cs
+     c       :cs -> c : mk cs
+     _ -> s 
+
diff --git a/src-3.0/GF/Devel/ModDeps.hs b/src-3.0/GF/Devel/ModDeps.hs
new file mode 100644
index 000000000..ec5702910
--- /dev/null
+++ b/src-3.0/GF/Devel/ModDeps.hs
@@ -0,0 +1,153 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ModDeps
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
+--
+-- Check correctness of module dependencies. Incomplete.
+--
+-- AR 13\/5\/2003
+-----------------------------------------------------------------------------
+
+module GF.Devel.ModDeps (mkSourceGrammar,
+		moduleDeps,
+		openInterfaces,
+		requiredCanModules
+	       ) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Devel.PrGrammar
+import GF.Compile.Update
+import GF.Grammar.Lookup
+import GF.Infra.Modules
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.List
+
+-- | to check uniqueness of module names and import names, the
+-- appropriateness of import and extend types,
+-- to build a dependency graph of modules, and to sort them topologically
+mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar
+mkSourceGrammar ms = do
+  let ns = map fst ms
+  checkUniqueErr ns
+  mapM (checkUniqueImportNames ns . snd) ms
+  deps    <- moduleDeps ms
+  deplist <- either 
+               return 
+               (\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $ 
+               topoTest deps
+  return $ MGrammar [(m, maybe undefined id $ lookup m ms)  | IdentM m _ <- deplist]
+
+checkUniqueErr ::  (Show i, Eq i) => [i] -> Err ()
+checkUniqueErr ms = do
+  let msg = checkUnique ms
+  if null msg then return () else Bad $ unlines msg
+
+-- | check that import names don't clash with module names
+checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
+checkUniqueImportNames ns mo = case mo of
+  ModMod m -> test [n | OQualif _ n v <- opens m, n /= v]
+  _ -> return () --- Bad $ "bug: ModDeps does not treat" +++ show mo
+ where
+
+  test ms = testErr (all (`notElem` ns) ms)
+                    ("import names clashing with module names among" +++ 
+                       unwords (map prt ms))
+
+type Dependencies = [(IdentM Ident,[IdentM Ident])]
+
+-- | to decide what modules immediately depend on what, and check if the
+-- dependencies are appropriate
+moduleDeps :: [(Ident,SourceModInfo)] -> Err Dependencies
+moduleDeps ms = mapM deps ms where
+  deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
+    ModMod m -> case mtype m of
+      MTConcrete a -> do
+        aty <- lookupModuleType gr a
+        testErr (aty == MTAbstract) "the of-module is not an abstract syntax" 
+        chDep (IdentM c (MTConcrete a)) 
+              (extends m) (MTConcrete a) (opens m) MTResource
+      t -> chDep (IdentM c t) (extends m) t (opens m) t
+
+  chDep it es ety os oty = do
+    ests <- mapM (lookupModuleType gr) es
+    testErr (all (compatMType ety) ests) "inappropriate extension module type" 
+----    osts <- mapM (lookupModuleType gr . openedModule) os
+----    testErr (all (compatOType oty) osts) "inappropriate open module type"
+    let ab = case it of
+               IdentM _ (MTConcrete a) -> [IdentM a MTAbstract]
+               _ -> [] ---- 
+    return (it, ab ++
+                [IdentM e ety | e <- es] ++ 
+                [IdentM (openedModule o) oty | o <- os])
+
+  -- check for superficial compatibility, not submodule relation etc: what can be extended
+  compatMType mt0 mt = case (mt0,mt) of
+    (MTResource,   MTConcrete _) -> True
+    (MTInstance _, MTConcrete _) -> True
+    (MTInterface,  MTAbstract)   -> True
+    (MTConcrete _, MTConcrete _) -> True
+    (MTInstance _, MTInstance _) -> True
+    (MTReuse _, MTReuse _) -> True
+    (MTInstance _, MTResource) -> True
+    (MTResource, MTInstance _) -> True
+    ---- some more?
+    _ -> mt0 == mt
+  -- in the same way; this defines what can be opened
+  compatOType mt0 mt = case mt0 of
+    MTAbstract     -> mt == MTAbstract
+    MTTransfer _ _ -> mt == MTAbstract
+    _ -> case mt of
+      MTResource -> True
+      MTReuse _ -> True
+      MTInterface -> True
+      MTInstance _ -> True
+      _ -> False      
+
+  gr = MGrammar ms --- hack
+
+openInterfaces :: Dependencies -> Ident -> Err [Ident]
+openInterfaces ds m = do
+  let deps = [(i,ds) | (IdentM i _,ds) <- ds]
+  let more (c,_) = [(i,mt) | Just is <- [lookup c deps], IdentM i mt <- is]
+  let mods = iterFix (concatMap more) (more (m,undefined))
+  return $ [i | (i,MTInterface) <- mods]
+
+-- | this function finds out what modules are really needed in the canonical gr.
+-- its argument is typically a concrete module name
+requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i f a -> i -> [i]
+requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
+  exts = allExtends gr c
+  ops  = if isSingle 
+         then map fst (modules gr) 
+         else iterFix (concatMap more) $ exts
+  more i = errVal [] $ do
+    m <- lookupModMod gr i
+    return $ extends m ++ [o | o <- map openedModule (opens m)]
+  notReuse i = errVal True $ do
+    m <- lookupModMod gr i
+    return $ isModRes m -- to exclude reused Cnc and Abs from required
+
+
+{-
+-- to test
+exampleDeps = [
+  (ir "Nat",[ii "Gen", ir "Adj"]),
+  (ir "Adj",[ii "Num", ii "Gen", ir "Nou"]),
+  (ir "Nou",[ii "Cas"])
+  ]
+
+ii s = IdentM (IC s) MTInterface
+ir s = IdentM (IC s) MTResource
+-}
+
diff --git a/src-3.0/GF/Devel/Optimize.hs b/src-3.0/GF/Devel/Optimize.hs
new file mode 100644
index 000000000..b44f6a53d
--- /dev/null
+++ b/src-3.0/GF/Devel/Optimize.hs
@@ -0,0 +1,299 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Optimize
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/16 13:56:13 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.18 $
+--
+-- Top-level partial evaluation for GF source modules.
+-----------------------------------------------------------------------------
+
+module GF.Devel.Optimize (optimizeModule) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.PrGrammar
+import GF.Grammar.Macros
+import GF.Grammar.Lookup
+import GF.Grammar.Refresh
+import GF.Devel.Compute
+import GF.Compile.BackOpt
+import GF.Devel.CheckGrammar
+import GF.Compile.Update
+--import GF.Compile.Evaluate
+
+import GF.Data.Operations
+import GF.Infra.CheckM
+import GF.Infra.Option
+
+import Control.Monad
+import Data.List
+
+import Debug.Trace
+
+
+-- conditional trace
+
+prtIf :: (Print a) => Bool -> a -> a
+prtIf b t = if b then trace (" " ++ prt t) t else t
+
+-- experimental evaluation, option to import
+oEval = iOpt "eval"
+
+-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
+
+type EEnv = () --- not used
+
+-- only do this for resource: concrete is optimized in gfc form
+optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> 
+                  (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
+optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
+  ModMod m0@(Module mt st fs me ops js) | 
+    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+      (mo1,_) <- evalModule oopts mse mo
+      let 
+       mo2 = case optim of
+        "parametrize" -> shareModule paramOpt mo1  -- parametrization and sharing
+        "values"      -> shareModule valOpt mo1    -- tables as courses-of-values
+        "share"       -> shareModule shareOpt mo1  -- sharing of branches
+        "all"         -> shareModule allOpt mo1    -- first parametrize then values
+        "none"        -> mo1                       -- no optimization
+        _             -> mo1                       -- none; default for src
+      return (mo2,eenv)
+  _ -> evalModule oopts mse mo
+ where
+   oopts = addOptions opts (iOpts (flagsModule mo))
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+
+evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 && not (oElem oEval oopts) -> do
+      let deps = allOperDependencies name js
+      ids <- topoSortOpers deps
+      MGrammar (mod' : _) <- foldM evalOp gr ids
+      return $ (mod',eenv)
+
+    MTConcrete a -> do
+      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      return $ ((name, ModMod (Module mt st fs me ops js')),eenv)
+
+    _ -> return $ ((name,mod),eenv)
+  _ -> return $ ((name,mod),eenv)
+ where
+   gr0 = MGrammar $ ms
+   gr  = MGrammar $ (name,mod) : ms
+
+   evalOp g@(MGrammar ((_, ModMod m) : _)) i = do
+     info  <- lookupTree prt i $ jments m
+     info' <- evalResInfo oopts gr (i,info)
+     return $ updateRes g name i info'
+
+-- | only operations need be compiled in a resource, and this is local to each
+-- definition since the module is traversed in topological order
+evalResInfo :: Options -> SourceGrammar -> (Ident,Info) -> Err Info
+evalResInfo oopts gr (c,info) = case info of
+
+  ResOper pty pde -> eIn "operation" $ do
+    pde' <- case pde of
+       Yes de | optres -> liftM yes $ comp de 
+       _ -> return pde
+    return $ ResOper pty pde'
+
+  _ ->  return info
+ where
+   comp = if optres then computeConcrete gr else computeConcreteRec gr
+   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+   optres = case optim of
+     "noexpand" -> False
+     _ -> True
+
+
+evalCncInfo :: 
+  Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
+evalCncInfo opts gr cnc abs (c,info) = do
+
+ seq (prtIf (oElem beVerbose opts) c) $ return ()
+
+ errIn ("optimizing" +++ prt c) $ case info of
+
+  CncCat ptyp pde ppr -> do
+    pde' <- case (ptyp,pde) of
+      (Yes typ, Yes de) -> 
+        liftM yes $ pEval ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, typeStr)],typ)
+      (May b, Nope) ->
+        return $ May b
+      _ -> return pde   -- indirection
+
+    ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c)
+
+    return (c, CncCat ptyp pde' ppr')
+
+  CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> 
+       eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
+    pde' <- case pde of
+      Yes de | notNewEval -> do
+        liftM yes $ pEval ty de
+
+      _ -> return pde
+    ppr' <-  liftM yes $ evalPrintname gr c ppr pde'
+    return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed
+
+  _ ->  return (c,info)
+ where
+   pEval = partEval opts gr
+   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
+   notNewEval = not (oElem oEval opts)
+
+-- | the main function for compiling linearizations
+partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
+partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do
+  let vars  = map fst context
+      args  = map Vr vars
+      subst = [(v, Vr v) | v <- vars]
+      trm1  = mkApp trm args
+  trm3 <- if globalTable 
+             then etaExpand subst trm1 >>= outCase subst
+             else etaExpand subst trm1
+  return $ mkAbs vars trm3
+
+ where 
+
+   globalTable = oElem showAll opts --- i -all
+
+   comp g t = {- refreshTerm t >>= -} computeTerm gr g t
+
+   etaExpand su t = do
+     t' <- comp su t 
+     case t' of
+       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
+       _ -> recordExpand val t' >>= comp su
+   -- don't eta expand records of right length (correct by type checking)
+   rightType t = case (t,val) of
+     (R rs, RecType ts) -> length rs == length ts
+     _ -> False
+
+   outCase subst t = do
+     pts <- getParams context
+     let (args,ptyps) = unzip $ filter (flip occur t . fst) pts
+     if null args 
+       then return t 
+       else do 
+         let argtyp = RecType $ tuple2recordType ptyps
+         let pvars = map (Vr . zIdent . prt) args -- gets eliminated
+         patt <- term2patt $ R $ tuple2record $ pvars
+         let t' = replace (zip args pvars) t
+         t1 <- comp subst $ T (TTyped argtyp) [(patt, t')]
+         return $ S t1 $ R $ tuple2record args
+
+   --- notice: this assumes that all lin types follow the "old JFP style" 
+   getParams = liftM concat . mapM getParam 
+   getParam (argv,RecType rs) = return 
+     [(P (Vr argv) lab, ptyp) | (lab,ptyp) <- rs,  not (isLinLabel lab)] 
+   ---getParam (_,ty) | ty==typeStr = return [] --- in lindef 
+   getParam (av,ty) = 
+     Bad ("record type expected not" +++ prt ty +++ "for" +++ prt av) 
+     --- all lin types are rec types
+
+   replace :: [(Term,Term)] -> Term -> Term
+   replace reps trm = case trm of  
+     -- this is the important case
+     P _ _ -> maybe trm id $ lookup trm reps
+     _ -> composSafeOp (replace reps) trm
+
+   occur t trm = case trm of
+
+     -- this is the important case
+     P _ _   -> t == trm
+     S x y   -> occur t y || occur t x
+     App f x -> occur t x || occur t f
+     Abs _ f -> occur t f
+     R rs    -> any (occur t) (map (snd . snd) rs)
+     T _ cs  -> any (occur t) (map snd cs)
+     C x y   -> occur t x || occur t y
+     Glue x y -> occur t x || occur t y
+     ExtR x y -> occur t x || occur t y
+     FV ts   -> any (occur t) ts
+     V _ ts   -> any (occur t) ts
+     Let (_,(_,x)) y -> occur t x || occur t y
+     _ -> False
+
+
+-- here we must be careful not to reduce
+--   variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}
+--   {s  = variants {"Auto" ; "Wagen"} ; g  = variants {N ; M}} ;
+
+recordExpand :: Type -> Term -> Err Term
+recordExpand typ trm = case unComputed typ of
+  RecType tys -> case trm of
+    FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs]
+    _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
+  _ -> return trm
+
+
+-- | auxiliaries for compiling the resource
+
+mkLinDefault :: SourceGrammar -> Type -> Err Term
+mkLinDefault gr typ = do
+  case unComputed typ of
+    RecType lts -> mapPairsM mkDefField lts >>= (return . Abs strVar . R . mkAssign)
+    _ -> liftM (Abs strVar) $ mkDefField typ
+----    _ -> prtBad "linearization type must be a record type, not" typ
+ where
+   mkDefField typ = case unComputed typ of
+     Table p t  -> do
+       t' <- mkDefField t
+       let T _ cs = mkWildCases t'
+       return $ T (TWild p) cs 
+     Sort "Str" -> return $ Vr strVar
+     QC q p     -> lookupFirstTag gr q p
+     RecType r  -> do
+       let (ls,ts) = unzip r
+       ts' <- mapM mkDefField ts
+       return $ R $ [assign l t | (l,t) <- zip ls ts']
+     _ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val
+     _ -> prtBad "linearization type field cannot be" typ
+
+-- | Form the printname: if given, compute. If not, use the computed
+-- lin for functions, cat name for cats (dispatch made in evalCncDef above).
+--- We cannot use linearization at this stage, since we do not know the
+--- defaults we would need for question marks - and we're not yet in canon.
+evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term
+evalPrintname gr c ppr lin =
+  case ppr of
+    Yes pr -> comp pr
+    _ -> case lin of
+      Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm
+      _ -> return $ K $ prt c ----
+ where
+   comp = computeConcrete gr
+
+   oneBranch t = case t of
+     Abs _ b   -> oneBranch b
+     R   (r:_) -> oneBranch $ snd $ snd r
+     T _ (c:_) -> oneBranch $ snd c
+     V _ (c:_) -> oneBranch c
+     FV  (t:_) -> oneBranch t
+     C x y     -> C (oneBranch x) (oneBranch y)
+     S x _     -> oneBranch x
+     P x _     -> oneBranch x
+     Alts (d,_) -> oneBranch d
+     _ -> t
+
+  --- very unclean cleaner
+   clean s = case s of
+     '+':'+':' ':cs -> clean cs
+     '"':cs -> clean cs
+     c:cs -> c: clean cs
+     _ -> s
+
diff --git a/src-3.0/GF/Devel/OptimizeGF.hs b/src-3.0/GF/Devel/OptimizeGF.hs
new file mode 100644
index 000000000..99e33941f
--- /dev/null
+++ b/src-3.0/GF/Devel/OptimizeGF.hs
@@ -0,0 +1,271 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : OptimizeGF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:33 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- Optimizations on GF source code: sharing, parametrization, value sets.
+--
+-- optimization: sharing branches in tables. AR 25\/4\/2003.
+-- following advice of Josef Svenningsson
+-----------------------------------------------------------------------------
+
+module GF.Devel.OptimizeGF (
+  optModule,unshareModule,unsubexpModule,unoptModule,subexpModule,shareModule
+  ) where 
+
+import GF.Grammar.Grammar
+import GF.Grammar.Lookup
+import GF.Infra.Ident
+import qualified GF.Grammar.Macros as C
+import GF.Grammar.PrGrammar (prt)
+import qualified GF.Infra.Modules as M
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List
+
+optModule :: (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+optModule = subexpModule . shareModule
+
+shareModule = processModule optim
+
+unoptModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+unoptModule gr = unshareModule gr . unsubexpModule
+
+unshareModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+unshareModule gr = processModule (const (unoptim gr))
+
+processModule :: 
+  (Ident -> Term -> Term) -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+processModule opt (i,m) = case m of
+  M.ModMod (M.Module mt st fs me ops js) -> 
+    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+  _ -> (i,m)
+
+shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (opt c t)) m)
+shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (opt c t)) m)
+shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (opt c t)))
+shareInfo _ i = i
+
+-- the function putting together optimizations
+optim :: Ident -> Term -> Term
+optim c = values . factor c 0
+
+-- we need no counter to create new variable names, since variables are 
+-- local to tables (only true in GFC) ---
+
+-- factor parametric branches
+
+factor :: Ident -> Int -> Term -> Term
+factor c i t = case t of
+  T _ [_] -> t
+  T _ []  -> t
+  T (TComp ty) cs -> 
+    T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs]
+  _ -> C.composSafeOp (factor c i) t
+ where
+
+   factors i psvs =   -- we know psvs has at least 2 elements
+     let p   = qqIdent c i
+         vs' = map (mkFun p) psvs
+     in if   allEqs vs'
+        then mkCase p vs' 
+        else psvs
+
+   mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val
+
+   allEqs (v:vs) = all (==v) vs
+
+   mkCase p (v:_) = [(PV p, v)]
+
+--- we hope this will be fresh and don't check... in GFC would be safe
+
+qqIdent c i = identC ("q_" ++ prt c ++ "__" ++ show i)
+
+
+--  we need to replace subterms
+
+replace :: Term -> Term -> Term -> Term
+replace old new trm = case trm of
+  
+  -- these are the important cases, since they can correspond to patterns  
+  QC _ _   | trm == old -> new
+  App t ts | trm == old -> new
+  App t ts              -> App (repl t) (repl ts)
+  R _ | isRec && trm == old -> new
+  _ -> C.composSafeOp repl trm
+ where
+   repl = replace old new
+   isRec = case trm of
+     R _ -> True
+     _ -> False
+
+-- It is very important that this is performed only after case
+-- expansion since otherwise the order and number of values can
+-- be incorrect. Guaranteed by the TComp flag.
+
+values :: Term -> Term
+values t = case t of
+  T ty [(ps,t)]    -> T ty [(ps,values t)] -- don't destroy parametrization
+  T (TComp ty)  cs -> V ty [values t | (_, t) <- cs]
+  T (TTyped ty) cs -> V ty [values t | (_, t) <- cs] 
+        ---- why are these left?
+        ---- printing with GrammarToSource does not preserve the distinction
+  _ -> C.composSafeOp values t
+
+
+-- to undo the effect of factorization
+
+unoptim :: SourceGrammar -> Term -> Term
+unoptim gr = unfactor gr
+
+unfactor :: SourceGrammar -> Term -> Term
+unfactor gr t = case t of
+  T (TTyped ty) [(PV x,u)] -> V ty [restore x v (unfac u) | v <- vals ty]
+  _ -> C.composSafeOp unfac t
+ where
+   unfac = unfactor gr
+   vals  = err error id . allParamValues gr
+   restore x u t = case t of
+     Vr y | y == x -> u
+     _ -> C.composSafeOp (restore x u) t
+
+
+----------------------------------------------------------------------
+
+{-
+This module implements a simple common subexpression elimination
+ for gfc grammars, to factor out shared subterms in lin rules.
+It works in three phases: 
+
+  (1) collectSubterms collects recursively all subterms of forms table and (P x..y)
+      from lin definitions (experience shows that only these forms
+      tend to get shared) and counts how many times they occur
+  (2) addSubexpConsts takes those subterms t that occur more than once
+      and creates definitions of form "oper A''n = t" where n is a
+      fresh number; notice that we assume no ids of this form are in
+      scope otherwise
+  (3) elimSubtermsMod goes through lins and the created opers by replacing largest
+      possible subterms by the newly created identifiers
+
+The optimization is invoked in gf by the flag i -subs.
+
+If an application does not support GFC opers, the effect of this
+optimization can be undone by the function unSubelimCanon.
+
+The function unSubelimCanon can be used to diagnostisize how much
+cse is possible in the grammar. It is used by the flag pg -printer=subs.
+
+-}
+
+subexpModule :: SourceModule -> SourceModule
+subexpModule (mo,m) = errVal (mo,m) $ case m of
+  M.ModMod (M.Module mt st fs me ops js) -> do
+    (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0)
+    js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js
+    return (mo,M.ModMod (M.Module mt st fs me ops js2))
+  _ -> return (mo,m)
+
+unsubexpModule :: SourceModule -> SourceModule
+unsubexpModule mo@(i,m) = case m of
+    M.ModMod (M.Module mt st fs me ops js) | hasSub ljs ->
+      (i, M.ModMod (M.Module mt st fs me ops 
+                     (rebuild (map unparInfo ljs)))) 
+                        where ljs = tree2list js
+    _ -> (i,m)
+  where
+    -- perform this iff the module has opers
+    hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
+    unparInfo (c,info) = case info of
+      CncFun xs (Yes t) m -> [(c, CncFun xs (Yes (unparTerm t)) m)]
+      ResOper (Yes (EInt 8)) _ -> [] -- subexp-generated opers
+      ResOper pty (Yes t) -> [(c, ResOper pty (Yes (unparTerm t)))]
+      _ -> [(c,info)]
+    unparTerm t = case t of
+      Q m c@(IC ('A':'\'':'\'':_)) -> --- name convention of subexp opers
+        errVal t $ liftM unparTerm $ lookupResDef gr m c 
+      _ -> C.composSafeOp unparTerm t
+    gr = M.MGrammar [mo] 
+    rebuild = buildTree . concat
+
+-- implementation
+
+type TermList = Map Term (Int,Int) -- number of occs, id
+type TermM a = STM (TermList,Int) a
+
+addSubexpConsts :: 
+  Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)]
+addSubexpConsts mo tree lins = do
+  let opers = [oper id trm | (trm,(_,id)) <- list]
+  mapM mkOne $ opers ++ lins
+ where
+
+   mkOne (f,def) = case def of
+     CncFun xs (Yes trm) pn -> do
+       trm' <- recomp f trm
+       return (f,CncFun xs (Yes trm') pn)
+     ResOper ty (Yes trm) -> do
+       trm' <- recomp f trm
+       return (f,ResOper ty (Yes trm'))
+     _ -> return (f,def)
+   recomp f t = case Map.lookup t tree of
+     Just (_,id) | ident id /= f -> return $ Q mo (ident id)
+     _ -> C.composOp (recomp f) t
+
+   list = Map.toList tree
+
+   oper id trm = (ident id, ResOper (Yes (EInt 8)) (Yes trm)) 
+   --- impossible type encoding generated opers
+
+getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
+getSubtermsMod mo js = do
+  mapM (getInfo (collectSubterms mo)) js
+  (tree0,_) <- readSTM
+  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
+ where
+   getInfo get fi@(f,i) = case i of
+     CncFun xs (Yes trm) pn -> do
+       get trm
+       return $ fi
+     ResOper ty (Yes trm) -> do
+       get trm
+       return $ fi
+     _ -> return fi
+
+collectSubterms :: Ident -> Term -> TermM Term
+collectSubterms mo t = case t of
+  App f a -> do
+    collect f
+    collect a
+    add t 
+  T ty cs -> do
+    let (_,ts) = unzip cs
+    mapM collect ts
+    add t
+  V ty ts -> do
+    mapM collect ts
+    add t
+----  K (KP _ _)  -> add t
+  _ -> C.composOp (collectSubterms mo) t
+ where
+   collect = collectSubterms mo
+   add t = do
+     (ts,i) <- readSTM
+     let 
+       ((count,id),next) = case Map.lookup t ts of
+         Just (nu,id) -> ((nu+1,id), i)
+         _ ->            ((1,   i ), i+1)
+     writeSTM (Map.insert t (count,id) ts, next)
+     return t --- only because of composOp
+
+ident :: Int -> Ident
+ident i = identC ("A''" ++ show i) ---
+
diff --git a/src-3.0/GF/Devel/Options.hs b/src-3.0/GF/Devel/Options.hs
new file mode 100644
index 000000000..9a4087096
--- /dev/null
+++ b/src-3.0/GF/Devel/Options.hs
@@ -0,0 +1,269 @@
+module GF.Devel.Options 
+    (
+     Err(..), -- FIXME: take from somewhere else
+
+     Options(..),
+     Mode(..), Phase(..), OutputFormat(..), Optimization(..),
+     parseOptions, helpMessage
+    ) where
+
+import Control.Monad
+import Data.Char (toLower)
+import Data.List
+import Data.Maybe
+import System.Console.GetOpt
+import System.FilePath
+
+
+
+
+
+usageHeader :: String
+usageHeader = unlines 
+ ["Usage: gfc [OPTIONS] [FILE [...]]",
+  "",
+  "How each FILE is handled depends on the file name suffix:",
+  "",
+  ".gf Normal or old GF source, will be compiled.",
+  ".gfc Compiled GF source, will be loaded as is.",
+  ".gfe Example-based GF source, will be converted to .gf and compiled.",
+  ".ebnf Extended BNF format, will be converted to .gf and compiled.",
+  ".cf Context-free (BNF) format, will be converted to .gf and compiled.",
+  "",
+  "If multiple FILES are given, they must be normal GF source, .gfc or .gfe files.",
+  "For the other input formats, only one file can be given.",
+  "",
+  "Command-line options:"]
+
+
+helpMessage :: String
+helpMessage = usageInfo usageHeader optDescr
+
+-- Error monad
+
+type ErrorMsg = String
+
+data Err a = Ok a | Errors [ErrorMsg]
+  deriving (Read, Show, Eq)
+
+instance Monad Err where
+  return      = Ok
+  fail e      = Errors [e]
+  Ok a  >>= f = f a
+  Errors s >>= f = Errors s
+
+errors :: [ErrorMsg] -> Err a
+errors = Errors
+
+-- Types
+
+data Mode = Version | Help | Interactive | Compiler
+  deriving (Show,Eq,Ord)
+
+data Phase = Preproc | Convert | Compile | Link
+  deriving (Show,Eq,Ord)
+
+data Encoding = UTF_8 | ISO_8859_1
+  deriving (Show,Eq,Ord)
+
+data OutputFormat = FmtGFCC | FmtJS
+  deriving (Show,Eq,Ord)
+
+data Optimization = OptStem | OptCSE
+  deriving (Show,Eq,Ord)
+
+data Warning = WarnMissingLincat
+  deriving (Show,Eq,Ord)
+
+data Dump = DumpRebuild | DumpExtend | DumpRename | DumpTypecheck | DumpRefresh | DumpOptimize | DumpCanon
+  deriving (Show,Eq,Ord)
+
+data ModuleOptions = ModuleOptions {
+      optPreprocessors   :: [String],
+      optEncoding        :: Encoding,
+      optOptimizations   :: [Optimization],
+      optLibraryPath     :: [FilePath],
+      optSpeechLanguage  :: Maybe String,
+      optBuildParser     :: Bool,
+      optWarnings        :: [Warning],
+      optDump            :: [Dump]
+    }
+  deriving (Show)
+
+data Options = Options {
+      optMode            :: Mode,
+      optStopAfterPhase  :: Phase,
+      optVerbosity       :: Int,
+      optShowCPUTime     :: Bool,
+      optEmitGFO         :: Bool,
+      optGFODir          :: FilePath,
+      optOutputFormats   :: [OutputFormat],
+      optOutputName      :: Maybe String,
+      optOutputFile      :: Maybe FilePath,
+      optOutputDir       :: FilePath,
+      optForceRecomp     :: Bool,
+      optProb            :: Bool,
+      optStartCategory   :: Maybe String,
+      optModuleOptions   :: ModuleOptions
+    }
+  deriving (Show)
+
+-- Option parsing
+
+parseOptions :: [String] -> Err (Options, [FilePath])
+parseOptions args = case errs of
+                      [] -> do o <- foldM (\o f -> f o) defaultOptions opts
+                               return (o, files)
+                      _  -> errors errs
+    where (opts, files, errs) = getOpt RequireOrder optDescr args
+
+parseModuleFlags :: Options -> [(String,String)] -> Err ModuleOptions
+parseModuleFlags opts flags = foldr setOpt (optModuleOptions opts) moduleOptDescr
+  where
+    setOpt (Option _ ss arg _) d
+            | null values = d
+            | otherwise = case arg of
+                            NoArg a -> 
+                            ReqArg (String -> a) _ ->
+OptArg (Maybe String -> a) String
+last values
+        where values = [v | (k,v) <- flags, k `elem` ss ]
+
+-- Default options
+
+defaultModuleOptions :: ModuleOptions
+defaultModuleOptions = ModuleOptions {
+      optPreprocessors   = [],
+      optEncoding        = ISO_8859_1,
+      optOptimizations   = [OptStem,OptCSE],
+      optLibraryPath     = [],  
+      optSpeechLanguage  = Nothing,
+      optBuildParser     = True,
+      optWarnings        = [],
+      optDump            = []
+    }
+
+defaultOptions :: Options
+defaultOptions = Options {
+      optMode            = Interactive,
+      optStopAfterPhase  = Link,
+      optVerbosity       = 1,
+      optShowCPUTime     = False,
+      optEmitGFO         = True,
+      optGFODir          = ".",
+      optOutputFormats   = [FmtGFCC],
+      optOutputName      = Nothing,
+      optOutputFile      = Nothing,
+      optOutputDir       = ".",
+      optForceRecomp     = False,
+      optProb            = False,
+      optStartCategory   = Nothing,
+      optModuleOptions   = defaultModuleOptions
+    }
+
+-- Option descriptions
+
+moduleOptDescr :: [OptDescr (ModuleOptions -> Err ModuleOptions)]
+moduleOptDescr = 
+    [
+     Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",
+     Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",
+     Option [] ["preproc"] (ReqArg preproc "CMD") 
+                 (unlines ["Use CMD to preprocess input files.",
+                           "Multiple preprocessors can be used by giving this option multiple times."]),
+     Option [] ["stem"] (onOff (optimize OptStem) True) "Perform stem-suffix analysis (default on).",
+     Option [] ["cse"] (onOff (optimize OptCSE) True) "Perform common sub-expression elimination (default on).",
+     Option [] ["parser"] (onOff parser True) "Build parser (default on).",
+     Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar."
+    ]
+    where
+       addLibDir   x o = return $ o { optLibraryPath = x:optLibraryPath o }
+       setLibPath  x o = return $ o { optLibraryPath = splitInModuleSearchPath x }
+       preproc     x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
+       optimize  x b o = return $ o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
+       parser      x o = return $ o { optBuildParser = x }
+       language    x o = return $ o { optSpeechLanguage = Just x }
+
+optDescr :: [OptDescr (Options -> Err Options)]
+optDescr = 
+    [
+     Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",
+     Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
+     Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo.",
+     Option ['V'] ["version"] (NoArg (mode Version)) "Display GF version number.",
+     Option ['?','h'] ["help"] (NoArg (mode Help)) "Show help message.",
+     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
+     Option ['q'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
+     Option [] ["batch"] (NoArg (mode Compiler)) "Run in batch compiler mode.",
+     Option [] ["interactive"] (NoArg (mode Interactive)) "Run in interactive mode (default).",
+     Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
+     Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
+     Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).",
+     Option [] ["no-emit-gfo"] (NoArg (emitGFO False)) "Do not create .gfo files.",
+     Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",
+     Option ['f'] ["output-format"] (ReqArg outFmt "FMT") 
+        (unlines ["Output format. FMT can be one of:",
+                  "Multiple concrete: gfcc (default), gar, js, ...",
+                  "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
+                  "Abstract only: haskell, ..."]),
+     Option ['n'] ["output-name"] (ReqArg outName "NAME") 
+           ("Use NAME as the name of the output. This is used in the output file names, "
+            ++ "with suffixes depending on the formats, and, when relevant, "
+            ++ "internally in the output."),
+     Option ['o'] ["output-file"] (ReqArg outFile "FILE") 
+           "Save output in FILE (default is out.X, where X depends on output format.",
+     Option ['D'] ["output-dir"] (ReqArg outDir "DIR") 
+           "Save output files (other than .gfc files) in DIR.",
+     Option [] ["src","force-recomp"] (NoArg (forceRecomp True)) 
+                 "Always recompile from source, i.e. disable recompilation checking.",
+     Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.",
+     Option [] ["startcat"] (ReqArg startcat "CAT") "Use CAT as the start category in the generated grammar."
+    ] ++ map (fmap onModuleOptions) moduleOptDescr
+ where phase       x o = return $ o { optStopAfterPhase = x }
+       mode        x o = return $ o { optMode = x }
+       verbosity mv o  = case mv of
+                           Nothing -> return $ o { optVerbosity = 3 }
+                           Just v  -> case reads v of
+                                        [(i,"")] | i >= 0 -> return $ o { optVerbosity = i }
+                                        _        -> fail $ "Bad verbosity: " ++ show v
+       cpu         x o = return $ o { optShowCPUTime = x }
+       emitGFO     x o = return $ o { optEmitGFO = x }
+       gfoDir      x o = return $ o { optGFODir = x }
+       outFmt      x o = readOutputFormat x >>= \f ->
+                         return $ o { optOutputFormats = optOutputFormats o ++ [f] }
+       outName     x o = return $ o { optOutputName = Just x }
+       outFile     x o = return $ o { optOutputFile = Just x }
+       outDir      x o = return $ o { optOutputDir = x }
+       forceRecomp x o = return $ o { optForceRecomp = x }
+       prob        x o = return $ o { optProb = x }
+       startcat    x o = return $ o { optStartCategory = Just x }
+
+onModuleOptions :: Monad m => (ModuleOptions -> m ModuleOptions) -> Options -> m Options
+onModuleOptions f o = do mo' <- f (optModuleOptions o)
+                         return $ o { optModuleOptions = mo' }
+
+instance Functor OptDescr where
+    fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
+
+instance Functor ArgDescr where
+    fmap f (NoArg x)    = NoArg (f x)
+    fmap f (ReqArg g s) = ReqArg (f . g) s
+    fmap f (OptArg g s) = OptArg (f . g) s
+
+outputFormats :: [(String,OutputFormat)]
+outputFormats = 
+    [("gfcc", FmtGFCC),
+     ("js",   FmtJS)]
+
+onOff :: Monad m => (Bool -> (a -> m a)) -> Bool -> ArgDescr (a -> m a)
+onOff f def = OptArg g "[on,off]"
+  where g ma x = do b <- maybe (return def) readOnOff ma
+                    f b x
+        readOnOff x = case map toLower x of
+                        "on"  -> return True
+                        "off" -> return False
+                        _     -> fail $ "Expected [on,off], got: " ++ show x
+
+readOutputFormat :: Monad m => String -> m OutputFormat
+readOutputFormat s = 
+    maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
diff --git a/src-3.0/GF/Devel/PrGrammar.hs b/src-3.0/GF/Devel/PrGrammar.hs
new file mode 100644
index 000000000..44d1c3200
--- /dev/null
+++ b/src-3.0/GF/Devel/PrGrammar.hs
@@ -0,0 +1,233 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/04 11:45:38 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
+--
+-- printing and prettyprinting class
+--
+-- 8\/1\/2004:
+-- Usually followed principle: 'prt_' for displaying in the editor, 'prt'
+-- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree',
+-- only the former is ever needed.
+-----------------------------------------------------------------------------
+
+module GF.Devel.PrGrammar where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+import GF.Grammar.Grammar
+import GF.Infra.Modules
+import qualified GF.Source.PrintGF as P
+import GF.Grammar.Values
+import GF.Source.GrammarToSource
+--- import GFC (CanonGrammar) --- cycle of modules
+
+import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Data.Str
+
+import Data.List (intersperse)
+
+class Print a where
+  prt  :: a -> String
+  -- | printing with parentheses, if needed
+  prt2 :: a -> String
+  -- | pretty printing
+  prpr :: a -> [String]
+  -- | printing without ident qualifications
+  prt_ :: a -> String 
+  prt2 = prt
+  prt_ = prt
+  prpr = return . prt
+
+-- 8/1/2004
+--- Usually followed principle: prt_ for displaying in the editor, prt
+--- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
+--- only the former is ever needed.
+
+-- | to show terms etc in error messages
+prtBad :: Print a => String -> a -> Err b
+prtBad s a = Bad (s +++ prt a)
+
+prGrammar :: SourceGrammar -> String
+prGrammar = P.printTree . trGrammar
+
+prModule :: (Ident, SourceModInfo) -> String
+prModule  = P.printTree . trModule
+
+instance Print Term where
+  prt = P.printTree . trt
+  prt_ = prExp
+
+instance Print Ident where
+  prt = P.printTree . tri
+
+instance Print Patt where
+  prt = P.printTree . trp
+
+instance Print Label where
+  prt = P.printTree . trLabel
+
+instance Print MetaSymb where
+  prt (MetaSymb i) = "?" ++ show i
+
+prParam :: Param -> String
+prParam (c,co) = prt c +++ prContext co
+
+prContext :: Context -> String
+prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
+
+
+-- printing values and trees in editing
+
+instance Print a => Print (Tr a) where
+  prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
+  prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
+
+-- | we cannot define the method prt_ in this way 
+prt_Tree :: Tree -> String
+prt_Tree = prt_ . tree2exp
+
+instance Print TrNode where
+  prt (N (bi,at,vt,(cs,ms),_)) = 
+    prBinds bi ++ 
+    prt at +++ ":" +++ prt vt 
+    +++ prConstraints cs +++ prMetaSubst ms
+  prt_ (N (bi,at,vt,(cs,ms),_)) = 
+    prBinds bi ++ 
+    prt_ at +++ ":" +++ prt_ vt 
+    +++ prConstraints cs +++ prMetaSubst ms
+
+prMarkedTree :: Tr (TrNode,Bool) -> [String]
+prMarkedTree = prf 1 where
+  prf ind t@(Tr (node, trees)) = 
+    prNode ind node : concatMap (prf (ind + 2)) trees
+  prNode ind node = case node of
+    (n, False) -> indent ind (prt_ n)
+    (n, _)     -> '*' : indent (ind - 1) (prt_ n)
+
+prTree :: Tree -> [String]
+prTree = prMarkedTree . mapTr (\n -> (n,False))
+
+-- | a pretty-printer for parsable output
+tree2string :: Tree -> String
+tree2string = unlines . prprTree
+
+prprTree :: Tree -> [String]
+prprTree = prf False where
+  prf par t@(Tr (node, trees)) = 
+    parIf par (prn node : concat [prf (ifPar t) t | t <- trees])
+  prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at
+  prb [] = ""
+  prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
+  parIf par (s:ss) = map (indent 2) $
+                         if par 
+                            then ('(':s) : ss ++ [")"] 
+                            else s:ss
+  ifPar (Tr (N ([],_,_,_,_), [])) = False
+  ifPar _ = True
+
+
+-- auxiliaries
+
+prConstraints :: Constraints -> String
+prConstraints = concat . prConstrs
+
+prMetaSubst :: MetaSubst -> String
+prMetaSubst = concat . prMSubst
+  
+prEnv :: Env -> String
+---- prEnv [] = prCurly "" ---- for debugging
+prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
+
+prConstrs :: Constraints -> [String]
+prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w))
+
+prMSubst :: MetaSubst -> [String]
+prMSubst = map (\ (m,e) -> prCurly ("?" ++ show m ++ "=" ++ prt e))
+
+prBinds bi = if null bi 
+                then [] 
+                else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
+ where
+   prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
+
+instance Print Val where
+  prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging
+  prt (VApp u v) = prt u +++ prv1 v
+  prt (VCn mc) = prQIdent_ mc
+  prt (VClos env e) = case e of
+    Meta _ -> prt_ e ++ prEnv env
+    _      -> prt_ e ---- ++ prEnv env ---- for debugging
+  prt VType = "Type"
+ 
+prv1 v = case v of
+  VApp _ _  -> prParenth $ prt v
+  VClos _ _ -> prParenth $ prt v
+  _ -> prt v
+
+instance Print Atom where
+  prt (AtC f) = prQIdent f
+  prt (AtM i) = prt i
+  prt (AtV i) = prt i
+  prt (AtL s) = prQuotedString s
+  prt (AtI i) = show i
+  prt (AtF i) = show i
+  prt_ (AtC (_,f)) = prt f 
+  prt_ a = prt a
+
+prQIdent :: QIdent -> String
+prQIdent (m,f) = prt m ++ "." ++ prt f
+
+prQIdent_ :: QIdent -> String
+prQIdent_ (_,f) = prt f
+
+-- | print terms without qualifications
+prExp :: Term -> String
+prExp e = case e of
+  App f a    -> pr1 f +++ pr2 a
+  Abs x b    -> "\\" ++ prt x +++ "->" +++ prExp b
+  Prod x a b -> "(\\" ++ prt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b
+  Q _ c      -> prt c
+  QC _ c     -> prt c  
+  _ -> prt e
+ where
+   pr1 e = case e of
+     Abs _ _    -> prParenth $ prExp e
+     Prod _ _ _ -> prParenth $ prExp e
+     _ -> prExp e
+   pr2 e = case e of
+     App _ _ -> prParenth $ prExp e
+     _ -> pr1 e
+
+-- | option @-strip@ strips qualifications
+prTermOpt :: Options -> Term -> String
+prTermOpt opts = if oElem nostripQualif opts then prt else prExp
+
+-- | to get rid of brackets in the editor
+prRefinement :: Term -> String
+prRefinement t = case t of
+    Q m c  -> prQIdent (m,c)
+    QC m c -> prQIdent (m,c)
+    _ -> prt t
+
+prOperSignature :: (QIdent,Type) -> String
+prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t
+
+-- to look up a constant etc in a search tree
+
+lookupIdent :: Ident -> BinTree Ident b -> Err b
+lookupIdent c t = case lookupTree prt c t of
+  Ok v -> return v
+  _ -> prtBad "unknown identifier" c
+
+lookupIdentInfo :: Module Ident f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)
diff --git a/src-3.0/GF/Devel/PrintGFCC.hs b/src-3.0/GF/Devel/PrintGFCC.hs
new file mode 100644
index 000000000..c7e668884
--- /dev/null
+++ b/src-3.0/GF/Devel/PrintGFCC.hs
@@ -0,0 +1,21 @@
+module GF.Devel.PrintGFCC where
+
+import GF.GFCC.DataGFCC (GFCC)
+import GF.GFCC.Raw.ConvertGFCC (fromGFCC)
+import GF.GFCC.Raw.PrintGFCCRaw (printTree)
+import GF.Devel.GFCCtoHaskell
+import GF.Devel.GFCCtoJS
+import GF.Text.UTF8
+
+-- top-level access to code generation
+
+prGFCC :: String -> GFCC -> String
+prGFCC printer gr = case printer of
+  "haskell" -> grammar2haskell gr
+  "haskell_gadt" -> grammar2haskellGADT gr
+  "js" -> gfcc2js gr
+  _ -> printGFCC gr
+
+printGFCC :: GFCC -> String
+printGFCC = encodeUTF8 . printTree . fromGFCC
+
diff --git a/src-3.0/GF/Devel/README-testgf3 b/src-3.0/GF/Devel/README-testgf3
new file mode 100644
index 000000000..0d1b6e80a
--- /dev/null
+++ b/src-3.0/GF/Devel/README-testgf3
@@ -0,0 +1,49 @@
+GF3, the next version of GF
+Aarne Ranta 
+
+
+Version 1: 20/2/2008
+
+To compile:
+
+  make testgf3
+
+To run:
+
+  testgf3 <options>
+
+Options:
+
+  -src      -- read from source
+  -doemit   -- emit gfn files
+
+More options (debugging flags):
+
+  -show_gf         -- show compiled source module after parsing
+  -show_extend     -- ... after extension
+  -show_rename     -- ... after renaming
+  -show_typecheck  -- ... after type checking
+  -show_refreshing -- ... after refreshing variables
+  -show_optimize   -- ... after partial evaluation
+  -show_factorize  -- ... after factoring optimization
+  -show_all        -- show all phases
+
+  -1  -- stop after parsing
+  -2  -- ... extending
+  -3  -- ... renaming
+  -4  -- ... type checking
+  -5  -- ... refreshing
+
+==Compiler Phases==
+
+LexGF
+ParGF
+SourceToGF
+Extend
+Rename
+CheckGrammar
+Refresh
+Optimize
+Factorize
+GFtoGFCC
+
diff --git a/src-3.0/GF/Devel/ReadFiles.hs b/src-3.0/GF/Devel/ReadFiles.hs
new file mode 100644
index 000000000..a10ee1991
--- /dev/null
+++ b/src-3.0/GF/Devel/ReadFiles.hs
@@ -0,0 +1,196 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ReadFiles
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.26 $
+--
+-- Decide what files to read as function of dependencies and time stamps.
+--
+-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
+--
+-- to find all files that have to be read, put them in dependency order, and
+-- decide which files need recompilation. Name @file.gf@ is returned for them,
+-- and @file.gfo@ otherwise.
+-----------------------------------------------------------------------------
+
+module GF.Devel.ReadFiles 
+           ( getAllFiles,ModName,ModEnv,getOptionsFromFile,importsOfModule,
+             gfoFile,gfFile,isGFO ) where
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Devel.UseIO
+import GF.Source.AbsGF hiding (FileName)
+import GF.Source.LexGF
+import GF.Source.ParGF
+
+import Control.Monad
+import Data.Char
+import Data.List
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map as Map
+import System
+import System.Time
+import System.Directory
+import System.FilePath
+
+type ModName = String
+type ModEnv  = Map.Map ModName (ClockTime,[ModName])
+
+
+-- | Returns a list of all files to be compiled in topological order i.e.
+-- the low level (leaf) modules are first.
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
+  -- read module headers from all files recursively
+  ds <- liftM reverse $ get [] [] (justModuleName file)
+  if oElem beVerbose opts
+    then ioeIO $ putStrLn $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds]
+    else return ()
+  return $ paths ds
+  where
+    -- construct list of paths to read
+    paths cs = [mk (p </> f) | (f,st,_,_,p) <- cs, mk <- mkFile st]
+      where
+        mkFile CSComp = [gfFile ]
+        mkFile CSRead = [gfoFile]
+        mkFile _      = []
+
+    -- | traverses the dependency graph and returns a topologicaly sorted
+    -- list of ModuleInfo. An error is raised if there is circular dependency
+    get :: [ModName]          -- ^ keeps the current path in the dependency graph to avoid cycles
+        -> [ModuleInfo]       -- ^ a list of already traversed modules
+        -> ModName            -- ^ the current module
+        -> IOE [ModuleInfo]   -- ^ the final 
+    get trc ds name
+      | name `elem` trc = ioeErr $ Bad $ "circular modules" +++ unwords trc
+      | (not . null) [n | (n,_,_,_,_) <- ds, name == n]     --- file already read
+                        = return ds
+      | otherwise       = do
+           (name,st0,t0,imps,p) <- findModule name
+           ds <- foldM (get (name:trc)) ds imps
+           let (st,t) | (not . null) [f | (f,CSComp,_,_,_) <- ds, elem f imps]
+                                  = (CSComp,Nothing)
+                      | otherwise = (st0,t0)
+           return ((name,st,t,imps,p):ds)
+
+    -- searches for module in the search path and if it is found
+    -- returns 'ModuleInfo'. It fails if there is no such module
+    findModule :: ModName -> IOE ModuleInfo
+    findModule name = do
+      (file,gfTime,gfoTime) <- do
+          mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name)
+          case mb_gfFile of
+            Just gfFile -> do gfTime  <- ioeIO $ getModificationTime gfFile
+                              mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo"))
+                                                        (\_->return Nothing)
+                              return (gfFile, Just gfTime, mb_gfoTime)
+            Nothing     -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name)
+                              case mb_gfoFile of
+                                Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile
+                                                   return (gfoFile, Nothing, Just gfoTime)
+                                Nothing      -> ioeErr $ Bad ("File " ++ gfFile name ++ " does not exist.")
+
+
+      let mb_envmod = Map.lookup name env
+          (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime
+
+      imps <- if st == CSEnv
+                then return (maybe [] snd mb_envmod)
+                else do s <- ioeIO $ BS.readFile file
+                        (mname,imps) <- ioeErr ((liftM importsOfModule . pModHeader . myLexer) s)
+                        ioeErr $ testErr  (mname == name)
+                                          ("module name" +++ mname +++ "differs from file name" +++ name)
+                        return imps
+
+      return (name,st,t,imps,dropFileName file)
+
+
+isGFO :: FilePath -> Bool
+isGFO = (== ".gfo") . takeExtensions
+
+gfoFile :: FilePath -> FilePath
+gfoFile f = addExtension f "gfo"
+
+gfFile :: FilePath -> FilePath
+gfFile f = addExtension f "gf"
+
+
+-- From the given Options and the time stamps computes
+-- whether the module have to be computed, read from .gfo or
+-- the environment version have to be used
+selectFormat :: Options -> Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime -> (CompStatus,Maybe ClockTime)
+selectFormat opts mtenv mtgf mtgfo =
+  case (mtenv,mtgfo,mtgf) of
+    (_,_,Just tgf)         | fromSrc  -> (CSComp,Nothing)
+    (Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
+    (_,Just tgfo,_)        | fromComp -> (CSRead,Just tgfo)
+    (Just tenv,_,Just tgf) | tenv > tgf -> (CSEnv, Just tenv)
+    (_,Just tgfo,Just tgf) | tgfo > tgf -> (CSRead,Just tgfo)
+    (Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
+    (_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
+    _ -> (CSComp,Nothing)
+  where
+    fromComp = oElem isCompiled opts -- i -gfo
+    fromSrc  = oElem fromSource opts
+
+
+-- internal module dep information
+
+
+data CompStatus =
+   CSComp -- compile: read gf
+ | CSRead -- read gfo
+ | CSEnv  -- gfo is in env
+  deriving Eq
+
+type ModuleInfo = (ModName,CompStatus,Maybe ClockTime,[ModName],InitPath)
+
+ 
+importsOfModule :: ModDef -> (ModName,[ModName])
+importsOfModule (MModule _ typ body) = modType typ (modBody body [])
+  where
+    modType (MTAbstract  m)      xs = (modName m,xs)
+    modType (MTResource m)       xs = (modName m,xs)
+    modType (MTInterface m)      xs = (modName m,xs)
+    modType (MTConcrete m m2)    xs = (modName m,modName m2:xs)
+    modType (MTInstance m m2)    xs = (modName m,modName m2:xs)
+    modType (MTTransfer m o1 o2) xs = (modName m,open o1 (open o2 xs))
+
+    modBody (MBody e o _)            xs = extend e (opens o xs)
+    modBody (MNoBody is)             xs = foldr include xs is
+    modBody (MWith i os)             xs = include i (foldr open xs os)
+    modBody (MWithBody i os o _)     xs = include i (foldr open (opens o xs) os)
+    modBody (MWithE is i os)         xs = foldr include (include i (foldr open xs os)) is
+    modBody (MWithEBody is i os o _) xs = foldr include (include i (foldr open (opens o xs) os)) is
+    modBody (MReuse m)               xs = modName m:xs
+    modBody (MUnion is)              xs = foldr include xs is
+
+    include (IAll   m)   xs = modName m:xs
+    include (ISome  m _) xs = modName m:xs
+    include (IMinus m _) xs = modName m:xs
+
+    open (OName n)     xs = modName n:xs
+    open (OQualQO _ n) xs = modName n:xs
+    open (OQual _ _ n) xs = modName n:xs
+
+    extend NoExt    xs = xs
+    extend (Ext is) xs = foldr include xs is
+
+    opens NoOpens     xs = xs
+    opens (OpenIn os) xs = foldr open xs os
+
+    modName (PIdent (_,s)) = s
+
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile file = do
+  s <- readFileIfStrict file
+  let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
+  return $ fst $ getOptions "-" $ map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
diff --git a/src-3.0/GF/Devel/TC.hs b/src-3.0/GF/Devel/TC.hs
new file mode 100644
index 000000000..5c439f671
--- /dev/null
+++ b/src-3.0/GF/Devel/TC.hs
@@ -0,0 +1,299 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : TC
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.11 $
+--
+-- Thierry Coquand's type checking algorithm that creates a trace
+-----------------------------------------------------------------------------
+
+module GF.Devel.TC (AExp(..),
+	   Theory,
+	   checkExp,
+	   inferExp,
+           checkEqs,
+	   eqVal,
+	   whnf
+	  ) where
+
+import GF.Data.Operations
+import GF.Grammar.Abstract
+import GF.Devel.AbsCompute
+
+import Control.Monad
+import Data.List (sortBy)
+
+data AExp =
+     AVr   Ident Val 
+   | ACn   QIdent Val
+   | AType 
+   | AInt  Integer 
+   | AFloat Double
+   | AStr  String
+   | AMeta MetaSymb Val
+   | AApp  AExp AExp Val 
+   | AAbs  Ident Val AExp 
+   | AProd Ident AExp AExp 
+   | AEqs  [([Exp],AExp)] --- not used
+   | AData Val
+  deriving (Eq,Show)
+
+type Theory = QIdent -> Err Val
+
+lookupConst :: Theory -> QIdent -> Err Val
+lookupConst th f = th f
+
+lookupVar :: Env -> Ident -> Err Val
+lookupVar g x = maybe (prtBad "unknown variable" x) return $ lookup x ((IW,uVal):g)
+-- wild card IW: no error produced, ?0 instead.
+
+type TCEnv = (Int,Env,Env)
+
+emptyTCEnv :: TCEnv
+emptyTCEnv = (0,[],[])
+
+whnf :: Val -> Err Val
+whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug
+         case v of
+  VApp u w -> do
+    u' <- whnf u 
+    w' <- whnf w
+    app u' w'
+  VClos env e -> eval env e
+  _ -> return v
+
+app :: Val -> Val -> Err Val
+app u v = case u of
+  VClos env (Abs x e) -> eval ((x,v):env) e
+  _ -> return $ VApp u v
+  
+eval :: Env -> Exp -> Err Val
+eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $ 
+             case e of
+  Vr x    -> lookupVar env x
+  Q m c   -> return $ VCn (m,c)
+  QC m c  -> return $ VCn (m,c) ---- == Q ?
+  Sort c  -> return $ VType --- the only sort is Type
+  App f a -> join $ liftM2 app (eval env f) (eval env a)
+  _ -> return $ VClos env e
+
+eqVal :: Int -> Val -> Val -> Err [(Val,Val)]
+eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $ 
+                do
+  w1 <- whnf u1
+  w2 <- whnf u2 
+  let v = VGen k
+  case (w1,w2) of
+    (VApp f1 a1, VApp f2 a2) -> liftM2 (++) (eqVal k f1 f2) (eqVal k a1 a2)
+    (VClos env1 (Abs x1 e1), VClos env2 (Abs x2 e2)) ->
+      eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2)
+    (VClos env1 (Prod x1 a1 e1), VClos env2 (Prod x2 a2 e2)) ->
+      liftM2 (++) 
+        (eqVal k     (VClos env1          a1) (VClos env2          a2))
+        (eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2))
+    (VGen i _, VGen j _) -> return [(w1,w2) | i /= j]
+    (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j] 
+    --- thus ignore qualifications; valid because inheritance cannot
+    --- be qualified. Simplifies annotation. AR 17/3/2005 
+    _ -> return [(w1,w2) | w1 /= w2]
+-- invariant: constraints are in whnf
+
+checkType :: Theory -> TCEnv -> Exp -> Err (AExp,[(Val,Val)])
+checkType th tenv e = checkExp th tenv e vType
+
+checkExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)])
+checkExp th tenv@(k,rho,gamma) e ty = do
+  typ <- whnf ty
+  let v = VGen k
+  case e of
+    Meta m -> return $ (AMeta m typ,[])
+    EData -> return $ (AData typ,[])
+
+    Abs x t -> case typ of
+      VClos env (Prod y a b) -> do
+	a' <- whnf $ VClos env a ---
+	(t',cs) <- checkExp th 
+                           (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
+	return (AAbs x a' t', cs)
+      _ -> prtBad ("function type expected for" +++ prt e +++ "instead of") typ
+
+-- {- --- to get deprec when checkEqs works (15/9/2005)
+    Eqs es -> do
+      bcs <- mapM (\b -> checkBranch th tenv b typ) es
+      let (bs,css) = unzip bcs
+      return (AEqs bs, concat css) 
+-- - }
+    Prod x a b -> do
+      testErr (typ == vType) "expected Type"
+      (a',csa) <- checkType th tenv a
+      (b',csb) <- checkType th (k+1, (x,v x):rho, (x,VClos rho a):gamma) b
+      return (AProd x a' b', csa ++ csb)
+
+    _ -> checkInferExp th tenv e typ
+
+checkInferExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)])
+checkInferExp th tenv@(k,_,_) e typ = do
+  (e',w,cs1) <- inferExp th tenv e
+  cs2 <- eqVal k w typ
+  return (e',cs1 ++ cs2)
+      
+inferExp :: Theory -> TCEnv -> Exp -> Err (AExp, Val, [(Val,Val)])
+inferExp th tenv@(k,rho,gamma) e = case e of
+   Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
+   Q m c 
+    | m == cPredefAbs && (elem c (map identC ["Int","String","Float"])) ->
+                                       return (ACn (m,c) vType, vType, [])
+    | otherwise -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
+   QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
+   EInt i -> return (AInt i, valAbsInt, [])
+   EFloat i -> return (AFloat i, valAbsFloat, [])
+   K i -> return (AStr i, valAbsString, [])
+   Sort _ -> return (AType, vType, [])
+   App f t -> do
+    (f',w,csf) <- inferExp th tenv f 
+    typ <- whnf w
+    case typ of
+      VClos env (Prod x a b) -> do
+        (a',csa) <- checkExp th tenv t (VClos env a)
+	b' <- whnf $ VClos ((x,VClos rho t):env) b
+	return $ (AApp f' a' b', b', csf ++ csa)
+      _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ
+   _ -> prtBad "cannot infer type of expression" e
+ where
+   predefAbs c s = case c of
+     IC "Int" -> return $ const $ Q cPredefAbs cInt
+     IC "Float" -> return $ const $ Q cPredefAbs cFloat
+     IC "String" -> return $ const $ Q cPredefAbs cString
+     _ -> Bad s
+
+checkEqs :: Theory -> TCEnv -> (Fun,Trm) -> Val -> Err [(Val,Val)]
+checkEqs th tenv@(k,rho,gamma) (fun@(m,f),def) val = case def of
+  Eqs es -> liftM concat $ mapM checkBranch es
+  _      -> liftM snd $ checkExp th tenv def val
+ where
+  checkBranch (ps,df) = 
+   let
+      (ps',_,vars) = foldr p2t ([],0,[]) ps
+      fps        = mkApp (Q m f) ps'
+   in errIn ("branch" +++ prt fps) $ do
+    (aexp, typ, cs1) <- inferExp th tenv fps
+    let
+      bds = binds vars aexp 
+      tenv' = (k, rho, bds ++ gamma) 
+    (_,cs2)  <- errIn (show bds) $ checkExp th tenv' df typ
+    return $ (cs1 ++ cs2)
+  p2t p (ps,i,g) = case p of
+     PW      -> (meta (MetaSymb i) : ps, i+1,        g) 
+     PV IW   -> (meta (MetaSymb i) : ps, i+1,        g) 
+     PV x    -> (meta (MetaSymb i) : ps, i+1,upd x i g)
+     PString s -> (            K s : ps, i,          g)
+     PInt n -> (EInt n : ps, i, g)
+     PFloat n -> (EFloat n : ps, i, g)
+     PP m c xs -> (mkApp (qq (m,c)) xss : ps, i', g') 
+                    where (xss,i',g') = foldr p2t ([],i,g) xs
+     _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch"
+  upd x i g = (x,i) : g --- to annotate pattern variables: treat as metas
+  
+  -- notice: in vars, the sequence 0.. is sorted. In subst aexp, all
+  -- this occurs and nothing else.
+  binds vars aexp = [(x,v) | ((x,_),v) <- zip vars metas] where
+    metas = map snd $ sortBy (\ (x,_) (y,_) -> compare x y) $ subst aexp
+  subst aexp = case aexp of
+   AMeta (MetaSymb i) v -> [(i,v)]
+   AApp  c a _ -> subst c ++ subst a
+   _ -> [] -- never matter in patterns
+
+checkBranch :: Theory -> TCEnv -> Equation -> Val -> Err (([Exp],AExp),[(Val,Val)])
+checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $ 
+                                  chB tenv' ps' ty 
+ where 
+
+  (ps',_,rho2,k') = ps2ts k ps
+  tenv' = (k, rho2++rho, gamma) ---- k' ?
+  (k,rho,gamma) = tenv
+
+  chB tenv@(k,rho,gamma) ps ty = case ps of
+    p:ps2 -> do
+      typ <- whnf ty
+      case typ of
+        VClos env (Prod y a b) -> do
+	  a' <- whnf $ VClos env a
+          (p', sigma, binds, cs1) <- checkP tenv p y a'
+          let tenv' = (length binds, sigma ++ rho, binds ++ gamma)
+          ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)
+	  return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
+        _ -> prtBad ("Product expected for definiens" +++prt t +++ "instead of") typ
+    [] -> do
+      (e,cs) <- checkExp th tenv t ty
+      return (([],e),cs)
+  checkP env@(k,rho,gamma) t x a = do
+     (delta,cs) <- checkPatt th env t a
+     let sigma = [(x, VGen i x) | ((x,_),i) <- zip delta [k..]]
+     return (VClos sigma t, sigma, delta, cs)
+
+  ps2ts k = foldr p2t ([],0,[],k) 
+  p2t p (ps,i,g,k) = case p of
+     PW      -> (meta (MetaSymb i) : ps, i+1,g,k) 
+     PV IW   -> (meta (MetaSymb i) : ps, i+1,g,k) 
+     PV x    -> (vr x   : ps, i, upd x k g,k+1)
+     PString s -> (K s : ps, i, g, k)
+     PInt n -> (EInt n : ps, i, g, k)
+     PFloat n -> (EFloat n : ps, i, g, k)
+     PP m c xs -> (mkApp (qq (m,c)) xss : ps, j, g',k') 
+                    where (xss,j,g',k') = foldr p2t ([],i,g,k) xs
+     _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch"
+
+  upd x k g = (x, VGen k x) : g --- hack to recognize pattern variables
+
+
+checkPatt :: Theory -> TCEnv -> Exp -> Val -> Err (Binds,[(Val,Val)])
+checkPatt th tenv exp val = do
+  (aexp,_,cs) <- checkExpP tenv exp val
+  let binds = extrBinds aexp
+  return (binds,cs)
+ where
+   extrBinds aexp = case aexp of
+     AVr i v    -> [(i,v)]
+     AApp f a _ -> extrBinds f ++ extrBinds a
+     _ -> [] -- no other cases are possible
+
+--- ad hoc, to find types of variables
+   checkExpP tenv@(k,rho,gamma) exp val = case exp of
+     Meta m -> return $ (AMeta m val, val, [])
+     Vr x   -> return $ (AVr   x val, val, [])
+     EInt i -> return (AInt i, valAbsInt, [])
+     EFloat i -> return (AFloat i, valAbsFloat, [])
+     K s    -> return (AStr s, valAbsString, [])
+
+     Q m c  -> do
+       typ <- lookupConst th (m,c)
+       return $ (ACn (m,c) typ, typ, [])
+     QC m c  -> do
+       typ <- lookupConst th (m,c)
+       return $ (ACn (m,c) typ, typ, []) ----
+     App f t -> do
+       (f',w,csf) <- checkExpP tenv f val
+       typ <- whnf w
+       case typ of
+         VClos env (Prod x a b) -> do
+           (a',_,csa) <- checkExpP tenv t (VClos env a)
+	   b' <- whnf $ VClos ((x,VClos rho t):env) b
+	   return $ (AApp f' a' b', b', csf ++ csa)
+         _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ
+     _ -> prtBad "cannot typecheck pattern" exp
+
+-- auxiliaries
+
+noConstr :: Err Val -> Err (Val,[(Val,Val)])
+noConstr er = er >>= (\v -> return (v,[]))
+
+mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)])
+mkAnnot a ti = do
+  (v,cs) <- ti
+  return (a v, v, cs)
+
diff --git a/src-3.0/GF/Devel/TestGF3.hs b/src-3.0/GF/Devel/TestGF3.hs
new file mode 100644
index 000000000..da4b5c8f6
--- /dev/null
+++ b/src-3.0/GF/Devel/TestGF3.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import GF.Devel.Compile.GFC
+
+import System (getArgs)
+
+main = do
+  xx <- getArgs
+  mainGFC xx
diff --git a/src-3.0/GF/Devel/TypeCheck.hs b/src-3.0/GF/Devel/TypeCheck.hs
new file mode 100644
index 000000000..818b48a10
--- /dev/null
+++ b/src-3.0/GF/Devel/TypeCheck.hs
@@ -0,0 +1,311 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : TypeCheck
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/15 16:22:02 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Devel.TypeCheck (-- * top-level type checking functions; TC should not be called directly.
+		  annotate, annotateIn,
+		  justTypeCheck, checkIfValidExp,
+		  reduceConstraints, 
+		  splitConstraints,
+		  possibleConstraints,
+		  reduceConstraintsNode,
+		  performMetaSubstNode,
+		  -- * some top-level batch-mode checkers for the compiler
+		  justTypeCheckSrc,
+		  grammar2theorySrc,
+		  checkContext,
+		  checkTyp,
+		  checkEquation,
+		  checkConstrs,
+		  editAsTermCommand,
+		  exp2termCommand,
+		  exp2termlistCommand,
+		  tree2termlistCommand
+		 ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Grammar.Abstract
+import GF.Devel.AbsCompute
+import GF.Grammar.Refresh
+import GF.Grammar.LookAbs
+import qualified GF.Grammar.Lookup as Lookup ---
+
+import GF.Devel.TC
+
+import GF.Grammar.Unify ---
+
+import Control.Monad (foldM, liftM, liftM2)
+import Data.List (nub) ---
+
+-- top-level type checking functions; TC should not be called directly.
+
+annotate :: GFCGrammar -> Exp -> Err Tree
+annotate gr exp = annotateIn gr [] exp Nothing 
+
+-- | type check in empty context, return a list of constraints
+justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints
+justTypeCheck gr e v = do
+  (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
+  constrs1     <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  return $ fst $ splitConstraints gr constrs1
+
+-- | type check in empty context, return the expression itself if valid
+checkIfValidExp :: GFCGrammar -> Exp -> Err Exp
+checkIfValidExp gr e = do
+  (_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e
+  constrs1       <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  ifNull (return e) (Bad  . unwords . prConstrs) constrs1
+
+annotateIn :: GFCGrammar -> Binds -> Exp -> Maybe Val -> Err Tree
+annotateIn gr gamma exp = maybe (infer exp) (check exp) where
+  infer e = do 
+    (a,_,cs) <- inferExp theory env e
+    aexp2treeC (a,cs)
+  check e v = do
+    (a,cs) <- checkExp theory env e v
+    aexp2treeC (a,cs)
+  env = initTCEnv gamma
+  theory = grammar2theory gr 
+  aexp2treeC (a,c) = do
+    c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c
+    aexp2tree (a,c')
+
+-- | invariant way of creating TCEnv from context
+initTCEnv gamma = 
+  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) 
+
+-- | process constraints after eqVal by computing by defs
+reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints
+reduceConstraints look i = liftM concat . mapM redOne where
+  redOne (u,v) = do
+    u' <- computeVal look u
+    v' <- computeVal look v
+    eqVal i u' v' 
+
+computeVal :: LookDef -> Val -> Err Val
+computeVal look v = case v of
+  VClos g@(_:_) e -> do
+    e' <- compt (map fst g) e          --- bindings of g in e?
+    whnf $ VClos g e'
+{- ----
+  _ -> do            ---- how to compute a Val, really??
+    e  <- val2exp v
+    e' <- compt [] e
+    whnf $ vClos e'
+-}
+  VApp f c -> liftM2 VApp (compv f) (compv c) >>= whnf
+  _ -> whnf v
+ where
+   compt = computeAbsTermIn look
+   compv = computeVal look
+
+-- | take apart constraints that have the form (? <> t), usable as solutions
+splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraints gr = splitConstraintsGen (lookupAbsDef gr)
+
+splitConstraintsSrc :: Grammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsSrc gr = splitConstraintsGen (Lookup.lookupAbsDef gr)
+
+splitConstraintsGen :: LookDef -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsGen look cs = csmsu where
+
+  csmsu       = (nub [(a,b) | (a,b) <- csf1,a /= b],msf1)
+  (csf1,msf1) = unif (csf,msf)  -- alternative: filter first
+  (csf,msf)   = foldr mkOne ([],[]) cs
+
+  csmsf     = foldr mkOne ([],msu) csu
+  (csu,msu) = unif (cs1,[])    -- alternative: unify first
+
+  cs1 = errVal cs $ reduceConstraints look 0 cs
+
+  mkOne (u,v) = case (u,v) of
+    (VClos g (Meta m), v) | null g -> sub m v
+    (v, VClos g (Meta m)) | null g -> sub m v
+    -- do nothing if meta has nonempty closure; null g || isConstVal v WAS WRONG
+    c -> con c
+  con c (cs,ms) = (c:cs,ms)
+  sub m v (cs,ms) = (cs,(m,v):ms)
+
+  unifo = id -- alternative: don't use unification
+
+  unif cm@(cs,ms) = errVal cm $ do --- alternative: use unification  
+    (cs',ms') <- unifyVal cs
+    return (cs', ms' ++ ms)
+
+performMetaSubstNode :: MetaSubst -> TrNode -> TrNode
+performMetaSubstNode subst n@(N (b,a,v,(c,m),s)) = let
+  v' = metaSubstVal v
+  b' = [(x,metaSubstVal v) | (x,v) <- b]
+  c' = [(u',v') | (u,v) <- c, 
+                  let (u',v') = (metaSubstVal u, metaSubstVal v), u' /= v']
+  in N (b',a,v',(c',m),s)
+ where
+   metaSubstVal u = errVal u $ whnf $ case u of
+     VApp  f a -> VApp  (metaSubstVal f) (metaSubstVal a)
+     VClos g e -> VClos [(x,metaSubstVal v) | (x,v) <- g] (metaSubstExp e)
+     _ -> u
+   metaSubstExp e = case e of
+     Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst
+     _ -> composSafeOp metaSubstExp e
+
+reduceConstraintsNode :: GFCGrammar -> TrNode -> TrNode
+reduceConstraintsNode gr = changeConstrs red where
+  red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs
+
+-- | weak heuristic to narrow down menus; not used for TC. 15\/11\/2001.
+-- the age-old method from GF 0.9
+possibleConstraints :: GFCGrammar -> Constraints -> Bool
+possibleConstraints gr = and . map (possibleConstraint gr)
+
+possibleConstraint :: GFCGrammar -> (Val,Val) -> Bool
+possibleConstraint gr (u,v) = errVal True $ do
+    u' <- val2exp u >>= compute gr
+    v' <- val2exp v >>= compute gr
+    return $ cts u' v'
+ where
+  cts t u = isUnknown t || isUnknown u || case (t,u) of
+    (Q m c,      Q n d)      -> c == d || notCan (m,c) || notCan (n,d)
+    (QC m c,     QC n d)     -> c == d
+    (App f a,    App g b)    -> cts f g && cts a b
+    (Abs x b,    Abs y c)    -> cts b c
+    (Prod x a f, Prod y b g) -> cts a b && cts f g
+    (_         , _)          -> False
+
+  isUnknown t = case t of
+    Vr _ -> True
+    Meta _ -> True
+    _ -> False
+
+  notCan = not . isPrimitiveFun gr
+
+-- interface to TC type checker
+
+type2val :: Type -> Val
+type2val = VClos []
+
+aexp2tree :: (AExp,[(Val,Val)]) -> Err Tree
+aexp2tree (aexp,cs) = do
+  (bi,at,vt,ts) <- treeForm aexp
+  ts' <- mapM aexp2tree [(t,[]) | t <- ts]
+  return $ Tr (N (bi,at,vt,(cs,[]),False),ts')
+ where
+  treeForm a = case a of
+     AAbs x v b  -> do
+       (bi, at, vt, args) <- treeForm b
+       v' <- whnf v ---- should not be needed...
+       return ((x,v') : bi, at, vt, args)
+     AApp c a v -> do
+       (_,at,_,args) <- treeForm c
+       v' <- whnf v ---- 
+       return ([],at,v',args ++ [a]) 
+     AVr x v -> do
+       v' <- whnf v ---- 
+       return ([],AtV x,v',[])
+     ACn c v -> do
+       v' <- whnf v ---- 
+       return ([],AtC c,v',[])
+     AInt i -> do
+       return ([],AtI i,valAbsInt,[])
+     AFloat i -> do
+       return ([],AtF i,valAbsFloat,[])
+     AStr s -> do
+       return ([],AtL s,valAbsString,[])
+     AMeta m v -> do
+       v' <- whnf v ---- 
+       return ([],AtM m,v',[])
+     _ -> Bad "illegal tree" -- AProd
+
+grammar2theory :: GFCGrammar -> Theory
+grammar2theory gr (m,f) = case lookupFunType gr m f of
+  Ok t -> return $ type2val t
+  Bad s -> case lookupCatContext gr m f of
+    Ok cont -> return $ cont2val cont
+    _ -> Bad s
+
+cont2exp :: Context -> Exp
+cont2exp c = mkProd (c, eType, []) -- to check a context
+
+cont2val :: Context -> Val
+cont2val = type2val . cont2exp
+
+-- some top-level batch-mode checkers for the compiler
+
+justTypeCheckSrc :: Grammar -> Exp -> Val -> Err Constraints
+justTypeCheckSrc gr e v = do
+  (_,constrs0) <- checkExp (grammar2theorySrc gr) (initTCEnv []) e v
+  return $ filter notJustMeta constrs0
+----  return $ fst $ splitConstraintsSrc gr constrs0
+---- this change was to force proper tc of abstract modules. 
+---- May not be quite right. AR 13/9/2005 
+
+notJustMeta (c,k) = case (c,k) of
+     (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False
+     _ -> True
+
+grammar2theorySrc :: Grammar -> Theory
+grammar2theorySrc gr (m,f) = case lookupFunTypeSrc gr m f of
+  Ok t -> return $ type2val t
+  Bad s -> case lookupCatContextSrc gr m f of
+    Ok cont -> return $ cont2val cont
+    _ -> Bad s
+
+checkContext :: Grammar -> Context -> [String]
+checkContext st = checkTyp st . cont2exp
+
+checkTyp :: Grammar -> Type -> [String]
+checkTyp gr typ = err singleton prConstrs $ justTypeCheckSrc gr typ vType
+
+checkEquation :: Grammar -> Fun -> Trm -> [String]
+checkEquation gr (m,fun) def = err singleton id $ do
+  typ  <- lookupFunTypeSrc gr m fun
+----  cs   <- checkEqs (grammar2theorySrc gr) (initTCEnv []) ((m,fun),def) (vClos typ)
+  cs   <- justTypeCheckSrc gr def (vClos typ)
+  let cs1 = filter notJustMeta cs ----- filter (not . possibleConstraint gr) cs ----
+  return $ ifNull [] (singleton . prConstraints) cs1
+
+checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
+checkConstrs gr cat _ = [] ---- check constructors!
+
+
+
+
+
+ 
+{- ----
+err singleton concat . mapM checkOne where
+  checkOne con = do
+    typ   <- lookupFunType gr con
+    typ'  <- computeAbsTerm gr typ
+    vcat  <- valCat typ'
+    return $ if (cat == vcat) then [] else ["wrong type in constructor" +++ prt con]
+-}
+
+editAsTermCommand :: GFCGrammar -> (Loc TrNode -> Err (Loc TrNode)) -> Exp -> [Exp]
+editAsTermCommand gr c e = err (const []) singleton $ do
+  t  <- annotate gr $ refreshMetas [] e
+  t' <- c $ tree2loc t
+  return $ tree2exp $ loc2tree t'
+
+exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
+exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
+  let exp = tree2exp t
+  exp2 <- f exp
+  annotate gr exp2
+
+exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
+exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp
+
+tree2termlistCommand :: GFCGrammar -> (Tree -> [Exp]) -> Tree -> [Tree]
+tree2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f 
diff --git a/src-3.0/GF/Devel/UseIO.hs b/src-3.0/GF/Devel/UseIO.hs
new file mode 100644
index 000000000..afbf00efd
--- /dev/null
+++ b/src-3.0/GF/Devel/UseIO.hs
@@ -0,0 +1,298 @@
+{-# OPTIONS -cpp #-}
+----------------------------------------------------------------------
+-- |
+-- Module      : UseIO
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.17 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Devel.UseIO where
+
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Today (libdir)
+
+import System.Directory
+import System.FilePath
+import System.IO
+import System.IO.Error
+import System.Environment
+import System.CPUTime
+import Control.Monad
+import Control.Exception(evaluate)
+import qualified Data.ByteString.Char8 as BS
+
+#ifdef mingw32_HOST_OS
+import System.Win32.DLL
+import Foreign.Ptr
+#endif
+
+putShow' :: Show a => (c -> a) -> c -> IO ()
+putShow' f = putStrLn . show . length . show . f
+
+putIfVerb :: Options -> String -> IO ()
+putIfVerb opts msg =
+      if oElem beVerbose opts
+         then putStrLn msg
+         else return ()
+
+putIfVerbW :: Options -> String -> IO ()
+putIfVerbW opts msg =
+      if oElem beVerbose opts
+         then putStr (' ' : msg)
+         else return ()
+
+-- | obsolete with IOE monad
+errIO :: a -> Err a -> IO a
+errIO = errOptIO noOptions
+
+errOptIO :: Options -> a -> Err a -> IO a
+errOptIO os e m = case m of
+  Ok x  -> return x
+  Bad k -> do  
+    putIfVerb os k
+    return e
+
+readFileIf f = catch (readFile f) (\_ -> reportOn f) where
+ reportOn f = do
+   putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
+   return ""
+
+readFileIfStrict f = catch (BS.readFile f) (\_ -> reportOn f) where
+ reportOn f = do
+   putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
+   return BS.empty
+
+type FileName = String
+type InitPath = String
+type FullPath = String
+
+getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
+getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file
+
+getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
+getFilePathMsg msg paths file = get paths where
+  get []     = putStrFlush msg >> return Nothing
+  get (p:ps) = do
+    let pfile = p </> file
+    exist <- doesFileExist pfile
+    if not exist
+      then get ps
+      else do pfile <- canonicalizePath pfile
+              return (Just pfile)
+
+readFileIfPath :: [FilePath] -> String -> IOE (FilePath,BS.ByteString)
+readFileIfPath paths file = do
+  mpfile <- ioeIO $ getFilePath paths file
+  case mpfile of
+    Just pfile -> do
+      s <- ioeIO $ BS.readFile pfile
+      return (dropFileName pfile,s)
+    _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
+
+doesFileExistPath :: [FilePath] -> String -> IOE Bool
+doesFileExistPath paths file = do
+  mpfile <- ioeIO $ getFilePathMsg "" paths file
+  return $ maybe False (const True) mpfile
+
+gfLibraryPath    = "GF_LIB_PATH"
+gfGrammarPathVar = "GF_GRAMMAR_PATH"
+
+getLibraryPath :: IO FilePath
+getLibraryPath =
+  catch
+    (getEnv gfLibraryPath)
+#ifdef mingw32_HOST_OS
+    (\_ -> do exepath <- getModuleFileName nullPtr
+              let (path,_) = splitFileName exepath
+              canonicalizePath (combine path "../lib"))
+#else
+    (const (return libdir))
+#endif
+
+-- | extends the search path with the
+-- 'gfLibraryPath' and 'gfGrammarPathVar'
+-- environment variables. Returns only existing paths.
+extendPathEnv :: [FilePath] -> IO [FilePath]
+extendPathEnv ps = do
+  b <- getLibraryPath                             -- e.g. GF_LIB_PATH
+  s <- catch (getEnv gfGrammarPathVar) (const (return ""))     -- e.g. GF_GRAMMAR_PATH
+  let ss = ps ++ splitSearchPath s
+  liftM concat $ mapM allSubdirs $ ss ++ [b </> s | s <- ss ++ ["prelude"]]
+  where
+    allSubdirs :: FilePath -> IO [FilePath]
+    allSubdirs [] = return [[]]
+    allSubdirs p = case last p of
+      '*' -> do let path = init p
+                fs <- getSubdirs path
+                return [path </> f | f <- fs]
+      _   -> do exists <- doesDirectoryExist p
+                if exists
+                  then return [p]
+                  else return []
+
+getSubdirs :: FilePath -> IO [FilePath]
+getSubdirs dir = do
+  fs  <- catch (getDirectoryContents dir) (const $ return [])
+  foldM (\fs f -> do let fpath = dir </> f
+                     p <- getPermissions fpath
+                     if searchable p && not (take 1 f==".")
+                       then return (fpath:fs)
+                       else return        fs ) [] fs
+
+justModuleName :: FilePath -> String
+justModuleName = dropExtension . takeFileName
+
+splitInModuleSearchPath :: String -> [FilePath]
+splitInModuleSearchPath s = case break isPathSep s of
+  (f,_:cs) -> f : splitInModuleSearchPath cs
+  (f,_)    -> [f]
+  where
+    isPathSep :: Char -> Bool
+    isPathSep c = c == ':' || c == ';'
+
+--
+
+getLineWell :: IO String -> IO String
+getLineWell ios = 
+  catch getLine (\e -> if (isEOFError e) then ios else ioError e)
+
+putStrFlush :: String -> IO ()
+putStrFlush s = putStr s >> hFlush stdout
+
+putStrLnFlush :: String -> IO ()
+putStrLnFlush s = putStrLn s >> hFlush stdout
+
+-- * a generic quiz session
+
+type QuestionsAndAnswers = [(String, String -> (Integer,String))]
+
+teachDialogue :: QuestionsAndAnswers -> String -> IO ()
+teachDialogue qas welc = do
+  putStrLn $ welc ++++ genericTeachWelcome
+  teach (0,0) qas
+ where 
+    teach _ [] = do putStrLn "Sorry, ran out of problems"
+    teach (score,total) ((question,grade):quas) = do
+      putStr ("\n" ++ question ++ "\n> ") 
+      answer <- getLine
+      if (answer == ".") then return () else do
+        let (result, feedback) = grade answer
+            score' = score + result 
+            total' = total + 1
+        putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total')
+        if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75)
+           then do putStrLn "\nCongratulations - you passed!"
+           else teach (score',total') quas
+
+    genericTeachWelcome = 
+      "The quiz is over when you have done at least 10 examples" ++++
+      "with at least 75 % success." +++++
+      "You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
+
+
+-- * IO monad with error; adapted from state monad
+
+newtype IOE a = IOE (IO (Err a))
+
+appIOE :: IOE a -> IO (Err a)
+appIOE (IOE iea) = iea
+
+ioe :: IO (Err a) -> IOE a
+ioe = IOE
+
+ioeIO :: IO a -> IOE a
+ioeIO io = ioe (io >>= return . return)
+
+ioeErr :: Err a -> IOE a
+ioeErr = ioe . return 
+
+instance  Monad IOE where
+  return a    = ioe (return (return a))
+  IOE c >>= f = IOE $ do 
+                  x <- c          -- Err a
+                  appIOE $ err ioeBad f x         -- f :: a -> IOE a
+
+ioeBad :: String -> IOE a
+ioeBad = ioe . return . Bad
+
+useIOE :: a -> IOE a -> IO a
+useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return 
+
+foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String)
+foldIOE f s xs = case xs of
+  [] -> return (s,Nothing)
+  x:xx -> do
+    ev <- ioeIO $ appIOE (f s x) 
+    case ev of 
+      Ok v  -> foldIOE f v xx
+      Bad m -> return $ (s, Just m)
+
+putStrLnE :: String -> IOE ()
+putStrLnE = ioeIO . putStrLnFlush 
+
+putStrE :: String -> IOE ()
+putStrE = ioeIO . putStrFlush 
+
+-- this is more verbose
+putPointE :: Options -> String -> IOE a -> IOE a
+putPointE = putPointEgen (oElem beSilent)
+
+-- this is less verbose
+putPointEsil :: Options -> String -> IOE a -> IOE a
+putPointEsil = putPointEgen (not . oElem beVerbose)
+
+putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
+putPointEgen cond opts msg act = do
+  let ve x = if cond opts then return () else x
+  ve $ ioeIO $ putStrFlush msg
+
+  t1 <- ioeIO $ getCPUTime
+  a <- act >>= ioeIO . evaluate
+  t2 <- ioeIO $ getCPUTime
+
+  ve $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec")
+  return a
+
+
+-- | forces verbosity
+putPointEVerb :: Options -> String -> IOE a -> IOE a
+putPointEVerb opts = putPointE (addOption beVerbose opts)
+
+-- ((do {s <- readFile f; return (return s)}) ) 
+readFileIOE :: FilePath -> IOE BS.ByteString
+readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
+                            (\e -> return (Bad (show e)))
+
+-- | like readFileIOE but look also in the GF library if file not found
+--
+-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
+-- (even if file is an absolute path, but this should always fail)
+-- it returns not only contents of the file, but also the path used
+readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString)
+readFileLibraryIOE ini f = ioe $ do
+  lp <- getLibraryPath
+  tryRead ini $ \_ ->
+    tryRead lp  $ \e ->
+      return (Bad (show e))
+  where
+    tryRead path onError =
+      catch (BS.readFile fpath >>= \s -> return (return (fpath,s)))
+            onError
+      where
+        fpath = path </> f
+
+-- | example
+koeIOE :: IO ()
+koeIOE = useIOE () $ do
+  s  <- ioeIO  $ getLine
+  s2 <- ioeErr $ mapM (!? 2) $ words s
+  ioeIO $ putStrLn s2
+
diff --git a/src-3.0/GF/Devel/gf-code.txt b/src-3.0/GF/Devel/gf-code.txt
new file mode 100644
index 000000000..e8954bedf
--- /dev/null
+++ b/src-3.0/GF/Devel/gf-code.txt
@@ -0,0 +1,66 @@
+Guide to GF Implementation Code
+Aarne Ranta
+
+
+
+This document describes the code in GF grammar compiler and interactive
+environment. It is aimed to cover well the implementation of the forthcoming
+GF3. In comparison to GF 2.8, this implementation uses
+- the same source language, GF (only slightly modified)
+- a different run-time target language, GFCC (instead of GFCM)
+- a different separate compilation target language (a fragment GF itself, 
+  instead of GFC)
+- a different internal representation of source code
+
+
+Apart from GFCC, the goal of GF3 is simplification and consolidation, rather
+than innovation. This is shown in particular in the abolition of GFC, and in
+the streamlined internal source code format. The insight needed to achieve
+these simplifications would not have been possible (at least for us) without
+years of experimenting with the more messy formats; those formats moreover
+grew organically when features were added to the GF language, and the old
+implementation was thus a result of evolution rather than careful planning.
+
+GF3 is planned to be released in an Alpha version in the end of 2007, its
+sources forming a part of GF release 2.9.
+
+There are currently two versions of GF3, as regards executables and ``make`` 
+items:
+- ``gf3``, using the old internal representation of source language, and
+  integrating a compiler from GF to GFCC and an interpreter of GFCC
+- ``testgf3``, using the new formats everywhere but implementing the compiler
+  only; this program does not yet yield reasonable output
+
+
+The descriptions below will target the newest ideas, that is, ``textgf3`` 
+whenever it differs from ``gf3``.
+
+
+==The structure of the code==
+
+Code that is not shared with GF 2.8 is located in subdirectories of 
+``GF/Devel/``. Those subdirectories will, however, be moved one level
+up. Currently they include
+- ``GF/Devel/Grammar``: the datatypes and basic operations of source code
+- ``GF/Devel/Compile``: the phases of compiling GF to GFCC
+
+
+The other directories involved are
+- ``GF/GFCC``: data types and functionalities of GFCC
+- ``GF/Infra``: infrastructure utilities for the implementation
+- ``GF/Data``: datastructures belonging to infrastructure
+
+
+==The source code implementation==
+
+==The compiler==
+
+==The GFCC interpreter==
+
+==The GF command interpreter==
+
+
+
+
+
+
diff --git a/src-3.0/GF/Devel/gf3.txt b/src-3.0/GF/Devel/gf3.txt
new file mode 100644
index 000000000..56feeba2a
--- /dev/null
+++ b/src-3.0/GF/Devel/gf3.txt
@@ -0,0 +1,84 @@
+GF Version 3.0
+Aarne Ranta
+7 November 2007
+
+
+This document summarizes the goals and status of the forthcoming
+GF version 3.0.
+
+==Overview==
+
+GF 3 results from the following needs:
+- refactor GF to make it more maintainable
+- provide a simple command-line batch compiler
+- replace gfc by the much simpler gfcc format for embedded grammars
+
+
+The current implementation of GF 3 has three binaries:
+- gfc, batch compiler, for building grammar applications
+- gfi, interpreter for gfcc grammars, for using grammars
+- gf, interactive compiler with interpreter, for developing grammars
+
+
+Thus, roughly, gf = gfc + gfi.
+
+Question: should we have, like current GF, just one binary, gf, and
+implement the others by shell scripts calling gf with suitable options?
+- +: one binary is less code altogether
+- +: one binary is easier to distribute and update
+- -: each of the components is less code by itself
+- -: many users might only need either the compiler or the interpreter
+- -: those users could avoid installation problems such as readline
+
+
+There are some analogies in other languages:
+
+  || GF    | Haskell | Java   ||
+  |  gfc   | ghc     | javac   |
+  |  gfi   | ghci*   | java    |
+  |  gf    | ghci*   | -       |
+
+In Haskell, ghci makes more than gfi since it reads source files, but
+less than gf since it does not compile them to externally usable target
+code.
+
+
+
+
+==Status of code and functionalities==
+
+GF executable v. 2.8
+- gf: 263 modules, executable 7+ MB (on MacOS i386)
+
+
+Current status of GF 3.0 alpha:
+- gf3: 94 modules, executable 4+ MB
+- gfc: 71 modules, executable 3+ MB
+- gfi: 35 modules, executable 1+ MB
+
+
+Missing functionalities
+- in gfc:
+  - input formats: cf, ebnf, gfe, old gf
+  - output formats: speech grammars, bnfc
+  - integrating options for input, output, and debugging information
+    (as described in Devel/GFC/Options.hs)
+
+
+- in gfi:
+  - command cc (computing with resource)
+  - morphological analysis, linearization with tables
+  - quizzes, treebanks
+  - syntax editor
+  - readline
+
+
+==Additional feature options==
+
+Native Haskell readline
+
+Binary formats for gfo and gfcc
+
+Parallel compilation on multicore machines
+
+