summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Devel/Compile
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-05-21 09:26:44 +0000
committeraarne <aarne@cs.chalmers.se>2008-05-21 09:26:44 +0000
commit055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f (patch)
tree0e63fb68c69c8f6ad0f78893c63420f0a3600e1c /src-3.0/GF/Devel/Compile
parent915a1de71783ab8446b1af9e72c7ba7dfbc12d3f (diff)
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
Diffstat (limited to 'src-3.0/GF/Devel/Compile')
-rw-r--r--src-3.0/GF/Devel/Compile/AbsGF.hs274
-rw-r--r--src-3.0/GF/Devel/Compile/CheckGrammar.hs1089
-rw-r--r--src-3.0/GF/Devel/Compile/Compile.hs205
-rw-r--r--src-3.0/GF/Devel/Compile/ErrM.hs26
-rw-r--r--src-3.0/GF/Devel/Compile/Extend.hs154
-rw-r--r--src-3.0/GF/Devel/Compile/Factorize.hs251
-rw-r--r--src-3.0/GF/Devel/Compile/GF.cf326
-rw-r--r--src-3.0/GF/Devel/Compile/GFC.hs72
-rw-r--r--src-3.0/GF/Devel/Compile/GFtoGFCC.hs542
-rw-r--r--src-3.0/GF/Devel/Compile/GetGrammar.hs56
-rw-r--r--src-3.0/GF/Devel/Compile/LexGF.hs343
-rw-r--r--src-3.0/GF/Devel/Compile/Optimize.hs333
-rw-r--r--src-3.0/GF/Devel/Compile/ParGF.hs3210
-rw-r--r--src-3.0/GF/Devel/Compile/PrintGF.hs481
-rw-r--r--src-3.0/GF/Devel/Compile/Refresh.hs118
-rw-r--r--src-3.0/GF/Devel/Compile/Rename.hs239
-rw-r--r--src-3.0/GF/Devel/Compile/SourceToGF.hs679
17 files changed, 8398 insertions, 0 deletions
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)