diff options
Diffstat (limited to 'src-3.0/GF/Canon')
| -rw-r--r-- | src-3.0/GF/Canon/AbsGFC.hs | 182 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/AbsToBNF.hs | 38 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/CMacros.hs | 334 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/CanonToGFCC.hs | 45 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/CanonToGrammar.hs | 203 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/GFC.cf | 170 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/GFC.hs | 103 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/GetGFC.hs | 78 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/LexGFC.hs | 346 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/LexGFC.x | 132 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/Look.hs | 225 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/MkGFC.hs | 237 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/ParGFC.hs | 2142 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/ParGFC.y | 385 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/PrExp.hs | 46 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/PrintGFC.hs | 376 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/Share.hs | 147 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/SkelGFC.hs | 217 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/Subexpressions.hs | 170 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/TestGFC.hs | 58 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/Unlex.hs | 49 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/Unparametrize.hs | 63 | ||||
| -rw-r--r-- | src-3.0/GF/Canon/log.txt | 20 |
23 files changed, 5766 insertions, 0 deletions
diff --git a/src-3.0/GF/Canon/AbsGFC.hs b/src-3.0/GF/Canon/AbsGFC.hs new file mode 100644 index 000000000..8ce719104 --- /dev/null +++ b/src-3.0/GF/Canon/AbsGFC.hs @@ -0,0 +1,182 @@ +module GF.Canon.AbsGFC where + +import GF.Infra.Ident --H + +-- Haskell module generated by the BNF converter, except --H + +-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H + +data Canon = + MGr [Ident] Ident [Module] + | Gr [Module] + deriving (Eq,Ord,Show) + +data Line = + LMulti [Ident] Ident + | LHeader ModType Extend Open + | LFlag Flag + | LDef Def + | LEnd + deriving (Eq,Ord,Show) + +data Module = + Mod ModType Extend Open [Flag] [Def] + deriving (Eq,Ord,Show) + +data ModType = + MTAbs Ident + | MTCnc Ident Ident + | MTRes Ident + | MTTrans Ident Ident Ident + deriving (Eq,Ord,Show) + +data Extend = + Ext [Ident] + | NoExt + deriving (Eq,Ord,Show) + +data Open = + Opens [Ident] + | NoOpens + deriving (Eq,Ord,Show) + +data Flag = + Flg Ident Ident + deriving (Eq,Ord,Show) + +data Def = + AbsDCat Ident [Decl] [CIdent] + | AbsDFun Ident Exp Exp + | AbsDTrans Ident Exp + | ResDPar Ident [ParDef] + | ResDOper Ident CType Term + | CncDCat Ident CType Term Term + | CncDFun Ident CIdent [ArgVar] Term Term + | AnyDInd Ident Status Ident + deriving (Eq,Ord,Show) + +data ParDef = + ParD Ident [CType] + deriving (Eq,Ord,Show) + +data Status = + Canon + | NonCan + deriving (Eq,Ord,Show) + +data CIdent = + CIQ Ident Ident + deriving (Eq,Ord,Show) + +data Exp = + EApp Exp Exp + | EProd Ident Exp Exp + | EAbs Ident Exp + | EAtom Atom + | EData + | EEq [Equation] + deriving (Eq,Ord,Show) + +data Sort = + SType + deriving (Eq,Ord,Show) + +data Equation = + Equ [APatt] Exp + deriving (Eq,Ord,Show) + +data APatt = + APC CIdent [APatt] + | APV Ident + | APS String + | API Integer + | APF Double + | APW + deriving (Eq,Ord,Show) + +data Atom = + AC CIdent + | AD CIdent + | AV Ident + | AM Integer + | AS String + | AI Integer + | AF Double + | AT Sort + deriving (Eq,Ord,Show) + +data Decl = + Decl Ident Exp + deriving (Eq,Ord,Show) + +data CType = + RecType [Labelling] + | Table CType CType + | Cn CIdent + | TStr + | TInts Integer + deriving (Eq,Ord,Show) + +data Labelling = + Lbg Label CType + deriving (Eq,Ord,Show) + +data Term = + Arg ArgVar + | I CIdent + | Par CIdent [Term] + | LI Ident + | R [Assign] + | P Term Label + | T CType [Case] + | V CType [Term] + | S Term Term + | C Term Term + | FV [Term] + | EInt Integer + | EFloat Double + | K Tokn + | E + deriving (Eq,Ord,Show) + +data Tokn = + KS String + | KP [String] [Variant] + | KM String + deriving (Eq,Ord,Show) + +data Assign = + Ass Label Term + deriving (Eq,Ord,Show) + +data Case = + Cas [Patt] Term + deriving (Eq,Ord,Show) + +data Variant = + Var [String] [String] + deriving (Eq,Ord,Show) + +data Label = + L Ident + | LV Integer + deriving (Eq,Ord,Show) + +data ArgVar = + A Ident Integer + | AB Ident Integer Integer + deriving (Eq,Ord,Show) + +data Patt = + PC CIdent [Patt] + | PV Ident + | PW + | PR [PattAssign] + | PI Integer + | PF Double + deriving (Eq,Ord,Show) + +data PattAssign = + PAss Label Patt + deriving (Eq,Ord,Show) + diff --git a/src-3.0/GF/Canon/AbsToBNF.hs b/src-3.0/GF/Canon/AbsToBNF.hs new file mode 100644 index 000000000..e30e836da --- /dev/null +++ b/src-3.0/GF/Canon/AbsToBNF.hs @@ -0,0 +1,38 @@ +module GF.Canon.AbsToBNF where + +import GF.Grammar.SGrammar +import GF.Data.Operations +import GF.Infra.Option +import GF.Canon.GFC (CanonGrammar) + +-- AR 10/5/2007 + +abstract2bnf :: CanonGrammar -> String +abstract2bnf = sgrammar2bnf . gr2sgr noOptions emptyProbs + +sgrammar2bnf :: SGrammar -> String +sgrammar2bnf = unlines . map (prBNFRule . mkBNF) . allRules + +prBNFRule :: BNFRule -> String +prBNFRule = id + +type BNFRule = String + +mkBNF :: SRule -> BNFRule +mkBNF (pfun,(args,cat)) = + fun ++ "." +++ gfId cat +++ "::=" +++ rhs +++ ";" + where + fun = gfId (snd pfun) + rhs = case args of + [] -> prQuotedString (snd pfun) + _ -> unwords (map gfId args) + +-- good for GF +gfId i = i + +-- good for BNFC +gfIdd i = case i of + "Int" -> "Integer" + "String" -> i + "Float" -> "Double" + _ -> "G" ++ i ++ "_" diff --git a/src-3.0/GF/Canon/CMacros.hs b/src-3.0/GF/Canon/CMacros.hs new file mode 100644 index 000000000..572f09763 --- /dev/null +++ b/src-3.0/GF/Canon/CMacros.hs @@ -0,0 +1,334 @@ +---------------------------------------------------------------------- +-- | +-- Module : CMacros +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/14 16:03:41 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.29 $ +-- +-- Macros for building and analysing terms in GFC concrete syntax. +-- +-- macros for concrete syntax in GFC that do not need lookup in a grammar +----------------------------------------------------------------------------- + +module GF.Canon.CMacros where + +import GF.Infra.Ident +import GF.Canon.AbsGFC +import GF.Canon.GFC +import qualified GF.Infra.Ident as A ---- no need to qualif? 21/9 +import qualified GF.Grammar.Values as V +import qualified GF.Grammar.MMacros as M +import GF.Grammar.PrGrammar +import GF.Data.Str + +import GF.Data.Operations + +import Data.Char +import Control.Monad + +-- | how to mark subtrees, dep. on node, position, whether focus +type JustMarker = V.TrNode -> [Int] -> Bool -> (String, String) + +-- | also to process the text (needed for escapes e.g. in XML) +type Marker = (JustMarker, Maybe (String -> String)) + +defTMarker :: JustMarker -> Marker +defTMarker = flip (curry id) Nothing + +markSubtree :: Marker -> V.TrNode -> [Int] -> Bool -> Term -> Term +markSubtree (mk,esc) n is = markSubterm esc . mk n is + +escapeMkString :: Marker -> Maybe (String -> String) +escapeMkString = snd + +-- | if no marking is wanted, use the following +noMark :: Marker +noMark = defTMarker mk where + mk _ _ _ = ("","") + +-- | mark metas with their categories +metaCatMark :: Marker +metaCatMark = defTMarker mk where + mk nod _ _ = case nod of + V.N (_,V.AtM _,val,_,_) -> ("", '+':prt val) + _ -> ("","") + +-- | for vanilla brackets, focus, and position, use +markBracket :: Marker +markBracket = defTMarker mk where + mk n p b = if b then ("[*" ++ show p,"*]") else ("[" ++ show p,"]") + +-- | for focus only +markFocus :: Marker +markFocus = defTMarker mk where + mk n p b = if b then ("[*","*]") else ("","") + +-- | for XML, use +markJustXML :: JustMarker +markJustXML n i b = + if b + then ("<focus" +++ p +++ c ++ s ++ ">", "</focus>") + else ("<subtree" +++ p +++ c ++ s ++ ">", "</subtree>") + where + c = "type=" ++ prt (M.valNode n) + p = "position=" ++ (show $ reverse i) + s = if (null (M.constrsNode n)) then "" else " status=incorrect" + +markXML :: Marker +markXML = (markJustXML, Just esc) where + esc s = case s of + '\\':'<':cs -> '\\':'<':esc cs + '\\':'>':cs -> '\\':'>':esc cs + '\\':'\\':cs -> '\\':'\\':esc cs + ----- the first 3 needed because marking may revisit; needs to be fixed + + '<':cs -> '\\':'<':esc cs + '>':cs -> '\\':'>':esc cs + '\\':cs -> '\\':'\\':esc cs + c :cs -> c :esc cs + _ -> s + +-- | for XML in JGF 1, use +markXMLjgf :: Marker +markXMLjgf = defTMarker mk where + mk n p b = + if b + then ("<focus" +++ c ++ ">", "</focus>") + else ("","") + where + c = "type=" ++ prt (M.valNode n) + +-- | the marking engine +markSubterm :: Maybe (String -> String) -> (String,String) -> Term -> Term +markSubterm esc (beg, end) t = case t of + R rs -> R $ map markField rs + T ty cs -> T ty [Cas p (mark v) | Cas p v <- cs] + FV ts -> FV $ map mark ts + _ -> foldr1 C (tm beg ++ [mkEscIf t] ++ tm end) -- t : Str guaranteed? + where + mark = markSubterm esc (beg, end) + markField lt@(Ass l t) = if isLinLabel l then (Ass l (mark t)) else lt + tm s = if null s then [] else [tM s] + mkEscIf t = case esc of + Just f -> mkEsc f t + _ -> t + mkEsc f t = case t of + K (KS s) -> K (KS (f s)) + C u v -> C (mkEsc f u) (mkEsc f v) + FV ts -> FV (map (mkEsc f) ts) + _ -> t ---- do we need to look at other cases? + +tK,tM :: String -> Term +tK = K . KS +tM = K . KM + +term2patt :: Term -> Err Patt +term2patt trm = case trm of + Par c aa -> do + aa' <- mapM term2patt aa + return (PC c aa') + R r -> do + let (ll,aa) = unzip [(l,a) | Ass l a <- r] + aa' <- mapM term2patt aa + return (PR (map (uncurry PAss) (zip ll aa'))) + LI x -> return $ PV x + EInt i -> return $ PI i + EFloat i -> return $ PF i + FV (t:_) -> term2patt t ---- + _ -> prtBad "no pattern corresponds to term" trm + +patt2term :: Patt -> Term +patt2term p = case p of + PC x ps -> Par x (map patt2term ps) + PV x -> LI x + PW -> anyTerm ---- + PR pas -> R [ Ass lbl (patt2term q) | PAss lbl q <- pas ] + PI i -> EInt i + PF i -> EFloat i + +anyTerm :: Term +anyTerm = LI (A.identC "_") --- should not happen + +matchPatt :: [Case] -> Term -> Err Term +matchPatt cs0 (FV ts) = liftM FV $ mapM (matchPatt cs0) ts +matchPatt cs0 trm = term2patt trm >>= match cs0 where + match cs t = + case cs of + Cas ps b :_ | elem t ps -> return b + _:cs' -> match cs' t + [] -> Bad $ "pattern not found for" +++ prt t + +++ "among" ++++ unlines (map prt cs0) ---- debug + +defLinType :: CType +defLinType = RecType [Lbg (L (A.identC "s")) TStr] + +defLindef :: Term +defLindef = R [Ass (L (A.identC "s")) (Arg (A (A.identC "str") 0))] + +isDiscontinuousCType :: CType -> Bool +isDiscontinuousCType t = case t of + RecType rs -> length [t | Lbg _ t <- rs, valTableType t == TStr] > 1 + _ -> True --- does not occur; would not behave well in lin commands + +valTableType :: CType -> CType +valTableType t = case t of + Table _ v -> valTableType v + _ -> t + +strsFromTerm :: Term -> Err [Str] +strsFromTerm t = case t of + K (KS s) -> return [str s] + K (KM s) -> return [str s] + K (KP d vs) -> return $ [Str [TN d [(s,v) | Var s v <- vs]]] + C s t -> do + s' <- strsFromTerm s + t' <- strsFromTerm t + return [plusStr x y | x <- s', y <- t'] + FV ts -> liftM concat $ mapM strsFromTerm ts + E -> return [str []] + _ -> return [str ("BUG[" ++ prt t ++ "]")] ---- debug +---- _ -> prtBad "cannot get Str from term " t + +-- | recursively collect all branches in a table +allInTable :: Term -> [Term] +allInTable t = case t of + T _ ts -> concatMap (\ (Cas _ v) -> allInTable v) ts --- expand ? + _ -> [t] + +-- | to gather s-fields; assumes term in normal form, preserves label +allLinFields :: Term -> Err [[(Label,Term)]] +allLinFields trm = case trm of +---- R rs -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good + R rs -> return [[(l,t) | Ass l t <- rs, isLinLabel l]] ---- bad + FV ts -> do + lts <- mapM allLinFields ts + return $ concat lts + + T _ ts -> liftM concat $ mapM allLinFields [t | Cas _ t <- ts] + V _ ts -> liftM concat $ mapM allLinFields ts + S t _ -> allLinFields t + + _ -> prtBad "fields can only be sought in a record not in" trm + +-- | deprecated +isLinLabel :: Label -> Bool +isLinLabel l = case l of + L (A.IC ('s':cs)) | all isDigit cs -> True + -- peb (28/4-04), for MCFG grammars to work: + L (A.IC cs) | null cs || head cs `elem` ".!" -> True + _ -> False + +-- | to gather ultimate cases in a table; preserves pattern list +allCaseValues :: Term -> [([Patt],Term)] +allCaseValues trm = case trm of + T _ cs -> [(p:ps, t) | Cas pp t0 <- cs, p <- pp, (ps,t) <- allCaseValues t0] + _ -> [([],trm)] + +-- | to gather all linearizations; assumes normal form, preserves label and args +allLinValues :: Term -> Err [[(Label,[([Patt],Term)])]] +allLinValues trm = do + lts <- allLinFields trm + mapM (mapPairsM (return . allCaseValues)) lts + +-- | to gather all fields; does not assume s naming of fields; +-- used in Morpho only +allAllLinValues :: Term -> Err [[(Label,[([Patt],Term)])]] +allAllLinValues trm = do + lts <- allFields trm + mapM (mapPairsM (return . allCaseValues)) lts + where + allFields trm = case trm of + R rs -> return [[(l,t) | Ass l t <- rs]] + FV ts -> do + lts <- mapM allFields ts + return $ concat lts + _ -> prtBad "fields can only be sought in a record not in" trm + +-- | to gather all linearizations, even from nested records; params ignored +allLinBranches :: Term -> [([Label],Term)] +allLinBranches trm = case trm of + R rs -> [(l:ls,u) | Ass l t <- rs, (ls,u) <- allLinBranches t] + FV ts -> concatMap allLinBranches ts + T _ ts -> concatMap allLinBranches [t | Cas _ t <- ts] + V _ ts -> concatMap allLinBranches ts + _ -> [([],trm)] + +redirectIdent :: A.Ident -> CIdent -> CIdent +redirectIdent n f@(CIQ _ c) = CIQ n c + +ciq :: A.Ident -> A.Ident -> CIdent +ciq n f = CIQ n f + +wordsInTerm :: Term -> [String] +wordsInTerm trm = filter (not . null) $ case trm of + K (KS s) -> [s] + S c _ -> wo c + R rs -> concat [wo t | Ass _ t <- rs] + T _ cs -> concat [wo t | Cas _ t <- cs] + V _ cs -> concat [wo t | t <- cs] + C s t -> wo s ++ wo t + FV ts -> concatMap wo ts + K (KP ss vs) -> ss ++ concat [s | Var s _ <- vs] + P t _ -> wo t --- not needed ? + _ -> [] + where wo = wordsInTerm + +onTokens :: (String -> String) -> Term -> Term +onTokens f t = case t of + K (KS s) -> K (KS (f s)) + K (KP ss vs) -> K (KP (map f ss) [Var (map f x) (map f y) | Var x y <- vs]) + _ -> composSafeOp (onTokens f) t + +-- | to define compositional term functions +composSafeOp :: (Term -> Term) -> Term -> Term +composSafeOp op trm = case composOp (mkMonadic op) trm of + Ok t -> t + _ -> error "the operation is safe isn't it ?" + where + mkMonadic f = return . f + +-- | to define compositional term functions +composOp :: Monad m => (Term -> m Term) -> Term -> m Term +composOp co trm = + case trm of + Par x as -> + do + as' <- mapM co as + return (Par x as') + R as -> + do + let onAss (Ass l t) = liftM (Ass l) (co t) + as' <- mapM onAss as + return (R as') + P a x -> + do + a' <- co a + return (P a' x) + T x as -> + do + let onCas (Cas ps t) = liftM (Cas ps) (co t) + as' <- mapM onCas as + return (T x as') + S a b -> + do + a' <- co a + b' <- co b + return (S a' b') + C a b -> + do + a' <- co a + b' <- co b + return (C a' b') + FV as -> + do + as' <- mapM co as + return (FV as') + V x as -> + do + as' <- mapM co as + return (V x as') + _ -> return trm -- covers Arg, I, LI, K, E diff --git a/src-3.0/GF/Canon/CanonToGFCC.hs b/src-3.0/GF/Canon/CanonToGFCC.hs new file mode 100644 index 000000000..044ea3669 --- /dev/null +++ b/src-3.0/GF/Canon/CanonToGFCC.hs @@ -0,0 +1,45 @@ +module GF.Canon.CanonToGFCC where + +import GF.Devel.GrammarToGFCC +import GF.Devel.PrintGFCC +import GF.GFCC.CheckGFCC (checkGFCCmaybe) +import GF.GFCC.OptimizeGFCC +import GF.Canon.AbsGFC +import GF.Canon.GFC +import GF.Canon.CanonToGrammar +import GF.Canon.Subexpressions +import GF.Devel.PrintGFCC +import GF.Grammar.PrGrammar + +import qualified GF.Infra.Modules as M +import GF.Infra.Option + +import GF.Data.Operations +import GF.Text.UTF8 + +canon2gfccPr opts = printGFCC . canon2gfcc opts +canon2gfcc opts = source2gfcc opts . canon2source ---- +canon2source = err error id . canon2sourceGrammar . unSubelimCanon + +source2gfcc opts gf = + let + (abs,gfcc) = mkCanon2gfcc opts (gfcabs gf) gf + gfcc1 = maybe undefined id $ checkGFCCmaybe gfcc + in addParsers $ if oElem (iOpt "noopt") opts then gfcc1 else optGFCC gfcc1 + +gfcabs gfc = + prt $ head $ M.allConcretes gfc $ maybe (error "no abstract") id $ + M.greatestAbstract gfc + +{- +-- this variant makes utf8 conversion; used in back ends +mkCanon2gfcc :: CanonGrammar -> D.GFCC +mkCanon2gfcc = +-- canon2gfcc . reorder abs . utf8Conv . canon2canon abs + optGFCC . canon2gfcc . reorder . utf8Conv . canon2canon . normalize + +-- this variant makes no utf8 conversion; used in ShellState +mkCanon2gfccNoUTF8 :: CanonGrammar -> D.GFCC +mkCanon2gfccNoUTF8 = optGFCC . canon2gfcc . reorder . canon2canon . normalize +-} + diff --git a/src-3.0/GF/Canon/CanonToGrammar.hs b/src-3.0/GF/Canon/CanonToGrammar.hs new file mode 100644 index 000000000..078c3cc03 --- /dev/null +++ b/src-3.0/GF/Canon/CanonToGrammar.hs @@ -0,0 +1,203 @@ +---------------------------------------------------------------------- +-- | +-- Module : CanonToGrammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/06/17 14:15:17 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.15 $ +-- +-- a decompiler. AR 12/6/2003 -- 19/4/2004 +----------------------------------------------------------------------------- + +module GF.Canon.CanonToGrammar (canon2sourceGrammar, canon2sourceModule, redFlag) where + +import GF.Canon.AbsGFC +import GF.Canon.GFC +import GF.Canon.MkGFC +---import CMacros +import qualified GF.Infra.Modules as M +import qualified GF.Infra.Option as O +import qualified GF.Grammar.Grammar as G +import qualified GF.Grammar.Macros as F + +import GF.Infra.Ident +import GF.Data.Operations + +import Control.Monad + +canon2sourceGrammar :: CanonGrammar -> Err G.SourceGrammar +canon2sourceGrammar gr = do + ms' <- mapM canon2sourceModule $ M.modules gr + return $ M.MGrammar ms' + +canon2sourceModule :: CanonModule -> Err G.SourceModule +canon2sourceModule (i,mi) = do + i' <- redIdent i + info' <- case mi of + M.ModMod m -> do + (e,os) <- redExtOpen m + flags <- mapM redFlag $ M.flags m + (abstr,mt) <- case M.mtype m of + M.MTConcrete a -> do + a' <- redIdent a + return (a', M.MTConcrete a') + M.MTAbstract -> return (i',M.MTAbstract) --- c' not needed + M.MTResource -> return (i',M.MTResource) --- c' not needed + M.MTTransfer x y -> return (i',M.MTTransfer x y) --- c' not needed + defs <- mapMTree redInfo $ M.jments m + return $ M.ModMod $ M.Module mt (M.mstatus m) flags e os defs + _ -> Bad $ "cannot decompile module type" + return (i',info') + where + redExtOpen m = do + e' <- return $ M.extend m + os' <- mapM (\ (M.OSimple q i) -> liftM (\i -> M.OQualif q i i) (redIdent i)) $ + M.opens m + return (e',os') + +redInfo :: (Ident,Info) -> Err (Ident,G.Info) +redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do + c' <- redIdent c + info' <- case info of + AbsCat cont fs -> do + return $ G.AbsCat (Yes cont) (Yes (map (uncurry G.Q) fs)) + AbsFun typ df -> do + return $ G.AbsFun (Yes typ) (Yes df) + AbsTrans t -> do + return $ G.AbsTrans t + + ResPar par -> do + par' <- mapM redParam par + return $ G.ResParam (Yes (par',Nothing)) ---- list of values + + ResOper pty ptr -> do + ty' <- redCType pty + trm' <- redCTerm ptr + return $ G.ResOper (Yes ty') (Yes trm') + + CncCat pty ptr ppr -> do + ty' <- redCType pty + trm' <- redCTerm ptr + ppr' <- redCTerm ppr + return $ G.CncCat (Yes ty') (Yes trm') (Yes ppr') + CncFun (CIQ abstr cat) xx body ppr -> do + xx' <- mapM redArgVar xx + body' <- redCTerm body + ppr' <- redCTerm ppr + cat' <- redIdent cat + return $ G.CncFun (Just (cat', ([],F.typeStr))) -- Nothing + (Yes (F.mkAbs xx' body')) (Yes ppr') + + AnyInd b c -> liftM (G.AnyInd b) $ redIdent c + + return (c',info') + +redQIdent :: CIdent -> Err G.QIdent +redQIdent (CIQ m c) = liftM2 (,) (redIdent m) (redIdent c) + +redIdent :: Ident -> Err Ident +redIdent = return + +redFlag :: Flag -> Err O.Option +redFlag (Flg f x) = return $ O.Opt (prIdent f,[prIdent x]) + +redDecl :: Decl -> Err G.Decl +redDecl (Decl x a) = liftM2 (,) (redIdent x) (redTerm a) + +redType :: Exp -> Err G.Type +redType = redTerm + +redTerm :: Exp -> Err G.Term +redTerm t = return $ trExp t + +-- resource + +redParam (ParD c cont) = do + c' <- redIdent c + cont' <- mapM redCType cont + return $ (c', [(IW,t) | t <- cont']) + +-- concrete syntax + +redCType :: CType -> Err G.Type +redCType t = case t of + RecType lbs -> do + let (ls,ts) = unzip [(l,t) | Lbg l t <- lbs] + ls' = map redLabel ls + ts' <- mapM redCType ts + return $ G.RecType $ zip ls' ts' + Table p v -> liftM2 G.Table (redCType p) (redCType v) + Cn mc -> liftM (uncurry G.QC) $ redQIdent mc + TStr -> return $ F.typeStr + TInts i -> return $ F.typeInts (fromInteger i) + +redCTerm :: Term -> Err G.Term +redCTerm x = case x of + Arg argvar -> liftM G.Vr $ redArgVar argvar + I cident -> liftM (uncurry G.Q) $ redQIdent cident + Par cident terms -> liftM2 F.mkApp + (liftM (uncurry G.QC) $ redQIdent cident) + (mapM redCTerm terms) + LI id -> liftM G.Vr $ redIdent id + R assigns -> do + let (ls,ts) = unzip [(l,t) | Ass l t <- assigns] + let ls' = map redLabel ls + ts' <- mapM redCTerm ts + return $ G.R [(l,(Nothing,t)) | (l,t) <- zip ls' ts'] + P term label -> liftM2 G.P (redCTerm term) (return $ redLabel label) + T ctype cases -> do + ctype' <- redCType ctype + let (ps,ts) = unzip [(p,t) | Cas [p] t <- cases] + ps' <- mapM redPatt ps + ts' <- mapM redCTerm ts + let tinfo = case ps' of + [G.PV _] -> G.TTyped ctype' + _ -> G.TComp ctype' + return $ G.T tinfo $ zip ps' ts' + V ctype ts -> do + ctype' <- redCType ctype + ts' <- mapM redCTerm ts + return $ G.V ctype' ts' + S term0 term -> liftM2 G.S (redCTerm term0) (redCTerm term) + C term0 term -> liftM2 G.C (redCTerm term0) (redCTerm term) + FV terms -> liftM G.FV $ mapM redCTerm terms + K (KS str) -> return $ G.K str + EInt i -> return $ G.EInt i + EFloat i -> return $ G.EFloat i + E -> return $ G.Empty + K (KP d vs) -> return $ + G.Alts (tList d,[(tList s, G.Strs $ map G.K v) | Var s v <- vs]) + where + tList ss = case ss of --- this should be in Macros + [] -> G.Empty + _ -> foldr1 G.C $ map G.K ss + +failure x = Bad $ "not yet" +++ show x ---- + +redArgVar :: ArgVar -> Err Ident +redArgVar x = case x of + A x i -> return $ IA (prIdent x, fromInteger i) + AB x b i -> return $ IAV (prIdent x, fromInteger b, fromInteger i) + +redLabel :: Label -> G.Label +redLabel (L x) = G.LIdent $ prIdent x +redLabel (LV i) = G.LVar $ fromInteger i + +redPatt :: Patt -> Err G.Patt +redPatt p = case p of + PV x -> liftM G.PV $ redIdent x + PC mc ps -> do + (m,c) <- redQIdent mc + liftM (G.PP m c) (mapM redPatt ps) + PR rs -> do + let (ls,ts) = unzip [(l,t) | PAss l t <- rs] + ls' = map redLabel ls + ts <- mapM redPatt ts + return $ G.PR $ zip ls' ts + PI i -> return $ G.PInt i + PF i -> return $ G.PFloat i + _ -> Bad $ "cannot recompile pattern" +++ show p + diff --git a/src-3.0/GF/Canon/GFC.cf b/src-3.0/GF/Canon/GFC.cf new file mode 100644 index 000000000..d9385a49f --- /dev/null +++ b/src-3.0/GF/Canon/GFC.cf @@ -0,0 +1,170 @@ +-- top-level grammar + +-- Canonical GF. AR 27/4/2003 + +entrypoints Canon, Line ; + +-- old approach: read in a whole grammar + +MGr. Canon ::= "grammar" [Ident] "of" Ident ";" [Module] ; +Gr. Canon ::= [Module] ; + +-- new approach: read line by line + +LMulti. Line ::= "grammar" [Ident] "of" Ident ";" ; +LHeader. Line ::= ModType "=" Extend Open "{" ; +LFlag. Line ::= Flag ";" ; +LDef. Line ::= Def ";" ; +LEnd. Line ::= "}" ; + +Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ; + +MTAbs. ModType ::= "abstract" Ident ; +MTCnc. ModType ::= "concrete" Ident "of" Ident ; +MTRes. ModType ::= "resource" Ident ; +MTTrans. ModType ::= "transfer" Ident ":" Ident "->" Ident ; + +separator Module "" ; + +Ext. Extend ::= [Ident] "**" ; +NoExt. Extend ::= ; + +Opens. Open ::= "open" [Ident] "in" ; +NoOpens. Open ::= ; + + +-- judgements + +Flg. Flag ::= "flags" Ident "=" Ident ; --- to have the same res word as in GF + +AbsDCat. Def ::= "cat" Ident "[" [Decl] "]" "=" [CIdent] ; +AbsDFun. Def ::= "fun" Ident ":" Exp "=" Exp ; +AbsDTrans. Def ::= "transfer" Ident "=" Exp ; + +ResDPar. Def ::= "param" Ident "=" [ParDef] ; +ResDOper. Def ::= "oper" Ident ":" CType "=" Term ; + +CncDCat. Def ::= "lincat" Ident "=" CType "=" Term ";" Term ; +CncDFun. Def ::= "lin" Ident ":" CIdent "=" "\\" [ArgVar] "->" Term ";" Term ; + +AnyDInd. Def ::= Ident Status "in" Ident ; + +ParD. ParDef ::= Ident [CType] ; + +-- the canonicity of an indirected constant + +Canon. Status ::= "data" ; +NonCan. Status ::= ; + +-- names originating from resource modules: prefixed by the module name + +CIQ. CIdent ::= Ident "." Ident ; + +-- types and terms in abstract syntax; no longer type-annotated + +EApp. Exp1 ::= Exp1 Exp2 ; +EProd. Exp ::= "(" Ident ":" Exp ")" "->" Exp ; +EAbs. Exp ::= "\\" Ident "->" Exp ; +EAtom. Exp2 ::= Atom ; +EData. Exp2 ::= "data" ; + +EEq. Exp ::= "{" [Equation] "}" ; -- list of pattern eqs; primitive notion: [] + +coercions Exp 2 ; + +SType. Sort ::= "Type" ; + +Equ. Equation ::= [APatt] "->" Exp ; + +APC. APatt ::= "(" CIdent [APatt] ")" ; +APV. APatt ::= Ident ; +APS. APatt ::= String ; +API. APatt ::= Integer ; +APF. APatt ::= Double ; +APW. APatt ::= "_" ; + +separator Decl ";" ; +terminator APatt "" ; +terminator Equation ";" ; + +AC. Atom ::= CIdent ; +AD. Atom ::= "<" CIdent ">" ; +AV. Atom ::= "$" Ident ; +AM. Atom ::= "?" Integer ; +AS. Atom ::= String ; +AI. Atom ::= Integer ; +AT. Atom ::= Sort ; + +Decl. Decl ::= Ident ":" Exp ; + + +-- types, terms, and patterns in concrete syntax + +RecType. CType ::= "{" [Labelling] "}" ; +Table. CType ::= "(" CType "=>" CType ")" ; +Cn. CType ::= CIdent ; +TStr. CType ::= "Str" ; +TInts. CType ::= "Ints" Integer ; + +Lbg. Labelling ::= Label ":" CType ; + +Arg. Term2 ::= ArgVar ; +I. Term2 ::= CIdent ; -- from resources +Par. Term2 ::= "<" CIdent [Term2] ">" ; +LI. Term2 ::= "$" Ident ; -- from pattern variables + +R. Term2 ::= "{" [Assign] "}" ; +P. Term1 ::= Term2 "." Label ; +T. Term1 ::= "table" CType "{" [Case] "}" ; +V. Term1 ::= "table" CType "[" [Term2] "]" ; +S. Term1 ::= Term1 "!" Term2 ; +C. Term ::= Term "++" Term1 ; +FV. Term1 ::= "variants" "{" [Term2] "}" ; --- no separator! + +EInt. Term2 ::= Integer ; +EFloat. Term2 ::= Double ; +K. Term2 ::= Tokn ; +E. Term2 ::= "[" "]" ; + +KS. Tokn ::= String ; +KP. Tokn ::= "[" "pre" [String] "{" [Variant] "}" "]" ; +internal KM. Tokn ::= String ; -- mark-up + +Ass. Assign ::= Label "=" Term ; +Cas. Case ::= [Patt] "=>" Term ; +Var. Variant ::= [String] "/" [String] ; + +coercions Term 2 ; + +L. Label ::= Ident ; +LV. Label ::= "$" Integer ; +A. ArgVar ::= Ident "@" Integer ; -- no bindings +AB. ArgVar ::= Ident "+" Integer "@" Integer ; -- with a number of bindings + +PC. Patt ::= "(" CIdent [Patt] ")" ; +PV. Patt ::= Ident ; +PW. Patt ::= "_" ; +PR. Patt ::= "{" [PattAssign] "}" ; +PI. Patt ::= Integer ; +PF. Patt ::= Double ; + +PAss. PattAssign ::= Label "=" Patt ; + +--- here we use the new pragmas to generate list rules + +terminator Flag ";" ; +terminator Def ";" ; +separator ParDef "|" ; +separator CType "" ; +separator CIdent "" ; +separator Assign ";" ; +separator ArgVar "," ; +separator Labelling ";" ; +separator Case ";" ; +separator Term2 "" ; +separator String "" ; +separator Variant ";" ; +separator PattAssign ";" ; +separator Patt "" ; +separator Ident "," ; + diff --git a/src-3.0/GF/Canon/GFC.hs b/src-3.0/GF/Canon/GFC.hs new file mode 100644 index 000000000..ae9097c44 --- /dev/null +++ b/src-3.0/GF/Canon/GFC.hs @@ -0,0 +1,103 @@ +---------------------------------------------------------------------- +-- | +-- Module : GFC +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:22 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.12 $ +-- +-- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9 +----------------------------------------------------------------------------- + +module GF.Canon.GFC (Context, + CanonGrammar, + CanonModInfo, + CanonModule, + CanonAbs, + Info(..), + Printname, + prPrintnamesGrammar, + mapInfoTerms, + setFlag, + flagIncomplete, + isIncompleteCanon, + hasFlagCanon, + flagCanon + ) where + +import GF.Canon.AbsGFC +import GF.Canon.PrintGFC +import qualified GF.Grammar.Abstract as A + +import GF.Infra.Ident +import GF.Infra.Option +import GF.Data.Zipper +import GF.Data.Operations +import qualified GF.Infra.Modules as M + +import Data.Char +import Control.Arrow (first) + +type Context = [(Ident,Exp)] + +type CanonGrammar = M.MGrammar Ident Flag Info + +type CanonModInfo = M.ModInfo Ident Flag Info + +type CanonModule = (Ident, CanonModInfo) + +type CanonAbs = M.Module Ident Option Info + +data Info = + AbsCat A.Context [A.Fun] + | AbsFun A.Type A.Term + | AbsTrans A.Term + + | ResPar [ParDef] + | ResOper CType Term -- ^ global constant + | CncCat CType Term Printname + | CncFun CIdent [ArgVar] Term Printname + | AnyInd Bool Ident + deriving (Show) + +type Printname = Term + +mapInfoTerms :: (Term -> Term) -> Info -> Info +mapInfoTerms f i = case i of + ResOper x a -> ResOper x (f a) + CncCat x a y -> CncCat x (f a) y + CncFun x y a z -> CncFun x y (f a) z + _ -> i + +setFlag :: String -> String -> [Flag] -> [Flag] +setFlag n v fs = flagCanon n v : [f | f@(Flg (IC n') _) <- fs, n' /= n] + +flagIncomplete :: Flag +flagIncomplete = flagCanon "incomplete" "true" + +isIncompleteCanon :: CanonModule -> Bool +isIncompleteCanon = hasFlagCanon flagIncomplete + +hasFlagCanon :: Flag -> CanonModule -> Bool +hasFlagCanon f (_,M.ModMod mo) = elem f $ M.flags mo +hasFlagCanon f _ = True ---- safe, useless + +flagCanon :: String -> String -> Flag +flagCanon f v = Flg (identC f) (identC v) + +-- for Ha-Jo 20/2/2005 + +prPrintnamesGrammar :: CanonGrammar -> String +prPrintnamesGrammar gr = unlines $ filter (not . null) [prPrint j | + (_,M.ModMod m) <- M.modules gr, + M.isModCnc m, + j <- tree2list $ M.jments m + ] + where + prPrint j = case j of + (c,CncCat _ _ p) -> "printname cat" +++ A.prt_ c +++ "=" +++ A.prt_ p + (c,CncFun _ _ _ p) -> "printname fun" +++ A.prt_ c +++ "=" +++ A.prt_ p + _ -> [] diff --git a/src-3.0/GF/Canon/GetGFC.hs b/src-3.0/GF/Canon/GetGFC.hs new file mode 100644 index 000000000..049f75efe --- /dev/null +++ b/src-3.0/GF/Canon/GetGFC.hs @@ -0,0 +1,78 @@ +---------------------------------------------------------------------- +-- | +-- Module : GetGFC +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/30 18:39:43 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.9 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Canon.GetGFC (getCanonModule, getCanonGrammar) where + +import GF.Data.Operations +import GF.Canon.ParGFC +import GF.Canon.GFC +import GF.Canon.MkGFC +import GF.Infra.Modules +import GF.Infra.UseIO + +import System.IO +import System.Directory +import Control.Monad + +getCanonModule :: FilePath -> IOE CanonModule +getCanonModule file = do + gr <- getCanonGrammar file + case modules gr of + [m] -> return m + _ -> ioeErr $ Bad "expected exactly one module in a file" + +getCanonGrammar :: FilePath -> IOE CanonGrammar +-- getCanonGrammar = getCanonGrammarByLine +getCanonGrammar file = do + s <- ioeIO $ readFileIf file + c <- ioeErr $ pCanon $ myLexer s + return $ canon2grammar c + +{- +-- the following surprisingly does not save memory so it is +-- not in use + +getCanonGrammarByLine :: FilePath -> IOE CanonGrammar +getCanonGrammarByLine file = do + b <- ioeIO $ doesFileExist file + if not b + then ioeErr $ Bad $ "file" +++ file +++ "does not exist" + else do + ioeIO $ putStrLn "" + hand <- ioeIO $ openFile file ReadMode ---- err + size <- ioeIO $ hFileSize hand + gr <- addNextLine (size,0) 1 hand emptyMGrammar + ioeIO $ hClose hand + return $ MGrammar $ reverse $ modules gr + + where + addNextLine (size,act) d hand gr = do + eof <- ioeIO $ hIsEOF hand + if eof + then return gr + else do + s <- ioeIO $ hGetLine hand + let act' = act + toInteger (length s) +-- if isHash act act' then (ioeIO $ putChar '#') else return () + updGrammar act' d gr $ pLine $ myLexer s + where + updGrammar a d gr (Ok t) = case buildCanonGrammar d gr t of + (gr',d') -> addNextLine (size,a) d' hand gr' + updGrammar _ _ gr (Bad s) = do + ioeIO $ putStrLn s + return emptyMGrammar + + isHash a b = a `div` step < b `div` step + step = size `div` 50 +-} diff --git a/src-3.0/GF/Canon/LexGFC.hs b/src-3.0/GF/Canon/LexGFC.hs new file mode 100644 index 000000000..31a4a9b30 --- /dev/null +++ b/src-3.0/GF/Canon/LexGFC.hs @@ -0,0 +1,346 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# LINE 3 "LexGFC.x" #-} +module GF.Canon.LexGFC where --H + +import GF.Data.ErrM --H +import GF.Data.SharedString --H + +#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\x39\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x1d\x00\x00\x00\x0b\x00\x00\x00\x20\x00\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\xd3\x00\x00\x00\x35\x00\x00\x00\xe5\x00\x00\x00\x3f\x00\x00\x00\xf0\x00\x00\x00\x1b\x01\x00\x00\x6d\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\x02\x00\x02\x00\x02\x00\x02\x00\x02\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\x02\x00\x03\x00\x0a\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\x07\x00\x05\x00\x03\x00\x06\x00\x03\x00\x03\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x03\x00\x03\x00\x03\x00\x04\x00\x03\x00\x03\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x03\x00\x03\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\xff\xff\x03\x00\xff\xff\x02\x00\x0f\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\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\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0a\x00\x00\x00\x00\x00\xff\xff\x08\x00\x0a\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0b\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x10\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3e\x00\x2b\x00\x3e\x00\x2a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\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\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\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\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\xff\xff\xff\xff\xd7\x00\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\xff\xff\xff\xff\xf7\x00\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\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2d\x00\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# "\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,17) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[],[],[]] +{-# LINE 32 "LexGFC.x" #-} + +tok f p s = f p s + +share :: String -> String +share = shareString + +data Tok = + TS !String -- reserved words + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + 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 + + _ -> 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 "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" 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, _, _) -> fail $ show pos ++ ": lexical error" + 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_1 = tok (\p s -> PT p (TS $ share s)) +alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_4 = tok (\p s -> PT p (TI $ share s)) +alex_action_5 = 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" #-} + + + + + + + + + + + + +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 -> Maybe (AlexInput,Int,act) +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 + case s of + -1# -> (last_acc, input) + _ -> alex_scan_tkn' user orig_input len input s last_acc + +alex_scan_tkn' user orig_input len input s last_acc = + 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 + 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/Canon/LexGFC.x b/src-3.0/GF/Canon/LexGFC.x new file mode 100644 index 000000000..0a50e49d1 --- /dev/null +++ b/src-3.0/GF/Canon/LexGFC.x @@ -0,0 +1,132 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +module GF.Canon.LexGFC where + +import GF.Data.ErrM -- H +import GF.Data.SharedString -- H +} + + +$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME +$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME +$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME +$d = [0-9] -- digit +$i = [$l $d _ '] -- identifier character +$u = [\0-\255] -- universal: any character + +@rsyms = -- reserved words consisting of special symbols + \; | \= | \{ | \} | \: | \- \> | \* \* | \[ | \] | \\ | \. | \( | \) | \_ | \< | \> | \$ | \? | \= \> | \! | \+ \+ | \/ | \@ | \+ | \| | \, + +:- + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share s)) } + +$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } +\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } + +$d+ { tok (\p s -> PT p (TI $ share s)) } + + +{ + +tok f p s = f p s + +share :: String -> String +share = shareString + +data Tok = + TS !String -- reserved words + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + 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 + + _ -> 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 "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" 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, _, _) -> fail $ show pos ++ ": lexical error" + 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 +} diff --git a/src-3.0/GF/Canon/Look.hs b/src-3.0/GF/Canon/Look.hs new file mode 100644 index 000000000..a93d4c834 --- /dev/null +++ b/src-3.0/GF/Canon/Look.hs @@ -0,0 +1,225 @@ +---------------------------------------------------------------------- +-- | +-- Module : Look +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/20 09:32:56 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.17 $ +-- +-- lookup in GFC. AR 2003 +----------------------------------------------------------------------------- + +module GF.Canon.Look (lookupCncInfo, + lookupLin, + lookupLincat, + lookupPrintname, + lookupResInfo, + lookupGlobal, + lookupOptionsCan, + lookupParamValues, + allParamValues, + ccompute + ) where + +import GF.Canon.AbsGFC +import GF.Canon.GFC +import GF.Grammar.PrGrammar +import GF.Canon.CMacros +----import Values +import GF.Grammar.MMacros +import GF.Grammar.Macros (zIdent) +import qualified GF.Infra.Modules as M +import qualified GF.Canon.CanonToGrammar as CG + +import GF.Data.Operations +import GF.Infra.Option + +import Control.Monad +import Data.List + +-- linearization lookup + +lookupCncInfo :: CanonGrammar -> CIdent -> Err Info +lookupCncInfo gr f@(CIQ m c) = do + mt <- M.lookupModule gr m + case mt of + M.ModMod a -> errIn ("module" +++ prt m) $ + lookupIdent c $ M.jments a + _ -> prtBad "not concrete module" m + +lookupLin :: CanonGrammar -> CIdent -> Err Term +lookupLin gr f = errIn "looking up linearization rule" $ do + info <- lookupCncInfo gr f + case info of + CncFun _ _ t _ -> return t + CncCat _ t _ -> return t + AnyInd _ n -> lookupLin gr $ redirectIdent n f + +lookupLincat :: CanonGrammar -> CIdent -> Err CType +lookupLincat gr (CIQ _ c) | elem c [zIdent "String", zIdent "Int", zIdent "Float"] = + return defLinType --- ad hoc; not needed? cf. Grammar.Lookup.lookupLincat +lookupLincat gr f = errIn "looking up linearization type" $ do + info <- lookupCncInfo gr f + case info of + CncCat t _ _ -> return t + AnyInd _ n -> lookupLincat gr $ redirectIdent n f + _ -> prtBad "no lincat found for" f + +lookupPrintname :: CanonGrammar -> CIdent -> Err Term +lookupPrintname gr f = errIn "looking up printname" $ do + info <- lookupCncInfo gr f + case info of + CncFun _ _ _ t -> return t + CncCat _ _ t -> return t + AnyInd _ n -> lookupPrintname gr $ redirectIdent n f + +lookupResInfo :: CanonGrammar -> CIdent -> Err Info +lookupResInfo gr f@(CIQ m c) = do + mt <- M.lookupModule gr m + case mt of + M.ModMod a -> lookupIdent c $ M.jments a + _ -> prtBad "not resource module" m + +lookupGlobal :: CanonGrammar -> CIdent -> Err Term +lookupGlobal gr f = do + info <- lookupResInfo gr f + case info of + ResOper _ t -> return t + AnyInd _ n -> lookupGlobal gr $ redirectIdent n f + _ -> prtBad "cannot find global" f + +lookupOptionsCan :: CanonGrammar -> Err Options +lookupOptionsCan gr = do + let fs = M.allFlags gr + os <- mapM CG.redFlag fs + return $ options os + +lookupParamValues :: CanonGrammar -> CIdent -> Err [Term] +lookupParamValues gr pt@(CIQ m _) = do + info <- lookupResInfo gr pt + case info of + ResPar ps -> liftM concat $ mapM mkPar ps + AnyInd _ n -> lookupParamValues gr $ redirectIdent n pt + _ -> prtBad "cannot find parameter type" pt + where + mkPar (ParD f co) = do + vs <- liftM combinations $ mapM (allParamValues gr) co + return $ map (Par (CIQ m f)) vs + +-- this is needed since param type can also be a record type + +allParamValues :: CanonGrammar -> CType -> Err [Term] +allParamValues cnc ptyp = case ptyp of + Cn pc -> lookupParamValues cnc pc + RecType r -> do + let (ls,tys) = unzip [(l,t) | Lbg l t <- r] + tss <- mapM allPV tys + return [R (map (uncurry Ass) (zip ls ts)) | ts <- combinations tss] + TInts n -> return [EInt i | i <- [0..n]] + _ -> prtBad "cannot possibly find parameter values for" ptyp + where + allPV = allParamValues cnc + +-- runtime computation on GFC objects + +ccompute :: CanonGrammar -> [Term] -> Term -> Err Term +ccompute cnc = vcomp + where + + vcomp xs t = do + let xss = variations xs + ts <- mapM (\xx -> comp [] xx t) xss + return $ variants ts + + variations xs = combinations [getVariants t | t <- xs] + variants ts = case ts of + [t] -> t + _ -> FV ts + getVariants t = case t of + FV ts -> ts + _ -> [t] + + comp g xs t = case t of + Arg (A _ i) -> err (const (return t)) return $ xs !? fromInteger i + Arg (AB _ _ i) -> err (const (return t)) return $ xs !? fromInteger i + I c -> look c + LI c -> lookVar c g + + -- short-cut computation of selections: compute the table only if needed + S u v -> do + u' <- compt u + case u' of + T _ [Cas [PW] b] -> compt b + T _ [Cas [PV x] b] -> do + v' <- compt v + comp ((x,v') : g) xs b + T _ cs -> do + v' <- compt v + if noVar v' + then matchPatt cs v' >>= compt + else return $ S u' v' + FV ccs -> do + v' <- compt v + mapM (\c -> compt (S c v')) ccs >>= return . FV + + _ -> liftM (S u') $ compt v + + P u l -> do + u' <- compt u + case u' of + R rs -> maybe (Bad ("unknown label" +++ prt l +++ "in" +++ prt u')) + return $ + lookup l [ (x,y) | Ass x y <- rs] + FV rrs -> do + mapM (\r -> compt (P r l)) rrs >>= return . FV + + _ -> return $ P u' l + FV ts -> liftM FV (mapM compt ts) + C E b -> compt b + C a E -> compt a + C a b -> do + a' <- compt a + b' <- compt b + return $ case (a',b') of + (E,_) -> b' + (_,E) -> a' + _ -> C a' b' + R rs -> liftM (R . map (uncurry Ass)) $ + mapPairsM compt [(l,r) | Ass l r <- rs] + + -- only expand the table when the table is really needed: use expandLin + T ty rs -> liftM (T ty . map (uncurry Cas)) $ + mapPairsM compt [(l,r) | Cas l r <- rs] + + V ptyp ts -> do + ts' <- mapM compt ts + vs0 <- allParamValues cnc ptyp + vs <- mapM term2patt vs0 + let cc = [Cas [p] u | (p,u) <- zip vs ts'] + return $ T ptyp cc + + Par c xs -> liftM (Par c) $ mapM compt xs + + K (KS []) -> return E --- should not be needed + + _ -> return t + where + compt = comp g xs + look c = lookupGlobal cnc c >>= compt + + lookVar c co = case lookup c co of + Just t -> return t + _ -> return $ LI c --- Bad $ "unknown local variable" +++ prt c --- + + noVar v = case v of + LI _ -> False + Arg _ -> False + R rs -> all noVar [t | Ass _ t <- rs] + Par _ ts -> all noVar ts + FV ts -> all noVar ts + S x y -> noVar x && noVar y + P t _ -> noVar t + _ -> True --- other cases that can be values to pattern match? diff --git a/src-3.0/GF/Canon/MkGFC.hs b/src-3.0/GF/Canon/MkGFC.hs new file mode 100644 index 000000000..8443354fc --- /dev/null +++ b/src-3.0/GF/Canon/MkGFC.hs @@ -0,0 +1,237 @@ +---------------------------------------------------------------------- +-- | +-- Module : MkGFC +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/04 11:45:38 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.16 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Canon.MkGFC (prCanonModInfo, prCanon, prCanonMGr, + canon2grammar, grammar2canon, -- buildCanonGrammar, + info2mod,info2def, + trExp, rtExp, rtQIdent) where + +import GF.Canon.GFC +import GF.Canon.AbsGFC +import qualified GF.Grammar.Abstract as A +import GF.Grammar.PrGrammar + +import GF.Infra.Ident +import GF.Data.Operations +import qualified GF.Infra.Modules as M + +prCanonModInfo :: CanonModule -> String +prCanonModInfo = prt . info2mod + +prCanon :: CanonGrammar -> String +prCanon = unlines . map prCanonModInfo . M.modules + +prCanonMGr :: CanonGrammar -> String +prCanonMGr g = header ++++ prCanon g where + header = case M.greatestAbstract g of + Just a -> prt (MGr (M.allConcretes g a) a []) + _ -> [] + +canon2grammar :: Canon -> CanonGrammar +canon2grammar (MGr _ _ modules) = canon2grammar (Gr modules) ---- ignoring the header +canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules + +mod2info m = case m of + Mod mt e os flags defs -> + let defs' = buildTree $ map def2info defs + (a,mt') = case mt of + MTAbs a -> (a,M.MTAbstract) + MTRes a -> (a,M.MTResource) + MTCnc a x -> (a,M.MTConcrete x) + MTTrans a x y -> (a,M.MTTransfer (M.oSimple x) (M.oSimple y)) + in (a,M.ModMod (M.Module mt' M.MSComplete flags (ee e) (oo os) defs')) + where + ee (Ext m) = map M.inheritAll m + ee _ = [] + oo (Opens ms) = map M.oSimple ms + oo _ = [] + +grammar2canon :: CanonGrammar -> Canon +grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules + +info2mod :: (Ident, M.ModInfo Ident Flag Info) -> Module +info2mod m = case m of + (a, M.ModMod (M.Module mt _ flags me os defs)) -> + let defs' = map info2def $ tree2list defs + mt' = case mt of + M.MTAbstract -> MTAbs a + M.MTResource -> MTRes a + M.MTConcrete x -> MTCnc a x + M.MTTransfer (M.OSimple _ x) (M.OSimple _ y) -> MTTrans a x y + in + Mod mt' (gfcE me) (gfcO os) flags defs' + where + gfcE = ifNull NoExt Ext . map fst + gfcO os = if null os then NoOpens else Opens [m | M.OSimple _ m <- os] + + +-- these translations are meant to be trivial + +defs2infos = sorted2tree . map def2info + +def2info d = case d of + AbsDCat c cont fs -> (c,AbsCat (trCont cont) (trFs fs)) + AbsDFun c ty df -> (c,AbsFun (trExp ty) (trExp df)) + AbsDTrans c t -> (c,AbsTrans (trExp t)) + ResDPar c df -> (c,ResPar df) + ResDOper c ty df -> (c,ResOper ty df) + CncDCat c ty df pr -> (c, CncCat ty df pr) + CncDFun f c xs li pr -> (f, CncFun c xs li pr) + AnyDInd c b m -> (c, AnyInd (b == Canon) m) + +-- from file to internal + +trCont cont = [(x,trExp t) | Decl x t <- cont] + +trFs = map trQIdent + +trExp :: Exp -> A.Term +trExp t = case t of + EProd x a b -> A.Prod x (trExp a) (trExp b) + EAbs x b -> A.Abs x (trExp b) + EApp f a -> A.App (trExp f) (trExp a) + EEq eqs -> A.Eqs [(map trPt ps, trExp e) | Equ ps e <- eqs] + EData -> A.EData + _ -> trAt t + where + trAt (EAtom t) = case t of + AC c -> (uncurry A.Q) $ trQIdent c + AD c -> (uncurry A.QC) $ trQIdent c + AV v -> A.Vr v + AM i -> A.Meta $ A.MetaSymb $ fromInteger i + AT s -> A.Sort $ prt s + AS s -> A.K s + AI i -> A.EInt $ i + AF i -> A.EFloat $ i + trPt p = case p of + APC mc ps -> let (m,c) = trQIdent mc in A.PP m c (map trPt ps) + APV x -> A.PV x + APS s -> A.PString s + API i -> A.PInt $ i + APF i -> A.PFloat $ i + APW -> A.PW + +trQIdent (CIQ m c) = (m,c) + +-- from internal to file + +infos2defs = map info2def . tree2list + +info2def d = case d of + (c,AbsCat cont fs) -> AbsDCat c (rtCont cont) (rtFs fs) + (c,AbsFun ty df) -> AbsDFun c (rtExp ty) (rtExp df) + (c,AbsTrans t) -> AbsDTrans c (rtExp t) + (c,ResPar df) -> ResDPar c df + (c,ResOper ty df) -> ResDOper c ty df + (c,CncCat ty df pr) -> CncDCat c ty df pr + (f,CncFun c xs li pr) -> CncDFun f c xs li pr + (c,AnyInd b m) -> AnyDInd c (if b then Canon else NonCan) m + +rtCont cont = [Decl (rtIdent x) (rtExp t) | (x,t) <- cont] + +rtFs = map rtQIdent + +rtExp :: A.Term -> Exp +rtExp t = case t of + A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b) + A.Abs x b -> EAbs (rtIdent x) (rtExp b) + A.App f a -> EApp (rtExp f) (rtExp a) + A.Eqs eqs -> EEq [Equ (map rtPt ps) (rtExp e) | (ps,e) <- eqs] + A.EData -> EData + _ -> EAtom $ rtAt t + where + rtAt t = case t of + A.Q m c -> AC $ rtQIdent (m,c) + A.QC m c -> AD $ rtQIdent (m,c) + A.Vr v -> AV v + A.Meta i -> AM $ toInteger $ A.metaSymbInt i + A.Sort "Type" -> AT SType + A.K s -> AS s + A.EInt i -> AI $ toInteger i + _ -> error $ "MkGFC.rt not defined for" +++ show t + rtPt p = case p of + A.PP m c ps -> APC (rtQIdent (m,c)) (map rtPt ps) + A.PV x -> APV x + A.PString s -> APS s + A.PInt i -> API $ toInteger i + A.PW -> APW + _ -> error $ "MkGFC.rt not defined for" +++ show p + + +rtQIdent :: (Ident, Ident) -> CIdent +rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c) +rtIdent x + | isWildIdent x = identC "h_" --- needed in declarations + | otherwise = identC $ prt x --- + +{- +-- the following is called in GetGFC to read gfc files line +-- by line. It does not save memory, though, and is therefore +-- not used. + +buildCanonGrammar :: Int -> CanonGrammar -> Line -> (CanonGrammar,Int) +buildCanonGrammar n gr0 line = mgr $ case line of +-- LMulti ids id + LHeader mt ext op -> newModule mt ext op + LFlag f@(Flg (IC "modulesize") (IC n)) -> initModule f $ read $ tail n + LFlag flag -> newFlag flag + LDef def -> newDef $ def2info def +-- LEnd -> cleanNames + _ -> M.modules gr0 + where + newModule mt ext op = mod2info (Mod mt ext op [] []) : mods + initModule f i = case actm of + (name, M.ModMod (M.Module mt com flags ee oo defs)) -> + (name, M.ModMod (M.Module mt com (f:flags) ee oo (newtree i))) : tmods + newFlag f = case actm of + (name, M.ModMod (M.Module mt com flags ee oo defs)) -> + (name, M.ModMod (M.Module mt com (f:flags) ee oo defs)) : tmods + newDef d = case actm of + (name, M.ModMod (M.Module mt com flags ee oo defs)) -> + (name, M.ModMod (M.Module mt com flags ee oo + (upd (padd 8 n) d defs))) : tmods + +-- cleanNames = case actm of +-- (name, M.ModMod (M.Module mt com flags ee oo defs)) -> +-- (name, M.ModMod (M.Module mt com (reverse flags) ee oo +-- (mapTree (\ (IC f,t) -> (IC (drop 8 f),t)) defs))) : tmods + + actm = head mods -- only used when a new mod has been created + mods = M.modules gr0 + tmods = tail mods + + mgr ms = (M.MGrammar ms, case line of + LDef _ -> n+1 + LEnd -> 1 + _ -> n + ) + + -- create an initial tree with who-cares value + newtree (i :: Int) = emptyBinTree +-- newtree (i :: Int) = sorted2tree [ +-- (padd 8 k, ResPar []) | +-- k <- [1..i]] --- padd (length (show i)) + + padd l k = 0 +-- padd l k = let sk = show k in identC (replicate (l - length sk) '0' ++ sk) + + upd _ d defs = updateTree d defs +-- upd n d@(f,t) defs = case defs of +-- NT -> BT (merg n f,t) NT NT --- should not happen +-- BT c@(a,_) left right +-- | n < a -> let left' = upd n d left in BT c left' right +-- | n > a -> let right' = upd n d right in BT c left right' +-- | otherwise -> BT (merg n f,t) left right +-- merg (IC n) (IC f) = IC (n ++ f) +-} diff --git a/src-3.0/GF/Canon/ParGFC.hs b/src-3.0/GF/Canon/ParGFC.hs new file mode 100644 index 000000000..4332c06e4 --- /dev/null +++ b/src-3.0/GF/Canon/ParGFC.hs @@ -0,0 +1,2142 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +module GF.Canon.ParGFC where -- H +import GF.Canon.AbsGFC -- H +import GF.Canon.LexGFC -- H +import GF.Data.ErrM -- H +import GF.Infra.Ident -- H +import Array +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.15 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn5 :: (Ident) -> (HappyAbsSyn ) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (Ident) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (String) -> (HappyAbsSyn ) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> (String) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (Integer) -> (HappyAbsSyn ) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (Integer) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (Double) -> (HappyAbsSyn ) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (Double) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (Canon) -> (HappyAbsSyn ) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (Canon) +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (Line) -> (HappyAbsSyn ) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (Line) +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (Module) -> (HappyAbsSyn ) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (Module) +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (ModType) -> (HappyAbsSyn ) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (ModType) +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: ([Module]) -> (HappyAbsSyn ) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn ) -> ([Module]) +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: (Extend) -> (HappyAbsSyn ) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn ) -> (Extend) +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: (Open) -> (HappyAbsSyn ) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn ) -> (Open) +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: (Flag) -> (HappyAbsSyn ) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> (Flag) +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: (Def) -> (HappyAbsSyn ) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> (Def) +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: (ParDef) -> (HappyAbsSyn ) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> (ParDef) +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: (Status) -> (HappyAbsSyn ) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> (Status) +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: (CIdent) -> (HappyAbsSyn ) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> (CIdent) +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: (Exp) -> (HappyAbsSyn ) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> (Exp) +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: (Exp) -> (HappyAbsSyn ) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> (Exp) +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: (Exp) -> (HappyAbsSyn ) +happyIn23 x = unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> (Exp) +happyOut23 x = unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: (Sort) -> (HappyAbsSyn ) +happyIn24 x = unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> (Sort) +happyOut24 x = unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: (Equation) -> (HappyAbsSyn ) +happyIn25 x = unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> (Equation) +happyOut25 x = unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (APatt) -> (HappyAbsSyn ) +happyIn26 x = unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> (APatt) +happyOut26 x = unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: ([Decl]) -> (HappyAbsSyn ) +happyIn27 x = unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> ([Decl]) +happyOut27 x = unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: ([APatt]) -> (HappyAbsSyn ) +happyIn28 x = unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> ([APatt]) +happyOut28 x = unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: ([Equation]) -> (HappyAbsSyn ) +happyIn29 x = unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> ([Equation]) +happyOut29 x = unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: (Atom) -> (HappyAbsSyn ) +happyIn30 x = unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> (Atom) +happyOut30 x = unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (Decl) -> (HappyAbsSyn ) +happyIn31 x = unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> (Decl) +happyOut31 x = unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: (CType) -> (HappyAbsSyn ) +happyIn32 x = unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> (CType) +happyOut32 x = unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: (Labelling) -> (HappyAbsSyn ) +happyIn33 x = unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> (Labelling) +happyOut33 x = unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: (Term) -> (HappyAbsSyn ) +happyIn34 x = unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> (Term) +happyOut34 x = unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: (Term) -> (HappyAbsSyn ) +happyIn35 x = unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> (Term) +happyOut35 x = unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: (Term) -> (HappyAbsSyn ) +happyIn36 x = unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> (Term) +happyOut36 x = unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: (Tokn) -> (HappyAbsSyn ) +happyIn37 x = unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> (Tokn) +happyOut37 x = unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: (Assign) -> (HappyAbsSyn ) +happyIn38 x = unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> (Assign) +happyOut38 x = unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: (Case) -> (HappyAbsSyn ) +happyIn39 x = unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> (Case) +happyOut39 x = unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: (Variant) -> (HappyAbsSyn ) +happyIn40 x = unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> (Variant) +happyOut40 x = unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: (Label) -> (HappyAbsSyn ) +happyIn41 x = unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> (Label) +happyOut41 x = unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: (ArgVar) -> (HappyAbsSyn ) +happyIn42 x = unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> (ArgVar) +happyOut42 x = unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: (Patt) -> (HappyAbsSyn ) +happyIn43 x = unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> (Patt) +happyOut43 x = unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: (PattAssign) -> (HappyAbsSyn ) +happyIn44 x = unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> (PattAssign) +happyOut44 x = unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: ([Flag]) -> (HappyAbsSyn ) +happyIn45 x = unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> ([Flag]) +happyOut45 x = unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: ([Def]) -> (HappyAbsSyn ) +happyIn46 x = unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> ([Def]) +happyOut46 x = unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: ([ParDef]) -> (HappyAbsSyn ) +happyIn47 x = unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> ([ParDef]) +happyOut47 x = unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: ([CType]) -> (HappyAbsSyn ) +happyIn48 x = unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> ([CType]) +happyOut48 x = unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyIn49 :: ([CIdent]) -> (HappyAbsSyn ) +happyIn49 x = unsafeCoerce# x +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> ([CIdent]) +happyOut49 x = unsafeCoerce# x +{-# INLINE happyOut49 #-} +happyIn50 :: ([Assign]) -> (HappyAbsSyn ) +happyIn50 x = unsafeCoerce# x +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> ([Assign]) +happyOut50 x = unsafeCoerce# x +{-# INLINE happyOut50 #-} +happyIn51 :: ([ArgVar]) -> (HappyAbsSyn ) +happyIn51 x = unsafeCoerce# x +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> ([ArgVar]) +happyOut51 x = unsafeCoerce# x +{-# INLINE happyOut51 #-} +happyIn52 :: ([Labelling]) -> (HappyAbsSyn ) +happyIn52 x = unsafeCoerce# x +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn ) -> ([Labelling]) +happyOut52 x = unsafeCoerce# x +{-# INLINE happyOut52 #-} +happyIn53 :: ([Case]) -> (HappyAbsSyn ) +happyIn53 x = unsafeCoerce# x +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn ) -> ([Case]) +happyOut53 x = unsafeCoerce# x +{-# INLINE happyOut53 #-} +happyIn54 :: ([Term]) -> (HappyAbsSyn ) +happyIn54 x = unsafeCoerce# x +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn ) -> ([Term]) +happyOut54 x = unsafeCoerce# x +{-# INLINE happyOut54 #-} +happyIn55 :: ([String]) -> (HappyAbsSyn ) +happyIn55 x = unsafeCoerce# x +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn ) -> ([String]) +happyOut55 x = unsafeCoerce# x +{-# INLINE happyOut55 #-} +happyIn56 :: ([Variant]) -> (HappyAbsSyn ) +happyIn56 x = unsafeCoerce# x +{-# INLINE happyIn56 #-} +happyOut56 :: (HappyAbsSyn ) -> ([Variant]) +happyOut56 x = unsafeCoerce# x +{-# INLINE happyOut56 #-} +happyIn57 :: ([PattAssign]) -> (HappyAbsSyn ) +happyIn57 x = unsafeCoerce# x +{-# INLINE happyIn57 #-} +happyOut57 :: (HappyAbsSyn ) -> ([PattAssign]) +happyOut57 x = unsafeCoerce# x +{-# INLINE happyOut57 #-} +happyIn58 :: ([Patt]) -> (HappyAbsSyn ) +happyIn58 x = unsafeCoerce# x +{-# INLINE happyIn58 #-} +happyOut58 :: (HappyAbsSyn ) -> ([Patt]) +happyOut58 x = unsafeCoerce# x +{-# INLINE happyOut58 #-} +happyIn59 :: ([Ident]) -> (HappyAbsSyn ) +happyIn59 x = unsafeCoerce# x +{-# INLINE happyIn59 #-} +happyOut59 :: (HappyAbsSyn ) -> ([Ident]) +happyOut59 x = unsafeCoerce# x +{-# INLINE happyOut59 #-} +happyInTok :: Token -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> Token +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x74\x02\xa7\x00\x6e\x02\x00\x00\x6c\x02\x66\x02\x89\x02\x88\x02\x84\x02\x00\x00\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x52\x02\x21\x02\x60\x02\x6d\x02\x5e\x02\x00\x00\x82\x02\x5b\x02\xdb\x00\x00\x00\x80\x02\x7e\x02\x7d\x02\x79\x02\x59\x02\x78\x02\x7a\x02\x58\x02\x73\x02\x00\x00\x00\x00\x00\x00\x28\x00\x53\x02\x00\x00\x46\x02\x51\x02\x72\x02\x44\x02\x44\x02\x44\x02\x8b\x00\x44\x02\x44\x02\x9b\x00\x9b\x00\x44\x02\x8b\x00\x44\x02\x71\x02\x28\x00\x42\x02\x42\x02\x00\x00\x70\x02\x4b\x02\x6a\x02\x64\x02\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x02\x8b\x00\x38\x02\x38\x02\x3f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x02\x00\x00\x00\x00\x6b\x02\xf7\xff\x9b\x00\x39\x02\x00\x00\x69\x02\x68\x02\x67\x02\x65\x02\x00\x00\x00\x00\x61\x02\x5c\x02\x63\x02\x00\x00\x5f\x02\x30\x02\x00\x00\x3e\x02\x00\x00\x2f\x02\x5d\x02\x8b\x00\x8b\x00\x00\x00\x54\x02\x12\x00\x00\x00\x4a\x02\x00\x00\x5a\x02\x57\x02\x56\x02\x26\x02\x12\x00\x27\x02\x9b\x00\x00\x00\x00\x00\x47\x02\xd7\x00\x48\x02\x50\x02\x4d\x02\x00\x00\x8b\x00\x23\x02\x23\x02\x4f\x02\x00\x00\x21\x02\x00\x00\x00\x00\x00\x00\x4e\x02\x7e\x00\x00\x00\x8b\x00\x00\x00\x8b\x00\x00\x00\x00\x00\x00\x00\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\x36\x02\x33\x02\x00\x00\x00\x00\xf7\xff\xfe\xff\x12\x00\x16\x02\x16\x02\x9b\x00\x43\x02\x00\x00\x00\x00\x00\x00\x9b\x00\xf7\xff\x9b\x00\xba\x00\x14\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x02\x66\x00\x2a\x02\x3d\x02\x12\x00\x12\x00\x35\x02\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x07\x00\x00\x00\x00\x00\x3c\x02\x2c\x02\x29\x02\x5f\x00\xf7\xff\x0d\x02\x0d\x02\x1e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x00\xfb\x01\x00\x00\x00\x00\x08\x02\x28\x02\xb4\x00\x00\x00\x00\x00\x22\x02\x0c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\xf7\xff\x1a\x00\x00\x00\x55\x00\x10\x02\x00\x00\x4f\x00\x00\x00\xff\x01\xfc\x01\x12\x00\xe1\x01\x00\x00\x00\x00\xac\x00\x00\x00\x00\x00\x1d\x00\x0f\x02\x0a\x02\x65\x00\x00\x00\x00\x00\x6f\x00\x00\x00\xfa\x01\xd6\x01\x8b\x00\xda\x00\xf9\x01\x00\x00\xc8\x01\x00\x00\xf6\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x01\x59\x00\xf3\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf7\xff\xc5\x01\x00\x00\x12\x00\x00\x00\xf0\x01\x00\x00\x12\x00\xc9\x01\x00\x00\xc9\x01\x00\x00\xdd\x01\xdc\x01\xd8\x01\xd1\x01\x00\x00\x37\x00\x00\x00\xa9\x01\x00\x00\x00\x00\xf7\xff\x16\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x9c\x00\x5d\x01\x00\x00\x00\x00\xb7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x01\xc2\x01\xc1\x01\xbc\x01\xb1\x01\x06\x00\xb0\x01\xa8\x01\xa4\x01\x8f\x01\x8e\x01\x8c\x01\x00\x00\x6e\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x86\x01\x72\x01\x00\x00\x9f\x00\x7b\x01\x70\x01\x25\x02\x65\x01\xe0\x01\x36\x01\x19\x01\xa6\x00\x20\x02\x52\x01\x00\x00\x01\x00\x40\x01\x04\x00\x00\x00\x00\x00\x35\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x26\x01\x3c\x01\x0b\x02\xc6\x01\x3b\x01\x38\x01\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x18\x01\x33\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x00\x00\x06\x02\xf1\x01\x00\x00\x00\x00\x7e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x01\x6b\x01\x6a\x00\x17\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xec\x01\x1f\x01\x1d\x01\x00\x00\x14\x01\x6e\x00\xf3\x00\x00\x00\x00\x00\x00\x00\xab\x01\x00\x00\xd7\x01\x00\x00\xd2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x58\x01\xb4\x01\xfd\x00\xf9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xef\x00\x0f\x00\x0c\x00\x00\x00\x35\x00\x00\x00\x00\x00\xc7\x00\x00\x00\x00\x00\xa6\x01\x00\x00\x00\x00\x00\x00\x54\x01\x82\x01\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x90\x00\x00\x00\x00\x00\x00\x00\x96\x01\x0e\x00\xe8\x00\xd3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x01\x37\x01\x00\x00\x00\x00\x51\x00\x00\x00\x03\x01\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x01\xc0\x00\xa1\x00\x00\x00\x92\x01\x3a\x01\x5c\x00\x92\x01\x00\x00\x00\x00\x00\x00\x2e\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\x01\x00\x00\x00\x00\xff\x00\x00\x00\x00\x00\x77\x01\x00\x00\x00\x00\x74\x00\xb8\x01\xab\x01\x00\x00\x00\x00\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x10\x00\x00\x00\x2a\x01\x00\x00\x3d\x00\x00\x00\x04\x01\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xff\x91\x00\x00\x00\x17\x00\x00\x00\x00\x00\x09\x00\xf8\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xed\xff\x00\x00\x00\x00\xfd\xff\xdc\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xff\x6f\xff\x6e\xff\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xff\xf4\xff\xf5\xff\xea\xff\x00\x00\xdd\xff\x00\x00\xe8\xff\x00\x00\xc9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\xff\x00\x00\x00\x00\x00\x00\xea\xff\x00\x00\x6f\xff\x6d\xff\x00\x00\xe8\xff\x00\x00\x00\x00\xbe\xff\xbd\xff\xc2\xff\xd5\xff\xe4\xff\xd9\xff\xbc\xff\xd4\xff\xc4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\xff\xd3\xff\xfc\xff\xfb\xff\x8b\xff\x8d\xff\xe3\xff\xb8\xff\x00\x00\x81\xff\x00\x00\x00\x00\xb7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\xf0\xff\x00\x00\x00\x00\xc8\xff\xeb\xff\x00\x00\x6f\xff\xdf\xff\x00\x00\xf6\xff\xc9\xff\x00\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\xb6\xff\x00\x00\x9d\xff\x80\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8e\xff\xde\xff\xbf\xff\xc0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xff\xda\xff\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xf9\xff\x92\xff\xee\xff\xdb\xff\x00\x00\x00\x00\xd6\xff\x00\x00\xd2\xff\x00\x00\xc1\xff\x8a\xff\x8c\xff\x00\x00\xa2\xff\xaf\xff\xae\xff\xb3\xff\xa5\xff\xa3\xff\xe2\xff\xad\xff\xb4\xff\x87\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\x9c\xff\xba\xff\x00\x00\x81\xff\x00\x00\x00\x00\x84\xff\xe5\xff\xbb\xff\x89\xff\xc7\xff\xe9\xff\xe6\xff\x00\x00\x83\xff\x00\x00\x00\x00\x00\x00\x00\x00\x7f\xff\xb5\xff\x7b\xff\x00\x00\xb1\xff\x7b\xff\x00\x00\xac\xff\x79\xff\x86\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\xff\xce\xff\xcd\xff\xcc\xff\xcb\xff\xc5\xff\x00\x00\x00\x00\xca\xff\xc3\xff\x90\xff\x00\x00\x00\x00\xc6\xff\xd0\xff\x00\x00\x00\x00\x9b\xff\xaa\xff\xa7\xff\xb0\xff\x00\x00\x87\xff\x00\x00\xab\xff\x00\x00\x71\xff\x7b\xff\x00\x00\xb9\xff\xa4\xff\xe1\xff\x00\x00\x84\xff\x88\xff\x82\xff\x00\x00\x7a\xff\xa6\xff\x00\x00\x7d\xff\x00\x00\x00\x00\xb2\xff\x78\xff\x77\xff\x85\xff\xa0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\x00\x00\x91\xff\x00\x00\x8f\xff\xcf\xff\xd8\xff\x9a\xff\x76\xff\x00\x00\x00\x00\x98\xff\x95\xff\x94\xff\x70\xff\x74\xff\x00\x00\x97\xff\x00\x00\xa9\xff\x71\xff\xa8\xff\x00\x00\xe0\xff\x7c\xff\x9f\xff\x71\xff\x00\x00\x73\xff\x00\x00\x00\x00\x79\xff\x77\xff\x75\xff\x9e\xff\xa1\xff\x96\xff\x74\xff\x00\x00\x00\x00\x99\xff\x93\xff\x72\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x11\x00\x00\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x14\x00\x0d\x00\x03\x00\x17\x00\x35\x00\x01\x00\x03\x00\x08\x00\x0f\x00\x15\x00\x03\x00\x0c\x00\x0f\x00\x03\x00\x0f\x00\x0c\x00\x11\x00\x0e\x00\x08\x00\x09\x00\x1b\x00\x31\x00\x0c\x00\x2c\x00\x1c\x00\x0f\x00\x24\x00\x11\x00\x07\x00\x27\x00\x24\x00\x24\x00\x24\x00\x27\x00\x00\x00\x25\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x34\x00\x2f\x00\x2e\x00\x2e\x00\x34\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x31\x00\x01\x00\x33\x00\x34\x00\x03\x00\x32\x00\x16\x00\x31\x00\x32\x00\x33\x00\x34\x00\x03\x00\x04\x00\x0c\x00\x0d\x00\x0e\x00\x08\x00\x03\x00\x31\x00\x25\x00\x0c\x00\x0b\x00\x08\x00\x0f\x00\x22\x00\x11\x00\x0c\x00\x03\x00\x2e\x00\x0f\x00\x10\x00\x11\x00\x08\x00\x03\x00\x32\x00\x00\x00\x0c\x00\x00\x00\x30\x00\x0f\x00\x16\x00\x11\x00\x0c\x00\x35\x00\x0e\x00\x06\x00\x07\x00\x02\x00\x0d\x00\x13\x00\x31\x00\x29\x00\x33\x00\x34\x00\x17\x00\x18\x00\x00\x00\x31\x00\x32\x00\x33\x00\x34\x00\x06\x00\x16\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0c\x00\x32\x00\x0e\x00\x31\x00\x03\x00\x00\x00\x31\x00\x32\x00\x33\x00\x34\x00\x2a\x00\x0a\x00\x31\x00\x0c\x00\x33\x00\x34\x00\x0f\x00\x1c\x00\x11\x00\x12\x00\x03\x00\x00\x00\x04\x00\x32\x00\x01\x00\x24\x00\x08\x00\x16\x00\x00\x00\x0c\x00\x1d\x00\x1a\x00\x17\x00\x04\x00\x21\x00\x01\x00\x2f\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0d\x00\x23\x00\x16\x00\x1b\x00\x1c\x00\x04\x00\x1a\x00\x03\x00\x01\x00\x31\x00\x32\x00\x33\x00\x08\x00\x00\x00\x15\x00\x32\x00\x32\x00\x33\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x22\x00\x23\x00\x24\x00\x31\x00\x26\x00\x27\x00\x15\x00\x2a\x00\x2a\x00\x2b\x00\x1f\x00\x2d\x00\x02\x00\x2f\x00\x23\x00\x31\x00\x31\x00\x26\x00\x27\x00\x05\x00\x02\x00\x2a\x00\x2b\x00\x05\x00\x21\x00\x0b\x00\x2f\x00\x24\x00\x31\x00\x0c\x00\x0d\x00\x0e\x00\x21\x00\x02\x00\x0c\x00\x24\x00\x2d\x00\x0f\x00\x00\x00\x11\x00\x12\x00\x31\x00\x2c\x00\x00\x00\x2d\x00\x02\x00\x03\x00\x00\x00\x00\x00\x02\x00\x03\x00\x1d\x00\x00\x00\x0f\x00\x00\x00\x21\x00\x02\x00\x03\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x0b\x00\x1b\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0c\x00\x31\x00\x32\x00\x33\x00\x0f\x00\x1b\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x26\x00\x28\x00\x08\x00\x00\x00\x26\x00\x00\x00\x02\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x26\x00\x0f\x00\x0f\x00\x0f\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1b\x00\x1b\x00\x1b\x00\x02\x00\x00\x00\x00\x00\x2b\x00\x0f\x00\x02\x00\x00\x00\x00\x00\x0f\x00\x18\x00\x0a\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x0f\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x25\x00\x0f\x00\x1b\x00\x00\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x22\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x05\x00\x0f\x00\x07\x00\x00\x00\x25\x00\x0f\x00\x0b\x00\x0c\x00\x30\x00\x00\x00\x01\x00\x02\x00\x03\x00\x35\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x25\x00\x0f\x00\x00\x00\x0a\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x25\x00\x0f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x23\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x0f\x00\x20\x00\x25\x00\x00\x00\x0f\x00\x00\x00\x25\x00\x00\x00\x32\x00\x33\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1d\x00\x00\x00\x00\x00\x20\x00\x1d\x00\x00\x00\x0f\x00\x20\x00\x25\x00\x00\x00\x01\x00\x02\x00\x25\x00\x00\x00\x00\x00\x01\x00\x02\x00\x15\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x0f\x00\x19\x00\x00\x00\x01\x00\x02\x00\x09\x00\x32\x00\x04\x00\x01\x00\x15\x00\x02\x00\x00\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x0f\x00\x19\x00\x00\x00\x01\x00\x02\x00\x04\x00\x01\x00\x31\x00\x04\x00\x02\x00\x31\x00\x01\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x33\x00\x19\x00\x00\x00\x01\x00\x02\x00\x04\x00\x15\x00\x01\x00\x15\x00\x31\x00\x14\x00\x04\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x17\x00\x19\x00\x00\x00\x01\x00\x02\x00\x06\x00\x01\x00\x22\x00\x0d\x00\x31\x00\x04\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x01\x00\x19\x00\x1e\x00\x33\x00\x20\x00\x0d\x00\x06\x00\x1a\x00\x31\x00\x03\x00\x31\x00\x15\x00\x0f\x00\x14\x00\x0b\x00\x12\x00\x13\x00\x2d\x00\x01\x00\x2f\x00\x04\x00\x03\x00\x19\x00\x31\x00\x0d\x00\x06\x00\x10\x00\x31\x00\x33\x00\x04\x00\x01\x00\x05\x00\x13\x00\x0a\x00\x02\x00\x31\x00\x31\x00\x03\x00\x25\x00\x01\x00\x09\x00\x05\x00\x02\x00\x01\x00\x31\x00\x02\x00\x02\x00\x33\x00\x02\x00\x19\x00\x0b\x00\x06\x00\x01\x00\x33\x00\x31\x00\x29\x00\x31\x00\x05\x00\x31\x00\x25\x00\x07\x00\x29\x00\x08\x00\x02\x00\x05\x00\x05\x00\x02\x00\x28\x00\x28\x00\x02\x00\x05\x00\x02\x00\x01\x00\x28\x00\x1a\x00\x36\x00\x01\x00\xff\xff\x02\x00\x31\x00\x21\x00\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\xff\xff\x31\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"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\xc8\x00\x7e\x00\x79\x00\x43\x00\x30\x00\x45\x00\x79\x00\x79\x00\x79\x00\x45\x00\xba\x00\x27\x01\x92\x00\xea\x00\xa6\x00\x93\x00\x2c\x01\xfd\x00\x15\x01\xa7\x00\x5b\x00\xbf\x00\xff\x00\xa8\x00\x1f\x01\xa6\x00\xa9\x00\x16\x01\xaa\x00\x17\x01\xa7\x00\x1b\x01\xbf\x00\x04\x00\xa8\x00\xc9\x00\x7a\x00\xa9\x00\x20\x01\xaa\x00\x6f\xff\x21\x01\x20\x01\xe3\x00\x7b\x00\x21\x01\xba\x00\xbb\x00\x31\x00\x31\x00\x6e\x00\x41\x00\x1a\x00\x24\x00\x2f\x01\xc0\x00\xf4\x00\xab\x00\x22\x01\xac\x00\x04\x00\x57\x00\x58\x00\xad\x00\x04\x00\xfd\x00\x58\x00\xad\x00\x15\x01\x57\x00\x79\xff\x04\x00\x57\x00\x58\x00\xad\x00\xa6\x00\xf8\x00\x16\x01\x2e\x01\x17\x01\xa7\x00\xa6\x00\x04\x00\xbb\x00\xa8\x00\xdc\x00\xa7\x00\xa9\x00\xf9\x00\xaa\x00\xa8\x00\xa6\x00\xbc\x00\xa9\x00\xfd\x00\xaa\x00\xa7\x00\x15\x01\x79\xff\x58\x00\xa8\x00\x08\x01\x1d\x01\xa9\x00\x25\x01\xaa\x00\x16\x01\xfb\x00\x17\x01\x1b\x00\x1c\x00\x0c\x01\x59\x00\x18\x01\x04\x00\xdd\x00\x58\x00\xad\x00\xcf\x00\xd0\x00\x79\x00\x04\x00\x57\x00\x58\x00\xad\x00\xd8\x00\x79\xff\x04\x00\x57\x00\x58\x00\xad\x00\xd9\x00\x57\x00\xda\x00\xf8\x00\x4f\x00\x67\x00\x04\x00\x57\x00\x58\x00\xad\x00\x9a\x00\x50\x00\x04\x00\x51\x00\x58\x00\xad\x00\x52\x00\x7a\x00\x53\x00\x54\x00\x5e\x00\x67\x00\x16\x00\x79\xff\xfd\x00\x7b\x00\x17\x00\xb7\x00\x58\x00\x5f\x00\x55\x00\x69\x00\x03\x01\x0a\x00\x56\x00\x1c\x01\x7c\x00\x04\x00\x57\x00\x58\x00\xad\x00\x59\x00\x0d\x01\x68\x00\x60\x00\x61\x00\x06\x01\x69\x00\xec\x00\xbe\x00\x04\x00\x57\x00\x58\x00\xed\x00\x79\x00\xbf\x00\xe8\x00\x0e\x01\x26\x01\x0b\x00\x0c\x00\x0d\x00\x79\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x11\x00\x12\x00\xbf\x00\x5a\x00\x13\x00\x14\x00\x0c\x00\x15\x00\xe1\x00\x16\x00\x0f\x00\x04\x00\xea\x00\x11\x00\x12\x00\x98\x00\x3c\x00\x13\x00\x14\x00\x3d\x00\xc9\x00\x8b\x00\x07\x01\xca\x00\x04\x00\xd9\x00\x0b\x01\xda\x00\xc9\x00\xe2\x00\x8a\x00\xca\x00\xff\x00\x52\x00\x45\x00\x53\x00\x54\x00\xed\x00\xb9\x00\x10\x01\xcb\x00\x11\x01\x12\x01\x10\x01\x45\x00\x11\x01\x12\x01\x55\x00\xc4\x00\x5b\x00\x10\x01\x56\x00\x11\x01\x12\x01\x04\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x5b\x00\x8b\x00\xc1\x00\x04\x00\x57\x00\x58\x00\xad\x00\x04\x01\x04\x00\x57\x00\x58\x00\x9f\x00\xc3\x00\xcf\x00\xd0\x00\x45\x00\x45\x00\x45\x00\x13\x01\xdb\x00\x8e\x00\x90\x00\x2e\x01\x91\x00\xad\x00\xa0\x00\xa1\x00\x1c\x01\xa3\x00\x13\x01\x5b\x00\x5b\x00\x5b\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x99\x00\x78\x00\x5c\x00\x77\x00\x45\x00\x45\x00\x80\x00\x9f\x00\x81\x00\x82\x00\x86\x00\x9f\x00\x87\x00\x8c\x00\x42\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x5b\x00\xde\x00\xa0\x00\xa1\x00\x1e\x01\xa3\x00\xa0\x00\xa1\x00\xf5\x00\xa3\x00\xa4\x00\x9f\x00\x61\x00\x44\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\xf9\x00\x04\x00\xa0\x00\xa1\x00\x00\x01\xa3\x00\x05\x00\x9f\x00\x06\x00\x63\x00\xa4\x00\x9f\x00\x07\x00\x08\x00\xfa\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\xfb\x00\x65\x00\xa0\x00\xa1\x00\xf0\x00\xa3\x00\xa0\x00\xa1\x00\xc6\x00\xa3\x00\xa4\x00\x9f\x00\x66\x00\x6b\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x6d\x00\x3d\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\x1e\x00\x9f\x00\x1f\x00\x20\x00\xa4\x00\x9f\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x0d\x01\xa0\x00\xa1\x00\xb2\x00\xa3\x00\xa0\x00\xef\x00\x9f\x00\xa3\x00\xa4\x00\x21\x00\x9f\x00\x45\x00\xa4\x00\x22\x00\x0e\x01\x0f\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xf6\x00\x23\x00\x25\x00\xa3\x00\xe4\x00\x45\x00\xf3\x00\xa3\x00\xa4\x00\x45\x00\x46\x00\x47\x00\xa4\x00\x26\x00\x45\x00\x46\x00\x47\x00\xd6\x00\x27\x00\x28\x00\xc5\x00\x29\x00\x2d\x00\x45\x00\x48\x00\x49\x00\x0b\x01\x4b\x00\x4c\x00\x48\x00\x49\x00\xdf\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x83\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x29\x01\x57\x00\x2a\x01\x2b\x01\xbf\x00\x2c\x01\x45\x00\x48\x00\x49\x00\xd0\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\xd1\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x62\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x7e\xff\x26\x01\x04\x00\x24\x01\x3c\x00\x04\x00\x0a\x01\x48\x00\x49\x00\x85\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\xb4\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x58\x00\x4d\x00\x84\x00\x46\x00\x47\x00\x19\x01\xbf\x00\x1a\x01\xbf\x00\x04\x00\xcd\x00\x7e\xff\x48\x00\x49\x00\xb5\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\x85\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x02\x01\x4d\x00\x45\x00\x46\x00\x47\x00\x03\x01\x08\x01\x0e\x00\xe1\x00\x04\x00\xe6\x00\xe7\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\x64\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\xe8\x00\x4d\x00\x0b\x00\x58\x00\x0d\x00\xef\x00\xf2\x00\xf3\x00\x04\x00\xc3\x00\x04\x00\xbf\x00\x48\x00\xcd\x00\xce\x00\x88\x00\x4c\x00\x15\x00\xdb\x00\x1e\x00\x95\x00\x90\x00\x4d\x00\x04\x00\x97\x00\x96\x00\x99\x00\x04\x00\x58\x00\xaf\x00\xb1\x00\xb0\x00\xb2\x00\xb4\x00\xb7\x00\x04\x00\x04\x00\x70\x00\xb9\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x04\x00\x76\x00\x77\x00\x58\x00\x7f\x00\x80\x00\x8b\x00\x8c\x00\x8e\x00\x58\x00\x04\x00\x6d\x00\x04\x00\x3d\x00\x04\x00\x30\x00\x6b\x00\x6d\x00\x33\x00\x35\x00\x36\x00\x38\x00\x39\x00\x34\x00\x37\x00\x3b\x00\x3a\x00\x3f\x00\x2b\x00\x40\x00\x41\x00\xff\xff\x2c\x00\x00\x00\x2d\x00\x04\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (2, 146) [ + (2 , happyReduce_2), + (3 , happyReduce_3), + (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) + ] + +happy_n_terms = 55 :: Int +happy_n_nonterms = 55 :: Int + +happyReduce_2 = happySpecReduce_1 0# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> + happyIn5 + (identC happy_var_1 --H + )} + +happyReduce_3 = happySpecReduce_1 1# happyReduction_3 +happyReduction_3 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_4 = happySpecReduce_1 2# 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 3# happyReduction_5 +happyReduction_5 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn8 + ((read happy_var_1) :: Double + )} + +happyReduce_6 = happyReduce 6# 4# happyReduction_6 +happyReduction_6 (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 happyOut59 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + case happyOut13 happy_x_6 of { happy_var_6 -> + happyIn9 + (MGr happy_var_2 happy_var_4 (reverse happy_var_6) + ) `HappyStk` happyRest}}} + +happyReduce_7 = happySpecReduce_1 4# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + happyIn9 + (Gr (reverse happy_var_1) + )} + +happyReduce_8 = happyReduce 5# 5# happyReduction_8 +happyReduction_8 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut59 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + happyIn10 + (LMulti happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_9 = happyReduce 5# 5# happyReduction_9 +happyReduction_9 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_3 of { happy_var_3 -> + case happyOut15 happy_x_4 of { happy_var_4 -> + happyIn10 + (LHeader happy_var_1 happy_var_3 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_10 = happySpecReduce_2 5# happyReduction_10 +happyReduction_10 happy_x_2 + happy_x_1 + = case happyOut16 happy_x_1 of { happy_var_1 -> + happyIn10 + (LFlag happy_var_1 + )} + +happyReduce_11 = happySpecReduce_2 5# happyReduction_11 +happyReduction_11 happy_x_2 + happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn10 + (LDef happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 5# happyReduction_12 +happyReduction_12 happy_x_1 + = happyIn10 + (LEnd + ) + +happyReduce_13 = happyReduce 8# 6# happyReduction_13 +happyReduction_13 (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 happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_3 of { happy_var_3 -> + case happyOut15 happy_x_4 of { happy_var_4 -> + case happyOut45 happy_x_6 of { happy_var_6 -> + case happyOut46 happy_x_7 of { happy_var_7 -> + happyIn11 + (Mod happy_var_1 happy_var_3 happy_var_4 (reverse happy_var_6) (reverse happy_var_7) + ) `HappyStk` happyRest}}}}} + +happyReduce_14 = happySpecReduce_2 7# happyReduction_14 +happyReduction_14 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn12 + (MTAbs happy_var_2 + )} + +happyReduce_15 = happyReduce 4# 7# happyReduction_15 +happyReduction_15 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + happyIn12 + (MTCnc happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_16 = happySpecReduce_2 7# happyReduction_16 +happyReduction_16 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn12 + (MTRes happy_var_2 + )} + +happyReduce_17 = happyReduce 6# 7# happyReduction_17 +happyReduction_17 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + case happyOut5 happy_x_6 of { happy_var_6 -> + happyIn12 + (MTTrans happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_18 = happySpecReduce_0 8# happyReduction_18 +happyReduction_18 = happyIn13 + ([] + ) + +happyReduce_19 = happySpecReduce_2 8# happyReduction_19 +happyReduction_19 happy_x_2 + happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn13 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_20 = happySpecReduce_2 9# happyReduction_20 +happyReduction_20 happy_x_2 + happy_x_1 + = case happyOut59 happy_x_1 of { happy_var_1 -> + happyIn14 + (Ext happy_var_1 + )} + +happyReduce_21 = happySpecReduce_0 9# happyReduction_21 +happyReduction_21 = happyIn14 + (NoExt + ) + +happyReduce_22 = happySpecReduce_3 10# happyReduction_22 +happyReduction_22 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut59 happy_x_2 of { happy_var_2 -> + happyIn15 + (Opens happy_var_2 + )} + +happyReduce_23 = happySpecReduce_0 10# happyReduction_23 +happyReduction_23 = happyIn15 + (NoOpens + ) + +happyReduce_24 = happyReduce 4# 11# happyReduction_24 +happyReduction_24 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + happyIn16 + (Flg happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_25 = happyReduce 7# 12# happyReduction_25 +happyReduction_25 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut27 happy_x_4 of { happy_var_4 -> + case happyOut49 happy_x_7 of { happy_var_7 -> + happyIn17 + (AbsDCat happy_var_2 happy_var_4 (reverse happy_var_7) + ) `HappyStk` happyRest}}} + +happyReduce_26 = happyReduce 6# 12# happyReduction_26 +happyReduction_26 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + case happyOut22 happy_x_6 of { happy_var_6 -> + happyIn17 + (AbsDFun happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_27 = happyReduce 4# 12# happyReduction_27 +happyReduction_27 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + happyIn17 + (AbsDTrans happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_28 = happyReduce 4# 12# happyReduction_28 +happyReduction_28 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut47 happy_x_4 of { happy_var_4 -> + happyIn17 + (ResDPar happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_29 = happyReduce 6# 12# happyReduction_29 +happyReduction_29 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut32 happy_x_4 of { happy_var_4 -> + case happyOut36 happy_x_6 of { happy_var_6 -> + happyIn17 + (ResDOper happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_30 = happyReduce 8# 12# happyReduction_30 +happyReduction_30 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut32 happy_x_4 of { happy_var_4 -> + case happyOut36 happy_x_6 of { happy_var_6 -> + case happyOut36 happy_x_8 of { happy_var_8 -> + happyIn17 + (CncDCat happy_var_2 happy_var_4 happy_var_6 happy_var_8 + ) `HappyStk` happyRest}}}} + +happyReduce_31 = happyReduce 11# 12# happyReduction_31 +happyReduction_31 (happy_x_11 `HappyStk` + 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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut20 happy_x_4 of { happy_var_4 -> + case happyOut51 happy_x_7 of { happy_var_7 -> + case happyOut36 happy_x_9 of { happy_var_9 -> + case happyOut36 happy_x_11 of { happy_var_11 -> + happyIn17 + (CncDFun happy_var_2 happy_var_4 happy_var_7 happy_var_9 happy_var_11 + ) `HappyStk` happyRest}}}}} + +happyReduce_32 = happyReduce 4# 12# happyReduction_32 +happyReduction_32 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_4 of { happy_var_4 -> + happyIn17 + (AnyDInd happy_var_1 happy_var_2 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_33 = happySpecReduce_2 13# happyReduction_33 +happyReduction_33 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut48 happy_x_2 of { happy_var_2 -> + happyIn18 + (ParD happy_var_1 (reverse happy_var_2) + )}} + +happyReduce_34 = happySpecReduce_1 14# happyReduction_34 +happyReduction_34 happy_x_1 + = happyIn19 + (Canon + ) + +happyReduce_35 = happySpecReduce_0 14# happyReduction_35 +happyReduction_35 = happyIn19 + (NonCan + ) + +happyReduce_36 = happySpecReduce_3 15# happyReduction_36 +happyReduction_36 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn20 + (CIQ happy_var_1 happy_var_3 + )}} + +happyReduce_37 = happySpecReduce_2 16# happyReduction_37 +happyReduction_37 happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn21 + (EApp happy_var_1 happy_var_2 + )}} + +happyReduce_38 = happySpecReduce_1 16# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn21 + (happy_var_1 + )} + +happyReduce_39 = happyReduce 7# 17# happyReduction_39 +happyReduction_39 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + case happyOut22 happy_x_7 of { happy_var_7 -> + happyIn22 + (EProd happy_var_2 happy_var_4 happy_var_7 + ) `HappyStk` happyRest}}} + +happyReduce_40 = happyReduce 4# 17# happyReduction_40 +happyReduction_40 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + happyIn22 + (EAbs happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_41 = happySpecReduce_3 17# happyReduction_41 +happyReduction_41 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_2 of { happy_var_2 -> + happyIn22 + (EEq (reverse happy_var_2) + )} + +happyReduce_42 = happySpecReduce_1 17# happyReduction_42 +happyReduction_42 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn22 + (happy_var_1 + )} + +happyReduce_43 = happySpecReduce_1 18# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn23 + (EAtom happy_var_1 + )} + +happyReduce_44 = happySpecReduce_1 18# happyReduction_44 +happyReduction_44 happy_x_1 + = happyIn23 + (EData + ) + +happyReduce_45 = happySpecReduce_3 18# happyReduction_45 +happyReduction_45 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut22 happy_x_2 of { happy_var_2 -> + happyIn23 + (happy_var_2 + )} + +happyReduce_46 = happySpecReduce_1 19# happyReduction_46 +happyReduction_46 happy_x_1 + = happyIn24 + (SType + ) + +happyReduce_47 = happySpecReduce_3 20# happyReduction_47 +happyReduction_47 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn25 + (Equ (reverse happy_var_1) happy_var_3 + )}} + +happyReduce_48 = happyReduce 4# 21# happyReduction_48 +happyReduction_48 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut20 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + happyIn26 + (APC happy_var_2 (reverse happy_var_3) + ) `HappyStk` happyRest}} + +happyReduce_49 = happySpecReduce_1 21# happyReduction_49 +happyReduction_49 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn26 + (APV happy_var_1 + )} + +happyReduce_50 = happySpecReduce_1 21# happyReduction_50 +happyReduction_50 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn26 + (APS happy_var_1 + )} + +happyReduce_51 = happySpecReduce_1 21# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn26 + (API happy_var_1 + )} + +happyReduce_52 = happySpecReduce_1 21# happyReduction_52 +happyReduction_52 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn26 + (APF happy_var_1 + )} + +happyReduce_53 = happySpecReduce_1 21# happyReduction_53 +happyReduction_53 happy_x_1 + = happyIn26 + (APW + ) + +happyReduce_54 = happySpecReduce_0 22# happyReduction_54 +happyReduction_54 = happyIn27 + ([] + ) + +happyReduce_55 = happySpecReduce_1 22# happyReduction_55 +happyReduction_55 happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + happyIn27 + ((:[]) happy_var_1 + )} + +happyReduce_56 = happySpecReduce_3 22# happyReduction_56 +happyReduction_56 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + case happyOut27 happy_x_3 of { happy_var_3 -> + happyIn27 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_57 = happySpecReduce_0 23# happyReduction_57 +happyReduction_57 = happyIn28 + ([] + ) + +happyReduce_58 = happySpecReduce_2 23# happyReduction_58 +happyReduction_58 happy_x_2 + happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_2 of { happy_var_2 -> + happyIn28 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_59 = happySpecReduce_0 24# happyReduction_59 +happyReduction_59 = happyIn29 + ([] + ) + +happyReduce_60 = happySpecReduce_3 24# happyReduction_60 +happyReduction_60 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut25 happy_x_2 of { happy_var_2 -> + happyIn29 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_61 = happySpecReduce_1 25# happyReduction_61 +happyReduction_61 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn30 + (AC happy_var_1 + )} + +happyReduce_62 = happySpecReduce_3 25# happyReduction_62 +happyReduction_62 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut20 happy_x_2 of { happy_var_2 -> + happyIn30 + (AD happy_var_2 + )} + +happyReduce_63 = happySpecReduce_2 25# happyReduction_63 +happyReduction_63 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn30 + (AV happy_var_2 + )} + +happyReduce_64 = happySpecReduce_2 25# happyReduction_64 +happyReduction_64 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn30 + (AM happy_var_2 + )} + +happyReduce_65 = happySpecReduce_1 25# happyReduction_65 +happyReduction_65 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn30 + (AS happy_var_1 + )} + +happyReduce_66 = happySpecReduce_1 25# happyReduction_66 +happyReduction_66 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn30 + (AI happy_var_1 + )} + +happyReduce_67 = happySpecReduce_1 25# happyReduction_67 +happyReduction_67 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn30 + (AT happy_var_1 + )} + +happyReduce_68 = happySpecReduce_3 26# happyReduction_68 +happyReduction_68 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn31 + (Decl happy_var_1 happy_var_3 + )}} + +happyReduce_69 = happySpecReduce_3 27# happyReduction_69 +happyReduction_69 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut52 happy_x_2 of { happy_var_2 -> + happyIn32 + (RecType happy_var_2 + )} + +happyReduce_70 = happyReduce 5# 27# happyReduction_70 +happyReduction_70 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut32 happy_x_2 of { happy_var_2 -> + case happyOut32 happy_x_4 of { happy_var_4 -> + happyIn32 + (Table happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_71 = happySpecReduce_1 27# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn32 + (Cn happy_var_1 + )} + +happyReduce_72 = happySpecReduce_1 27# happyReduction_72 +happyReduction_72 happy_x_1 + = happyIn32 + (TStr + ) + +happyReduce_73 = happySpecReduce_2 27# happyReduction_73 +happyReduction_73 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn32 + (TInts happy_var_2 + )} + +happyReduce_74 = happySpecReduce_3 28# happyReduction_74 +happyReduction_74 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_3 of { happy_var_3 -> + happyIn33 + (Lbg happy_var_1 happy_var_3 + )}} + +happyReduce_75 = happySpecReduce_1 29# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn34 + (Arg happy_var_1 + )} + +happyReduce_76 = happySpecReduce_1 29# happyReduction_76 +happyReduction_76 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn34 + (I happy_var_1 + )} + +happyReduce_77 = happyReduce 4# 29# happyReduction_77 +happyReduction_77 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut20 happy_x_2 of { happy_var_2 -> + case happyOut54 happy_x_3 of { happy_var_3 -> + happyIn34 + (Par happy_var_2 (reverse happy_var_3) + ) `HappyStk` happyRest}} + +happyReduce_78 = happySpecReduce_2 29# happyReduction_78 +happyReduction_78 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn34 + (LI happy_var_2 + )} + +happyReduce_79 = happySpecReduce_3 29# happyReduction_79 +happyReduction_79 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut50 happy_x_2 of { happy_var_2 -> + happyIn34 + (R happy_var_2 + )} + +happyReduce_80 = happySpecReduce_1 29# happyReduction_80 +happyReduction_80 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn34 + (EInt happy_var_1 + )} + +happyReduce_81 = happySpecReduce_1 29# happyReduction_81 +happyReduction_81 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn34 + (EFloat happy_var_1 + )} + +happyReduce_82 = happySpecReduce_1 29# happyReduction_82 +happyReduction_82 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn34 + (K happy_var_1 + )} + +happyReduce_83 = happySpecReduce_2 29# happyReduction_83 +happyReduction_83 happy_x_2 + happy_x_1 + = happyIn34 + (E + ) + +happyReduce_84 = happySpecReduce_3 29# happyReduction_84 +happyReduction_84 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_2 of { happy_var_2 -> + happyIn34 + (happy_var_2 + )} + +happyReduce_85 = happySpecReduce_3 30# happyReduction_85 +happyReduction_85 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut41 happy_x_3 of { happy_var_3 -> + happyIn35 + (P happy_var_1 happy_var_3 + )}} + +happyReduce_86 = happyReduce 5# 30# happyReduction_86 +happyReduction_86 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut32 happy_x_2 of { happy_var_2 -> + case happyOut53 happy_x_4 of { happy_var_4 -> + happyIn35 + (T happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_87 = happyReduce 5# 30# happyReduction_87 +happyReduction_87 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut32 happy_x_2 of { happy_var_2 -> + case happyOut54 happy_x_4 of { happy_var_4 -> + happyIn35 + (V happy_var_2 (reverse happy_var_4) + ) `HappyStk` happyRest}} + +happyReduce_88 = happySpecReduce_3 30# happyReduction_88 +happyReduction_88 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + case happyOut34 happy_x_3 of { happy_var_3 -> + happyIn35 + (S happy_var_1 happy_var_3 + )}} + +happyReduce_89 = happyReduce 4# 30# happyReduction_89 +happyReduction_89 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut54 happy_x_3 of { happy_var_3 -> + happyIn35 + (FV (reverse happy_var_3) + ) `HappyStk` happyRest} + +happyReduce_90 = happySpecReduce_1 30# happyReduction_90 +happyReduction_90 happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + happyIn35 + (happy_var_1 + )} + +happyReduce_91 = happySpecReduce_3 31# happyReduction_91 +happyReduction_91 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + case happyOut35 happy_x_3 of { happy_var_3 -> + happyIn36 + (C happy_var_1 happy_var_3 + )}} + +happyReduce_92 = happySpecReduce_1 31# happyReduction_92 +happyReduction_92 happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn36 + (happy_var_1 + )} + +happyReduce_93 = happySpecReduce_1 32# happyReduction_93 +happyReduction_93 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn37 + (KS happy_var_1 + )} + +happyReduce_94 = happyReduce 7# 32# happyReduction_94 +happyReduction_94 (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 happyOut55 happy_x_3 of { happy_var_3 -> + case happyOut56 happy_x_5 of { happy_var_5 -> + happyIn37 + (KP (reverse happy_var_3) happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_95 = happySpecReduce_3 33# happyReduction_95 +happyReduction_95 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn38 + (Ass happy_var_1 happy_var_3 + )}} + +happyReduce_96 = happySpecReduce_3 34# happyReduction_96 +happyReduction_96 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut58 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn39 + (Cas (reverse happy_var_1) happy_var_3 + )}} + +happyReduce_97 = happySpecReduce_3 35# happyReduction_97 +happyReduction_97 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { happy_var_1 -> + case happyOut55 happy_x_3 of { happy_var_3 -> + happyIn40 + (Var (reverse happy_var_1) (reverse happy_var_3) + )}} + +happyReduce_98 = happySpecReduce_1 36# happyReduction_98 +happyReduction_98 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn41 + (L happy_var_1 + )} + +happyReduce_99 = happySpecReduce_2 36# happyReduction_99 +happyReduction_99 happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + happyIn41 + (LV happy_var_2 + )} + +happyReduce_100 = happySpecReduce_3 37# happyReduction_100 +happyReduction_100 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut7 happy_x_3 of { happy_var_3 -> + happyIn42 + (A happy_var_1 happy_var_3 + )}} + +happyReduce_101 = happyReduce 5# 37# happyReduction_101 +happyReduction_101 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut7 happy_x_3 of { happy_var_3 -> + case happyOut7 happy_x_5 of { happy_var_5 -> + happyIn42 + (AB happy_var_1 happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_102 = happyReduce 4# 38# happyReduction_102 +happyReduction_102 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut20 happy_x_2 of { happy_var_2 -> + case happyOut58 happy_x_3 of { happy_var_3 -> + happyIn43 + (PC happy_var_2 (reverse happy_var_3) + ) `HappyStk` happyRest}} + +happyReduce_103 = happySpecReduce_1 38# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn43 + (PV happy_var_1 + )} + +happyReduce_104 = happySpecReduce_1 38# happyReduction_104 +happyReduction_104 happy_x_1 + = happyIn43 + (PW + ) + +happyReduce_105 = happySpecReduce_3 38# happyReduction_105 +happyReduction_105 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut57 happy_x_2 of { happy_var_2 -> + happyIn43 + (PR happy_var_2 + )} + +happyReduce_106 = happySpecReduce_1 38# happyReduction_106 +happyReduction_106 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn43 + (PI happy_var_1 + )} + +happyReduce_107 = happySpecReduce_1 38# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn43 + (PF happy_var_1 + )} + +happyReduce_108 = happySpecReduce_3 39# happyReduction_108 +happyReduction_108 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_3 of { happy_var_3 -> + happyIn44 + (PAss happy_var_1 happy_var_3 + )}} + +happyReduce_109 = happySpecReduce_0 40# happyReduction_109 +happyReduction_109 = happyIn45 + ([] + ) + +happyReduce_110 = happySpecReduce_3 40# happyReduction_110 +happyReduction_110 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn45 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_111 = happySpecReduce_0 41# happyReduction_111 +happyReduction_111 = happyIn46 + ([] + ) + +happyReduce_112 = happySpecReduce_3 41# happyReduction_112 +happyReduction_112 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn46 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_113 = happySpecReduce_0 42# happyReduction_113 +happyReduction_113 = happyIn47 + ([] + ) + +happyReduce_114 = happySpecReduce_1 42# happyReduction_114 +happyReduction_114 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn47 + ((:[]) happy_var_1 + )} + +happyReduce_115 = happySpecReduce_3 42# happyReduction_115 +happyReduction_115 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_3 of { happy_var_3 -> + happyIn47 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_116 = happySpecReduce_0 43# happyReduction_116 +happyReduction_116 = happyIn48 + ([] + ) + +happyReduce_117 = happySpecReduce_2 43# happyReduction_117 +happyReduction_117 happy_x_2 + happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_2 of { happy_var_2 -> + happyIn48 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_118 = happySpecReduce_0 44# happyReduction_118 +happyReduction_118 = happyIn49 + ([] + ) + +happyReduce_119 = happySpecReduce_2 44# happyReduction_119 +happyReduction_119 happy_x_2 + happy_x_1 + = case happyOut49 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_2 of { happy_var_2 -> + happyIn49 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_120 = happySpecReduce_0 45# happyReduction_120 +happyReduction_120 = happyIn50 + ([] + ) + +happyReduce_121 = happySpecReduce_1 45# happyReduction_121 +happyReduction_121 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn50 + ((:[]) happy_var_1 + )} + +happyReduce_122 = happySpecReduce_3 45# happyReduction_122 +happyReduction_122 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut50 happy_x_3 of { happy_var_3 -> + happyIn50 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_123 = happySpecReduce_0 46# happyReduction_123 +happyReduction_123 = happyIn51 + ([] + ) + +happyReduce_124 = happySpecReduce_1 46# happyReduction_124 +happyReduction_124 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn51 + ((:[]) happy_var_1 + )} + +happyReduce_125 = happySpecReduce_3 46# happyReduction_125 +happyReduction_125 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut51 happy_x_3 of { happy_var_3 -> + happyIn51 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_126 = happySpecReduce_0 47# happyReduction_126 +happyReduction_126 = happyIn52 + ([] + ) + +happyReduce_127 = happySpecReduce_1 47# happyReduction_127 +happyReduction_127 happy_x_1 + = case happyOut33 happy_x_1 of { happy_var_1 -> + happyIn52 + ((:[]) happy_var_1 + )} + +happyReduce_128 = happySpecReduce_3 47# happyReduction_128 +happyReduction_128 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut33 happy_x_1 of { happy_var_1 -> + case happyOut52 happy_x_3 of { happy_var_3 -> + happyIn52 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_129 = happySpecReduce_0 48# happyReduction_129 +happyReduction_129 = happyIn53 + ([] + ) + +happyReduce_130 = happySpecReduce_1 48# happyReduction_130 +happyReduction_130 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn53 + ((:[]) happy_var_1 + )} + +happyReduce_131 = happySpecReduce_3 48# happyReduction_131 +happyReduction_131 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut53 happy_x_3 of { happy_var_3 -> + happyIn53 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_132 = happySpecReduce_0 49# happyReduction_132 +happyReduction_132 = happyIn54 + ([] + ) + +happyReduce_133 = happySpecReduce_2 49# happyReduction_133 +happyReduction_133 happy_x_2 + happy_x_1 + = case happyOut54 happy_x_1 of { happy_var_1 -> + case happyOut34 happy_x_2 of { happy_var_2 -> + happyIn54 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_134 = happySpecReduce_0 50# happyReduction_134 +happyReduction_134 = happyIn55 + ([] + ) + +happyReduce_135 = happySpecReduce_2 50# happyReduction_135 +happyReduction_135 happy_x_2 + happy_x_1 + = case happyOut55 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn55 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_136 = happySpecReduce_0 51# happyReduction_136 +happyReduction_136 = happyIn56 + ([] + ) + +happyReduce_137 = happySpecReduce_1 51# happyReduction_137 +happyReduction_137 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn56 + ((:[]) happy_var_1 + )} + +happyReduce_138 = happySpecReduce_3 51# happyReduction_138 +happyReduction_138 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 -> + happyIn56 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_139 = happySpecReduce_0 52# happyReduction_139 +happyReduction_139 = happyIn57 + ([] + ) + +happyReduce_140 = happySpecReduce_1 52# happyReduction_140 +happyReduction_140 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn57 + ((:[]) happy_var_1 + )} + +happyReduce_141 = happySpecReduce_3 52# happyReduction_141 +happyReduction_141 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut57 happy_x_3 of { happy_var_3 -> + happyIn57 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_142 = happySpecReduce_0 53# happyReduction_142 +happyReduction_142 = happyIn58 + ([] + ) + +happyReduce_143 = happySpecReduce_2 53# happyReduction_143 +happyReduction_143 happy_x_2 + happy_x_1 + = case happyOut58 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn58 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_144 = happySpecReduce_0 54# happyReduction_144 +happyReduction_144 = happyIn59 + ([] + ) + +happyReduce_145 = happySpecReduce_1 54# happyReduction_145 +happyReduction_145 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn59 + ((:[]) happy_var_1 + )} + +happyReduce_146 = happySpecReduce_3 54# happyReduction_146 +happyReduction_146 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut59 happy_x_3 of { happy_var_3 -> + happyIn59 + ((:) happy_var_1 happy_var_3 + )}} + +happyNewToken action sts stk [] = + happyDoAction 54# (error "reading EOF!") 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 "Ints") -> cont 27#; + PT _ (TS "Str") -> cont 28#; + PT _ (TS "Type") -> cont 29#; + PT _ (TS "abstract") -> cont 30#; + PT _ (TS "cat") -> cont 31#; + PT _ (TS "concrete") -> cont 32#; + PT _ (TS "data") -> cont 33#; + PT _ (TS "flags") -> cont 34#; + PT _ (TS "fun") -> cont 35#; + PT _ (TS "grammar") -> cont 36#; + PT _ (TS "in") -> cont 37#; + PT _ (TS "lin") -> cont 38#; + PT _ (TS "lincat") -> cont 39#; + PT _ (TS "of") -> cont 40#; + PT _ (TS "open") -> cont 41#; + PT _ (TS "oper") -> cont 42#; + PT _ (TS "param") -> cont 43#; + PT _ (TS "pre") -> cont 44#; + PT _ (TS "resource") -> cont 45#; + PT _ (TS "table") -> cont 46#; + PT _ (TS "transfer") -> cont 47#; + PT _ (TS "variants") -> cont 48#; + PT _ (TV happy_dollar_dollar) -> cont 49#; + PT _ (TL happy_dollar_dollar) -> cont 50#; + PT _ (TI happy_dollar_dollar) -> cont 51#; + PT _ (TD happy_dollar_dollar) -> cont 52#; + _ -> cont 53#; + _ -> 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 + +pCanon tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut9 x)) + +pLine tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut10 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 ++ if null ts then [] else (" 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$ + + +{-# LINE 28 "GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + + +{-# LINE 49 "GenericTemplate.hs" #-} + + +{-# LINE 59 "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 + + + + + + + + + + + +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) (\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 + +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/Canon/ParGFC.y b/src-3.0/GF/Canon/ParGFC.y new file mode 100644 index 000000000..6432a8696 --- /dev/null +++ b/src-3.0/GF/Canon/ParGFC.y @@ -0,0 +1,385 @@ +-- This Happy file was machine-generated by the BNF converter +{ +module GF.Canon.ParGFC where +import GF.Canon.AbsGFC +import GF.Canon.LexGFC +import GF.Data.ErrM -- H +import GF.Infra.Ident -- H +} + +%name pCanon Canon +%name pLine Line + +-- no lexer declaration +%monad { Err } { thenM } { returnM } +%tokentype { Token } + +%token + ';' { PT _ (TS ";") } + '=' { PT _ (TS "=") } + '{' { PT _ (TS "{") } + '}' { PT _ (TS "}") } + ':' { PT _ (TS ":") } + '->' { PT _ (TS "->") } + '**' { PT _ (TS "**") } + '[' { PT _ (TS "[") } + ']' { PT _ (TS "]") } + '\\' { PT _ (TS "\\") } + '.' { PT _ (TS ".") } + '(' { PT _ (TS "(") } + ')' { PT _ (TS ")") } + '_' { PT _ (TS "_") } + '<' { PT _ (TS "<") } + '>' { PT _ (TS ">") } + '$' { PT _ (TS "$") } + '?' { PT _ (TS "?") } + '=>' { PT _ (TS "=>") } + '!' { PT _ (TS "!") } + '++' { PT _ (TS "++") } + '/' { PT _ (TS "/") } + '@' { PT _ (TS "@") } + '+' { PT _ (TS "+") } + '|' { PT _ (TS "|") } + ',' { PT _ (TS ",") } + 'Ints' { PT _ (TS "Ints") } + 'Str' { PT _ (TS "Str") } + 'Type' { PT _ (TS "Type") } + 'abstract' { PT _ (TS "abstract") } + 'cat' { PT _ (TS "cat") } + 'concrete' { PT _ (TS "concrete") } + 'data' { PT _ (TS "data") } + 'flags' { PT _ (TS "flags") } + 'fun' { PT _ (TS "fun") } + 'grammar' { PT _ (TS "grammar") } + 'in' { PT _ (TS "in") } + 'lin' { PT _ (TS "lin") } + 'lincat' { PT _ (TS "lincat") } + 'of' { PT _ (TS "of") } + 'open' { PT _ (TS "open") } + 'oper' { PT _ (TS "oper") } + 'param' { PT _ (TS "param") } + 'pre' { PT _ (TS "pre") } + 'resource' { PT _ (TS "resource") } + 'table' { PT _ (TS "table") } + 'transfer' { PT _ (TS "transfer") } + 'variants' { PT _ (TS "variants") } + +L_ident { PT _ (TV $$) } +L_quoted { PT _ (TL $$) } +L_integ { PT _ (TI $$) } +L_err { _ } + + +%% + +Ident :: { Ident } : L_ident { identC $1 } -- H +String :: { String } : L_quoted { $1 } +Integer :: { Integer } : L_integ { (read $1) :: Integer } + +Canon :: { Canon } +Canon : 'grammar' ListIdent 'of' Ident ';' ListModule { MGr $2 $4 (reverse $6) } + | ListModule { Gr (reverse $1) } + + +Line :: { Line } +Line : 'grammar' ListIdent 'of' Ident ';' { LMulti $2 $4 } + | ModType '=' Extend Open '{' { LHeader $1 $3 $4 } + | Flag ';' { LFlag $1 } + | Def ';' { LDef $1 } + | '}' { LEnd } + + +Module :: { Module } +Module : ModType '=' Extend Open '{' ListFlag ListDef '}' { Mod $1 $3 $4 (reverse $6) (reverse $7) } + + +ModType :: { ModType } +ModType : 'abstract' Ident { MTAbs $2 } + | 'concrete' Ident 'of' Ident { MTCnc $2 $4 } + | 'resource' Ident { MTRes $2 } + | 'transfer' Ident ':' Ident '->' Ident { MTTrans $2 $4 $6 } + + +ListModule :: { [Module] } +ListModule : {- empty -} { [] } + | ListModule Module { flip (:) $1 $2 } + + +Extend :: { Extend } +Extend : ListIdent '**' { Ext $1 } + | {- empty -} { NoExt } + + +Open :: { Open } +Open : 'open' ListIdent 'in' { Opens $2 } + | {- empty -} { NoOpens } + + +Flag :: { Flag } +Flag : 'flags' Ident '=' Ident { Flg $2 $4 } + + +Def :: { Def } +Def : 'cat' Ident '[' ListDecl ']' '=' ListCIdent { AbsDCat $2 $4 (reverse $7) } + | 'fun' Ident ':' Exp '=' Exp { AbsDFun $2 $4 $6 } + | 'transfer' Ident '=' Exp { AbsDTrans $2 $4 } + | 'param' Ident '=' ListParDef { ResDPar $2 $4 } + | 'oper' Ident ':' CType '=' Term { ResDOper $2 $4 $6 } + | 'lincat' Ident '=' CType '=' Term ';' Term { CncDCat $2 $4 $6 $8 } + | 'lin' Ident ':' CIdent '=' '\\' ListArgVar '->' Term ';' Term { CncDFun $2 $4 $7 $9 $11 } + | Ident Status 'in' Ident { AnyDInd $1 $2 $4 } + + +ParDef :: { ParDef } +ParDef : Ident ListCType { ParD $1 (reverse $2) } + + +Status :: { Status } +Status : 'data' { Canon } + | {- empty -} { NonCan } + + +CIdent :: { CIdent } +CIdent : Ident '.' Ident { CIQ $1 $3 } + + +Exp1 :: { Exp } +Exp1 : Exp1 Exp2 { EApp $1 $2 } + | Exp2 { $1 } + + +Exp :: { Exp } +Exp : '(' Ident ':' Exp ')' '->' Exp { EProd $2 $4 $7 } + | '\\' Ident '->' Exp { EAbs $2 $4 } + | '{' ListEquation '}' { EEq (reverse $2) } + | Exp1 { $1 } + + +Exp2 :: { Exp } +Exp2 : Atom { EAtom $1 } + | 'data' { EData } + | '(' Exp ')' { $2 } + + +Sort :: { Sort } +Sort : 'Type' { SType } + + +Equation :: { Equation } +Equation : ListAPatt '->' Exp { Equ (reverse $1) $3 } + + +APatt :: { APatt } +APatt : '(' CIdent ListAPatt ')' { APC $2 (reverse $3) } + | Ident { APV $1 } + | String { APS $1 } + | Integer { API $1 } + | '_' { APW } + + +ListDecl :: { [Decl] } +ListDecl : {- empty -} { [] } + | Decl { (:[]) $1 } + | Decl ';' ListDecl { (:) $1 $3 } + + +ListAPatt :: { [APatt] } +ListAPatt : {- empty -} { [] } + | ListAPatt APatt { flip (:) $1 $2 } + + +ListEquation :: { [Equation] } +ListEquation : {- empty -} { [] } + | ListEquation Equation ';' { flip (:) $1 $2 } + + +Atom :: { Atom } +Atom : CIdent { AC $1 } + | '<' CIdent '>' { AD $2 } + | '$' Ident { AV $2 } + | '?' Integer { AM $2 } + | String { AS $1 } + | Integer { AI $1 } + | Sort { AT $1 } + + +Decl :: { Decl } +Decl : Ident ':' Exp { Decl $1 $3 } + + +CType :: { CType } +CType : '{' ListLabelling '}' { RecType $2 } + | '(' CType '=>' CType ')' { Table $2 $4 } + | CIdent { Cn $1 } + | 'Str' { TStr } + | 'Ints' Integer { TInts $2 } + + +Labelling :: { Labelling } +Labelling : Label ':' CType { Lbg $1 $3 } + + +Term2 :: { Term } +Term2 : ArgVar { Arg $1 } + | CIdent { I $1 } + | '<' CIdent ListTerm2 '>' { Par $2 (reverse $3) } + | '$' Ident { LI $2 } + | '{' ListAssign '}' { R $2 } + | Integer { EInt $1 } + | Tokn { K $1 } + | '[' ']' { E } + | '(' Term ')' { $2 } + + +Term1 :: { Term } +Term1 : Term2 '.' Label { P $1 $3 } + | 'table' CType '{' ListCase '}' { T $2 $4 } + | 'table' CType '[' ListTerm2 ']' { V $2 (reverse $4) } + | Term1 '!' Term2 { S $1 $3 } + | 'variants' '{' ListTerm2 '}' { FV (reverse $3) } + | Term2 { $1 } + + +Term :: { Term } +Term : Term '++' Term1 { C $1 $3 } + | Term1 { $1 } + + +Tokn :: { Tokn } +Tokn : String { KS $1 } + | '[' 'pre' ListString '{' ListVariant '}' ']' { KP (reverse $3) $5 } + + +Assign :: { Assign } +Assign : Label '=' Term { Ass $1 $3 } + + +Case :: { Case } +Case : ListPatt '=>' Term { Cas (reverse $1) $3 } + + +Variant :: { Variant } +Variant : ListString '/' ListString { Var (reverse $1) (reverse $3) } + + +Label :: { Label } +Label : Ident { L $1 } + | '$' Integer { LV $2 } + + +ArgVar :: { ArgVar } +ArgVar : Ident '@' Integer { A $1 $3 } + | Ident '+' Integer '@' Integer { AB $1 $3 $5 } + + +Patt :: { Patt } +Patt : '(' CIdent ListPatt ')' { PC $2 (reverse $3) } + | Ident { PV $1 } + | '_' { PW } + | '{' ListPattAssign '}' { PR $2 } + | Integer { PI $1 } + + +PattAssign :: { PattAssign } +PattAssign : Label '=' Patt { PAss $1 $3 } + + +ListFlag :: { [Flag] } +ListFlag : {- empty -} { [] } + | ListFlag Flag ';' { flip (:) $1 $2 } + + +ListDef :: { [Def] } +ListDef : {- empty -} { [] } + | ListDef Def ';' { flip (:) $1 $2 } + + +ListParDef :: { [ParDef] } +ListParDef : {- empty -} { [] } + | ParDef { (:[]) $1 } + | ParDef '|' ListParDef { (:) $1 $3 } + + +ListCType :: { [CType] } +ListCType : {- empty -} { [] } + | ListCType CType { flip (:) $1 $2 } + + +ListCIdent :: { [CIdent] } +ListCIdent : {- empty -} { [] } + | ListCIdent CIdent { flip (:) $1 $2 } + + +ListAssign :: { [Assign] } +ListAssign : {- empty -} { [] } + | Assign { (:[]) $1 } + | Assign ';' ListAssign { (:) $1 $3 } + + +ListArgVar :: { [ArgVar] } +ListArgVar : {- empty -} { [] } + | ArgVar { (:[]) $1 } + | ArgVar ',' ListArgVar { (:) $1 $3 } + + +ListLabelling :: { [Labelling] } +ListLabelling : {- empty -} { [] } + | Labelling { (:[]) $1 } + | Labelling ';' ListLabelling { (:) $1 $3 } + + +ListCase :: { [Case] } +ListCase : {- empty -} { [] } + | Case { (:[]) $1 } + | Case ';' ListCase { (:) $1 $3 } + + +ListTerm2 :: { [Term] } +ListTerm2 : {- empty -} { [] } + | ListTerm2 Term2 { flip (:) $1 $2 } + + +ListString :: { [String] } +ListString : {- empty -} { [] } + | ListString String { flip (:) $1 $2 } + + +ListVariant :: { [Variant] } +ListVariant : {- empty -} { [] } + | Variant { (:[]) $1 } + | Variant ';' ListVariant { (:) $1 $3 } + + +ListPattAssign :: { [PattAssign] } +ListPattAssign : {- empty -} { [] } + | PattAssign { (:[]) $1 } + | PattAssign ';' ListPattAssign { (:) $1 $3 } + + +ListPatt :: { [Patt] } +ListPatt : {- empty -} { [] } + | ListPatt Patt { flip (:) $1 $2 } + + +ListIdent :: { [Ident] } +ListIdent : {- empty -} { [] } + | Ident { (:[]) $1 } + | Ident ',' ListIdent { (:) $1 $3 } + + + +{ + +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 ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts))) + +myLexer = tokens +} + diff --git a/src-3.0/GF/Canon/PrExp.hs b/src-3.0/GF/Canon/PrExp.hs new file mode 100644 index 000000000..6202a760e --- /dev/null +++ b/src-3.0/GF/Canon/PrExp.hs @@ -0,0 +1,46 @@ +---------------------------------------------------------------------- +-- | +-- Module : PrExp +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:28 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.5 $ +-- +-- print trees without qualifications +----------------------------------------------------------------------------- + +module GF.Canon.PrExp (prExp) where + +import GF.Canon.AbsGFC +import GF.Canon.GFC + +import GF.Data.Operations + +prExp :: Exp -> String +prExp e = case e of + EApp f a -> pr1 f +++ pr2 a + EAbsR x b -> "\\" ++ prtt x +++ "->" +++ prExp b + EAbs x _ b -> prExp $ EAbsR x b + EProd x a b -> "(\\" ++ prtt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b + EAtomR a -> prAtom a + EAtom a _ -> prAtom a + _ -> prtt e + where + pr1 e = case e of + EAbsR _ _ -> prParenth $ prExp e + EAbs _ _ _ -> prParenth $ prExp e + EProd _ _ _ -> prParenth $ prExp e + _ -> prExp e + pr2 e = case e of + EApp _ _ -> prParenth $ prExp e + _ -> pr1 e + +prAtom a = case a of + AC c -> prCIdent c + AD c -> prCIdent c + _ -> prtt a + +prCIdent (CIQ _ c) = prtt c diff --git a/src-3.0/GF/Canon/PrintGFC.hs b/src-3.0/GF/Canon/PrintGFC.hs new file mode 100644 index 000000000..437f3a1e9 --- /dev/null +++ b/src-3.0/GF/Canon/PrintGFC.hs @@ -0,0 +1,376 @@ +module GF.Canon.PrintGFC where + + +-- pretty-printer generated by the BNF converter, except handhacked spacing --H + +import GF.Infra.Ident --H +import GF.Canon.AbsGFC +import Data.Char + +-- the top-level printing method +printTree :: Print a => a -> String +printTree = render . prt 0 + +type Doc = [ShowS] -> [ShowS] + +doc :: ShowS -> Doc +doc = (:) + +docs :: ShowS -> Doc +docs x y = concatD [spc, doc x, spc ] y + +spc = doc (showString "&") + +render :: Doc -> String +render d = rend 0 (map ($ "") $ d []) "" where + rend i ss = case ss of + "*" :ts -> realnew . rend i ts --H + "&":"&":ts -> showChar ' ' . rend i ts --H + "&" :ts -> rend i ts --H + t :ts -> showString t . rend i ts + _ -> id + realnew = showChar '\n' --H + +{- +render :: Doc -> String +render d = rend 0 (map ($ "") $ d []) "" where + rend i ss = case ss of + "*NEW" :ts -> realnew . rend i ts --H + "<" :ts -> showString "<" . rend i ts --H + "$" :ts -> showString "$" . rend i ts --H + "?" :ts -> showString "?" . rend i ts --H + "[" :ts -> showChar '[' . rend i ts + "(" :ts -> showChar '(' . rend i ts + "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts + "}" : ";":ts -> new (i-1) . showChar '}' . 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 . showChar '@' . rend i ts + t : "," :ts -> showString t . showChar ',' . rend i ts + t : ")" :ts -> showString t . showChar ')' . rend i ts + t : "]" :ts -> showString t . showChar ']' . rend i ts + t : ">" :ts -> showString t . showChar '>' . rend i ts --H + t : "." :ts -> showString t . showChar '.' . rend i ts --H + t@"=>" :ts -> showString t . rend i ts --H + t@"->" :ts -> showString t . rend i ts --H + t :ts -> realspace t . rend i ts --H + _ -> id + space t = showString t . showChar ' ' -- H + realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H + new i s = s -- H + realnew = showChar '\n' --H +-} + +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 = docs (shows x) + + +instance Print Double where + prt _ x = docs (shows x) + +instance Print Ident where + prt _ i = docs (showString $ prIdent i) -- H + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) + +instance Print Canon where + prt i e = case e of + MGr ids id modules -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc , doc (showString "of") , spc, prt 0 id , doc (showString ";") , prt 0 modules]) + Gr modules -> prPrec i 0 (concatD [prt 0 modules]) + + +instance Print Line where + prt i e = case e of + LMulti ids id -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc, doc (showString "of") , spc, prt 0 id , doc (showString ";")]) + LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{")]) + LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";")]) + LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";")]) + LEnd -> prPrec i 0 (concatD [doc (showString "}")]) + + +instance Print Module where + prt i e = case e of + Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , prt 0 flags , prt 0 defs , doc (showString "}")]) + + 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 + MTAbs id -> prPrec i 0 (concatD [spc, doc (showString "abstract") , spc , prt 0 id]) + MTCnc id0 id -> prPrec i 0 (concatD [spc, doc (showString "concrete") , spc, prt 0 id0 , spc, doc (showString "of") , spc, prt 0 id]) + MTRes id -> prPrec i 0 (concatD [spc, doc (showString "resource") , spc, prt 0 id]) + MTTrans id0 id1 id -> prPrec i 0 (concatD [spc, doc (showString "transfer") , spc, prt 0 id0 , doc (showString ":") , prt 0 id1 , doc (showString "->") , prt 0 id]) + + +instance Print Extend where + prt i e = case e of + Ext ids -> prPrec i 0 (concatD [prt 0 ids , doc (showString "**")]) + NoExt -> prPrec i 0 (concatD []) + + +instance Print Open where + prt i e = case e of + Opens ids -> prPrec i 0 (concatD [spc, doc (showString "open") , spc, prt 0 ids , docs (showString "in")]) + NoOpens -> prPrec i 0 (concatD []) + + +instance Print Flag where + prt i e = case e of + Flg id0 id -> prPrec i 0 (concatD [spc, doc (showString "flags") , spc, prt 0 id0 , doc (showString "=") , prt 0 id]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) + +instance Print Def where + prt i e = case e of + AbsDCat id decls cidents -> prPrec i 0 (concatD [docs (showString "cat") , prt 0 id , doc (showString "[") , prt 0 decls , doc (showString "]") , doc (showString "=") , prt 0 cidents]) + AbsDFun id exp0 exp -> prPrec i 0 (concatD [docs (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp]) + AbsDTrans id exp -> prPrec i 0 (concatD [docs (showString "transfer") , prt 0 id , doc (showString "=") , prt 0 exp]) + ResDPar id pardefs -> prPrec i 0 (concatD [docs (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs]) + ResDOper id ctype term -> prPrec i 0 (concatD [docs (showString "oper") , prt 0 id , doc (showString ":") , prt 0 ctype , doc (showString "=") , prt 0 term]) + CncDCat id ctype term0 term -> prPrec i 0 (concatD [docs (showString "lincat") , prt 0 id , doc (showString "=") , prt 0 ctype , doc (showString "=") , prt 0 term0 , doc (showString ";") , prt 0 term]) + CncDFun id cident argvars term0 term -> prPrec i 0 (concatD [docs (showString "lin") , prt 0 id , doc (showString ":") , prt 0 cident , doc (showString "=") , doc (showString "\\") , prt 0 argvars , doc (showString "->") , prt 0 term0 , doc (showString ";") , prt 0 term]) + AnyDInd id0 status id -> prPrec i 0 (concatD [prt 0 id0 , prt 0 status , docs (showString "in") , prt 0 id]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*") , prt 0 xs]) -- H + + +instance Print ParDef where + prt i e = case e of + ParD id ctypes -> prPrec i 0 (concatD [prt 0 id , prt 0 ctypes]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs]) + +instance Print Status where + prt i e = case e of + Canon -> prPrec i 0 (concatD [docs (showString "data")]) + NonCan -> prPrec i 0 (concatD []) + + +instance Print CIdent where + prt i e = case e of + CIQ id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print Exp where + prt i e = case e of + EApp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , prt 2 exp]) + EProd id exp0 exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp]) + EAbs id exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 id , doc (showString "->") , prt 0 exp]) + EAtom atom -> prPrec i 2 (concatD [prt 0 atom]) + EData -> prPrec i 2 (concatD [docs (showString "data")]) + EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")]) + + +instance Print Sort where + prt i e = case e of + SType -> prPrec i 0 (concatD [docs (showString "Type")]) + + +instance Print Equation where + prt i e = case e of + Equ apatts exp -> prPrec i 0 (concatD [prt 0 apatts , doc (showString "->") , prt 0 exp]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) + +instance Print APatt where + prt i e = case e of + APC cident apatts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 apatts , doc (showString ")")]) + APV id -> prPrec i 0 (concatD [prt 0 id]) + APS str -> prPrec i 0 (concatD [prt 0 str]) + API n -> prPrec i 0 (concatD [prt 0 n]) + APF n -> prPrec i 0 (concatD [prt 0 n]) + APW -> prPrec i 0 (concatD [doc (showString "_")]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print Atom where + prt i e = case e of + AC cident -> prPrec i 0 (concatD [prt 0 cident]) + AD cident -> prPrec i 0 (concatD [doc (showString "<") , prt 0 cident , doc (showString ">")]) + AV id -> prPrec i 0 (concatD [doc (showString "$") , prt 0 id]) + AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n]) + AS str -> prPrec i 0 (concatD [prt 0 str]) + AI n -> prPrec i 0 (concatD [prt 0 n]) + AT sort -> prPrec i 0 (concatD [prt 0 sort]) + + +instance Print Decl where + prt i e = case e of + Decl id exp -> prPrec i 0 (concatD [prt 0 id , 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 CType where + prt i e = case e of + RecType labellings -> prPrec i 0 (concatD [doc (showString "{") , prt 0 labellings , doc (showString "}")]) + Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")]) + Cn cident -> prPrec i 0 (concatD [prt 0 cident]) + TStr -> prPrec i 0 (concatD [docs (showString "Str")]) + TInts n -> prPrec i 0 (concatD [docs (showString "Ints") , prt 0 n]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print Labelling where + prt i e = case e of + Lbg label ctype -> prPrec i 0 (concatD [prt 0 label , doc (showString ":") , prt 0 ctype]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) + +instance Print Term where + prt i e = case e of + Arg argvar -> prPrec i 2 (concatD [prt 0 argvar]) + I cident -> prPrec i 2 (concatD [prt 0 cident]) + Par cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")]) + LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id]) + R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")]) + P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label]) + T ctype cases -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "{") , prt 0 cases , doc (showString "}")]) + V ctype terms -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "[") , prt 2 terms , doc (showString "]")]) + S term0 term -> prPrec i 1 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term]) + C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term]) + FV terms -> prPrec i 1 (concatD [docs (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")]) + EInt n -> prPrec i 2 (concatD [prt 0 n]) + EFloat n -> prPrec i 2 (concatD [prt 0 n]) + K tokn -> prPrec i 2 (concatD [prt 0 tokn]) + E -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 2 x , prt 2 xs]) + +instance Print Tokn where + prt i e = case e of + KS str -> prPrec i 0 (concatD [prt 0 str]) + KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , docs (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")]) + KM str -> prPrec i 0 (concatD [prt 0 str]) + + +instance Print Assign where + prt i e = case e of + Ass label term -> prPrec i 0 (concatD [prt 0 label , doc (showString "=") , prt 0 term]) + + 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 + Cas patts term -> prPrec i 0 (concatD [prt 0 patts , doc (showString "=>") , prt 0 term]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) + +instance Print Variant where + prt i e = case e of + Var strs0 strs -> prPrec i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs]) + + 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 + L id -> prPrec i 0 (concatD [prt 0 id]) + LV n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n]) + + +instance Print ArgVar where + prt i e = case e of + A id n -> prPrec i 0 (concatD [prt 0 id , doc (showString "@") , prt 0 n]) + AB id n0 n -> prPrec i 0 (concatD [prt 0 id , doc (showString "+") , prt 0 n0 , doc (showString "@") , prt 0 n]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) + +instance Print Patt where + prt i e = case e of + PC cident patts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patts , doc (showString ")")]) + PV id -> prPrec i 0 (concatD [prt 0 id]) + PW -> prPrec i 0 (concatD [docs (showString "_")]) + PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")]) + PI n -> prPrec i 0 (concatD [prt 0 n]) + PF n -> prPrec i 0 (concatD [prt 0 n]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print PattAssign where + prt i e = case e of + PAss label patt -> prPrec i 0 (concatD [prt 0 label , 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]) + + diff --git a/src-3.0/GF/Canon/Share.hs b/src-3.0/GF/Canon/Share.hs new file mode 100644 index 000000000..69725001a --- /dev/null +++ b/src-3.0/GF/Canon/Share.hs @@ -0,0 +1,147 @@ +---------------------------------------------------------------------- +-- | +-- Module : Share +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/06/17 14:15:18 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.12 $ +-- +-- Optimizations on GFC code: sharing, parametrization, value sets. +-- +-- optimization: sharing branches in tables. AR 25\/4\/2003. +-- following advice of Josef Svenningsson +----------------------------------------------------------------------------- + +module GF.Canon.Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where + +import GF.Canon.AbsGFC +import GF.Infra.Ident +import GF.Canon.GFC +import qualified GF.Canon.CMacros as C +import GF.Grammar.PrGrammar (prt) +import GF.Data.Operations +import Data.List +import qualified GF.Infra.Modules as M + +type OptSpec = [Integer] --- + +doOptFactor opt = elem 2 opt +doOptValues opt = elem 3 opt + +shareOpt :: OptSpec +shareOpt = [] + +paramOpt :: OptSpec +paramOpt = [2] + +valOpt :: OptSpec +valOpt = [3] + +allOpt :: OptSpec +allOpt = [2,3] + +shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo) +shareModule opt (i,m) = case m of + M.ModMod (M.Module mt st fs me ops js) -> + (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js))) + _ -> (i,m) + +shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt c t) m) +shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt c t) m) +shareInfo _ i = i + +-- | the function putting together optimizations +shareOptim :: OptSpec -> Ident -> Term -> Term +shareOptim opt c + | doOptFactor opt && doOptValues opt = values . factor c 0 + | doOptFactor opt = share . factor c 0 + | doOptValues opt = values + | otherwise = share + +-- | we need no counter to create new variable names, since variables are +-- local to tables +share :: Term -> Term +share t = case t of + T ty cs -> shareT ty [(p, share v) | Cas ps v <- cs, p <- ps] -- only substant. + R lts -> R [Ass l (share t) | Ass l t <- lts] + P t l -> P (share t) l + S t a -> S (share t) (share a) + C t a -> C (share t) (share a) + FV ts -> FV (map share ts) + + _ -> t -- including D, which is always born shared + + where + shareT ty = finalize ty . groupC . sortC + + sortC :: [(Patt,Term)] -> [(Patt,Term)] + sortC = sortBy $ \a b -> compare (snd a) (snd b) + + groupC :: [(Patt,Term)] -> [[(Patt,Term)]] + groupC = groupBy $ \a b -> snd a == snd b + + finalize :: CType -> [[(Patt,Term)]] -> Term + finalize ty css = T ty [Cas (map fst ps) t | ps@((_,t):_) <- css] + + +-- | do even more: factor parametric branches +factor :: Ident -> Int -> Term -> Term +factor c i t = case t of + T _ [_] -> t + T _ [] -> t + T ty cs -> T ty $ factors i [Cas [p] (factor c (i+1) v) | Cas ps v <- cs, p <- ps] + R lts -> R [Ass l (factor c i t) | Ass l t <- lts] + P t l -> P (factor c i t) l + S t a -> S (factor c i t) (factor c i a) + C t a -> C (factor c i t) (factor c i a) + FV ts -> FV (map (factor c i) ts) + + _ -> t + where + + factors i psvs = -- we know psvs has at least 2 elements + let p = pIdent c i + vs' = map (mkFun p) psvs + in if allEqs vs' + then mkCase p vs' + else psvs + + mkFun p (Cas [patt] val) = replace (C.patt2term patt) (LI p) val + + allEqs (v:vs) = all (==v) vs + + mkCase p (v:_) = [Cas [PV p] v] + +pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i) + + +-- | we need to replace subterms +replace :: Term -> Term -> Term -> Term +replace old new trm = case trm of + T ty cs -> T ty [Cas p (repl v) | Cas p v <- cs] + P t l -> P (repl t) l + S t a -> S (repl t) (repl a) + C t a -> C (repl t) (repl a) + FV ts -> FV (map repl ts) + + -- these are the important cases, since they can correspond to patterns + Par c ts | trm == old -> new + Par c ts -> Par c (map repl ts) + R _ | isRec && trm == old -> new + R lts -> R [Ass l (repl t) | Ass l t <- lts] + + _ -> trm + where + repl = replace old new + isRec = case trm of + R _ -> True + _ -> False + +values :: Term -> Term +values t = case t of + T ty [c] -> T ty [Cas p (values t) | Cas p t <- [c]] -- preserve parametrization + T ty cs -> V ty [values t | Cas _ t <- cs] -- assumes proper order + _ -> C.composSafeOp values t diff --git a/src-3.0/GF/Canon/SkelGFC.hs b/src-3.0/GF/Canon/SkelGFC.hs new file mode 100644 index 000000000..a1d9331d8 --- /dev/null +++ b/src-3.0/GF/Canon/SkelGFC.hs @@ -0,0 +1,217 @@ +module GF.Canon.SkelGFC where + +-- Haskell module generated by the BNF converter + +import GF.Canon.AbsGFC +import GF.Data.ErrM +import GF.Infra.Ident + +type Result = Err String + +failure :: Show a => a -> Result +failure x = Bad $ "Undefined case: " ++ show x + +transIdent :: Ident -> Result +transIdent x = case x of + Ident str -> failure x + + +transCanon :: Canon -> Result +transCanon x = case x of + MGr ids id modules -> failure x + Gr modules -> failure x + + +transLine :: Line -> Result +transLine x = case x of + LMulti ids id -> failure x + LHeader modtype extend open -> failure x + LFlag flag -> failure x + LDef def -> failure x + LEnd -> failure x + + +transModule :: Module -> Result +transModule x = case x of + Mod modtype extend open flags defs -> failure x + + +transModType :: ModType -> Result +transModType x = case x of + MTAbs id -> failure x + MTCnc id0 id -> failure x + MTRes id -> failure x + MTTrans id0 id1 id -> failure x + + +transExtend :: Extend -> Result +transExtend x = case x of + Ext ids -> failure x + NoExt -> failure x + + +transOpen :: Open -> Result +transOpen x = case x of + Opens ids -> failure x + NoOpens -> failure x + + +transFlag :: Flag -> Result +transFlag x = case x of + Flg id0 id -> failure x + + +transDef :: Def -> Result +transDef x = case x of + AbsDCat id decls cidents -> failure x + AbsDFun id exp0 exp -> failure x + AbsDTrans id exp -> failure x + ResDPar id pardefs -> failure x + ResDOper id ctype term -> failure x + CncDCat id ctype term0 term -> failure x + CncDFun id cident argvars term0 term -> failure x + AnyDInd id0 status id -> failure x + + +transParDef :: ParDef -> Result +transParDef x = case x of + ParD id ctypes -> failure x + + +transStatus :: Status -> Result +transStatus x = case x of + Canon -> failure x + NonCan -> failure x + + +transCIdent :: CIdent -> Result +transCIdent x = case x of + CIQ id0 id -> failure x + + +transExp :: Exp -> Result +transExp x = case x of + EApp exp0 exp -> failure x + EProd id exp0 exp -> failure x + EAbs id exp -> failure x + EAtom atom -> failure x + EData -> failure x + EEq equations -> failure x + + +transSort :: Sort -> Result +transSort x = case x of + SType -> failure x + + +transEquation :: Equation -> Result +transEquation x = case x of + Equ apatts exp -> failure x + + +transAPatt :: APatt -> Result +transAPatt x = case x of + APC cident apatts -> failure x + APV id -> failure x + APS str -> failure x + API n -> failure x + APW -> failure x + + +transAtom :: Atom -> Result +transAtom x = case x of + AC cident -> failure x + AD cident -> failure x + AV id -> failure x + AM n -> failure x + AS str -> failure x + AI n -> failure x + AT sort -> failure x + + +transDecl :: Decl -> Result +transDecl x = case x of + Decl id exp -> failure x + + +transCType :: CType -> Result +transCType x = case x of + RecType labellings -> failure x + Table ctype0 ctype -> failure x + Cn cident -> failure x + TStr -> failure x + TInts n -> failure x + + +transLabelling :: Labelling -> Result +transLabelling x = case x of + Lbg label ctype -> failure x + + +transTerm :: Term -> Result +transTerm x = case x of + Arg argvar -> failure x + I cident -> failure x + Par cident terms -> failure x + LI id -> failure x + R assigns -> failure x + P term label -> failure x + T ctype cases -> failure x + V ctype terms -> failure x + S term0 term -> failure x + C term0 term -> failure x + FV terms -> failure x + EInt n -> failure x + K tokn -> failure x + E -> failure x + + +transTokn :: Tokn -> Result +transTokn x = case x of + KS str -> failure x + KP strs variants -> failure x + KM str -> failure x + + +transAssign :: Assign -> Result +transAssign x = case x of + Ass label term -> failure x + + +transCase :: Case -> Result +transCase x = case x of + Cas patts term -> failure x + + +transVariant :: Variant -> Result +transVariant x = case x of + Var strs0 strs -> failure x + + +transLabel :: Label -> Result +transLabel x = case x of + L id -> failure x + LV n -> failure x + + +transArgVar :: ArgVar -> Result +transArgVar x = case x of + A id n -> failure x + AB id n0 n -> failure x + + +transPatt :: Patt -> Result +transPatt x = case x of + PC cident patts -> failure x + PV id -> failure x + PW -> failure x + PR pattassigns -> failure x + PI n -> failure x + + +transPattAssign :: PattAssign -> Result +transPattAssign x = case x of + PAss label patt -> failure x + + + diff --git a/src-3.0/GF/Canon/Subexpressions.hs b/src-3.0/GF/Canon/Subexpressions.hs new file mode 100644 index 000000000..683f9eecf --- /dev/null +++ b/src-3.0/GF/Canon/Subexpressions.hs @@ -0,0 +1,170 @@ +---------------------------------------------------------------------- +-- | +-- Module : Subexpressions +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/20 09:32:56 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.4 $ +-- +-- Common subexpression elimination. +-- all tables. AR 18\/9\/2005. +----------------------------------------------------------------------------- + +module GF.Canon.Subexpressions ( + elimSubtermsMod, prSubtermStat, unSubelimCanon, unSubelimModule + ) where + +import GF.Canon.AbsGFC +import GF.Infra.Ident +import GF.Canon.GFC +import GF.Canon.Look +import GF.Grammar.PrGrammar +import GF.Canon.CMacros as C +import GF.Data.Operations +import qualified GF.Infra.Modules as M + +import Control.Monad +import Data.Map (Map) +import qualified Data.Map as Map +import Data.List + +{- +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. + +-} + +-- exported functions + +elimSubtermsMod :: (Ident,CanonModInfo) -> Err (Ident, CanonModInfo) +elimSubtermsMod (mo,m) = case m of + M.ModMod (M.Module mt st fs me ops js) -> do + (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0) + js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js + return (mo,M.ModMod (M.Module mt st fs me ops js2)) + _ -> return (mo,m) + +prSubtermStat :: CanonGrammar -> String +prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where + mos = [(i, tree2list (M.jments m)) | (i, M.ModMod m) <- M.modules gr, M.isModCnc m] + expsIn mo js = err id id $ do + (tree,_) <- appSTM (getSubtermsMod mo js) (Map.empty,0) + let list0 = Map.toList tree + let list1 = sortBy (\ (_,(m,_)) (_,(n,_)) -> compare n m) list0 + return $ unlines [show n ++ "\t" ++ prt trm | (trm,(n,_)) <- list1] + +unSubelimCanon :: CanonGrammar -> CanonGrammar +unSubelimCanon gr@(M.MGrammar modules) = + M.MGrammar $ map unSubelimModule modules + +unSubelimModule :: CanonModule -> CanonModule +unSubelimModule mo@(i,m) = case m of + M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) | hasSub ljs -> + (i, M.ModMod (M.Module mt st fs me ops + (rebuild (map unparInfo ljs)))) + where ljs = tree2list js + _ -> (i,m) + where + -- perform this iff the module has opers + hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs] + unparInfo (c,info) = case info of + CncFun k xs t m -> [(c, CncFun k xs (unparTerm t) m)] + ResOper _ _ -> [] + _ -> [(c,info)] + unparTerm t = case t of + I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c + _ -> C.composSafeOp unparTerm t + gr = M.MGrammar [mo] + rebuild = buildTree . concat + +-- implementation + +type TermList = Map Term (Int,Int) -- number of occs, id +type TermM a = STM (TermList,Int) a + +addSubexpConsts :: Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)] +addSubexpConsts mo tree lins = do + let opers = [oper id trm | (trm,(_,id)) <- list] + mapM mkOne $ opers ++ lins + where + + mkOne (f,def) = case def of + CncFun ci xs trm pn -> do + trm' <- recomp f trm + return (f,CncFun ci xs trm' pn) + ResOper ty trm -> do + trm' <- recomp f trm + return (f,ResOper ty trm') + _ -> return (f,def) + recomp f t = case Map.lookup t tree of + Just (_,id) | ident id /= f -> return $ I $ cident mo id + _ -> composOp (recomp f) t + + list = Map.toList tree + + oper id trm = (ident id, ResOper TStr trm) --- type TStr does not matter + +getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int)) +getSubtermsMod mo js = do + mapM (getInfo (collectSubterms mo)) js + (tree0,_) <- readSTM + return $ Map.filter (\ (nu,_) -> nu > 1) tree0 + where + getInfo get fi@(f,i) = case i of + CncFun ci xs trm pn -> do + get trm + return $ fi + ResOper ty trm -> do + get trm + return $ fi + _ -> return fi + +collectSubterms :: Ident -> Term -> TermM Term +collectSubterms mo t = case t of + Par _ (_:_) -> add t + T ty cs -> do + let (ps,ts) = unzip [(p,t) | Cas p t <- cs] + mapM (collectSubterms mo) ts + add t + V ty ts -> do + mapM (collectSubterms mo) ts + add t + K (KP _ _) -> add t + _ -> composOp (collectSubterms mo) t + where + 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) --- + +cident :: Ident -> Int -> CIdent +cident mo = CIQ mo . ident diff --git a/src-3.0/GF/Canon/TestGFC.hs b/src-3.0/GF/Canon/TestGFC.hs new file mode 100644 index 000000000..7c89d64e8 --- /dev/null +++ b/src-3.0/GF/Canon/TestGFC.hs @@ -0,0 +1,58 @@ +-- automatically generated by BNF Converter +module Main where + + +import IO ( stdin, hGetContents ) +import System ( getArgs, getProgName ) + +import GF.Canon.LexGFC +import GF.Canon.ParGFC +import GF.Canon.SkelGFC +import GF.Canon.PrintGFC +import GF.Canon.AbsGFC +import GF.Infra.Ident + + + +import GF.Data.ErrM + +type ParseFun a = [Token] -> Err a + +myLLexer = myLexer + +type Verbosity = Int + +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts + putStrLn s + Ok tree -> do putStrLn "\nParse Successful!" + showTree v tree + + + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree + +main :: IO () +main = do args <- getArgs + case args of + [] -> hGetContents stdin >>= run 2 pCanon + "-s":fs -> mapM_ (runFile 0 pCanon) fs + fs -> mapM_ (runFile 2 pCanon) fs + + + + + diff --git a/src-3.0/GF/Canon/Unlex.hs b/src-3.0/GF/Canon/Unlex.hs new file mode 100644 index 000000000..dd93390e2 --- /dev/null +++ b/src-3.0/GF/Canon/Unlex.hs @@ -0,0 +1,49 @@ +---------------------------------------------------------------------- +-- | +-- Module : Unlex +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:32 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.8 $ +-- +-- elementary text postprocessing. AR 21/11/2001 +----------------------------------------------------------------------------- + +module GF.Canon.Unlex (formatAsText, unlex, performBinds) where + +import GF.Data.Operations +import GF.Data.Str + +import Data.Char +import Data.List (isPrefixOf) + +formatAsText :: String -> String +formatAsText = unwords . format . cap . words where + format ws = case ws of + w : c : ww | major c -> (w ++ c) : format (cap ww) + w : c : ww | minor c -> (w ++ c) : format ww + c : ww | para c -> "\n\n" : format ww + w : ww -> w : format ww + [] -> [] + cap (p:(c:cs):ww) | para p = p : (toUpper c : cs) : ww + cap ((c:cs):ww) = (toUpper c : cs) : ww + cap [] = [] + major = flip elem (map (:[]) ".!?") + minor = flip elem (map (:[]) ",:;") + para = (=="&-") + +unlex :: [Str] -> String +unlex = formatAsText . performBinds . concat . map sstr . take 1 ---- + +-- | modified from GF/src/Text by adding hyphen +performBinds :: String -> String +performBinds = unwords . format . words where + format ws = case ws of + w : "-" : u : ws -> format ((w ++ "-" ++ u) : ws) + w : "&+" : u : ws -> format ((w ++ u) : ws) + w : ws -> w : format ws + [] -> [] + diff --git a/src-3.0/GF/Canon/Unparametrize.hs b/src-3.0/GF/Canon/Unparametrize.hs new file mode 100644 index 000000000..0ca6a2d9c --- /dev/null +++ b/src-3.0/GF/Canon/Unparametrize.hs @@ -0,0 +1,63 @@ +---------------------------------------------------------------------- +-- | +-- Module : Unparametrize +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/14 16:26:21 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.1 $ +-- +-- Taking away parameters from a canonical grammar. All param +-- types are replaced by {}, and only one branch is left in +-- all tables. AR 14\/9\/2005. +----------------------------------------------------------------------------- + +module GF.Canon.Unparametrize (unparametrizeCanon) where + +import GF.Canon.AbsGFC +import GF.Infra.Ident +import GF.Canon.GFC +import qualified GF.Canon.CMacros as C +import GF.Data.Operations +import qualified GF.Infra.Modules as M + +unparametrizeCanon :: CanonGrammar -> CanonGrammar +unparametrizeCanon (M.MGrammar modules) = + M.MGrammar $ map unparModule modules where + + unparModule (i,m) = case m of + M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) -> + let me' = [(unparIdent j,incl) | (j,incl) <- me] in + (unparIdent i, M.ModMod (M.Module mt st fs me' ops (mapTree unparInfo js))) + _ -> (i,m) + + unparInfo (c,info) = case info of + CncCat ty t m -> (c, CncCat (unparCType ty) (unparTerm t) m) + CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m) + AnyInd b i -> (c, AnyInd b (unparIdent i)) + _ -> (c,info) + + unparCType ty = case ty of + RecType ls -> RecType [Lbg lab (unparCType t) | Lbg lab t <- ls] + Table _ v -> unparCType v --- Table unitType (unparCType v) + Cn _ -> unitType + _ -> ty + + unparTerm t = case t of + Par _ _ -> unitTerm + T _ cs -> unparTerm (head [t | Cas _ t <- cs]) + V _ ts -> unparTerm (head ts) + S t _ -> unparTerm t +{- + T _ cs -> V unitType [unparTerm (head [t | Cas _ t <- cs])] + V _ ts -> V unitType [unparTerm (head ts)] + S t _ -> S (unparTerm t) unitTerm +-} + _ -> C.composSafeOp unparTerm t + + unitType = RecType [] + unitTerm = R [] + + unparIdent (IC s) = IC $ "UP_" ++ s diff --git a/src-3.0/GF/Canon/log.txt b/src-3.0/GF/Canon/log.txt new file mode 100644 index 000000000..44dba3954 --- /dev/null +++ b/src-3.0/GF/Canon/log.txt @@ -0,0 +1,20 @@ +GFCC, 6/9/2006 + +66661 24 Par remaining to be sent to GFC +66662 0 not covered by mkTerm +66663 36 label not in numeric format in mkTerm +66664 2 label not found in symbol table +66665 36 projection from deeper than just arg var: NP.agr.n +66667 0 parameter value not found in symbol table +66668 1 variable in parameter argument + + + +66664 2 +66665 125 missing: (VP.s!vf).fin +66668 1 + + +66661/3 24 same lines: +66664 2 +66668 1 |