{-# OPTIONS -fglasgow-exts -cpp #-} ----------------------------------------------------------------------------- -- | -- Module : Parser -- Copyright : (c) ByteLABS.org -- License : BSD-style (see the file LICENSE) -- -- The LR parser for our tree pattern matching grammar. It does some basic -- semantic checking, e.g. duplicate bindings, type checking, etc. ----------------------------------------------------------------------------- module Parser.Parser ( -- * Types ParseResult(..), -- * Functions parse ) where import qualified Data.Map as M import qualified Data.Set as S import Maybe (isJust, fromJust) import Util (stringToInt) import Ast.Op (Operator, op, opMap) import qualified Ast.Incl as Incl (Include, new) import qualified Ast.Ident as Id (toIdent) import qualified Ast.Bind as B (new, empty, getIdent) import qualified Ast.Attr as A (Attr, AttrTy(..), new, ty, emptyTy) import qualified Ast.Code as C (Code, new, empty, isEmpty) import qualified Ast.Decl as Decl (new) import qualified Ast.Def as Def (Definition, new) import qualified Ast.Nt as Nt (new) import qualified Ast.T as T (new) import Ast.Term (Term, TermClass(..), terminal, nonTerminal) import qualified Ast.Node as N (Node, TreeClass(..), new, setLink, addLinkCode) import Ast.Prod (Production, prod) import Ast.Cost as Cost (Cost, static, dynamic) import Ast.Ir (Ir(..), OperatorMap) import qualified Csa.Csa as Csa (updateCtx, checkCtx, checkDef, checkProd) import qualified Csa.Ctx as Ctx (Ctx, new, empty, merge) import qualified Csa.Elem as Elem (new) import Parser.Lexer (Token(..), TokenClass(..)) import Parser.ParseErr (parseErrDupBind, parseErrTok, parseErrRedefinition) ----------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ >= 503 import Data.Array #else import Array #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts #else import GlaExts #endif -- parser produced by Happy Version 1.17 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 type HappyAny = GHC.Exts.Any #else type HappyAny = forall a . a #endif happyIn4 :: (Ir) -> (HappyAbsSyn ) happyIn4 x = unsafeCoerce# x {-# INLINE happyIn4 #-} happyOut4 :: (HappyAbsSyn ) -> (Ir) happyOut4 x = unsafeCoerce# x {-# INLINE happyOut4 #-} happyIn5 :: (Incl.Include) -> (HappyAbsSyn ) happyIn5 x = unsafeCoerce# x {-# INLINE happyIn5 #-} happyOut5 :: (HappyAbsSyn ) -> (Incl.Include) happyOut5 x = unsafeCoerce# x {-# INLINE happyOut5 #-} happyIn6 :: (([Operator], Ctx.Ctx)) -> (HappyAbsSyn ) happyIn6 x = unsafeCoerce# x {-# INLINE happyIn6 #-} happyOut6 :: (HappyAbsSyn ) -> (([Operator], Ctx.Ctx)) happyOut6 x = unsafeCoerce# x {-# INLINE happyOut6 #-} happyIn7 :: ((Operator, Ctx.Ctx)) -> (HappyAbsSyn ) happyIn7 x = unsafeCoerce# x {-# INLINE happyIn7 #-} happyOut7 :: (HappyAbsSyn ) -> ((Operator, Ctx.Ctx)) happyOut7 x = unsafeCoerce# x {-# INLINE happyOut7 #-} happyIn8 :: (([ Def.Definition ], Ctx.Ctx, OperatorMap)) -> (HappyAbsSyn ) happyIn8 x = unsafeCoerce# x {-# INLINE happyIn8 #-} happyOut8 :: (HappyAbsSyn ) -> (([ Def.Definition ], Ctx.Ctx, OperatorMap)) happyOut8 x = unsafeCoerce# x {-# INLINE happyOut8 #-} happyIn9 :: ((Def.Definition, Ctx.Ctx, OperatorMap)) -> (HappyAbsSyn ) happyIn9 x = unsafeCoerce# x {-# INLINE happyIn9 #-} happyOut9 :: (HappyAbsSyn ) -> ((Def.Definition, Ctx.Ctx, OperatorMap)) happyOut9 x = unsafeCoerce# x {-# INLINE happyOut9 #-} happyIn10 :: (([ Production ], OperatorMap)) -> (HappyAbsSyn ) happyIn10 x = unsafeCoerce# x {-# INLINE happyIn10 #-} happyOut10 :: (HappyAbsSyn ) -> (([ Production ], OperatorMap)) happyOut10 x = unsafeCoerce# x {-# INLINE happyOut10 #-} happyIn11 :: ((Production, OperatorMap)) -> (HappyAbsSyn ) happyIn11 x = unsafeCoerce# x {-# INLINE happyIn11 #-} happyOut11 :: (HappyAbsSyn ) -> ((Production, OperatorMap)) happyOut11 x = unsafeCoerce# x {-# INLINE happyOut11 #-} happyIn12 :: ((N.Node, Ctx.Ctx, OperatorMap)) -> (HappyAbsSyn ) happyIn12 x = unsafeCoerce# x {-# INLINE happyIn12 #-} happyOut12 :: (HappyAbsSyn ) -> ((N.Node, Ctx.Ctx, OperatorMap)) happyOut12 x = unsafeCoerce# x {-# INLINE happyOut12 #-} happyIn13 :: ((N.Node, Ctx.Ctx, OperatorMap)) -> (HappyAbsSyn ) happyIn13 x = unsafeCoerce# x {-# INLINE happyIn13 #-} happyOut13 :: (HappyAbsSyn ) -> ((N.Node, Ctx.Ctx, OperatorMap)) happyOut13 x = unsafeCoerce# x {-# INLINE happyOut13 #-} happyIn14 :: (Term) -> (HappyAbsSyn ) happyIn14 x = unsafeCoerce# x {-# INLINE happyIn14 #-} happyOut14 :: (HappyAbsSyn ) -> (Term) happyOut14 x = unsafeCoerce# x {-# INLINE happyOut14 #-} happyIn15 :: (Term) -> (HappyAbsSyn ) happyIn15 x = unsafeCoerce# x {-# INLINE happyIn15 #-} happyOut15 :: (HappyAbsSyn ) -> (Term) happyOut15 x = unsafeCoerce# x {-# INLINE happyOut15 #-} happyIn16 :: ([A.Attr]) -> (HappyAbsSyn ) happyIn16 x = unsafeCoerce# x {-# INLINE happyIn16 #-} happyOut16 :: (HappyAbsSyn ) -> ([A.Attr]) happyOut16 x = unsafeCoerce# x {-# INLINE happyOut16 #-} happyIn17 :: (A.Attr) -> (HappyAbsSyn ) happyIn17 x = unsafeCoerce# x {-# INLINE happyIn17 #-} happyOut17 :: (HappyAbsSyn ) -> (A.Attr) happyOut17 x = unsafeCoerce# x {-# INLINE happyOut17 #-} happyIn18 :: ([A.Attr]) -> (HappyAbsSyn ) happyIn18 x = unsafeCoerce# x {-# INLINE happyIn18 #-} happyOut18 :: (HappyAbsSyn ) -> ([A.Attr]) happyOut18 x = unsafeCoerce# x {-# INLINE happyOut18 #-} happyIn19 :: (A.Attr) -> (HappyAbsSyn ) happyIn19 x = unsafeCoerce# x {-# INLINE happyIn19 #-} happyOut19 :: (HappyAbsSyn ) -> (A.Attr) happyOut19 x = unsafeCoerce# x {-# INLINE happyOut19 #-} happyIn20 :: (Cost.Cost) -> (HappyAbsSyn ) happyIn20 x = unsafeCoerce# x {-# INLINE happyIn20 #-} happyOut20 :: (HappyAbsSyn ) -> (Cost.Cost) happyOut20 x = unsafeCoerce# x {-# INLINE happyOut20 #-} happyIn21 :: (C.Code) -> (HappyAbsSyn ) happyIn21 x = unsafeCoerce# x {-# INLINE happyIn21 #-} happyOut21 :: (HappyAbsSyn ) -> (C.Code) happyOut21 x = unsafeCoerce# x {-# INLINE happyOut21 #-} happyInTok :: Token -> (HappyAbsSyn ) happyInTok x = unsafeCoerce# x {-# INLINE happyInTok #-} happyOutTok :: (HappyAbsSyn ) -> Token happyOutTok x = unsafeCoerce# x {-# INLINE happyOutTok #-} happyActOffsets :: HappyAddr happyActOffsets = HappyA# "\xa5\x00\xa5\x00\xa4\x00\x9b\x00\xa1\x00\x00\x00\x00\x00\xa2\x00\x9e\x00\x99\x00\x06\x00\x00\x00\x9f\x00\x00\x00\x98\x00\x96\x00\x00\x00\x54\x00\x00\x00\x05\x00\x95\x00\x4f\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x94\x00\x93\x00\x9a\x00\x04\x00\x00\x00\x4d\x00\x90\x00\x00\x00\x97\x00\x49\x00\x00\x00\x87\x00\x00\x00\x92\x00\x92\x00\x16\x00\x8f\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x07\x00\x0b\x00\x91\x00\xf9\xff\x91\x00\x4e\x00\x91\x00\x91\x00\x91\x00\x4e\x00\x3e\x00\x00\x00\x00\x00\x8e\x00\x8c\x00\x8b\x00\x8a\x00\x43\x00\x00\x00\x00\x00\x00\x00\x41\x00\x89\x00\x08\x00\x00\x00\x89\x00\x00\x00\x8d\x00\x8d\x00\x46\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\xfb\xff\x82\x00\x7d\x00\x00\x00\x84\x00\x7c\x00\x86\x00\x86\x00\x86\x00\x78\x00\x85\x00\x85\x00\x77\x00\x00\x00\x76\x00\x3d\x00\x00\x00\x74\x00\x75\x00\x70\x00\x42\x00\x81\x00\x42\x00\x81\x00\x81\x00\x6f\x00\x00\x00\xfb\xff\x73\x00\x00\x00\x4b\x00\x00\x00\x42\x00\x00\x00\x7e\x00\x00\x00\x71\x00\x00\x00\x00\x00\x00\x00"# happyGotoOffsets :: HappyAddr happyGotoOffsets = HappyA# "\x7b\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x3b\x00\x72\x00\x00\x00\x6e\x00\x00\x00\x6b\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x67\x00\x66\x00\x00\x00\x00\x00\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x02\x00\x00\x00\xfd\xff\x00\x00\x65\x00\x29\x00\x63\x00\x61\x00\x60\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x64\x00\x00\x00\x00\x00\x62\x00\x00\x00\x5f\x00\x5e\x00\x22\x00\x5c\x00\x5a\x00\x59\x00\x00\x00\x00\x00\x28\x00\x5d\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x58\x00\x57\x00\x53\x00\x00\x00\x52\x00\x51\x00\x00\x00\x00\x00\x56\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x50\x00\x1a\x00\x4c\x00\x27\x00\x00\x00\x00\x00\x0d\x00\x55\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x14\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00"# happyDefActions :: HappyAddr happyDefActions = HappyA# "\x00\x00\x00\x00\xd5\xff\x00\x00\x00\x00\xfd\xff\xd4\xff\xd5\xff\x00\x00\x00\x00\x00\x00\xfc\xff\xd5\xff\xfa\xff\x00\x00\x00\x00\xfb\xff\x00\x00\xf9\xff\xd5\xff\x00\x00\x00\x00\xf8\xff\xfe\xff\x00\x00\xdb\xff\x00\x00\x00\x00\xd5\xff\x00\x00\xf5\xff\x00\x00\x00\x00\xd9\xff\xd5\xff\x00\x00\xda\xff\x00\x00\xd8\xff\xd5\xff\xd5\xff\xe6\xff\xe2\xff\xd5\xff\xf7\xff\xf4\xff\xe1\xff\xe5\xff\x00\x00\x00\x00\x00\x00\xd5\xff\x00\x00\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\x00\x00\xe0\xff\xdc\xff\xde\xff\x00\x00\xdd\xff\xe4\xff\x00\x00\xf3\xff\xd6\xff\xd7\xff\x00\x00\x00\x00\x00\x00\xef\xff\x00\x00\xf6\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xdf\xff\xe3\xff\xea\xff\xea\xff\x00\x00\xf1\xff\x00\x00\x00\x00\xd5\xff\xd5\xff\xd5\xff\x00\x00\xd5\xff\xd5\xff\x00\x00\xec\xff\xea\xff\x00\x00\xed\xff\x00\x00\x00\x00\x00\x00\xd5\xff\xd5\xff\xd5\xff\xd5\xff\xd5\xff\x00\x00\xeb\xff\xea\xff\xea\xff\xf2\xff\x00\x00\xee\xff\xd5\xff\xe9\xff\xd5\xff\xe8\xff\xea\xff\xf0\xff\xe7\xff"# happyCheck :: HappyAddr happyCheck = HappyA# "\xff\xff\x07\x00\x01\x00\x06\x00\x07\x00\x06\x00\x07\x00\x02\x00\x0f\x00\x0e\x00\x08\x00\x11\x00\x06\x00\x12\x00\x11\x00\x16\x00\x11\x00\x0c\x00\x11\x00\x0f\x00\x0e\x00\x08\x00\x09\x00\x10\x00\x10\x00\x12\x00\x16\x00\x10\x00\x15\x00\x15\x00\x08\x00\x0d\x00\x15\x00\x0f\x00\x0c\x00\x0c\x00\x0d\x00\x11\x00\x0f\x00\x09\x00\x10\x00\x11\x00\x10\x00\x11\x00\x10\x00\x11\x00\x0a\x00\x0b\x00\x08\x00\x09\x00\x10\x00\x11\x00\x0a\x00\x0b\x00\x10\x00\x11\x00\x11\x00\x10\x00\x11\x00\x0a\x00\x0b\x00\x0e\x00\x0f\x00\x04\x00\x05\x00\x02\x00\x03\x00\x01\x00\x02\x00\x08\x00\x09\x00\x01\x00\x02\x00\x08\x00\x09\x00\x0d\x00\x0e\x00\x0a\x00\x0b\x00\x01\x00\x02\x00\x0a\x00\x0b\x00\x0a\x00\x0b\x00\x08\x00\x09\x00\x0d\x00\x0e\x00\x0a\x00\x0b\x00\x07\x00\x08\x00\x11\x00\x09\x00\x09\x00\x15\x00\x11\x00\x11\x00\x11\x00\x11\x00\x0a\x00\x09\x00\xff\xff\x11\x00\x11\x00\x11\x00\x11\x00\x0a\x00\x11\x00\x0a\x00\x11\x00\x11\x00\x11\x00\x11\x00\x05\x00\x11\x00\x03\x00\x11\x00\x11\x00\x11\x00\x0f\x00\x11\x00\x00\x00\x11\x00\x11\x00\x11\x00\x0e\x00\x02\x00\x0e\x00\x13\x00\x02\x00\x0e\x00\x15\x00\x11\x00\x02\x00\x02\x00\x15\x00\x13\x00\x13\x00\x08\x00\x11\x00\x11\x00\x02\x00\x0e\x00\x08\x00\x08\x00\x02\x00\x02\x00\x0a\x00\x0a\x00\x08\x00\x0a\x00\x02\x00\x0a\x00\x14\x00\x02\x00\x0a\x00\x0a\x00\x09\x00\x08\x00\x02\x00\x09\x00\x05\x00\x02\x00\x04\x00\x02\x00\xff\xff\x03\x00\x14\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x00\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\x2d\x00\x04\x00\x34\x00\x1e\x00\x1d\x00\x1e\x00\x07\x00\x2c\x00\x5f\x00\x37\x00\x1f\x00\x0f\x00\x3a\x00\x1f\x00\x4c\x00\x1f\x00\x16\x00\x05\x00\x2c\x00\x10\x00\x76\x00\x77\x00\x39\x00\x4e\x00\x3a\x00\x2d\x00\x36\x00\x3b\x00\x4f\x00\x30\x00\x52\x00\x37\x00\x3d\x00\x31\x00\x3b\x00\x3c\x00\x78\x00\x3d\x00\x7a\x00\x79\x00\x44\x00\x71\x00\x44\x00\x73\x00\x44\x00\x6b\x00\x6c\x00\x5f\x00\x60\x00\x57\x00\x44\x00\x50\x00\x51\x00\x43\x00\x44\x00\x6f\x00\x49\x00\x44\x00\x27\x00\x28\x00\x18\x00\x19\x00\x11\x00\x12\x00\x0a\x00\x0b\x00\x46\x00\x07\x00\x2a\x00\x2b\x00\x46\x00\x07\x00\x2a\x00\x2b\x00\x42\x00\x43\x00\x3f\x00\x40\x00\x46\x00\x07\x00\x3f\x00\x40\x00\x1b\x00\x1c\x00\x2a\x00\x2b\x00\x23\x00\x24\x00\x1b\x00\x1c\x00\x18\x00\x14\x00\x70\x00\x75\x00\x6d\x00\x75\x00\x72\x00\x62\x00\x63\x00\x65\x00\x5b\x00\x5d\x00\x00\x00\x66\x00\x67\x00\x54\x00\x55\x00\x4c\x00\x56\x00\x4f\x00\x58\x00\x59\x00\x46\x00\x47\x00\x16\x00\x48\x00\x10\x00\x4a\x00\x31\x00\x32\x00\x24\x00\x25\x00\x03\x00\x14\x00\x0d\x00\x08\x00\x5f\x00\x07\x00\x5f\x00\x6f\x00\x07\x00\x5f\x00\x69\x00\x6a\x00\x07\x00\x07\x00\x6b\x00\x62\x00\x65\x00\x2a\x00\x5b\x00\x5d\x00\x07\x00\x5f\x00\x2a\x00\x54\x00\x07\x00\x07\x00\x27\x00\x41\x00\x2f\x00\x22\x00\x07\x00\x27\x00\x34\x00\x07\x00\x21\x00\x22\x00\x0d\x00\x14\x00\x07\x00\x0d\x00\x0a\x00\x07\x00\x08\x00\x07\x00\x00\x00\x03\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# happyReduceArr = array (1, 43) [ (1 , happyReduce_1), (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) ] happy_n_terms = 24 :: Int happy_n_nonterms = 18 :: Int happyReduce_1 = happyMonadReduce 9# 0# happyReduction_1 happyReduction_1 (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) tk = happyThen (case happyOut5 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut6 happy_x_6 of { happy_var_6 -> case happyOut8 happy_x_8 of { happy_var_8 -> ( let (ops, opctx) = happy_var_6 in -- Operators and their Context let (defs, defctx, opmap) = happy_var_8 in -- Definitions and their Context let debugMsg = foldr (++) "" (map (\d -> show d) defs) ++ "\n\nDefinition "++ show defctx ++ "\n\nOperator "++ show opctx in -- if debug cli option is defined case (Ctx.merge defctx opctx) of Right ctx -> case Csa.checkCtx defs ctx of Nothing -> returnP Ir { include = happy_var_2 , declaration = Decl.new happy_var_4 , operators = ops , definitions = (reverse defs) , debug = debugMsg , operatorMap = opmap } Just errors -> failP (foldr1 (\e old -> e ++"\n"++ old) errors) Left (el1, el2) -> error "\nERROR: Merging of Definition and Operator Context failed!\n")}}}} ) (\r -> happyReturn (happyIn4 r)) happyReduce_2 = happySpecReduce_1 1# happyReduction_2 happyReduction_2 happy_x_1 = case happyOut21 happy_x_1 of { happy_var_1 -> happyIn5 (Incl.new happy_var_1 )} happyReduce_3 = happySpecReduce_1 2# happyReduction_3 happyReduction_3 happy_x_1 = case happyOut7 happy_x_1 of { happy_var_1 -> happyIn6 ((\(op, ctx) -> ([op], ctx)) (happy_var_1) )} happyReduce_4 = happyMonadReduce 3# 2# happyReduction_4 happyReduction_4 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut6 happy_x_1 of { happy_var_1 -> case happyOut7 happy_x_3 of { happy_var_3 -> ( let (ops, ctx) = happy_var_1 in let (nops, nctx) = happy_var_3 in case (Ctx.merge ctx nctx) of Right e -> returnP ( nops : ops, e) Left (el1, el2) -> errP (parseErrDupBind "Operator" el2 el1) (ops, ctx))}} ) (\r -> happyReturn (happyIn6 r)) happyReduce_5 = happySpecReduce_2 3# happyReduction_5 happyReduction_5 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut21 happy_x_2 of { happy_var_2 -> happyIn7 (if (C.isEmpty happy_var_2) then let o = op (Id.toIdent happy_var_1) in (o, Ctx.new (Elem.new o)) else let o = opMap (Id.toIdent happy_var_1) happy_var_2 in (o, Ctx.new (Elem.new o)) )}} happyReduce_6 = happySpecReduce_1 4# happyReduction_6 happyReduction_6 happy_x_1 = case happyOut9 happy_x_1 of { happy_var_1 -> happyIn8 ((\(d, ctx, opmap) -> ([d], ctx, opmap)) happy_var_1 )} happyReduce_7 = happyMonadReduce 2# 4# happyReduction_7 happyReduction_7 (happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut8 happy_x_1 of { happy_var_1 -> case happyOut9 happy_x_2 of { happy_var_2 -> ( let (ndef, nctx, opmap1) = happy_var_2 in let (odefs, octx, opmap2) = happy_var_1 in let opmap = M.unionWith (\a1 a2 -> S.union a1 a2) opmap1 opmap2 in -- CSA: Check for possible erroneous redefinitions, if this check -- fails we call failP instead of errP because otherwise we -- would get loads of subsequent errors due to missing definitions -- in our Context. This would only confuse the user. case (Ctx.merge nctx octx) of Right e -> returnP (ndef:odefs, e, opmap) Left (el1, el2) -> failP (parseErrDupBind "Non Terminal" el1 el2))}} ) (\r -> happyReturn (happyIn8 r)) happyReduce_8 = happyMonadReduce 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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut10 happy_x_4 of { happy_var_4 -> ( let def = Def.new (Id.toIdent happy_var_1) [] happy_var_2 (fst happy_var_4) in let ctx = Ctx.new (Elem.new def) in case Csa.checkDef def of Nothing -> returnP (def, ctx, snd happy_var_4) Just err -> errP (err) (def, ctx, snd happy_var_4))}}} ) (\r -> happyReturn (happyIn9 r)) happyReduce_9 = happyMonadReduce 8# 5# happyReduction_9 happyReduction_9 (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) tk = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut18 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_5 of { happy_var_5 -> case happyOut10 happy_x_7 of { happy_var_7 -> ( let def = Def.new (Id.toIdent happy_var_1) happy_var_3 happy_var_5 (fst happy_var_7) in let ctx = Ctx.new (Elem.new def) in case Csa.checkDef def of Nothing -> returnP (def, ctx, snd happy_var_7) Just err -> errP (err) (def, ctx, snd happy_var_7))}}}} ) (\r -> happyReturn (happyIn9 r)) happyReduce_10 = happySpecReduce_1 6# happyReduction_10 happyReduction_10 happy_x_1 = case happyOut11 happy_x_1 of { happy_var_1 -> happyIn10 (([ fst happy_var_1 ], snd happy_var_1) )} happyReduce_11 = happyMonadReduce 3# 6# happyReduction_11 happyReduction_11 (happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut10 happy_x_1 of { happy_var_1 -> case happyOut11 happy_x_3 of { happy_var_3 -> ( -- CSA: Check if all productions with the same ident have the same -- amount of parameters. case Csa.checkProd (fst happy_var_1) (fst happy_var_3) of Right prods -> returnP (prods, M.unionWith (\a1 a2 -> S.union a1 a2) (snd happy_var_1) (snd happy_var_3)) Left (n1, n2) -> errP (parseErrRedefinition "redefined with different amount of parameters at" (n1) (n2)) (((fst happy_var_3):(fst happy_var_1)), M.unionWith (\a1 a2 -> S.union a1 a2) (snd happy_var_1) (snd happy_var_3)))}} ) (\r -> happyReturn (happyIn10 r)) happyReduce_12 = happyReduce 5# 7# happyReduction_12 happyReduction_12 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut15 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut20 happy_x_5 of { happy_var_5 -> happyIn11 ((prod (N.new happy_var_2 happy_var_1 happy_var_3 N.empty C.empty N.empty C.empty) happy_var_5, M.singleton 0 $ S.singleton $ op (getId happy_var_2)) ) `HappyStk` happyRest}}}} happyReduce_13 = happyMonadReduce 11# 7# happyReduction_13 happyReduction_13 (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) tk = happyThen (case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut15 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_5 of { happy_var_5 -> case happyOut14 happy_x_6 of { happy_var_6 -> case happyOut21 happy_x_7 of { happy_var_7 -> case happyOut21 happy_x_9 of { happy_var_9 -> case happyOut20 happy_x_11 of { happy_var_11 -> ( let link = (N.new happy_var_6 C.empty C.empty N.empty C.empty N.empty C.empty) in let n = (N.new happy_var_2 happy_var_1 happy_var_3 N.empty C.empty N.empty happy_var_9) in let p = prod (N.setLink (N.addLinkCode n happy_var_5 happy_var_7) link) happy_var_11 in let opmap = M.singleton 0 $ S.singleton $ op (getId happy_var_2) in -- CSA: check duplicate bindings for T and Nt if (equalBindings happy_var_2 happy_var_6) then errP (parseErrDupBind "Binding" (Elem.new (B.getIdent (getBinding happy_var_6))) (Elem.new (B.getIdent (getBinding happy_var_2)))) (p, opmap) else returnP (p, opmap))}}}}}}}} ) (\r -> happyReturn (happyIn11 r)) happyReduce_14 = happyMonadReduce 7# 7# happyReduction_14 happyReduction_14 (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) tk = happyThen (case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut15 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_4 of { happy_var_4 -> case happyOut21 happy_x_5 of { happy_var_5 -> case happyOut20 happy_x_7 of { happy_var_7 -> ( let (ns, ctx, opmap) = happy_var_4 in let n = N.new happy_var_2 happy_var_1 happy_var_3 ns happy_var_5 N.empty C.empty in let p = prod n happy_var_7 in let opmap' = updateOpMap n opmap in -- CSA: check duplicate bindings case (Csa.updateCtx happy_var_2 ctx) of Right _ -> returnP (p, opmap') Left (el1 , el2) -> errP (parseErrDupBind "Binding" el1 el2) (p, opmap'))}}}}}} ) (\r -> happyReturn (happyIn11 r)) happyReduce_15 = happyMonadReduce 13# 7# happyReduction_15 happyReduction_15 (happy_x_13 `HappyStk` happy_x_12 `HappyStk` 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) tk = happyThen (case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut15 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut12 happy_x_4 of { happy_var_4 -> case happyOut21 happy_x_5 of { happy_var_5 -> case happyOut21 happy_x_7 of { happy_var_7 -> case happyOut14 happy_x_8 of { happy_var_8 -> case happyOut21 happy_x_9 of { happy_var_9 -> case happyOut21 happy_x_11 of { happy_var_11 -> case happyOut20 happy_x_13 of { happy_var_13 -> ( let link = N.new happy_var_8 C.empty C.empty N.empty C.empty N.empty C.empty in let (child, ctx, opmap) = happy_var_4 in let n = N.setLink (N.addLinkCode (N.new happy_var_2 happy_var_1 happy_var_3 child happy_var_5 N.empty happy_var_11) happy_var_7 happy_var_9) link in let p = prod n happy_var_13 in let opmap' = updateOpMap n opmap in -- CSA: check duplicate bindings -- 1: Check binding clashes for T in Context case (Csa.updateCtx happy_var_2 ctx) of Left (el1 , el2) -> errP (parseErrDupBind "Binding" el1 el2) (p, opmap') Right ctx1 -> -- 2: Check binding clashes for Nt in Context extended with T's binding case (Csa.updateCtx happy_var_8 ctx1) of Left (el1 , el2) -> errP (parseErrDupBind "Binding" el2 el1) (p, opmap') Right _ -> returnP (p, opmap'))}}}}}}}}}} ) (\r -> happyReturn (happyIn11 r)) happyReduce_16 = happyReduce 5# 7# happyReduction_16 happyReduction_16 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut14 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut20 happy_x_5 of { happy_var_5 -> happyIn11 ((prod (N.new happy_var_2 happy_var_1 happy_var_3 N.empty C.empty N.empty C.empty) happy_var_5, M.empty) ) `HappyStk` happyRest}}}} happyReduce_17 = happyMonadReduce 11# 7# happyReduction_17 happyReduction_17 (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) tk = happyThen (case happyOut21 happy_x_1 of { happy_var_1 -> case happyOut14 happy_x_2 of { happy_var_2 -> case happyOut21 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_5 of { happy_var_5 -> case happyOut14 happy_x_6 of { happy_var_6 -> case happyOut21 happy_x_7 of { happy_var_7 -> case happyOut21 happy_x_9 of { happy_var_9 -> case happyOut20 happy_x_11 of { happy_var_11 -> ( let link = (N.new happy_var_6 C.empty C.empty N.empty C.empty N.empty C.empty) in let n = N.new happy_var_2 happy_var_1 happy_var_3 N.empty C.empty N.empty happy_var_9 in let p = prod (N.setLink (N.addLinkCode n happy_var_5 happy_var_7) link) happy_var_11 in -- CSA: check duplicate bindings for Nt and Nt if (equalBindings happy_var_2 happy_var_6) then errP (parseErrDupBind "Binding" (Elem.new (B.getIdent (getBinding happy_var_6))) (Elem.new (B.getIdent (getBinding happy_var_2)))) (p, M.empty) else returnP (p, M.empty))}}}}}}}} ) (\r -> happyReturn (happyIn11 r)) happyReduce_18 = happyMonadReduce 6# 8# happyReduction_18 happyReduction_18 (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) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut13 happy_x_5 of { happy_var_5 -> ( let (ns, ctx, opmap) = happy_var_5 in let n = N.new happy_var_3 happy_var_2 happy_var_4 N.empty C.empty ns C.empty in -- CSA: Check for duplicate bindings case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap) Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap))}}}} ) (\r -> happyReturn (happyIn12 r)) happyReduce_19 = happyMonadReduce 6# 8# happyReduction_19 happyReduction_19 (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) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut15 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut13 happy_x_5 of { happy_var_5 -> ( let (ns, ctx, opmap) = happy_var_5 in let n = N.new happy_var_3 happy_var_2 happy_var_4 N.empty C.empty ns C.empty in let opmap' = updateOpMap n opmap in -- CSA: Check for duplicate bindings case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap') Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap'))}}}} ) (\r -> happyReturn (happyIn12 r)) happyReduce_20 = happyMonadReduce 8# 8# happyReduction_20 happyReduction_20 (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) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut15 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut12 happy_x_5 of { happy_var_5 -> case happyOut21 happy_x_6 of { happy_var_6 -> case happyOut13 happy_x_7 of { happy_var_7 -> ( let (ns1, ctx1, opmap1) = happy_var_5 in let (ns2, ctx2, opmap2) = happy_var_7 in let n = N.new happy_var_3 happy_var_2 happy_var_4 ns1 happy_var_6 ns2 C.empty in let opmap' = updateOpMap n (M.unionWith (\a1 a2 -> S.union a1 a2) opmap1 opmap2) in -- CSA: Check for duplicate bindings case Ctx.merge ctx2 ctx1 of Left (e1, e2) -> errP (parseErrDupBind "Binding" e1 e2) (n, ctx1, opmap') Right ctx -> case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap') Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap'))}}}}}} ) (\r -> happyReturn (happyIn12 r)) happyReduce_21 = happySpecReduce_0 9# happyReduction_21 happyReduction_21 = happyIn13 ((N.empty, Ctx.empty , M.empty) ) happyReduce_22 = happyMonadReduce 5# 9# happyReduction_22 happyReduction_22 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut14 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut13 happy_x_5 of { happy_var_5 -> ( let (ns, ctx, opmap) = happy_var_5 in let n = N.new happy_var_3 happy_var_2 happy_var_4 N.empty C.empty ns C.empty in -- CSA: Check for duplicate bindings case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap) Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap))}}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_23 = happyMonadReduce 5# 9# happyReduction_23 happyReduction_23 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut15 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut13 happy_x_5 of { happy_var_5 -> ( let (ns, ctx, opmap) = happy_var_5 in let n = N.new happy_var_3 happy_var_2 happy_var_4 N.empty C.empty ns C.empty in let opmap' = updateOpMap n opmap in -- CSA: Check for duplicate bindings case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap') Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap'))}}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_24 = happyMonadReduce 7# 9# happyReduction_24 happyReduction_24 (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) tk = happyThen (case happyOut21 happy_x_2 of { happy_var_2 -> case happyOut15 happy_x_3 of { happy_var_3 -> case happyOut21 happy_x_4 of { happy_var_4 -> case happyOut12 happy_x_5 of { happy_var_5 -> case happyOut21 happy_x_6 of { happy_var_6 -> case happyOut13 happy_x_7 of { happy_var_7 -> ( let (ns1, ctx1, opmap1) = happy_var_5 in let (ns2, ctx2, opmap2) = happy_var_7 in let n = N.new happy_var_3 happy_var_2 happy_var_4 ns1 happy_var_6 ns2 C.empty in let opmap' = updateOpMap n (M.unionWith (\a1 a2 -> S.union a1 a2) opmap1 opmap2) in -- CSA: Check for duplicate bindings case Ctx.merge ctx2 ctx1 of Left (e1, e2) -> failP (parseErrDupBind "Binding" e1 e2) Right ctx -> case (Csa.updateCtx happy_var_3 ctx) of Right e -> returnP (n, e, opmap') Left (el1, el2) -> errP (parseErrDupBind "Binding" el1 el2) (n, ctx, opmap'))}}}}}} ) (\r -> happyReturn (happyIn13 r)) happyReduce_25 = happySpecReduce_1 10# happyReduction_25 happyReduction_25 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn14 (nonTerminal (Nt.new (Id.toIdent happy_var_1) B.empty []) )} happyReduce_26 = happySpecReduce_2 10# happyReduction_26 happyReduction_26 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> happyIn14 (nonTerminal (Nt.new (Id.toIdent happy_var_1) (B.new (Id.toIdent happy_var_2)) []) )}} happyReduce_27 = happyReduce 4# 10# happyReduction_27 happyReduction_27 (happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut16 happy_x_3 of { happy_var_3 -> happyIn14 (nonTerminal (Nt.new (Id.toIdent happy_var_1) B.empty happy_var_3) ) `HappyStk` happyRest}} happyReduce_28 = happyReduce 5# 10# happyReduction_28 happyReduction_28 (happy_x_5 `HappyStk` happy_x_4 `HappyStk` happy_x_3 `HappyStk` happy_x_2 `HappyStk` happy_x_1 `HappyStk` happyRest) = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOut16 happy_x_3 of { happy_var_3 -> case happyOutTok happy_x_5 of { happy_var_5 -> happyIn14 (nonTerminal (Nt.new (Id.toIdent happy_var_1) (B.new (Id.toIdent happy_var_5)) happy_var_3) ) `HappyStk` happyRest}}} happyReduce_29 = happySpecReduce_1 11# happyReduction_29 happyReduction_29 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn15 (terminal (T.new (Id.toIdent happy_var_1) B.empty) )} happyReduce_30 = happySpecReduce_2 11# happyReduction_30 happyReduction_30 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> happyIn15 (terminal (T.new (Id.toIdent happy_var_1) (B.new (Id.toIdent happy_var_2))) )}} happyReduce_31 = happySpecReduce_1 12# happyReduction_31 happyReduction_31 happy_x_1 = case happyOut17 happy_x_1 of { happy_var_1 -> happyIn16 ([ happy_var_1 ] )} happyReduce_32 = happySpecReduce_3 12# happyReduction_32 happyReduction_32 happy_x_3 happy_x_2 happy_x_1 = case happyOut16 happy_x_1 of { happy_var_1 -> case happyOut17 happy_x_3 of { happy_var_3 -> happyIn16 (happy_var_1 ++ [ happy_var_3 ] )}} happyReduce_33 = happySpecReduce_1 13# happyReduction_33 happyReduction_33 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn17 (A.new (Id.toIdent happy_var_1) A.InAttr A.emptyTy )} happyReduce_34 = happySpecReduce_2 13# happyReduction_34 happyReduction_34 happy_x_2 happy_x_1 = case happyOutTok happy_x_2 of { happy_var_2 -> happyIn17 (A.new (Id.toIdent happy_var_2) A.OutAttr A.emptyTy )} happyReduce_35 = happySpecReduce_1 13# happyReduction_35 happyReduction_35 happy_x_1 = case happyOut19 happy_x_1 of { happy_var_1 -> happyIn17 (happy_var_1 )} happyReduce_36 = happySpecReduce_1 14# happyReduction_36 happyReduction_36 happy_x_1 = case happyOut19 happy_x_1 of { happy_var_1 -> happyIn18 ([ happy_var_1 ] )} happyReduce_37 = happySpecReduce_3 14# happyReduction_37 happyReduction_37 happy_x_3 happy_x_2 happy_x_1 = case happyOut18 happy_x_1 of { happy_var_1 -> case happyOut19 happy_x_3 of { happy_var_3 -> happyIn18 (happy_var_1 ++ [ happy_var_3 ] )}} happyReduce_38 = happySpecReduce_2 15# happyReduction_38 happyReduction_38 happy_x_2 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> case happyOutTok happy_x_2 of { happy_var_2 -> happyIn19 (A.new (Id.toIdent happy_var_2) A.InAttr (A.ty (Id.toIdent happy_var_1)) )}} happyReduce_39 = happySpecReduce_3 15# happyReduction_39 happyReduction_39 happy_x_3 happy_x_2 happy_x_1 = case happyOutTok happy_x_2 of { happy_var_2 -> case happyOutTok happy_x_3 of { happy_var_3 -> happyIn19 (A.new (Id.toIdent happy_var_3) A.OutAttr (A.ty (Id.toIdent happy_var_2)) )}} happyReduce_40 = happySpecReduce_1 16# happyReduction_40 happyReduction_40 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn20 (Cost.static (stringToInt (show (Id.toIdent happy_var_1))) )} happyReduce_41 = happySpecReduce_1 16# happyReduction_41 happyReduction_41 happy_x_1 = case happyOut21 happy_x_1 of { happy_var_1 -> happyIn20 (Cost.dynamic happy_var_1 )} happyReduce_42 = happySpecReduce_0 17# happyReduction_42 happyReduction_42 = happyIn21 (C.empty ) happyReduce_43 = happySpecReduce_1 17# happyReduction_43 happyReduction_43 happy_x_1 = case happyOutTok happy_x_1 of { happy_var_1 -> happyIn21 (C.new (show (Id.toIdent happy_var_1)) )} happyNewToken action sts stk [] = happyDoAction 23# notHappyAtAll action sts stk [] happyNewToken action sts stk (tk:tks) = let cont i = happyDoAction i tk action sts stk tks in case tk of { ConToken _ TCost _ -> cont 1#; ConToken _ TSemAction _ -> cont 2#; ConToken _ TKeyword "generator" -> cont 3#; ConToken _ TKeyword "declarations" -> cont 4#; ConToken _ TKeyword "operators" -> cont 5#; ConToken _ TKeyword "rules" -> cont 6#; ConToken _ TKeyword "end" -> cont 7#; ConToken _ TIdent _ -> cont 8#; ConToken _ TTerm _ -> cont 9#; ConToken _ TAttrIdent _ -> cont 10#; ConToken _ TAttrKeyword "out" -> cont 11#; ConToken _ TAttrStart "<:" -> cont 12#; ConToken _ TAttrEnd ":>" -> cont 13#; ConToken _ TComma _ -> cont 14#; ConToken _ TOr _ -> cont 15#; ConToken _ TBoxOpen _ -> cont 16#; ConToken _ TBoxClose _ -> cont 17#; ConToken _ TParenOpen _ -> cont 18#; ConToken _ TParenClose _ -> cont 19#; ConToken _ TAssign _ -> cont 20#; ConToken _ TColon _ -> cont 21#; ConToken _ TPeriod _ -> cont 22#; _ -> happyError' (tk:tks) } happyError_ tk tks = happyError' (tk:tks) happyThen :: () => P a -> (a -> P b) -> P b happyThen = (thenP) happyReturn :: () => a -> P a happyReturn = (returnP) happyThen1 m k tks = (thenP) m (\a -> k a tks) happyReturn1 :: () => a -> b -> P a happyReturn1 = \a tks -> (returnP) a happyError' :: () => [Token] -> P a happyError' = happyError parse tks = happySomeParser where happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) happySeq = happyDontSeq ----------------------------------------------------------------------------- -- | Monad P deals with Parse Results type P a = ParseResult a -- | ParseResult type data ParseResult a = ParseOk a -- ^ Successful parse | ParseErr [String] a -- ^ Parse contained errors | ParseFail String -- ^ Fatal error happened deriving (Show, Eq, Ord) thenP :: P a -> (a -> P b) -> P b m `thenP` k = case m of ParseOk a -> k a -- Indicates sucessful parse ParseErr err a -> -- Indicates CSA errors case k a of ParseOk a -> ParseErr err a ParseErr nerr a -> ParseErr (err ++ nerr) a ParseFail errmsg -> ParseFail (concat (err ++ [errmsg])) ParseFail err -> ParseFail err -- Indicates a serious CSA error returnP :: a -> P a returnP ok = ParseOk ok failP :: String -> P a failP err = ParseFail err errP :: String -> a -> P a errP errmsg rest = ParseErr [ errmsg ] rest updateOpMap :: N.Node -> OperatorMap -> OperatorMap updateOpMap n opmap = M.alter (\a -> if (isJust a) then Just $ S.insert (op $ getId n) (fromJust a) else Just $ S.singleton (op $ getId n)) (length (N.getChildren n)) opmap -- Called by Happy if a parse error occurs happyError :: [Token] -> P a happyError [] = failP ("\nParse Error at unknown token? Sorry!\n") happyError (tok:toks) = failP (parseErrTok tok (show (Id.toIdent tok))) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 28 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Int# Happy_IntList {-# LINE 49 "templates/GenericTemplate.hs" #-} {-# LINE 59 "templates/GenericTemplate.hs" #-} {-# LINE 68 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) ----------------------------------------------------------------------------- -- starting the parse happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll ----------------------------------------------------------------------------- -- Accepting the parse -- If the current token is 0#, it means we've just accepted a partial -- parse (a %partial parser). We must ignore the saved token on the top of -- the stack in this case. happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action happyDoAction i tk st = {- nothing -} case action of 0# -> {- nothing -} happyFail i tk st -1# -> {- nothing -} happyAccept i tk st n | (n <# (0# :: Int#)) -> {- nothing -} (happyReduceArr ! rule) i tk st where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) n -> {- nothing -} happyShift new_state i tk st where new_state = (n -# (1# :: Int#)) where off = indexShortOffAddr happyActOffsets st off_i = (off +# i) check = if (off_i >=# (0# :: Int#)) then (indexShortOffAddr happyCheck off_i ==# i) else False action | check = indexShortOffAddr happyTable off_i | otherwise = indexShortOffAddr happyDefActions st {-# LINE 127 "templates/GenericTemplate.hs" #-} indexShortOffAddr (HappyA# arr) off = #if __GLASGOW_HASKELL__ > 500 narrow16Int# i #elif __GLASGOW_HASKELL__ == 500 intToInt16# i #else (i `iShiftL#` 16#) `iShiftRA#` 16# #endif where #if __GLASGOW_HASKELL__ >= 503 i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) #else i = word2Int# ((high `shiftL#` 8#) `or#` low) #endif high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) low = int2Word# (ord# (indexCharOffAddr# arr off')) off' = off *# 2# data HappyAddr = HappyA# Addr# ----------------------------------------------------------------------------- -- HappyState data type (not arrays) {-# LINE 170 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in -- trace "shifting the error token" $ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) happyShift new_state i tk st sts stk = happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) -- happyReduce is specialised for the common cases. happySpecReduce_0 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_0 nt fn j tk st@((action)) sts stk = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) happySpecReduce_1 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') = let r = fn v1 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_2 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') = let r = fn v1 v2 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happySpecReduce_3 i fn 0# tk st sts stk = happyFail 0# tk st sts stk happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') = let r = fn v1 v2 v3 in happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) happyReduce k i fn 0# tk st sts stk = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k -# (1# :: Int#)) sts of sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r) happyMonadReduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk off = indexShortOffAddr happyGotoOffsets st1 off_i = (off +# nt) new_state = indexShortOffAddr happyTable off_i happyDrop 0# l = l happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t happyDropStk 0# l = l happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state where off = indexShortOffAddr happyGotoOffsets st off_i = (off +# nt) new_state = indexShortOffAddr happyTable off_i ----------------------------------------------------------------------------- -- Error recovery (0# is the error token) -- parse error if we are in recovery and we fail again happyFail 0# tk old_st _ stk = -- trace "failing" $ happyError_ tk {- We don't need state discarding for our restricted implementation of "error". In fact, it can cause some bogus parses, so I've disabled it for now --SDM -- discard a state happyFail 0# tk old_st (HappyCons ((action)) (sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $ happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) -- Internal happy errors: notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions happyTcHack :: Int# -> a -> a happyTcHack x y = y {-# INLINE happyTcHack #-} ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits -- happySeq = happyDoSeq -- otherwise it emits -- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b happyDontSeq a b = b ----------------------------------------------------------------------------- -- Don't inline any functions from the template. GHC has a nasty habit -- of deciding to inline happyGoto everywhere, which increases the size of -- the generated parser quite a bit. {-# NOINLINE happyDoAction #-} {-# NOINLINE happyTable #-} {-# NOINLINE happyCheck #-} {-# NOINLINE happyActOffsets #-} {-# NOINLINE happyGotoOffsets #-} {-# NOINLINE happyDefActions #-} {-# NOINLINE happyShift #-} {-# NOINLINE happySpecReduce_0 #-} {-# NOINLINE happySpecReduce_1 #-} {-# NOINLINE happySpecReduce_2 #-} {-# NOINLINE happySpecReduce_3 #-} {-# NOINLINE happyReduce #-} {-# NOINLINE happyMonadReduce #-} {-# NOINLINE happyGoto #-} {-# NOINLINE happyFail #-} -- end of Happy Template.