diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
| commit | 055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f (patch) | |
| tree | 0e63fb68c69c8f6ad0f78893c63420f0a3600e1c /src-3.0/GF/Devel/Compile | |
| parent | 915a1de71783ab8446b1af9e72c7ba7dfbc12d3f (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.hs | 274 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/CheckGrammar.hs | 1089 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Compile.hs | 205 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/ErrM.hs | 26 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Extend.hs | 154 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Factorize.hs | 251 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/GF.cf | 326 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/GFC.hs | 72 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/GFtoGFCC.hs | 542 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/GetGrammar.hs | 56 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/LexGF.hs | 343 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Optimize.hs | 333 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/ParGF.hs | 3210 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/PrintGF.hs | 481 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Refresh.hs | 118 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/Rename.hs | 239 | ||||
| -rw-r--r-- | src-3.0/GF/Devel/Compile/SourceToGF.hs | 679 |
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) |
