{-# OPTIONS_GHC -w #-} {-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-} module Parser where import Lexer hiding (main) import Spec import Spec0 import Convert0 import Control.Monad.State import qualified Data.Array as Happy_Data_Array import qualified Data.Bits as Bits import Control.Applicative(Applicative(..)) import Control.Monad (ap) -- parser produced by Happy Version 1.19.11 data HappyAbsSyn = HappyTerminal (Lexeme) | HappyErrorToken Int | HappyAbsSyn5 ([DProgramSpec0 Pos]) | HappyAbsSyn6 (DProgramSpec0 Pos) | HappyAbsSyn7 ([ DRecordSpec Pos]) | HappyAbsSyn8 (DRecordSpec Pos) | HappyAbsSyn9 ([(DField Pos, DType Pos)]) | HappyAbsSyn10 ((DField Pos, DType Pos)) | HappyAbsSyn11 (DField Pos) | HappyAbsSyn12 (DType Pos) | HappyAbsSyn13 ([DType Pos]) | HappyAbsSyn14 (()) | HappyAbsSyn16 (([DSmplDef0 Pos], DExpr0 Pos)) | HappyAbsSyn17 ([DSmplDef0 Pos]) | HappyAbsSyn18 (DSmplDef0 Pos) | HappyAbsSyn23 (DVar Pos) | HappyAbsSyn24 ([DVar Pos]) | HappyAbsSyn26 (DExpr0 Pos) | HappyAbsSyn32 (String) | HappyAbsSyn36 ([DField Pos]) | HappyAbsSyn37 (DTableExpr Pos) | HappyAbsSyn39 (DTermination0 Pos) | HappyAbsSyn42 ([DExpr0 Pos]) | HappyAbsSyn44 (DGen Pos) | HappyAbsSyn45 (DAgg0 Pos) | HappyAbsSyn46 (DConstructor Pos) | HappyAbsSyn47 (DConst Pos) {- to allow type-synonyms as our monads (likely - with explicitly-specified bind and return) - in Haskell98, it seems that with - /type M a = .../, then /(HappyReduction M)/ - is not allowed. But Happy is a - code-generator that can just substitute it. type HappyReduction m = Int -> (Lexeme) -> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> m HappyAbsSyn) -> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> m HappyAbsSyn)] -> HappyStk HappyAbsSyn -> [(Lexeme)] -> m HappyAbsSyn -} action_0, action_1, action_2, action_3, action_4, action_5, action_6, action_7, action_8, action_9, action_10, action_11, action_12, action_13, action_14, action_15, action_16, action_17, action_18, action_19, action_20, action_21, action_22, action_23, action_24, action_25, action_26, action_27, action_28, action_29, action_30, action_31, action_32, action_33, action_34, action_35, action_36, action_37, action_38, action_39, action_40, action_41, action_42, action_43, action_44, action_45, action_46, action_47, action_48, action_49, action_50, action_51, action_52, action_53, action_54, action_55, action_56, action_57, action_58, action_59, action_60, action_61, action_62, action_63, action_64, action_65, action_66, action_67, action_68, action_69, action_70, action_71, action_72, action_73, action_74, action_75, action_76, action_77, action_78, action_79, action_80, action_81, action_82, action_83, action_84, action_85, action_86, action_87, action_88, action_89, action_90, action_91, action_92, action_93, action_94, action_95, action_96, action_97, action_98, action_99, action_100, action_101, action_102, action_103, action_104, action_105, action_106, action_107, action_108, action_109, action_110, action_111, action_112, action_113, action_114, action_115, action_116, action_117, action_118, action_119, action_120, action_121, action_122, action_123, action_124, action_125, action_126, action_127, action_128, action_129, action_130, action_131, action_132, action_133, action_134, action_135, action_136, action_137, action_138, action_139, action_140, action_141, action_142, action_143, action_144, action_145, action_146, action_147, action_148, action_149, action_150, action_151, action_152, action_153, action_154, action_155, action_156, action_157, action_158, action_159, action_160, action_161, action_162, action_163, action_164, action_165, action_166, action_167, action_168, action_169, action_170, action_171, action_172, action_173, action_174, action_175, action_176, action_177, action_178, action_179, action_180, action_181, action_182, action_183, action_184, action_185, action_186, action_187, action_188, action_189, action_190, action_191, action_192, action_193, action_194, action_195, action_196, action_197, action_198, action_199, action_200, action_201, action_202, action_203, action_204, action_205, action_206, action_207, action_208, action_209, action_210, action_211, action_212, action_213, action_214, action_215, action_216, action_217, action_218, action_219, action_220, action_221, action_222, action_223, action_224, action_225, action_226, action_227, action_228, action_229, action_230, action_231 :: () => Int -> ({-HappyReduction (CM) = -} Int -> (Lexeme) -> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn) -> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)] -> HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn) happyReduce_2, happyReduce_3, happyReduce_4, happyReduce_5, happyReduce_6, happyReduce_7, happyReduce_8, happyReduce_9, happyReduce_10, happyReduce_11, happyReduce_12, happyReduce_13, happyReduce_14, happyReduce_15, happyReduce_16, happyReduce_17, happyReduce_18, happyReduce_19, happyReduce_20, happyReduce_21, happyReduce_22, happyReduce_23, happyReduce_24, happyReduce_25, happyReduce_26, happyReduce_27, happyReduce_28, happyReduce_29, happyReduce_30, happyReduce_31, happyReduce_32, happyReduce_33, happyReduce_34, happyReduce_35, happyReduce_36, happyReduce_37, happyReduce_38, happyReduce_39, happyReduce_40, happyReduce_41, happyReduce_42, happyReduce_43, happyReduce_44, happyReduce_45, happyReduce_46, happyReduce_47, happyReduce_48, happyReduce_49, happyReduce_50, happyReduce_51, happyReduce_52, happyReduce_53, happyReduce_54, happyReduce_55, happyReduce_56, happyReduce_57, happyReduce_58, happyReduce_59, happyReduce_60, happyReduce_61, happyReduce_62, happyReduce_63, happyReduce_64, happyReduce_65, happyReduce_66, happyReduce_67, happyReduce_68, happyReduce_69, happyReduce_70, happyReduce_71, happyReduce_72, happyReduce_73, happyReduce_74, happyReduce_75, happyReduce_76, happyReduce_77, happyReduce_78, happyReduce_79, happyReduce_80, happyReduce_81, happyReduce_82, happyReduce_83, happyReduce_84, happyReduce_85, happyReduce_86, happyReduce_87, happyReduce_88, happyReduce_89, happyReduce_90, happyReduce_91, happyReduce_92, happyReduce_93, happyReduce_94, happyReduce_95, happyReduce_96, happyReduce_97, happyReduce_98, happyReduce_99, happyReduce_100, happyReduce_101, happyReduce_102, happyReduce_103, happyReduce_104, happyReduce_105, happyReduce_106, happyReduce_107, happyReduce_108, happyReduce_109, happyReduce_110, happyReduce_111, happyReduce_112, happyReduce_113, happyReduce_114 :: () => ({-HappyReduction (CM) = -} Int -> (Lexeme) -> HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn) -> [HappyState (Lexeme) (HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn)] -> HappyStk HappyAbsSyn -> [(Lexeme)] -> (CM) HappyAbsSyn) happyExpList :: Happy_Data_Array.Array Int Int happyExpList = Happy_Data_Array.listArray (0,847) ([0,0,0,0,0,0,0,0,0,0,65408,58371,0,33312,31,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,4100,0,0,0,0,0,64,63520,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,61440,15,0,0,0,0,0,0,896,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8192,0,0,0,0,0,0,4096,124,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8188,1824,0,64529,0,0,0,0,0,0,0,2,0,0,0,0,0,0,16,0,0,0,0,0,0,128,0,0,0,0,0,0,1024,0,0,0,4094,896,32768,32264,0,0,0,0,0,0,0,1,0,0,0,0,0,0,8,0,0,0,0,0,0,64,0,0,57344,255,56,32768,2016,0,0,0,2047,456,16384,16132,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,512,16384,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,0,1,0,0,0,0,0,0,0,512,0,0,0,0,0,0,4096,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,31760,0,0,0,65504,14592,0,57480,7,0,0,0,0,0,0,16,0,0,63488,63,14,8192,504,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,65408,57347,0,33312,31,0,0,64512,31,7,4352,252,0,0,57344,255,56,34816,2016,0,0,0,2047,448,16384,16132,0,0,0,16376,3584,0,63522,1,0,0,65472,28673,0,49424,15,0,0,65024,32783,3,2176,126,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8188,1792,0,64529,0,0,0,65504,14336,0,57480,7,0,0,0,0,0,1024,31,0,0,0,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,4096,0,0,0,0,0,0,0,1,0,0,0,0,0,0,4,0,0,0,0,128,0,0,0,0,0,0,1024,32768,0,0,0,0,0,2048,0,0,0,0,0,0,512,0,0,0,0,0,0,0,2,0,2,0,0,65280,51719,1,1088,63,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3072,0,0,0,0,0,0,24576,0,0,0,0,0,0,0,3,0,0,0,0,0,0,24,0,0,0,0,0,0,192,0,0,0,0,0,0,1536,0,0,0,0,0,0,49152,0,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,2048,0,0,0,0,0,0,32768,0,0,0,0,0,512,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,512,0,0,0,64512,31,7,4352,252,0,0,57344,255,57,34816,2016,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,32768,0,0,0,0,0,0,0,0,256,0,0,0,0,0,0,0,0,0,0,57344,1,0,16,0,0,0,0,0,0,0,2,0,0,0,0,0,1024,16,0,0,0,0,0,0,128,0,0,49152,511,112,4096,4033,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,512,8,0,0,0,0,0,0,0,0,0,57344,16639,57,34816,2016,0,0,0,0,64,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,4,0,0,0,0,32,0,0,0,0,0,0,0,0,256,0,0,0,0,0,0,0,0,0,0,8188,1832,0,64529,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0,8,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,192,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,61440,32895,28,17408,1008,0,0,0,0,0,0,2,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,65280,49159,1,1088,63,0,0,0,0,512,16384,0,0,0,49152,511,114,4096,4033,0,0,0,0,0,0,0,0,0,0,0,0,1024,0,0,0,0,0,0,0,1024,0,0,0,0,0,1024,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0,128,0,1,0,0,0,0,128,0,256,0,0,32768,1023,228,8192,8066,0,0,0,0,0,0,16400,0,0,0,65504,14656,0,57480,7,0,0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,4096,0,8,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32768,0,0,0,0,0,0,0,0,0,0,0,0,0,0,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16384,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4096,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,32768,15,0,0,64,2,0,0,0,0,0,0,8,0,0,0,1024,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8196,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,31,0,0,128,4,0,0,248,0,0,1024,32,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,4094,912,32768,32264,0,0,0,0,0,0,128,0,0,0,0,0,3,0,0,0,0,0,0,256,8192,0,0,0,0,0,2048,0,1,0,0,63488,0,0,0,8196,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,128,4096,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,57344,3,0,0,32784,0,0,0,0,0,0,0,0,0,0,248,0,0,1024,32,0,0,0,0,0,0,0,0,0,0,0,0,0,1024,0,0,0,0,0,0,8192,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ]) {-# NOINLINE happyExpListPerState #-} happyExpListPerState st = token_strs_expected where token_strs = ["error","%dummy","%start_fregelparser","%start_exprparser","programSpecs","programSpec","recordSpecs","recordSpec","fieldSpecs","fieldSpec","field","type","types","opt_deriving","deriving_constructors","exprWithSmplDefs","smplDefs","smplDef","defFun","defVar","defTuple","defVertComp","var","vars","csVars","expr","expr8","expr7","expr6","expr5","expr4","op4","expr3","op3","expr2","dhsFields","tableExpr","expr1","termination","predExpr","expr0","expr0s","csExprs","gen","agg","constructor","constVal","T_INT","T_BOOL","T_DOUBLE","T_STRING","T_PAIR","A_SUM","A_PROD","A_MINIMUM","A_MAXIMUM","A_OR","A_AND","A_RANDOM","G_FREGEL","G_GMAP","G_GZIP","G_GITER","TC_FIX","TC_ITER","TC_UNTIL","TC_WHILE","DATA","DERIVING","LET","IN","IF","THEN","ELSE","CURR","PREV","VAL","IS","RS","GOF","EQUAL","DBLCOLON","COMMA","SEMICOLON","BACKSLASH","RARROW","LARROW","DOTHAT","PIPE","DBLAND","DBLOR","EQ","NE","LT","LE","GT","GE","PLUS","MINUS","AST","SLASH","BACKQUOTE","LPAREN","RPAREN","LBRACE","RBRACE","LBRACKET","RBRACKET","BOOL","INT","FLOAT","STRING","IDENT","CONSTRUCTOR","%eof"] bit_start = st * 115 bit_end = (st + 1) * 115 read_bit = readArrayBit happyExpList bits = map read_bit [bit_start..bit_end - 1] bits_indexed = zip bits [0..114] token_strs_expected = concatMap f bits_indexed f (False, _) = [] f (True, nr) = [token_strs !! nr] action_0 (5) = happyGoto action_43 action_0 (6) = happyGoto action_3 action_0 (7) = happyGoto action_4 action_0 _ = happyReduce_5 action_1 (53) = happyShift action_20 action_1 (54) = happyShift action_21 action_1 (55) = happyShift action_22 action_1 (56) = happyShift action_23 action_1 (57) = happyShift action_24 action_1 (58) = happyShift action_25 action_1 (59) = happyShift action_26 action_1 (60) = happyShift action_27 action_1 (61) = happyShift action_28 action_1 (62) = happyShift action_29 action_1 (63) = happyShift action_30 action_1 (72) = happyShift action_31 action_1 (75) = happyShift action_32 action_1 (76) = happyShift action_33 action_1 (77) = happyShift action_34 action_1 (99) = happyShift action_35 action_1 (103) = happyShift action_36 action_1 (109) = happyShift action_37 action_1 (110) = happyShift action_38 action_1 (111) = happyShift action_39 action_1 (112) = happyShift action_40 action_1 (113) = happyShift action_41 action_1 (114) = happyShift action_42 action_1 (23) = happyGoto action_5 action_1 (26) = happyGoto action_6 action_1 (27) = happyGoto action_7 action_1 (28) = happyGoto action_8 action_1 (29) = happyGoto action_9 action_1 (30) = happyGoto action_10 action_1 (31) = happyGoto action_11 action_1 (33) = happyGoto action_12 action_1 (35) = happyGoto action_13 action_1 (37) = happyGoto action_14 action_1 (38) = happyGoto action_15 action_1 (41) = happyGoto action_16 action_1 (45) = happyGoto action_17 action_1 (46) = happyGoto action_18 action_1 (47) = happyGoto action_19 action_1 _ = happyFail (happyExpListPerState 1) action_2 (6) = happyGoto action_3 action_2 (7) = happyGoto action_4 action_2 _ = happyFail (happyExpListPerState 2) action_3 _ = happyReduce_2 action_4 (68) = happyShift action_85 action_4 (103) = happyShift action_86 action_4 (113) = happyShift action_41 action_4 (8) = happyGoto action_78 action_4 (18) = happyGoto action_79 action_4 (19) = happyGoto action_80 action_4 (20) = happyGoto action_81 action_4 (21) = happyGoto action_82 action_4 (22) = happyGoto action_83 action_4 (23) = happyGoto action_84 action_4 _ = happyFail (happyExpListPerState 4) action_5 (88) = happyShift action_77 action_5 (103) = happyShift action_36 action_5 (109) = happyShift action_37 action_5 (110) = happyShift action_38 action_5 (111) = happyShift action_39 action_5 (112) = happyShift action_40 action_5 (113) = happyShift action_41 action_5 (23) = happyGoto action_56 action_5 (41) = happyGoto action_57 action_5 (42) = happyGoto action_76 action_5 (47) = happyGoto action_19 action_5 _ = happyReduce_92 action_6 (1) = happyAccept action_6 _ = happyFail (happyExpListPerState 6) action_7 _ = happyReduce_44 action_8 (91) = happyShift action_75 action_8 _ = happyReduce_46 action_9 (90) = happyShift action_74 action_9 _ = happyReduce_48 action_10 _ = happyReduce_50 action_11 (92) = happyShift action_66 action_11 (93) = happyShift action_67 action_11 (94) = happyShift action_68 action_11 (95) = happyShift action_69 action_11 (96) = happyShift action_70 action_11 (97) = happyShift action_71 action_11 (98) = happyShift action_72 action_11 (99) = happyShift action_73 action_11 (32) = happyGoto action_65 action_11 _ = happyReduce_57 action_12 (100) = happyShift action_62 action_12 (101) = happyShift action_63 action_12 (102) = happyShift action_64 action_12 (34) = happyGoto action_61 action_12 _ = happyReduce_60 action_13 _ = happyReduce_65 action_14 (88) = happyShift action_60 action_14 _ = happyReduce_69 action_15 _ = happyReduce_71 action_16 _ = happyReduce_80 action_17 (107) = happyShift action_59 action_17 _ = happyFail (happyExpListPerState 17) action_18 (103) = happyShift action_36 action_18 (109) = happyShift action_37 action_18 (110) = happyShift action_38 action_18 (111) = happyShift action_39 action_18 (112) = happyShift action_40 action_18 (113) = happyShift action_41 action_18 (23) = happyGoto action_56 action_18 (41) = happyGoto action_57 action_18 (42) = happyGoto action_58 action_18 (47) = happyGoto action_19 action_18 _ = happyFail (happyExpListPerState 18) action_19 _ = happyReduce_91 action_20 _ = happyReduce_105 action_21 _ = happyReduce_106 action_22 _ = happyReduce_103 action_23 _ = happyReduce_104 action_24 _ = happyReduce_108 action_25 _ = happyReduce_107 action_26 (53) = happyShift action_20 action_26 (54) = happyShift action_21 action_26 (55) = happyShift action_22 action_26 (56) = happyShift action_23 action_26 (57) = happyShift action_24 action_26 (58) = happyShift action_25 action_26 (59) = happyShift action_26 action_26 (60) = happyShift action_27 action_26 (61) = happyShift action_28 action_26 (62) = happyShift action_29 action_26 (63) = happyShift action_30 action_26 (72) = happyShift action_31 action_26 (75) = happyShift action_32 action_26 (76) = happyShift action_33 action_26 (77) = happyShift action_34 action_26 (99) = happyShift action_35 action_26 (103) = happyShift action_36 action_26 (109) = happyShift action_37 action_26 (110) = happyShift action_38 action_26 (111) = happyShift action_39 action_26 (112) = happyShift action_40 action_26 (113) = happyShift action_41 action_26 (114) = happyShift action_42 action_26 (23) = happyGoto action_5 action_26 (26) = happyGoto action_55 action_26 (27) = happyGoto action_7 action_26 (28) = happyGoto action_8 action_26 (29) = happyGoto action_9 action_26 (30) = happyGoto action_10 action_26 (31) = happyGoto action_11 action_26 (33) = happyGoto action_12 action_26 (35) = happyGoto action_13 action_26 (37) = happyGoto action_14 action_26 (38) = happyGoto action_15 action_26 (41) = happyGoto action_16 action_26 (45) = happyGoto action_17 action_26 (46) = happyGoto action_18 action_26 (47) = happyGoto action_19 action_26 _ = happyFail (happyExpListPerState 26) action_27 (113) = happyShift action_41 action_27 (23) = happyGoto action_54 action_27 _ = happyFail (happyExpListPerState 27) action_28 (113) = happyShift action_41 action_28 (23) = happyGoto action_53 action_28 _ = happyFail (happyExpListPerState 28) action_29 (113) = happyShift action_41 action_29 (23) = happyGoto action_52 action_29 _ = happyFail (happyExpListPerState 29) action_30 (113) = happyShift action_41 action_30 (23) = happyGoto action_51 action_30 _ = happyFail (happyExpListPerState 30) action_31 (53) = happyShift action_20 action_31 (54) = happyShift action_21 action_31 (55) = happyShift action_22 action_31 (56) = happyShift action_23 action_31 (57) = happyShift action_24 action_31 (58) = happyShift action_25 action_31 (59) = happyShift action_26 action_31 (60) = happyShift action_27 action_31 (61) = happyShift action_28 action_31 (62) = happyShift action_29 action_31 (63) = happyShift action_30 action_31 (75) = happyShift action_32 action_31 (76) = happyShift action_33 action_31 (77) = happyShift action_34 action_31 (99) = happyShift action_35 action_31 (103) = happyShift action_36 action_31 (109) = happyShift action_37 action_31 (110) = happyShift action_38 action_31 (111) = happyShift action_39 action_31 (112) = happyShift action_40 action_31 (113) = happyShift action_41 action_31 (114) = happyShift action_42 action_31 (23) = happyGoto action_5 action_31 (28) = happyGoto action_50 action_31 (29) = happyGoto action_9 action_31 (30) = happyGoto action_10 action_31 (31) = happyGoto action_11 action_31 (33) = happyGoto action_12 action_31 (35) = happyGoto action_13 action_31 (37) = happyGoto action_14 action_31 (38) = happyGoto action_15 action_31 (41) = happyGoto action_16 action_31 (45) = happyGoto action_17 action_31 (46) = happyGoto action_18 action_31 (47) = happyGoto action_19 action_31 _ = happyFail (happyExpListPerState 31) action_32 (113) = happyShift action_41 action_32 (23) = happyGoto action_49 action_32 _ = happyFail (happyExpListPerState 32) action_33 (113) = happyShift action_41 action_33 (23) = happyGoto action_48 action_33 _ = happyFail (happyExpListPerState 33) action_34 (113) = happyShift action_41 action_34 (23) = happyGoto action_47 action_34 _ = happyFail (happyExpListPerState 34) action_35 (53) = happyShift action_20 action_35 (54) = happyShift action_21 action_35 (55) = happyShift action_22 action_35 (56) = happyShift action_23 action_35 (57) = happyShift action_24 action_35 (58) = happyShift action_25 action_35 (59) = happyShift action_26 action_35 (60) = happyShift action_27 action_35 (61) = happyShift action_28 action_35 (62) = happyShift action_29 action_35 (63) = happyShift action_30 action_35 (75) = happyShift action_32 action_35 (76) = happyShift action_33 action_35 (77) = happyShift action_34 action_35 (103) = happyShift action_36 action_35 (109) = happyShift action_37 action_35 (110) = happyShift action_38 action_35 (111) = happyShift action_39 action_35 (112) = happyShift action_40 action_35 (113) = happyShift action_41 action_35 (114) = happyShift action_42 action_35 (23) = happyGoto action_5 action_35 (35) = happyGoto action_46 action_35 (37) = happyGoto action_14 action_35 (38) = happyGoto action_15 action_35 (41) = happyGoto action_16 action_35 (45) = happyGoto action_17 action_35 (46) = happyGoto action_18 action_35 (47) = happyGoto action_19 action_35 _ = happyFail (happyExpListPerState 35) action_36 (53) = happyShift action_20 action_36 (54) = happyShift action_21 action_36 (55) = happyShift action_22 action_36 (56) = happyShift action_23 action_36 (57) = happyShift action_24 action_36 (58) = happyShift action_25 action_36 (59) = happyShift action_26 action_36 (60) = happyShift action_27 action_36 (61) = happyShift action_28 action_36 (62) = happyShift action_29 action_36 (63) = happyShift action_30 action_36 (72) = happyShift action_31 action_36 (75) = happyShift action_32 action_36 (76) = happyShift action_33 action_36 (77) = happyShift action_34 action_36 (99) = happyShift action_35 action_36 (103) = happyShift action_36 action_36 (109) = happyShift action_37 action_36 (110) = happyShift action_38 action_36 (111) = happyShift action_39 action_36 (112) = happyShift action_40 action_36 (113) = happyShift action_41 action_36 (114) = happyShift action_42 action_36 (23) = happyGoto action_5 action_36 (26) = happyGoto action_45 action_36 (27) = happyGoto action_7 action_36 (28) = happyGoto action_8 action_36 (29) = happyGoto action_9 action_36 (30) = happyGoto action_10 action_36 (31) = happyGoto action_11 action_36 (33) = happyGoto action_12 action_36 (35) = happyGoto action_13 action_36 (37) = happyGoto action_14 action_36 (38) = happyGoto action_15 action_36 (41) = happyGoto action_16 action_36 (45) = happyGoto action_17 action_36 (46) = happyGoto action_18 action_36 (47) = happyGoto action_19 action_36 _ = happyFail (happyExpListPerState 36) action_37 _ = happyReduce_113 action_38 _ = happyReduce_111 action_39 _ = happyReduce_112 action_40 _ = happyReduce_114 action_41 _ = happyReduce_39 action_42 _ = happyReduce_110 action_43 (84) = happyShift action_44 action_43 (115) = happyAccept action_43 _ = happyFail (happyExpListPerState 43) action_44 (6) = happyGoto action_117 action_44 (7) = happyGoto action_4 action_44 _ = happyReduce_5 action_45 (83) = happyShift action_115 action_45 (104) = happyShift action_116 action_45 _ = happyFail (happyExpListPerState 45) action_46 _ = happyReduce_64 action_47 _ = happyReduce_76 action_48 _ = happyReduce_75 action_49 _ = happyReduce_74 action_50 (73) = happyShift action_114 action_50 (91) = happyShift action_75 action_50 _ = happyFail (happyExpListPerState 50) action_51 (113) = happyShift action_41 action_51 (23) = happyGoto action_113 action_51 _ = happyFail (happyExpListPerState 51) action_52 (113) = happyShift action_41 action_52 (23) = happyGoto action_112 action_52 _ = happyFail (happyExpListPerState 52) action_53 (113) = happyShift action_41 action_53 (23) = happyGoto action_111 action_53 _ = happyFail (happyExpListPerState 53) action_54 (113) = happyShift action_41 action_54 (23) = happyGoto action_110 action_54 _ = happyFail (happyExpListPerState 54) action_55 _ = happyReduce_109 action_56 _ = happyReduce_92 action_57 _ = happyReduce_95 action_58 (103) = happyShift action_36 action_58 (109) = happyShift action_37 action_58 (110) = happyShift action_38 action_58 (111) = happyShift action_39 action_58 (112) = happyShift action_40 action_58 (113) = happyShift action_41 action_58 (23) = happyGoto action_56 action_58 (41) = happyGoto action_96 action_58 (47) = happyGoto action_19 action_58 _ = happyReduce_78 action_59 (53) = happyShift action_20 action_59 (54) = happyShift action_21 action_59 (55) = happyShift action_22 action_59 (56) = happyShift action_23 action_59 (57) = happyShift action_24 action_59 (58) = happyShift action_25 action_59 (59) = happyShift action_26 action_59 (60) = happyShift action_27 action_59 (61) = happyShift action_28 action_59 (62) = happyShift action_29 action_59 (63) = happyShift action_30 action_59 (72) = happyShift action_31 action_59 (75) = happyShift action_32 action_59 (76) = happyShift action_33 action_59 (77) = happyShift action_34 action_59 (99) = happyShift action_35 action_59 (103) = happyShift action_36 action_59 (109) = happyShift action_37 action_59 (110) = happyShift action_38 action_59 (111) = happyShift action_39 action_59 (112) = happyShift action_40 action_59 (113) = happyShift action_41 action_59 (114) = happyShift action_42 action_59 (23) = happyGoto action_5 action_59 (26) = happyGoto action_109 action_59 (27) = happyGoto action_7 action_59 (28) = happyGoto action_8 action_59 (29) = happyGoto action_9 action_59 (30) = happyGoto action_10 action_59 (31) = happyGoto action_11 action_59 (33) = happyGoto action_12 action_59 (35) = happyGoto action_13 action_59 (37) = happyGoto action_14 action_59 (38) = happyGoto action_15 action_59 (41) = happyGoto action_16 action_59 (45) = happyGoto action_17 action_59 (46) = happyGoto action_18 action_59 (47) = happyGoto action_19 action_59 _ = happyFail (happyExpListPerState 59) action_60 (113) = happyShift action_95 action_60 (11) = happyGoto action_93 action_60 (36) = happyGoto action_108 action_60 _ = happyFail (happyExpListPerState 60) action_61 (53) = happyShift action_20 action_61 (54) = happyShift action_21 action_61 (55) = happyShift action_22 action_61 (56) = happyShift action_23 action_61 (57) = happyShift action_24 action_61 (58) = happyShift action_25 action_61 (59) = happyShift action_26 action_61 (60) = happyShift action_27 action_61 (61) = happyShift action_28 action_61 (62) = happyShift action_29 action_61 (63) = happyShift action_30 action_61 (75) = happyShift action_32 action_61 (76) = happyShift action_33 action_61 (77) = happyShift action_34 action_61 (103) = happyShift action_36 action_61 (109) = happyShift action_37 action_61 (110) = happyShift action_38 action_61 (111) = happyShift action_39 action_61 (112) = happyShift action_40 action_61 (113) = happyShift action_41 action_61 (114) = happyShift action_42 action_61 (23) = happyGoto action_5 action_61 (35) = happyGoto action_107 action_61 (37) = happyGoto action_14 action_61 (38) = happyGoto action_15 action_61 (41) = happyGoto action_16 action_61 (45) = happyGoto action_17 action_61 (46) = happyGoto action_18 action_61 (47) = happyGoto action_19 action_61 _ = happyFail (happyExpListPerState 61) action_62 _ = happyReduce_66 action_63 _ = happyReduce_67 action_64 (113) = happyShift action_41 action_64 (23) = happyGoto action_106 action_64 _ = happyFail (happyExpListPerState 64) action_65 (53) = happyShift action_20 action_65 (54) = happyShift action_21 action_65 (55) = happyShift action_22 action_65 (56) = happyShift action_23 action_65 (57) = happyShift action_24 action_65 (58) = happyShift action_25 action_65 (59) = happyShift action_26 action_65 (60) = happyShift action_27 action_65 (61) = happyShift action_28 action_65 (62) = happyShift action_29 action_65 (63) = happyShift action_30 action_65 (75) = happyShift action_32 action_65 (76) = happyShift action_33 action_65 (77) = happyShift action_34 action_65 (99) = happyShift action_35 action_65 (103) = happyShift action_36 action_65 (109) = happyShift action_37 action_65 (110) = happyShift action_38 action_65 (111) = happyShift action_39 action_65 (112) = happyShift action_40 action_65 (113) = happyShift action_41 action_65 (114) = happyShift action_42 action_65 (23) = happyGoto action_5 action_65 (33) = happyGoto action_105 action_65 (35) = happyGoto action_13 action_65 (37) = happyGoto action_14 action_65 (38) = happyGoto action_15 action_65 (41) = happyGoto action_16 action_65 (45) = happyGoto action_17 action_65 (46) = happyGoto action_18 action_65 (47) = happyGoto action_19 action_65 _ = happyFail (happyExpListPerState 65) action_66 (53) = happyShift action_20 action_66 (54) = happyShift action_21 action_66 (55) = happyShift action_22 action_66 (56) = happyShift action_23 action_66 (57) = happyShift action_24 action_66 (58) = happyShift action_25 action_66 (59) = happyShift action_26 action_66 (60) = happyShift action_27 action_66 (61) = happyShift action_28 action_66 (62) = happyShift action_29 action_66 (63) = happyShift action_30 action_66 (75) = happyShift action_32 action_66 (76) = happyShift action_33 action_66 (77) = happyShift action_34 action_66 (99) = happyShift action_35 action_66 (103) = happyShift action_36 action_66 (109) = happyShift action_37 action_66 (110) = happyShift action_38 action_66 (111) = happyShift action_39 action_66 (112) = happyShift action_40 action_66 (113) = happyShift action_41 action_66 (114) = happyShift action_42 action_66 (23) = happyGoto action_5 action_66 (31) = happyGoto action_104 action_66 (33) = happyGoto action_12 action_66 (35) = happyGoto action_13 action_66 (37) = happyGoto action_14 action_66 (38) = happyGoto action_15 action_66 (41) = happyGoto action_16 action_66 (45) = happyGoto action_17 action_66 (46) = happyGoto action_18 action_66 (47) = happyGoto action_19 action_66 _ = happyFail (happyExpListPerState 66) action_67 (53) = happyShift action_20 action_67 (54) = happyShift action_21 action_67 (55) = happyShift action_22 action_67 (56) = happyShift action_23 action_67 (57) = happyShift action_24 action_67 (58) = happyShift action_25 action_67 (59) = happyShift action_26 action_67 (60) = happyShift action_27 action_67 (61) = happyShift action_28 action_67 (62) = happyShift action_29 action_67 (63) = happyShift action_30 action_67 (75) = happyShift action_32 action_67 (76) = happyShift action_33 action_67 (77) = happyShift action_34 action_67 (99) = happyShift action_35 action_67 (103) = happyShift action_36 action_67 (109) = happyShift action_37 action_67 (110) = happyShift action_38 action_67 (111) = happyShift action_39 action_67 (112) = happyShift action_40 action_67 (113) = happyShift action_41 action_67 (114) = happyShift action_42 action_67 (23) = happyGoto action_5 action_67 (31) = happyGoto action_103 action_67 (33) = happyGoto action_12 action_67 (35) = happyGoto action_13 action_67 (37) = happyGoto action_14 action_67 (38) = happyGoto action_15 action_67 (41) = happyGoto action_16 action_67 (45) = happyGoto action_17 action_67 (46) = happyGoto action_18 action_67 (47) = happyGoto action_19 action_67 _ = happyFail (happyExpListPerState 67) action_68 (53) = happyShift action_20 action_68 (54) = happyShift action_21 action_68 (55) = happyShift action_22 action_68 (56) = happyShift action_23 action_68 (57) = happyShift action_24 action_68 (58) = happyShift action_25 action_68 (59) = happyShift action_26 action_68 (60) = happyShift action_27 action_68 (61) = happyShift action_28 action_68 (62) = happyShift action_29 action_68 (63) = happyShift action_30 action_68 (75) = happyShift action_32 action_68 (76) = happyShift action_33 action_68 (77) = happyShift action_34 action_68 (99) = happyShift action_35 action_68 (103) = happyShift action_36 action_68 (109) = happyShift action_37 action_68 (110) = happyShift action_38 action_68 (111) = happyShift action_39 action_68 (112) = happyShift action_40 action_68 (113) = happyShift action_41 action_68 (114) = happyShift action_42 action_68 (23) = happyGoto action_5 action_68 (31) = happyGoto action_102 action_68 (33) = happyGoto action_12 action_68 (35) = happyGoto action_13 action_68 (37) = happyGoto action_14 action_68 (38) = happyGoto action_15 action_68 (41) = happyGoto action_16 action_68 (45) = happyGoto action_17 action_68 (46) = happyGoto action_18 action_68 (47) = happyGoto action_19 action_68 _ = happyFail (happyExpListPerState 68) action_69 (53) = happyShift action_20 action_69 (54) = happyShift action_21 action_69 (55) = happyShift action_22 action_69 (56) = happyShift action_23 action_69 (57) = happyShift action_24 action_69 (58) = happyShift action_25 action_69 (59) = happyShift action_26 action_69 (60) = happyShift action_27 action_69 (61) = happyShift action_28 action_69 (62) = happyShift action_29 action_69 (63) = happyShift action_30 action_69 (75) = happyShift action_32 action_69 (76) = happyShift action_33 action_69 (77) = happyShift action_34 action_69 (99) = happyShift action_35 action_69 (103) = happyShift action_36 action_69 (109) = happyShift action_37 action_69 (110) = happyShift action_38 action_69 (111) = happyShift action_39 action_69 (112) = happyShift action_40 action_69 (113) = happyShift action_41 action_69 (114) = happyShift action_42 action_69 (23) = happyGoto action_5 action_69 (31) = happyGoto action_101 action_69 (33) = happyGoto action_12 action_69 (35) = happyGoto action_13 action_69 (37) = happyGoto action_14 action_69 (38) = happyGoto action_15 action_69 (41) = happyGoto action_16 action_69 (45) = happyGoto action_17 action_69 (46) = happyGoto action_18 action_69 (47) = happyGoto action_19 action_69 _ = happyFail (happyExpListPerState 69) action_70 (53) = happyShift action_20 action_70 (54) = happyShift action_21 action_70 (55) = happyShift action_22 action_70 (56) = happyShift action_23 action_70 (57) = happyShift action_24 action_70 (58) = happyShift action_25 action_70 (59) = happyShift action_26 action_70 (60) = happyShift action_27 action_70 (61) = happyShift action_28 action_70 (62) = happyShift action_29 action_70 (63) = happyShift action_30 action_70 (75) = happyShift action_32 action_70 (76) = happyShift action_33 action_70 (77) = happyShift action_34 action_70 (99) = happyShift action_35 action_70 (103) = happyShift action_36 action_70 (109) = happyShift action_37 action_70 (110) = happyShift action_38 action_70 (111) = happyShift action_39 action_70 (112) = happyShift action_40 action_70 (113) = happyShift action_41 action_70 (114) = happyShift action_42 action_70 (23) = happyGoto action_5 action_70 (31) = happyGoto action_100 action_70 (33) = happyGoto action_12 action_70 (35) = happyGoto action_13 action_70 (37) = happyGoto action_14 action_70 (38) = happyGoto action_15 action_70 (41) = happyGoto action_16 action_70 (45) = happyGoto action_17 action_70 (46) = happyGoto action_18 action_70 (47) = happyGoto action_19 action_70 _ = happyFail (happyExpListPerState 70) action_71 (53) = happyShift action_20 action_71 (54) = happyShift action_21 action_71 (55) = happyShift action_22 action_71 (56) = happyShift action_23 action_71 (57) = happyShift action_24 action_71 (58) = happyShift action_25 action_71 (59) = happyShift action_26 action_71 (60) = happyShift action_27 action_71 (61) = happyShift action_28 action_71 (62) = happyShift action_29 action_71 (63) = happyShift action_30 action_71 (75) = happyShift action_32 action_71 (76) = happyShift action_33 action_71 (77) = happyShift action_34 action_71 (99) = happyShift action_35 action_71 (103) = happyShift action_36 action_71 (109) = happyShift action_37 action_71 (110) = happyShift action_38 action_71 (111) = happyShift action_39 action_71 (112) = happyShift action_40 action_71 (113) = happyShift action_41 action_71 (114) = happyShift action_42 action_71 (23) = happyGoto action_5 action_71 (31) = happyGoto action_99 action_71 (33) = happyGoto action_12 action_71 (35) = happyGoto action_13 action_71 (37) = happyGoto action_14 action_71 (38) = happyGoto action_15 action_71 (41) = happyGoto action_16 action_71 (45) = happyGoto action_17 action_71 (46) = happyGoto action_18 action_71 (47) = happyGoto action_19 action_71 _ = happyFail (happyExpListPerState 71) action_72 _ = happyReduce_61 action_73 _ = happyReduce_62 action_74 (53) = happyShift action_20 action_74 (54) = happyShift action_21 action_74 (55) = happyShift action_22 action_74 (56) = happyShift action_23 action_74 (57) = happyShift action_24 action_74 (58) = happyShift action_25 action_74 (59) = happyShift action_26 action_74 (60) = happyShift action_27 action_74 (61) = happyShift action_28 action_74 (62) = happyShift action_29 action_74 (63) = happyShift action_30 action_74 (75) = happyShift action_32 action_74 (76) = happyShift action_33 action_74 (77) = happyShift action_34 action_74 (99) = happyShift action_35 action_74 (103) = happyShift action_36 action_74 (109) = happyShift action_37 action_74 (110) = happyShift action_38 action_74 (111) = happyShift action_39 action_74 (112) = happyShift action_40 action_74 (113) = happyShift action_41 action_74 (114) = happyShift action_42 action_74 (23) = happyGoto action_5 action_74 (30) = happyGoto action_98 action_74 (31) = happyGoto action_11 action_74 (33) = happyGoto action_12 action_74 (35) = happyGoto action_13 action_74 (37) = happyGoto action_14 action_74 (38) = happyGoto action_15 action_74 (41) = happyGoto action_16 action_74 (45) = happyGoto action_17 action_74 (46) = happyGoto action_18 action_74 (47) = happyGoto action_19 action_74 _ = happyFail (happyExpListPerState 74) action_75 (53) = happyShift action_20 action_75 (54) = happyShift action_21 action_75 (55) = happyShift action_22 action_75 (56) = happyShift action_23 action_75 (57) = happyShift action_24 action_75 (58) = happyShift action_25 action_75 (59) = happyShift action_26 action_75 (60) = happyShift action_27 action_75 (61) = happyShift action_28 action_75 (62) = happyShift action_29 action_75 (63) = happyShift action_30 action_75 (75) = happyShift action_32 action_75 (76) = happyShift action_33 action_75 (77) = happyShift action_34 action_75 (99) = happyShift action_35 action_75 (103) = happyShift action_36 action_75 (109) = happyShift action_37 action_75 (110) = happyShift action_38 action_75 (111) = happyShift action_39 action_75 (112) = happyShift action_40 action_75 (113) = happyShift action_41 action_75 (114) = happyShift action_42 action_75 (23) = happyGoto action_5 action_75 (29) = happyGoto action_97 action_75 (30) = happyGoto action_10 action_75 (31) = happyGoto action_11 action_75 (33) = happyGoto action_12 action_75 (35) = happyGoto action_13 action_75 (37) = happyGoto action_14 action_75 (38) = happyGoto action_15 action_75 (41) = happyGoto action_16 action_75 (45) = happyGoto action_17 action_75 (46) = happyGoto action_18 action_75 (47) = happyGoto action_19 action_75 _ = happyFail (happyExpListPerState 75) action_76 (103) = happyShift action_36 action_76 (109) = happyShift action_37 action_76 (110) = happyShift action_38 action_76 (111) = happyShift action_39 action_76 (112) = happyShift action_40 action_76 (113) = happyShift action_41 action_76 (23) = happyGoto action_56 action_76 (41) = happyGoto action_96 action_76 (47) = happyGoto action_19 action_76 _ = happyReduce_77 action_77 (113) = happyShift action_95 action_77 (11) = happyGoto action_93 action_77 (36) = happyGoto action_94 action_77 _ = happyFail (happyExpListPerState 77) action_78 _ = happyReduce_6 action_79 _ = happyReduce_4 action_80 _ = happyReduce_31 action_81 _ = happyReduce_32 action_82 _ = happyReduce_33 action_83 _ = happyReduce_34 action_84 (81) = happyShift action_92 action_84 (113) = happyShift action_41 action_84 (23) = happyGoto action_90 action_84 (24) = happyGoto action_91 action_84 _ = happyFail (happyExpListPerState 84) action_85 (114) = happyShift action_42 action_85 (46) = happyGoto action_89 action_85 _ = happyFail (happyExpListPerState 85) action_86 (113) = happyShift action_41 action_86 (23) = happyGoto action_87 action_86 (25) = happyGoto action_88 action_86 _ = happyFail (happyExpListPerState 86) action_87 (83) = happyShift action_136 action_87 _ = happyFail (happyExpListPerState 87) action_88 (83) = happyShift action_134 action_88 (104) = happyShift action_135 action_88 _ = happyFail (happyExpListPerState 88) action_89 (81) = happyShift action_133 action_89 _ = happyFail (happyExpListPerState 89) action_90 (76) = happyShift action_132 action_90 _ = happyReduce_40 action_91 (81) = happyShift action_131 action_91 (113) = happyShift action_41 action_91 (23) = happyGoto action_130 action_91 _ = happyFail (happyExpListPerState 91) action_92 (53) = happyShift action_20 action_92 (54) = happyShift action_21 action_92 (55) = happyShift action_22 action_92 (56) = happyShift action_23 action_92 (57) = happyShift action_24 action_92 (58) = happyShift action_25 action_92 (59) = happyShift action_26 action_92 (60) = happyShift action_27 action_92 (61) = happyShift action_28 action_92 (62) = happyShift action_29 action_92 (63) = happyShift action_30 action_92 (70) = happyShift action_129 action_92 (72) = happyShift action_31 action_92 (75) = happyShift action_32 action_92 (76) = happyShift action_33 action_92 (77) = happyShift action_34 action_92 (99) = happyShift action_35 action_92 (103) = happyShift action_36 action_92 (109) = happyShift action_37 action_92 (110) = happyShift action_38 action_92 (111) = happyShift action_39 action_92 (112) = happyShift action_40 action_92 (113) = happyShift action_41 action_92 (114) = happyShift action_42 action_92 (16) = happyGoto action_127 action_92 (23) = happyGoto action_5 action_92 (26) = happyGoto action_128 action_92 (27) = happyGoto action_7 action_92 (28) = happyGoto action_8 action_92 (29) = happyGoto action_9 action_92 (30) = happyGoto action_10 action_92 (31) = happyGoto action_11 action_92 (33) = happyGoto action_12 action_92 (35) = happyGoto action_13 action_92 (37) = happyGoto action_14 action_92 (38) = happyGoto action_15 action_92 (41) = happyGoto action_16 action_92 (45) = happyGoto action_17 action_92 (46) = happyGoto action_18 action_92 (47) = happyGoto action_19 action_92 _ = happyFail (happyExpListPerState 92) action_93 _ = happyReduce_72 action_94 (88) = happyShift action_125 action_94 _ = happyReduce_70 action_95 _ = happyReduce_11 action_96 _ = happyReduce_96 action_97 (90) = happyShift action_74 action_97 _ = happyReduce_47 action_98 _ = happyReduce_49 action_99 (98) = happyShift action_72 action_99 (99) = happyShift action_73 action_99 (32) = happyGoto action_65 action_99 _ = happyReduce_52 action_100 (98) = happyShift action_72 action_100 (99) = happyShift action_73 action_100 (32) = happyGoto action_65 action_100 _ = happyReduce_55 action_101 (98) = happyShift action_72 action_101 (99) = happyShift action_73 action_101 (32) = happyGoto action_65 action_101 _ = happyReduce_51 action_102 (98) = happyShift action_72 action_102 (99) = happyShift action_73 action_102 (32) = happyGoto action_65 action_102 _ = happyReduce_56 action_103 (98) = happyShift action_72 action_103 (99) = happyShift action_73 action_103 (32) = happyGoto action_65 action_103 _ = happyReduce_54 action_104 (98) = happyShift action_72 action_104 (99) = happyShift action_73 action_104 (32) = happyGoto action_65 action_104 _ = happyReduce_53 action_105 (100) = happyShift action_62 action_105 (101) = happyShift action_63 action_105 (34) = happyGoto action_61 action_105 _ = happyReduce_59 action_106 (102) = happyShift action_126 action_106 _ = happyFail (happyExpListPerState 106) action_107 _ = happyReduce_63 action_108 (88) = happyShift action_125 action_108 _ = happyReduce_68 action_109 (89) = happyShift action_124 action_109 _ = happyFail (happyExpListPerState 109) action_110 (64) = happyShift action_121 action_110 (103) = happyShift action_122 action_110 (39) = happyGoto action_123 action_110 _ = happyFail (happyExpListPerState 110) action_111 _ = happyReduce_82 action_112 _ = happyReduce_83 action_113 (64) = happyShift action_121 action_113 (103) = happyShift action_122 action_113 (39) = happyGoto action_120 action_113 _ = happyFail (happyExpListPerState 113) action_114 (53) = happyShift action_20 action_114 (54) = happyShift action_21 action_114 (55) = happyShift action_22 action_114 (56) = happyShift action_23 action_114 (57) = happyShift action_24 action_114 (58) = happyShift action_25 action_114 (59) = happyShift action_26 action_114 (60) = happyShift action_27 action_114 (61) = happyShift action_28 action_114 (62) = happyShift action_29 action_114 (63) = happyShift action_30 action_114 (75) = happyShift action_32 action_114 (76) = happyShift action_33 action_114 (77) = happyShift action_34 action_114 (99) = happyShift action_35 action_114 (103) = happyShift action_36 action_114 (109) = happyShift action_37 action_114 (110) = happyShift action_38 action_114 (111) = happyShift action_39 action_114 (112) = happyShift action_40 action_114 (113) = happyShift action_41 action_114 (114) = happyShift action_42 action_114 (23) = happyGoto action_5 action_114 (28) = happyGoto action_119 action_114 (29) = happyGoto action_9 action_114 (30) = happyGoto action_10 action_114 (31) = happyGoto action_11 action_114 (33) = happyGoto action_12 action_114 (35) = happyGoto action_13 action_114 (37) = happyGoto action_14 action_114 (38) = happyGoto action_15 action_114 (41) = happyGoto action_16 action_114 (45) = happyGoto action_17 action_114 (46) = happyGoto action_18 action_114 (47) = happyGoto action_19 action_114 _ = happyFail (happyExpListPerState 114) action_115 (53) = happyShift action_20 action_115 (54) = happyShift action_21 action_115 (55) = happyShift action_22 action_115 (56) = happyShift action_23 action_115 (57) = happyShift action_24 action_115 (58) = happyShift action_25 action_115 (59) = happyShift action_26 action_115 (60) = happyShift action_27 action_115 (61) = happyShift action_28 action_115 (62) = happyShift action_29 action_115 (63) = happyShift action_30 action_115 (72) = happyShift action_31 action_115 (75) = happyShift action_32 action_115 (76) = happyShift action_33 action_115 (77) = happyShift action_34 action_115 (99) = happyShift action_35 action_115 (103) = happyShift action_36 action_115 (109) = happyShift action_37 action_115 (110) = happyShift action_38 action_115 (111) = happyShift action_39 action_115 (112) = happyShift action_40 action_115 (113) = happyShift action_41 action_115 (114) = happyShift action_42 action_115 (23) = happyGoto action_5 action_115 (26) = happyGoto action_118 action_115 (27) = happyGoto action_7 action_115 (28) = happyGoto action_8 action_115 (29) = happyGoto action_9 action_115 (30) = happyGoto action_10 action_115 (31) = happyGoto action_11 action_115 (33) = happyGoto action_12 action_115 (35) = happyGoto action_13 action_115 (37) = happyGoto action_14 action_115 (38) = happyGoto action_15 action_115 (41) = happyGoto action_16 action_115 (45) = happyGoto action_17 action_115 (46) = happyGoto action_18 action_115 (47) = happyGoto action_19 action_115 _ = happyFail (happyExpListPerState 115) action_116 _ = happyReduce_93 action_117 _ = happyReduce_3 action_118 (43) = happyGoto action_157 action_118 _ = happyReduce_97 action_119 (74) = happyShift action_156 action_119 (91) = happyShift action_75 action_119 _ = happyFail (happyExpListPerState 119) action_120 (113) = happyShift action_41 action_120 (23) = happyGoto action_155 action_120 _ = happyFail (happyExpListPerState 120) action_121 _ = happyReduce_85 action_122 (64) = happyShift action_121 action_122 (65) = happyShift action_152 action_122 (66) = happyShift action_153 action_122 (67) = happyShift action_154 action_122 (103) = happyShift action_122 action_122 (39) = happyGoto action_151 action_122 _ = happyFail (happyExpListPerState 122) action_123 (113) = happyShift action_41 action_123 (23) = happyGoto action_150 action_123 _ = happyFail (happyExpListPerState 123) action_124 (103) = happyShift action_149 action_124 (113) = happyShift action_41 action_124 (23) = happyGoto action_147 action_124 (44) = happyGoto action_148 action_124 _ = happyFail (happyExpListPerState 124) action_125 (113) = happyShift action_95 action_125 (11) = happyGoto action_146 action_125 _ = happyFail (happyExpListPerState 125) action_126 (53) = happyShift action_20 action_126 (54) = happyShift action_21 action_126 (55) = happyShift action_22 action_126 (56) = happyShift action_23 action_126 (57) = happyShift action_24 action_126 (58) = happyShift action_25 action_126 (59) = happyShift action_26 action_126 (60) = happyShift action_27 action_126 (61) = happyShift action_28 action_126 (62) = happyShift action_29 action_126 (63) = happyShift action_30 action_126 (75) = happyShift action_32 action_126 (76) = happyShift action_33 action_126 (77) = happyShift action_34 action_126 (99) = happyShift action_35 action_126 (103) = happyShift action_36 action_126 (109) = happyShift action_37 action_126 (110) = happyShift action_38 action_126 (111) = happyShift action_39 action_126 (112) = happyShift action_40 action_126 (113) = happyShift action_41 action_126 (114) = happyShift action_42 action_126 (23) = happyGoto action_5 action_126 (33) = happyGoto action_145 action_126 (35) = happyGoto action_13 action_126 (37) = happyGoto action_14 action_126 (38) = happyGoto action_15 action_126 (41) = happyGoto action_16 action_126 (45) = happyGoto action_17 action_126 (46) = happyGoto action_18 action_126 (47) = happyGoto action_19 action_126 _ = happyFail (happyExpListPerState 126) action_127 _ = happyReduce_36 action_128 _ = happyReduce_28 action_129 (103) = happyShift action_86 action_129 (113) = happyShift action_41 action_129 (17) = happyGoto action_143 action_129 (18) = happyGoto action_144 action_129 (19) = happyGoto action_80 action_129 (20) = happyGoto action_81 action_129 (21) = happyGoto action_82 action_129 (22) = happyGoto action_83 action_129 (23) = happyGoto action_84 action_129 _ = happyFail (happyExpListPerState 129) action_130 _ = happyReduce_41 action_131 (53) = happyShift action_20 action_131 (54) = happyShift action_21 action_131 (55) = happyShift action_22 action_131 (56) = happyShift action_23 action_131 (57) = happyShift action_24 action_131 (58) = happyShift action_25 action_131 (59) = happyShift action_26 action_131 (60) = happyShift action_27 action_131 (61) = happyShift action_28 action_131 (62) = happyShift action_29 action_131 (63) = happyShift action_30 action_131 (70) = happyShift action_129 action_131 (72) = happyShift action_31 action_131 (75) = happyShift action_32 action_131 (76) = happyShift action_33 action_131 (77) = happyShift action_34 action_131 (99) = happyShift action_35 action_131 (103) = happyShift action_36 action_131 (109) = happyShift action_37 action_131 (110) = happyShift action_38 action_131 (111) = happyShift action_39 action_131 (112) = happyShift action_40 action_131 (113) = happyShift action_41 action_131 (114) = happyShift action_42 action_131 (16) = happyGoto action_142 action_131 (23) = happyGoto action_5 action_131 (26) = happyGoto action_128 action_131 (27) = happyGoto action_7 action_131 (28) = happyGoto action_8 action_131 (29) = happyGoto action_9 action_131 (30) = happyGoto action_10 action_131 (31) = happyGoto action_11 action_131 (33) = happyGoto action_12 action_131 (35) = happyGoto action_13 action_131 (37) = happyGoto action_14 action_131 (38) = happyGoto action_15 action_131 (41) = happyGoto action_16 action_131 (45) = happyGoto action_17 action_131 (46) = happyGoto action_18 action_131 (47) = happyGoto action_19 action_131 _ = happyFail (happyExpListPerState 131) action_132 (75) = happyShift action_141 action_132 _ = happyFail (happyExpListPerState 132) action_133 (114) = happyShift action_42 action_133 (46) = happyGoto action_140 action_133 _ = happyFail (happyExpListPerState 133) action_134 (113) = happyShift action_41 action_134 (23) = happyGoto action_139 action_134 _ = happyFail (happyExpListPerState 134) action_135 (81) = happyShift action_138 action_135 _ = happyFail (happyExpListPerState 135) action_136 (113) = happyShift action_41 action_136 (23) = happyGoto action_137 action_136 _ = happyFail (happyExpListPerState 136) action_137 _ = happyReduce_42 action_138 (53) = happyShift action_20 action_138 (54) = happyShift action_21 action_138 (55) = happyShift action_22 action_138 (56) = happyShift action_23 action_138 (57) = happyShift action_24 action_138 (58) = happyShift action_25 action_138 (59) = happyShift action_26 action_138 (60) = happyShift action_27 action_138 (61) = happyShift action_28 action_138 (62) = happyShift action_29 action_138 (63) = happyShift action_30 action_138 (70) = happyShift action_129 action_138 (72) = happyShift action_31 action_138 (75) = happyShift action_32 action_138 (76) = happyShift action_33 action_138 (77) = happyShift action_34 action_138 (99) = happyShift action_35 action_138 (103) = happyShift action_36 action_138 (109) = happyShift action_37 action_138 (110) = happyShift action_38 action_138 (111) = happyShift action_39 action_138 (112) = happyShift action_40 action_138 (113) = happyShift action_41 action_138 (114) = happyShift action_42 action_138 (16) = happyGoto action_173 action_138 (23) = happyGoto action_5 action_138 (26) = happyGoto action_128 action_138 (27) = happyGoto action_7 action_138 (28) = happyGoto action_8 action_138 (29) = happyGoto action_9 action_138 (30) = happyGoto action_10 action_138 (31) = happyGoto action_11 action_138 (33) = happyGoto action_12 action_138 (35) = happyGoto action_13 action_138 (37) = happyGoto action_14 action_138 (38) = happyGoto action_15 action_138 (41) = happyGoto action_16 action_138 (45) = happyGoto action_17 action_138 (46) = happyGoto action_18 action_138 (47) = happyGoto action_19 action_138 _ = happyFail (happyExpListPerState 138) action_139 _ = happyReduce_43 action_140 (105) = happyShift action_172 action_140 _ = happyFail (happyExpListPerState 140) action_141 (81) = happyShift action_171 action_141 _ = happyFail (happyExpListPerState 141) action_142 _ = happyReduce_35 action_143 (71) = happyShift action_169 action_143 (84) = happyShift action_170 action_143 _ = happyFail (happyExpListPerState 143) action_144 _ = happyReduce_29 action_145 (100) = happyShift action_62 action_145 (101) = happyShift action_63 action_145 (34) = happyGoto action_61 action_145 _ = happyReduce_58 action_146 _ = happyReduce_73 action_147 (87) = happyShift action_168 action_147 _ = happyFail (happyExpListPerState 147) action_148 (43) = happyGoto action_167 action_148 _ = happyReduce_97 action_149 (113) = happyShift action_41 action_149 (23) = happyGoto action_166 action_149 _ = happyFail (happyExpListPerState 149) action_150 _ = happyReduce_81 action_151 (104) = happyShift action_165 action_151 _ = happyFail (happyExpListPerState 151) action_152 (53) = happyShift action_20 action_152 (54) = happyShift action_21 action_152 (55) = happyShift action_22 action_152 (56) = happyShift action_23 action_152 (57) = happyShift action_24 action_152 (58) = happyShift action_25 action_152 (59) = happyShift action_26 action_152 (60) = happyShift action_27 action_152 (61) = happyShift action_28 action_152 (62) = happyShift action_29 action_152 (63) = happyShift action_30 action_152 (72) = happyShift action_31 action_152 (75) = happyShift action_32 action_152 (76) = happyShift action_33 action_152 (77) = happyShift action_34 action_152 (99) = happyShift action_35 action_152 (103) = happyShift action_36 action_152 (109) = happyShift action_37 action_152 (110) = happyShift action_38 action_152 (111) = happyShift action_39 action_152 (112) = happyShift action_40 action_152 (113) = happyShift action_41 action_152 (114) = happyShift action_42 action_152 (23) = happyGoto action_5 action_152 (26) = happyGoto action_164 action_152 (27) = happyGoto action_7 action_152 (28) = happyGoto action_8 action_152 (29) = happyGoto action_9 action_152 (30) = happyGoto action_10 action_152 (31) = happyGoto action_11 action_152 (33) = happyGoto action_12 action_152 (35) = happyGoto action_13 action_152 (37) = happyGoto action_14 action_152 (38) = happyGoto action_15 action_152 (41) = happyGoto action_16 action_152 (45) = happyGoto action_17 action_152 (46) = happyGoto action_18 action_152 (47) = happyGoto action_19 action_152 _ = happyFail (happyExpListPerState 152) action_153 (103) = happyShift action_162 action_153 (40) = happyGoto action_163 action_153 _ = happyFail (happyExpListPerState 153) action_154 (103) = happyShift action_162 action_154 (40) = happyGoto action_161 action_154 _ = happyFail (happyExpListPerState 154) action_155 _ = happyReduce_84 action_156 (53) = happyShift action_20 action_156 (54) = happyShift action_21 action_156 (55) = happyShift action_22 action_156 (56) = happyShift action_23 action_156 (57) = happyShift action_24 action_156 (58) = happyShift action_25 action_156 (59) = happyShift action_26 action_156 (60) = happyShift action_27 action_156 (61) = happyShift action_28 action_156 (62) = happyShift action_29 action_156 (63) = happyShift action_30 action_156 (75) = happyShift action_32 action_156 (76) = happyShift action_33 action_156 (77) = happyShift action_34 action_156 (99) = happyShift action_35 action_156 (103) = happyShift action_36 action_156 (109) = happyShift action_37 action_156 (110) = happyShift action_38 action_156 (111) = happyShift action_39 action_156 (112) = happyShift action_40 action_156 (113) = happyShift action_41 action_156 (114) = happyShift action_42 action_156 (23) = happyGoto action_5 action_156 (28) = happyGoto action_160 action_156 (29) = happyGoto action_9 action_156 (30) = happyGoto action_10 action_156 (31) = happyGoto action_11 action_156 (33) = happyGoto action_12 action_156 (35) = happyGoto action_13 action_156 (37) = happyGoto action_14 action_156 (38) = happyGoto action_15 action_156 (41) = happyGoto action_16 action_156 (45) = happyGoto action_17 action_156 (46) = happyGoto action_18 action_156 (47) = happyGoto action_19 action_156 _ = happyFail (happyExpListPerState 156) action_157 (83) = happyShift action_158 action_157 (104) = happyShift action_159 action_157 _ = happyFail (happyExpListPerState 157) action_158 (53) = happyShift action_20 action_158 (54) = happyShift action_21 action_158 (55) = happyShift action_22 action_158 (56) = happyShift action_23 action_158 (57) = happyShift action_24 action_158 (58) = happyShift action_25 action_158 (59) = happyShift action_26 action_158 (60) = happyShift action_27 action_158 (61) = happyShift action_28 action_158 (62) = happyShift action_29 action_158 (63) = happyShift action_30 action_158 (72) = happyShift action_31 action_158 (75) = happyShift action_32 action_158 (76) = happyShift action_33 action_158 (77) = happyShift action_34 action_158 (99) = happyShift action_35 action_158 (103) = happyShift action_36 action_158 (109) = happyShift action_37 action_158 (110) = happyShift action_38 action_158 (111) = happyShift action_39 action_158 (112) = happyShift action_40 action_158 (113) = happyShift action_41 action_158 (114) = happyShift action_42 action_158 (23) = happyGoto action_5 action_158 (26) = happyGoto action_188 action_158 (27) = happyGoto action_7 action_158 (28) = happyGoto action_8 action_158 (29) = happyGoto action_9 action_158 (30) = happyGoto action_10 action_158 (31) = happyGoto action_11 action_158 (33) = happyGoto action_12 action_158 (35) = happyGoto action_13 action_158 (37) = happyGoto action_14 action_158 (38) = happyGoto action_15 action_158 (41) = happyGoto action_16 action_158 (45) = happyGoto action_17 action_158 (46) = happyGoto action_18 action_158 (47) = happyGoto action_19 action_158 _ = happyFail (happyExpListPerState 158) action_159 _ = happyReduce_94 action_160 (91) = happyShift action_75 action_160 _ = happyReduce_45 action_161 (104) = happyShift action_187 action_161 _ = happyFail (happyExpListPerState 161) action_162 (85) = happyShift action_186 action_162 _ = happyFail (happyExpListPerState 162) action_163 (104) = happyShift action_185 action_163 _ = happyFail (happyExpListPerState 163) action_164 (104) = happyShift action_184 action_164 _ = happyFail (happyExpListPerState 164) action_165 _ = happyReduce_89 action_166 (83) = happyShift action_183 action_166 _ = happyFail (happyExpListPerState 166) action_167 (83) = happyShift action_158 action_167 (108) = happyShift action_182 action_167 _ = happyFail (happyExpListPerState 167) action_168 (80) = happyShift action_181 action_168 (113) = happyShift action_41 action_168 (23) = happyGoto action_180 action_168 _ = happyFail (happyExpListPerState 168) action_169 (53) = happyShift action_20 action_169 (54) = happyShift action_21 action_169 (55) = happyShift action_22 action_169 (56) = happyShift action_23 action_169 (57) = happyShift action_24 action_169 (58) = happyShift action_25 action_169 (59) = happyShift action_26 action_169 (60) = happyShift action_27 action_169 (61) = happyShift action_28 action_169 (62) = happyShift action_29 action_169 (63) = happyShift action_30 action_169 (72) = happyShift action_31 action_169 (75) = happyShift action_32 action_169 (76) = happyShift action_33 action_169 (77) = happyShift action_34 action_169 (99) = happyShift action_35 action_169 (103) = happyShift action_36 action_169 (109) = happyShift action_37 action_169 (110) = happyShift action_38 action_169 (111) = happyShift action_39 action_169 (112) = happyShift action_40 action_169 (113) = happyShift action_41 action_169 (114) = happyShift action_42 action_169 (23) = happyGoto action_5 action_169 (26) = happyGoto action_179 action_169 (27) = happyGoto action_7 action_169 (28) = happyGoto action_8 action_169 (29) = happyGoto action_9 action_169 (30) = happyGoto action_10 action_169 (31) = happyGoto action_11 action_169 (33) = happyGoto action_12 action_169 (35) = happyGoto action_13 action_169 (37) = happyGoto action_14 action_169 (38) = happyGoto action_15 action_169 (41) = happyGoto action_16 action_169 (45) = happyGoto action_17 action_169 (46) = happyGoto action_18 action_169 (47) = happyGoto action_19 action_169 _ = happyFail (happyExpListPerState 169) action_170 (103) = happyShift action_86 action_170 (113) = happyShift action_41 action_170 (18) = happyGoto action_178 action_170 (19) = happyGoto action_80 action_170 (20) = happyGoto action_81 action_170 (21) = happyGoto action_82 action_170 (22) = happyGoto action_83 action_170 (23) = happyGoto action_84 action_170 _ = happyFail (happyExpListPerState 170) action_171 (53) = happyShift action_20 action_171 (54) = happyShift action_21 action_171 (55) = happyShift action_22 action_171 (56) = happyShift action_23 action_171 (57) = happyShift action_24 action_171 (58) = happyShift action_25 action_171 (59) = happyShift action_26 action_171 (60) = happyShift action_27 action_171 (61) = happyShift action_28 action_171 (62) = happyShift action_29 action_171 (63) = happyShift action_30 action_171 (70) = happyShift action_129 action_171 (72) = happyShift action_31 action_171 (75) = happyShift action_32 action_171 (76) = happyShift action_33 action_171 (77) = happyShift action_34 action_171 (99) = happyShift action_35 action_171 (103) = happyShift action_36 action_171 (109) = happyShift action_37 action_171 (110) = happyShift action_38 action_171 (111) = happyShift action_39 action_171 (112) = happyShift action_40 action_171 (113) = happyShift action_41 action_171 (114) = happyShift action_42 action_171 (16) = happyGoto action_177 action_171 (23) = happyGoto action_5 action_171 (26) = happyGoto action_128 action_171 (27) = happyGoto action_7 action_171 (28) = happyGoto action_8 action_171 (29) = happyGoto action_9 action_171 (30) = happyGoto action_10 action_171 (31) = happyGoto action_11 action_171 (33) = happyGoto action_12 action_171 (35) = happyGoto action_13 action_171 (37) = happyGoto action_14 action_171 (38) = happyGoto action_15 action_171 (41) = happyGoto action_16 action_171 (45) = happyGoto action_17 action_171 (46) = happyGoto action_18 action_171 (47) = happyGoto action_19 action_171 _ = happyFail (happyExpListPerState 171) action_172 (113) = happyShift action_95 action_172 (9) = happyGoto action_174 action_172 (10) = happyGoto action_175 action_172 (11) = happyGoto action_176 action_172 _ = happyFail (happyExpListPerState 172) action_173 _ = happyReduce_37 action_174 (83) = happyShift action_193 action_174 (106) = happyShift action_194 action_174 _ = happyFail (happyExpListPerState 174) action_175 _ = happyReduce_8 action_176 (82) = happyShift action_192 action_176 _ = happyFail (happyExpListPerState 176) action_177 _ = happyReduce_38 action_178 _ = happyReduce_30 action_179 _ = happyReduce_27 action_180 _ = happyReduce_102 action_181 (113) = happyShift action_41 action_181 (23) = happyGoto action_191 action_181 _ = happyFail (happyExpListPerState 181) action_182 _ = happyReduce_79 action_183 (113) = happyShift action_41 action_183 (23) = happyGoto action_190 action_183 _ = happyFail (happyExpListPerState 183) action_184 _ = happyReduce_86 action_185 _ = happyReduce_87 action_186 (113) = happyShift action_41 action_186 (23) = happyGoto action_189 action_186 _ = happyFail (happyExpListPerState 186) action_187 _ = happyReduce_88 action_188 _ = happyReduce_98 action_189 (86) = happyShift action_207 action_189 _ = happyFail (happyExpListPerState 189) action_190 (104) = happyShift action_206 action_190 _ = happyFail (happyExpListPerState 190) action_191 _ = happyReduce_101 action_192 (48) = happyShift action_199 action_192 (49) = happyShift action_200 action_192 (50) = happyShift action_201 action_192 (51) = happyShift action_202 action_192 (52) = happyShift action_203 action_192 (103) = happyShift action_204 action_192 (114) = happyShift action_205 action_192 (12) = happyGoto action_198 action_192 _ = happyFail (happyExpListPerState 192) action_193 (113) = happyShift action_95 action_193 (10) = happyGoto action_197 action_193 (11) = happyGoto action_176 action_193 _ = happyFail (happyExpListPerState 193) action_194 (69) = happyShift action_196 action_194 (14) = happyGoto action_195 action_194 _ = happyReduce_22 action_195 _ = happyReduce_7 action_196 (103) = happyShift action_213 action_196 (114) = happyShift action_214 action_196 _ = happyFail (happyExpListPerState 196) action_197 _ = happyReduce_9 action_198 _ = happyReduce_10 action_199 _ = happyReduce_12 action_200 _ = happyReduce_13 action_201 _ = happyReduce_15 action_202 _ = happyReduce_14 action_203 (48) = happyShift action_199 action_203 (49) = happyShift action_200 action_203 (50) = happyShift action_201 action_203 (51) = happyShift action_202 action_203 (52) = happyShift action_203 action_203 (103) = happyShift action_204 action_203 (114) = happyShift action_205 action_203 (12) = happyGoto action_212 action_203 _ = happyFail (happyExpListPerState 203) action_204 (48) = happyShift action_199 action_204 (49) = happyShift action_200 action_204 (50) = happyShift action_201 action_204 (51) = happyShift action_202 action_204 (52) = happyShift action_203 action_204 (103) = happyShift action_204 action_204 (114) = happyShift action_205 action_204 (12) = happyGoto action_210 action_204 (13) = happyGoto action_211 action_204 _ = happyFail (happyExpListPerState 204) action_205 _ = happyReduce_19 action_206 (87) = happyShift action_209 action_206 _ = happyFail (happyExpListPerState 206) action_207 (53) = happyShift action_20 action_207 (54) = happyShift action_21 action_207 (55) = happyShift action_22 action_207 (56) = happyShift action_23 action_207 (57) = happyShift action_24 action_207 (58) = happyShift action_25 action_207 (59) = happyShift action_26 action_207 (60) = happyShift action_27 action_207 (61) = happyShift action_28 action_207 (62) = happyShift action_29 action_207 (63) = happyShift action_30 action_207 (72) = happyShift action_31 action_207 (75) = happyShift action_32 action_207 (76) = happyShift action_33 action_207 (77) = happyShift action_34 action_207 (99) = happyShift action_35 action_207 (103) = happyShift action_36 action_207 (109) = happyShift action_37 action_207 (110) = happyShift action_38 action_207 (111) = happyShift action_39 action_207 (112) = happyShift action_40 action_207 (113) = happyShift action_41 action_207 (114) = happyShift action_42 action_207 (23) = happyGoto action_5 action_207 (26) = happyGoto action_208 action_207 (27) = happyGoto action_7 action_207 (28) = happyGoto action_8 action_207 (29) = happyGoto action_9 action_207 (30) = happyGoto action_10 action_207 (31) = happyGoto action_11 action_207 (33) = happyGoto action_12 action_207 (35) = happyGoto action_13 action_207 (37) = happyGoto action_14 action_207 (38) = happyGoto action_15 action_207 (41) = happyGoto action_16 action_207 (45) = happyGoto action_17 action_207 (46) = happyGoto action_18 action_207 (47) = happyGoto action_19 action_207 _ = happyFail (happyExpListPerState 207) action_208 (104) = happyShift action_224 action_208 _ = happyFail (happyExpListPerState 208) action_209 (78) = happyShift action_222 action_209 (79) = happyShift action_223 action_209 _ = happyFail (happyExpListPerState 209) action_210 (83) = happyShift action_220 action_210 (104) = happyShift action_221 action_210 _ = happyFail (happyExpListPerState 210) action_211 (83) = happyShift action_218 action_211 (104) = happyShift action_219 action_211 _ = happyFail (happyExpListPerState 211) action_212 (48) = happyShift action_199 action_212 (49) = happyShift action_200 action_212 (50) = happyShift action_201 action_212 (51) = happyShift action_202 action_212 (52) = happyShift action_203 action_212 (103) = happyShift action_204 action_212 (114) = happyShift action_205 action_212 (12) = happyGoto action_217 action_212 _ = happyFail (happyExpListPerState 212) action_213 (114) = happyShift action_216 action_213 (15) = happyGoto action_215 action_213 _ = happyFail (happyExpListPerState 213) action_214 _ = happyReduce_23 action_215 (83) = happyShift action_229 action_215 (104) = happyShift action_230 action_215 _ = happyFail (happyExpListPerState 215) action_216 _ = happyReduce_25 action_217 _ = happyReduce_16 action_218 (48) = happyShift action_199 action_218 (49) = happyShift action_200 action_218 (50) = happyShift action_201 action_218 (51) = happyShift action_202 action_218 (52) = happyShift action_203 action_218 (103) = happyShift action_204 action_218 (114) = happyShift action_205 action_218 (12) = happyGoto action_228 action_218 _ = happyFail (happyExpListPerState 218) action_219 _ = happyReduce_18 action_220 (48) = happyShift action_199 action_220 (49) = happyShift action_200 action_220 (50) = happyShift action_201 action_220 (51) = happyShift action_202 action_220 (52) = happyShift action_203 action_220 (103) = happyShift action_204 action_220 (114) = happyShift action_205 action_220 (12) = happyGoto action_227 action_220 _ = happyFail (happyExpListPerState 220) action_221 _ = happyReduce_17 action_222 (113) = happyShift action_41 action_222 (23) = happyGoto action_226 action_222 _ = happyFail (happyExpListPerState 222) action_223 (113) = happyShift action_41 action_223 (23) = happyGoto action_225 action_223 _ = happyFail (happyExpListPerState 223) action_224 _ = happyReduce_90 action_225 _ = happyReduce_100 action_226 _ = happyReduce_99 action_227 _ = happyReduce_20 action_228 _ = happyReduce_21 action_229 (114) = happyShift action_231 action_229 _ = happyFail (happyExpListPerState 229) action_230 _ = happyReduce_24 action_231 _ = happyReduce_26 happyReduce_2 = happySpecReduce_1 5 happyReduction_2 happyReduction_2 (HappyAbsSyn6 happy_var_1) = HappyAbsSyn5 ([happy_var_1] ) happyReduction_2 _ = notHappyAtAll happyReduce_3 = happySpecReduce_3 5 happyReduction_3 happyReduction_3 (HappyAbsSyn6 happy_var_3) _ (HappyAbsSyn5 happy_var_1) = HappyAbsSyn5 (happy_var_3:happy_var_1 ) happyReduction_3 _ _ _ = notHappyAtAll happyReduce_4 = happySpecReduce_2 6 happyReduction_4 happyReduction_4 (HappyAbsSyn18 happy_var_2) (HappyAbsSyn7 happy_var_1) = HappyAbsSyn6 (DProgramSpec0 (reverse happy_var_1) happy_var_2 (if happy_var_1 == [] then getData happy_var_2 else getData (head happy_var_1)) ) happyReduction_4 _ _ = notHappyAtAll happyReduce_5 = happySpecReduce_0 7 happyReduction_5 happyReduction_5 = HappyAbsSyn7 ([ ] ) happyReduce_6 = happySpecReduce_2 7 happyReduction_6 happyReduction_6 (HappyAbsSyn8 happy_var_2) (HappyAbsSyn7 happy_var_1) = HappyAbsSyn7 (happy_var_2:happy_var_1 ) happyReduction_6 _ _ = notHappyAtAll happyReduce_7 = happyReduce 8 8 happyReduction_7 happyReduction_7 (_ `HappyStk` _ `HappyStk` (HappyAbsSyn9 happy_var_6) `HappyStk` _ `HappyStk` (HappyAbsSyn46 happy_var_4) `HappyStk` _ `HappyStk` _ `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn8 (DRecordSpec happy_var_4 (reverse happy_var_6) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_8 = happySpecReduce_1 9 happyReduction_8 happyReduction_8 (HappyAbsSyn10 happy_var_1) = HappyAbsSyn9 ([happy_var_1] ) happyReduction_8 _ = notHappyAtAll happyReduce_9 = happySpecReduce_3 9 happyReduction_9 happyReduction_9 (HappyAbsSyn10 happy_var_3) _ (HappyAbsSyn9 happy_var_1) = HappyAbsSyn9 (happy_var_3:happy_var_1 ) happyReduction_9 _ _ _ = notHappyAtAll happyReduce_10 = happySpecReduce_3 10 happyReduction_10 happyReduction_10 (HappyAbsSyn12 happy_var_3) _ (HappyAbsSyn11 happy_var_1) = HappyAbsSyn10 ((happy_var_1, happy_var_3) ) happyReduction_10 _ _ _ = notHappyAtAll happyReduce_11 = happySpecReduce_1 11 happyReduction_11 happyReduction_11 (HappyTerminal happy_var_1) = HappyAbsSyn11 (DField (strToken happy_var_1) (getData happy_var_1) ) happyReduction_11 _ = notHappyAtAll happyReduce_12 = happySpecReduce_1 12 happyReduction_12 happyReduction_12 (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTInt (getData happy_var_1) ) happyReduction_12 _ = notHappyAtAll happyReduce_13 = happySpecReduce_1 12 happyReduction_13 happyReduction_13 (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTBool (getData happy_var_1) ) happyReduction_13 _ = notHappyAtAll happyReduce_14 = happySpecReduce_1 12 happyReduction_14 happyReduction_14 (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTString (getData happy_var_1) ) happyReduction_14 _ = notHappyAtAll happyReduce_15 = happySpecReduce_1 12 happyReduction_15 happyReduction_15 (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTDouble (getData happy_var_1) ) happyReduction_15 _ = notHappyAtAll happyReduce_16 = happySpecReduce_3 12 happyReduction_16 happyReduction_16 (HappyAbsSyn12 happy_var_3) (HappyAbsSyn12 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTRecord (DConstructor "Pair" (getData happy_var_1)) [happy_var_2, happy_var_3] (getData happy_var_1) ) happyReduction_16 _ _ _ = notHappyAtAll happyReduce_17 = happySpecReduce_3 12 happyReduction_17 happyReduction_17 _ (HappyAbsSyn12 happy_var_2) _ = HappyAbsSyn12 (happy_var_2 ) happyReduction_17 _ _ _ = notHappyAtAll happyReduce_18 = happySpecReduce_3 12 happyReduction_18 happyReduction_18 _ (HappyAbsSyn13 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTTuple (reverse happy_var_2) (getData happy_var_1) ) happyReduction_18 _ _ _ = notHappyAtAll happyReduce_19 = happySpecReduce_1 12 happyReduction_19 happyReduction_19 (HappyTerminal happy_var_1) = HappyAbsSyn12 (DTRecord (DConstructor (strToken happy_var_1) (getData happy_var_1)) [] (getData happy_var_1) ) happyReduction_19 _ = notHappyAtAll happyReduce_20 = happySpecReduce_3 13 happyReduction_20 happyReduction_20 (HappyAbsSyn12 happy_var_3) _ (HappyAbsSyn12 happy_var_1) = HappyAbsSyn13 ([happy_var_3, happy_var_1] ) happyReduction_20 _ _ _ = notHappyAtAll happyReduce_21 = happySpecReduce_3 13 happyReduction_21 happyReduction_21 (HappyAbsSyn12 happy_var_3) _ (HappyAbsSyn13 happy_var_1) = HappyAbsSyn13 (happy_var_3:happy_var_1 ) happyReduction_21 _ _ _ = notHappyAtAll happyReduce_22 = happySpecReduce_0 14 happyReduction_22 happyReduction_22 = HappyAbsSyn14 (() ) happyReduce_23 = happySpecReduce_2 14 happyReduction_23 happyReduction_23 _ _ = HappyAbsSyn14 (() ) happyReduce_24 = happyReduce 4 14 happyReduction_24 happyReduction_24 (_ `HappyStk` _ `HappyStk` _ `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn14 (() ) `HappyStk` happyRest happyReduce_25 = happySpecReduce_1 15 happyReduction_25 happyReduction_25 _ = HappyAbsSyn14 (() ) happyReduce_26 = happySpecReduce_3 15 happyReduction_26 happyReduction_26 _ _ _ = HappyAbsSyn14 (() ) happyReduce_27 = happyReduce 4 16 happyReduction_27 happyReduction_27 ((HappyAbsSyn26 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn17 happy_var_2) `HappyStk` _ `HappyStk` happyRest) = HappyAbsSyn16 ((reverse happy_var_2, happy_var_4) ) `HappyStk` happyRest happyReduce_28 = happySpecReduce_1 16 happyReduction_28 happyReduction_28 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn16 (([], happy_var_1) ) happyReduction_28 _ = notHappyAtAll happyReduce_29 = happySpecReduce_1 17 happyReduction_29 happyReduction_29 (HappyAbsSyn18 happy_var_1) = HappyAbsSyn17 ([happy_var_1] ) happyReduction_29 _ = notHappyAtAll happyReduce_30 = happySpecReduce_3 17 happyReduction_30 happyReduction_30 (HappyAbsSyn18 happy_var_3) _ (HappyAbsSyn17 happy_var_1) = HappyAbsSyn17 (happy_var_3:happy_var_1 ) happyReduction_30 _ _ _ = notHappyAtAll happyReduce_31 = happySpecReduce_1 18 happyReduction_31 happyReduction_31 (HappyAbsSyn18 happy_var_1) = HappyAbsSyn18 (happy_var_1 ) happyReduction_31 _ = notHappyAtAll happyReduce_32 = happySpecReduce_1 18 happyReduction_32 happyReduction_32 (HappyAbsSyn18 happy_var_1) = HappyAbsSyn18 (happy_var_1 ) happyReduction_32 _ = notHappyAtAll happyReduce_33 = happySpecReduce_1 18 happyReduction_33 happyReduction_33 (HappyAbsSyn18 happy_var_1) = HappyAbsSyn18 (happy_var_1 ) happyReduction_33 _ = notHappyAtAll happyReduce_34 = happySpecReduce_1 18 happyReduction_34 happyReduction_34 (HappyAbsSyn18 happy_var_1) = HappyAbsSyn18 (happy_var_1 ) happyReduction_34 _ = notHappyAtAll happyReduce_35 = happyReduce 4 19 happyReduction_35 happyReduction_35 ((HappyAbsSyn16 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn24 happy_var_2) `HappyStk` (HappyAbsSyn23 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn18 (DDefFun0 happy_var_1 (reverse happy_var_2) (fst happy_var_4) (snd happy_var_4) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_36 = happySpecReduce_3 20 happyReduction_36 happyReduction_36 (HappyAbsSyn16 happy_var_3) _ (HappyAbsSyn23 happy_var_1) = HappyAbsSyn18 (DDefVar0 happy_var_1 (fst happy_var_3) (snd happy_var_3) (getData happy_var_1) ) happyReduction_36 _ _ _ = notHappyAtAll happyReduce_37 = happyReduce 5 21 happyReduction_37 happyReduction_37 ((HappyAbsSyn16 happy_var_5) `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn24 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn18 (DDefTuple0 (reverse happy_var_2) (fst happy_var_5) (snd happy_var_5) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_38 = happyMonadReduce 6 22 happyReduction_38 happyReduction_38 ((HappyAbsSyn16 happy_var_6) `HappyStk` _ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_2) `HappyStk` (HappyAbsSyn23 happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_2 "v" >> return (DDefVertComp0 happy_var_1 (fst happy_var_6) (snd happy_var_6) (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn18 r)) happyReduce_39 = happySpecReduce_1 23 happyReduction_39 happyReduction_39 (HappyTerminal happy_var_1) = HappyAbsSyn23 (DVar (strToken happy_var_1) (getData happy_var_1) ) happyReduction_39 _ = notHappyAtAll happyReduce_40 = happySpecReduce_1 24 happyReduction_40 happyReduction_40 (HappyAbsSyn23 happy_var_1) = HappyAbsSyn24 ([happy_var_1] ) happyReduction_40 _ = notHappyAtAll happyReduce_41 = happySpecReduce_2 24 happyReduction_41 happyReduction_41 (HappyAbsSyn23 happy_var_2) (HappyAbsSyn24 happy_var_1) = HappyAbsSyn24 (happy_var_2:happy_var_1 ) happyReduction_41 _ _ = notHappyAtAll happyReduce_42 = happySpecReduce_3 25 happyReduction_42 happyReduction_42 (HappyAbsSyn23 happy_var_3) _ (HappyAbsSyn23 happy_var_1) = HappyAbsSyn24 ([happy_var_3,happy_var_1] ) happyReduction_42 _ _ _ = notHappyAtAll happyReduce_43 = happySpecReduce_3 25 happyReduction_43 happyReduction_43 (HappyAbsSyn23 happy_var_3) _ (HappyAbsSyn24 happy_var_1) = HappyAbsSyn24 (happy_var_3:happy_var_1 ) happyReduction_43 _ _ _ = notHappyAtAll happyReduce_44 = happySpecReduce_1 26 happyReduction_44 happyReduction_44 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_44 _ = notHappyAtAll happyReduce_45 = happyReduce 6 27 happyReduction_45 happyReduction_45 ((HappyAbsSyn26 happy_var_6) `HappyStk` _ `HappyStk` (HappyAbsSyn26 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn26 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DIf0 happy_var_2 happy_var_4 happy_var_6 (getData happy_var_1) ) `HappyStk` happyRest happyReduce_46 = happySpecReduce_1 27 happyReduction_46 happyReduction_46 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_46 _ = notHappyAtAll happyReduce_47 = happySpecReduce_3 28 happyReduction_47 happyReduction_47 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "||" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_47 _ _ _ = notHappyAtAll happyReduce_48 = happySpecReduce_1 28 happyReduction_48 happyReduction_48 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_48 _ = notHappyAtAll happyReduce_49 = happySpecReduce_3 29 happyReduction_49 happyReduction_49 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "&&" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_49 _ _ _ = notHappyAtAll happyReduce_50 = happySpecReduce_1 29 happyReduction_50 happyReduction_50 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_50 _ = notHappyAtAll happyReduce_51 = happySpecReduce_3 30 happyReduction_51 happyReduction_51 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "<=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_51 _ _ _ = notHappyAtAll happyReduce_52 = happySpecReduce_3 30 happyReduction_52 happyReduction_52 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp ">=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_52 _ _ _ = notHappyAtAll happyReduce_53 = happySpecReduce_3 30 happyReduction_53 happyReduction_53 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "==" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_53 _ _ _ = notHappyAtAll happyReduce_54 = happySpecReduce_3 30 happyReduction_54 happyReduction_54 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "!=" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_54 _ _ _ = notHappyAtAll happyReduce_55 = happySpecReduce_3 30 happyReduction_55 happyReduction_55 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp ">" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_55 _ _ _ = notHappyAtAll happyReduce_56 = happySpecReduce_3 30 happyReduction_56 happyReduction_56 (HappyAbsSyn26 happy_var_3) (HappyTerminal happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp "<" (getData happy_var_2)) [happy_var_1,happy_var_3] (getData happy_var_1) ) happyReduction_56 _ _ _ = notHappyAtAll happyReduce_57 = happySpecReduce_1 30 happyReduction_57 happyReduction_57 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_57 _ = notHappyAtAll happyReduce_58 = happyReduce 5 31 happyReduction_58 happyReduction_58 ((HappyAbsSyn26 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn26 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DFunAp0 (v2f happy_var_3) [happy_var_1,happy_var_5] (getData happy_var_1) ) `HappyStk` happyRest happyReduce_59 = happySpecReduce_3 31 happyReduction_59 happyReduction_59 (HappyAbsSyn26 happy_var_3) (HappyAbsSyn32 happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp happy_var_2 (getData happy_var_1)) [happy_var_1, happy_var_3] (getData happy_var_1) ) happyReduction_59 _ _ _ = notHappyAtAll happyReduce_60 = happySpecReduce_1 31 happyReduction_60 happyReduction_60 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_60 _ = notHappyAtAll happyReduce_61 = happySpecReduce_1 32 happyReduction_61 happyReduction_61 _ = HappyAbsSyn32 ("+" ) happyReduce_62 = happySpecReduce_1 32 happyReduction_62 happyReduction_62 _ = HappyAbsSyn32 ("-" ) happyReduce_63 = happySpecReduce_3 33 happyReduction_63 happyReduction_63 (HappyAbsSyn26 happy_var_3) (HappyAbsSyn32 happy_var_2) (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (DFunAp0 (DBinOp happy_var_2 (getData happy_var_1)) [happy_var_1, happy_var_3] (getData happy_var_1) ) happyReduction_63 _ _ _ = notHappyAtAll happyReduce_64 = happySpecReduce_2 33 happyReduction_64 happyReduction_64 (HappyAbsSyn26 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn26 (if isConstNum happy_var_2 then negConst happy_var_2 else DFunAp0 (DFun "neg" (getData happy_var_1)) [happy_var_2] (getData happy_var_1) ) happyReduction_64 _ _ = notHappyAtAll happyReduce_65 = happySpecReduce_1 33 happyReduction_65 happyReduction_65 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_65 _ = notHappyAtAll happyReduce_66 = happySpecReduce_1 34 happyReduction_66 happyReduction_66 _ = HappyAbsSyn32 ("*" ) happyReduce_67 = happySpecReduce_1 34 happyReduction_67 happyReduction_67 _ = HappyAbsSyn32 ("/" ) happyReduce_68 = happySpecReduce_3 35 happyReduction_68 happyReduction_68 (HappyAbsSyn36 happy_var_3) _ (HappyAbsSyn37 happy_var_1) = HappyAbsSyn26 (DFieldAcc0 happy_var_1 (reverse happy_var_3) (getData happy_var_1) ) happyReduction_68 _ _ _ = notHappyAtAll happyReduce_69 = happySpecReduce_1 35 happyReduction_69 happyReduction_69 (HappyAbsSyn37 happy_var_1) = HappyAbsSyn26 (DFieldAcc0 happy_var_1 [] (getData happy_var_1) ) happyReduction_69 _ = notHappyAtAll happyReduce_70 = happyMonadReduce 3 35 happyReduction_70 happyReduction_70 ((HappyAbsSyn36 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_1 "e" >> return (DFieldAccE0 (DEdge (getData happy_var_1)) (reverse happy_var_3) (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn26 r)) happyReduce_71 = happySpecReduce_1 35 happyReduction_71 happyReduction_71 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_71 _ = notHappyAtAll happyReduce_72 = happySpecReduce_1 36 happyReduction_72 happyReduction_72 (HappyAbsSyn11 happy_var_1) = HappyAbsSyn36 ([happy_var_1] ) happyReduction_72 _ = notHappyAtAll happyReduce_73 = happySpecReduce_3 36 happyReduction_73 happyReduction_73 (HappyAbsSyn11 happy_var_3) _ (HappyAbsSyn36 happy_var_1) = HappyAbsSyn36 (happy_var_3:happy_var_1 ) happyReduction_73 _ _ _ = notHappyAtAll happyReduce_74 = happySpecReduce_2 37 happyReduction_74 happyReduction_74 (HappyAbsSyn23 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn37 (DCurr happy_var_2 (getData happy_var_1) ) happyReduction_74 _ _ = notHappyAtAll happyReduce_75 = happySpecReduce_2 37 happyReduction_75 happyReduction_75 (HappyAbsSyn23 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn37 (DPrev happy_var_2 (getData happy_var_1) ) happyReduction_75 _ _ = notHappyAtAll happyReduce_76 = happySpecReduce_2 37 happyReduction_76 happyReduction_76 (HappyAbsSyn23 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn37 (DVal happy_var_2 (getData happy_var_1) ) happyReduction_76 _ _ = notHappyAtAll happyReduce_77 = happySpecReduce_2 38 happyReduction_77 happyReduction_77 (HappyAbsSyn42 happy_var_2) (HappyAbsSyn23 happy_var_1) = HappyAbsSyn26 (DFunAp0 (v2f happy_var_1) (reverse happy_var_2) (getData happy_var_1) ) happyReduction_77 _ _ = notHappyAtAll happyReduce_78 = happySpecReduce_2 38 happyReduction_78 happyReduction_78 (HappyAbsSyn42 happy_var_2) (HappyAbsSyn46 happy_var_1) = HappyAbsSyn26 (DConsAp0 happy_var_1 (reverse happy_var_2) (getData happy_var_1) ) happyReduction_78 _ _ = notHappyAtAll happyReduce_79 = happyReduce 7 38 happyReduction_79 happyReduction_79 (_ `HappyStk` (HappyAbsSyn42 happy_var_6) `HappyStk` (HappyAbsSyn44 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn26 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn45 happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DAggr0 happy_var_1 happy_var_3 happy_var_5 (reverse happy_var_6) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_80 = happySpecReduce_1 38 happyReduction_80 happyReduction_80 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn26 (happy_var_1 ) happyReduction_80 _ = notHappyAtAll happyReduce_81 = happyReduce 5 38 happyReduction_81 happyReduction_81 ((HappyAbsSyn23 happy_var_5) `HappyStk` (HappyAbsSyn39 happy_var_4) `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` (HappyAbsSyn23 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DPregel0 happy_var_2 happy_var_3 happy_var_4 happy_var_5 (getData happy_var_1) ) `HappyStk` happyRest happyReduce_82 = happySpecReduce_3 38 happyReduction_82 happyReduction_82 (HappyAbsSyn23 happy_var_3) (HappyAbsSyn23 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn26 (DGMap0 happy_var_2 happy_var_3 (getData happy_var_1) ) happyReduction_82 _ _ _ = notHappyAtAll happyReduce_83 = happySpecReduce_3 38 happyReduction_83 happyReduction_83 (HappyAbsSyn23 happy_var_3) (HappyAbsSyn23 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn26 (DGZip0 happy_var_2 happy_var_3 (getData happy_var_1) ) happyReduction_83 _ _ _ = notHappyAtAll happyReduce_84 = happyReduce 5 38 happyReduction_84 happyReduction_84 ((HappyAbsSyn23 happy_var_5) `HappyStk` (HappyAbsSyn39 happy_var_4) `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` (HappyAbsSyn23 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DGIter0 happy_var_2 happy_var_3 happy_var_4 happy_var_5 (getData happy_var_1) ) `HappyStk` happyRest happyReduce_85 = happySpecReduce_1 39 happyReduction_85 happyReduction_85 (HappyTerminal happy_var_1) = HappyAbsSyn39 (DTermF0 (getData happy_var_1) ) happyReduction_85 _ = notHappyAtAll happyReduce_86 = happyReduce 4 39 happyReduction_86 happyReduction_86 (_ `HappyStk` (HappyAbsSyn26 happy_var_3) `HappyStk` _ `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn39 (DTermI0 happy_var_3 (getData happy_var_1) ) `HappyStk` happyRest happyReduce_87 = happyReduce 4 39 happyReduction_87 happyReduction_87 (_ `HappyStk` (HappyAbsSyn26 happy_var_3) `HappyStk` _ `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn39 (DTermU0 happy_var_3 (getData happy_var_1) ) `HappyStk` happyRest happyReduce_88 = happyReduce 4 39 happyReduction_88 happyReduction_88 (_ `HappyStk` (HappyAbsSyn26 happy_var_3) `HappyStk` _ `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn39 (DTermU0 (DFunAp0 (DFun "not" (getData happy_var_1)) [happy_var_3] (getData happy_var_1)) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_89 = happySpecReduce_3 39 happyReduction_89 happyReduction_89 _ (HappyAbsSyn39 happy_var_2) _ = HappyAbsSyn39 (happy_var_2 ) happyReduction_89 _ _ _ = notHappyAtAll happyReduce_90 = happyMonadReduce 6 40 happyReduction_90 happyReduction_90 (_ `HappyStk` (HappyAbsSyn26 happy_var_5) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_3) `HappyStk` _ `HappyStk` _ `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_3 "g" >> return happy_var_5)) ) (\r -> happyReturn (HappyAbsSyn26 r)) happyReduce_91 = happySpecReduce_1 41 happyReduction_91 happyReduction_91 (HappyAbsSyn47 happy_var_1) = HappyAbsSyn26 (DCExp0 happy_var_1 (getData happy_var_1) ) happyReduction_91 _ = notHappyAtAll happyReduce_92 = happySpecReduce_1 41 happyReduction_92 happyReduction_92 (HappyAbsSyn23 happy_var_1) = HappyAbsSyn26 (DVExp0 happy_var_1 (getData happy_var_1) ) happyReduction_92 _ = notHappyAtAll happyReduce_93 = happySpecReduce_3 41 happyReduction_93 happyReduction_93 _ (HappyAbsSyn26 happy_var_2) _ = HappyAbsSyn26 (happy_var_2 ) happyReduction_93 _ _ _ = notHappyAtAll happyReduce_94 = happyReduce 6 41 happyReduction_94 happyReduction_94 (_ `HappyStk` (HappyAbsSyn42 happy_var_5) `HappyStk` (HappyAbsSyn26 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn26 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) = HappyAbsSyn26 (DTuple0 (happy_var_2:happy_var_4:reverse happy_var_5) (getData happy_var_1) ) `HappyStk` happyRest happyReduce_95 = happySpecReduce_1 42 happyReduction_95 happyReduction_95 (HappyAbsSyn26 happy_var_1) = HappyAbsSyn42 ([happy_var_1] ) happyReduction_95 _ = notHappyAtAll happyReduce_96 = happySpecReduce_2 42 happyReduction_96 happyReduction_96 (HappyAbsSyn26 happy_var_2) (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_2:happy_var_1 ) happyReduction_96 _ _ = notHappyAtAll happyReduce_97 = happySpecReduce_0 43 happyReduction_97 happyReduction_97 = HappyAbsSyn42 ([] ) happyReduce_98 = happySpecReduce_3 43 happyReduction_98 happyReduction_98 (HappyAbsSyn26 happy_var_3) _ (HappyAbsSyn42 happy_var_1) = HappyAbsSyn42 (happy_var_3:happy_var_1 ) happyReduction_98 _ _ _ = notHappyAtAll happyReduce_99 = happyMonadReduce 8 44 happyReduction_99 happyReduction_99 ((HappyAbsSyn23 happy_var_8) `HappyStk` _ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_2 "e" >> mustbe happy_var_4 "u" >> mustbe happy_var_8 "v" >> return (DGenI (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn44 r)) happyReduce_100 = happyMonadReduce 8 44 happyReduction_100 happyReduction_100 ((HappyAbsSyn23 happy_var_8) `HappyStk` _ `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_4) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_2) `HappyStk` (HappyTerminal happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_2 "e" >> mustbe happy_var_4 "u" >> mustbe happy_var_8 "v" >> return (DGenO (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn44 r)) happyReduce_101 = happyMonadReduce 4 44 happyReduction_101 happyReduction_101 ((HappyAbsSyn23 happy_var_4) `HappyStk` _ `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_1 "u" >> mustbe happy_var_4 "v" >> return (DGenG (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn44 r)) happyReduce_102 = happyMonadReduce 3 44 happyReduction_102 happyReduction_102 ((HappyAbsSyn23 happy_var_3) `HappyStk` _ `HappyStk` (HappyAbsSyn23 happy_var_1) `HappyStk` happyRest) tk = happyThen ((( mustbe happy_var_1 "u" >> mustbe happy_var_3 "v" >> return (DGenG (getData happy_var_1)))) ) (\r -> happyReturn (HappyAbsSyn44 r)) happyReduce_103 = happySpecReduce_1 45 happyReduction_103 happyReduction_103 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggMin0 (getData happy_var_1) ) happyReduction_103 _ = notHappyAtAll happyReduce_104 = happySpecReduce_1 45 happyReduction_104 happyReduction_104 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggMax0 (getData happy_var_1) ) happyReduction_104 _ = notHappyAtAll happyReduce_105 = happySpecReduce_1 45 happyReduction_105 happyReduction_105 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggSum0 (getData happy_var_1) ) happyReduction_105 _ = notHappyAtAll happyReduce_106 = happySpecReduce_1 45 happyReduction_106 happyReduction_106 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggProd0 (getData happy_var_1) ) happyReduction_106 _ = notHappyAtAll happyReduce_107 = happySpecReduce_1 45 happyReduction_107 happyReduction_107 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggAnd0 (getData happy_var_1) ) happyReduction_107 _ = notHappyAtAll happyReduce_108 = happySpecReduce_1 45 happyReduction_108 happyReduction_108 (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggOr0 (getData happy_var_1) ) happyReduction_108 _ = notHappyAtAll happyReduce_109 = happySpecReduce_2 45 happyReduction_109 happyReduction_109 (HappyAbsSyn26 happy_var_2) (HappyTerminal happy_var_1) = HappyAbsSyn45 (DAggChoice0 happy_var_2 (getData happy_var_1) ) happyReduction_109 _ _ = notHappyAtAll happyReduce_110 = happySpecReduce_1 46 happyReduction_110 happyReduction_110 (HappyTerminal happy_var_1) = HappyAbsSyn46 (DConstructor (strToken happy_var_1) (getData happy_var_1) ) happyReduction_110 _ = notHappyAtAll happyReduce_111 = happySpecReduce_1 47 happyReduction_111 happyReduction_111 (HappyTerminal happy_var_1) = HappyAbsSyn47 (DCInt (readToken happy_var_1) (getData happy_var_1) ) happyReduction_111 _ = notHappyAtAll happyReduce_112 = happySpecReduce_1 47 happyReduction_112 happyReduction_112 (HappyTerminal happy_var_1) = HappyAbsSyn47 (DCDouble (readTokenF happy_var_1) (getData happy_var_1) ) happyReduction_112 _ = notHappyAtAll happyReduce_113 = happySpecReduce_1 47 happyReduction_113 happyReduction_113 (HappyTerminal happy_var_1) = HappyAbsSyn47 (DCBool (readToken happy_var_1) (getData happy_var_1) ) happyReduction_113 _ = notHappyAtAll happyReduce_114 = happySpecReduce_1 47 happyReduction_114 happyReduction_114 (HappyTerminal happy_var_1) = HappyAbsSyn47 (DCString (strToken happy_var_1) (getData happy_var_1) ) happyReduction_114 _ = notHappyAtAll happyNewToken action sts stk [] = action 115 115 notHappyAtAll (HappyState action) sts stk [] happyNewToken action sts stk (tk:tks) = let cont i = action i i tk (HappyState action) sts stk tks in case tk of { (L _ L_CONSTRUCTOR "Int") -> cont 48; (L _ L_CONSTRUCTOR "Bool") -> cont 49; (L _ L_CONSTRUCTOR "Double") -> cont 50; (L _ L_CONSTRUCTOR "String") -> cont 51; (L _ L_CONSTRUCTOR "Pair") -> cont 52; (L _ L_IDENT "sum") -> cont 53; (L _ L_IDENT "prod") -> cont 54; (L _ L_IDENT "minimum") -> cont 55; (L _ L_IDENT "maximum") -> cont 56; (L _ L_IDENT "or") -> cont 57; (L _ L_IDENT "and") -> cont 58; (L _ L_IDENT "random") -> cont 59; (L _ L_IDENT "fregel") -> cont 60; (L _ L_IDENT "gmap") -> cont 61; (L _ L_IDENT "gzip") -> cont 62; (L _ L_IDENT "giter") -> cont 63; (L _ L_CONSTRUCTOR "Fix") -> cont 64; (L _ L_CONSTRUCTOR "Iter") -> cont 65; (L _ L_CONSTRUCTOR "Until") -> cont 66; (L _ L_CONSTRUCTOR "While") -> cont 67; (L _ L_DATA _) -> cont 68; (L _ L_DERIVING _) -> cont 69; (L _ L_LET _) -> cont 70; (L _ L_IN _) -> cont 71; (L _ L_IF _) -> cont 72; (L _ L_THEN _) -> cont 73; (L _ L_ELSE _) -> cont 74; (L _ L_CURR _) -> cont 75; (L _ L_PREV _) -> cont 76; (L _ L_VAL _) -> cont 77; (L _ L_IS _) -> cont 78; (L _ L_RS _) -> cont 79; (L _ L_GOF _) -> cont 80; (L _ L_EQUAL _) -> cont 81; (L _ L_DBLCOLON _) -> cont 82; (L _ L_COMMA _) -> cont 83; (L _ L_SEMICOLON _) -> cont 84; (L _ L_BACKSLASH _) -> cont 85; (L _ L_RARROW _) -> cont 86; (L _ L_LARROW _) -> cont 87; (L _ L_DOTHAT _) -> cont 88; (L _ L_PIPE _) -> cont 89; (L _ L_DBLAND _) -> cont 90; (L _ L_DBLOR _) -> cont 91; (L _ L_EQ _) -> cont 92; (L _ L_NE _) -> cont 93; (L _ L_LT _) -> cont 94; (L _ L_LE _) -> cont 95; (L _ L_GT _) -> cont 96; (L _ L_GE _) -> cont 97; (L _ L_PLUS _) -> cont 98; (L _ L_MINUS _) -> cont 99; (L _ L_AST _) -> cont 100; (L _ L_SLASH _) -> cont 101; (L _ L_BACKQUOTE _) -> cont 102; (L _ L_LPAREN _) -> cont 103; (L _ L_RPAREN _) -> cont 104; (L _ L_LBRACE _) -> cont 105; (L _ L_RBRACE _) -> cont 106; (L _ L_LBRACKET _) -> cont 107; (L _ L_RBRACKET _) -> cont 108; (L _ L_BOOL _) -> cont 109; (L _ L_INT _) -> cont 110; (L _ L_FLOAT _) -> cont 111; (L _ L_STRING _) -> cont 112; (L _ L_IDENT _) -> cont 113; (L _ L_CONSTRUCTOR _) -> cont 114; _ -> happyError' ((tk:tks), []) } happyError_ explist 115 tk tks = happyError' (tks, explist) happyError_ explist _ tk tks = happyError' ((tk:tks), explist) happyThen :: () => CM a -> (a -> CM b) -> CM b happyThen = (>>=) happyReturn :: () => a -> CM a happyReturn = (return) happyThen1 m k tks = (>>=) m (\a -> k a tks) happyReturn1 :: () => a -> b -> CM a happyReturn1 = \a tks -> (return) a happyError' :: () => ([(Lexeme)], [String]) -> CM a happyError' = (\(tokens, _) -> parseError tokens) fregelparser tks = happySomeParser where happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn5 z -> happyReturn z; _other -> notHappyAtAll }) exprparser tks = happySomeParser where happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn26 z -> happyReturn z; _other -> notHappyAtAll }) happySeq = happyDontSeq -- misc functions -- extracs the string from a token strToken :: Lexeme -> String strToken (L _ _ s) = s -- reads data from a token readToken :: Read a => Lexeme -> a readToken = read . strToken -- reads data from a token readTokenF :: Lexeme -> Double readTokenF = read . correct . strToken where correct str = -- workaround for "0." let r = reverse str in reverse $ (if head r == '.' then ('0':) else id) r instance DAdditionalData Lexeme Pos where getData (L p t s) = p setData p (L _ t s) = L p t s -- a token must be a specific name mustbe :: DVar Pos -> String -> CM () mustbe (DVar name p) str = if name == str then return () else error $ "Parse error: variable name must be " ++ str ++ " at " ++ showPosn p parseError :: [Lexeme] -> a parseError ((L p t s):ts) = error $ "Parse error: " ++ s ++ " at " ++ showPosn p -- to make negative integral/float literals isConstNum :: DExpr0 Pos -> Bool isConstNum (DCExp0 (DCInt _ _) _) = True isConstNum (DCExp0 (DCDouble _ _) _) = True isConstNum _ = False negConst :: DExpr0 Pos -> DExpr0 Pos negConst (DCExp0 (DCInt i a) b) = (DCExp0 (DCInt (-i) a) b) negConst (DCExp0 (DCDouble d a) b) = (DCExp0 (DCDouble (-d) a) b) -- currently, these are meaningless data Params = Params deriving (Eq, Show) initParams = Params data CompilerState = CompilerState type CM a = State CompilerState a runCM m ps = runState m (initState ps) initState ps = CompilerState main = do str <- getContents let ast0 = parseString0 str ast = map convert0 ast0 print ast0 print ast {- for test use main = do getContents >>= mapM_ (\file -> check file >>= putStrLn . show) . lines -- checking function: parse = parse . prettyPrint . parse ? check file = do ast <- parseFile file print ast let pp = foldr (\x y -> x ++ "\n" ++ y) "" (map ppAST0 ast) putStrLn pp let ast2 = parseString0 pp print ast2 return (map (mapData (\_ -> "")) ast == map (mapData (\_ -> "")) ast2) --ignore line/pos -} --- misc functions to be used by other modules parseStringExpr0 str = let ts = snd (right (scanner str)) ast = fst $ runCM (exprparser ts) initParams in ast parseString0 :: String -> [DProgramSpec0 Pos] parseString0 str = let ts = snd (right (scanner str)) ast = fst $ runCM (fregelparser ts) initParams in ast parseString :: String -> [DProgramSpec String] parseString str = map (mapData (\_ -> "")) $ map convert0 $ parseString0 str parseFile file = do str <- readFile file return $ parseString str processFile file = do ast <- parseFile file print ast parseFile' file = do ast <- parseFile file return ast parseFile'' file = do asts <- parseFile file return (propRecs asts) where propRecs xs = let rss = concatMap (\(DProgramSpec rs _ _) -> rs) xs in map (\(DProgramSpec _ x a) -> DProgramSpec rss x a) xs parseString' ss = parseString ss {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 {-# LINE 7 "" #-} {-# LINE 1 "/usr/lib/ghc/include/ghcversion.h" #-} {-# LINE 7 "" #-} {-# LINE 1 "/tmp/ghc8336_0/ghc_2.h" #-} {-# LINE 7 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp {-# LINE 43 "templates/GenericTemplate.hs" #-} data Happy_IntList = HappyCons Int Happy_IntList {-# LINE 65 "templates/GenericTemplate.hs" #-} {-# LINE 75 "templates/GenericTemplate.hs" #-} {-# LINE 84 "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 (1), 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 (1) tk st sts (_ `HappyStk` ans `HappyStk` _) = happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action {-# LINE 137 "templates/GenericTemplate.hs" #-} {-# LINE 147 "templates/GenericTemplate.hs" #-} indexShortOffAddr arr off = arr Happy_Data_Array.! off {-# INLINE happyLt #-} happyLt x y = (x < y) readArrayBit arr bit = Bits.testBit (indexShortOffAddr arr (bit `div` 16)) (bit `mod` 16) ----------------------------------------------------------------------------- -- HappyState data type (not arrays) newtype HappyState b c = HappyState (Int -> -- token number Int -> -- token number (yes, again) b -> -- token semantic value HappyState b c -> -- current state [HappyState b c] -> -- state stack c) ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state (1) tk st sts stk@(x `HappyStk` _) = let i = (case x of { HappyErrorToken (i) -> i }) in -- trace "shifting the error token" $ new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk) happyShift new_state i tk st sts stk = happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk) -- happyReduce is specialised for the common cases. happySpecReduce_0 i fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk = action nt j tk st ((st):(sts)) (fn `HappyStk` stk) happySpecReduce_1 i fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk') = let r = fn v1 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happySpecReduce_2 i fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk') = let r = fn v1 v2 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happySpecReduce_3 i fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') = let r = fn v1 v2 v3 in happySeq r (action nt j tk st sts (r `HappyStk` stk')) happyReduce k i fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happyReduce k nt fn j tk st sts stk = case happyDrop (k - ((1) :: Int)) sts of sts1@(((st1@(HappyState (action))):(_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (action nt j tk st1 sts1 r) happyMonadReduce k nt fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happyMonadReduce k nt fn j tk st sts stk = case happyDrop k ((st):(sts)) of sts1@(((st1@(HappyState (action))):(_))) -> let drop_stk = happyDropStk k stk in happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk)) happyMonad2Reduce k nt fn (1) tk st sts stk = happyFail [] (1) tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = case happyDrop k ((st):(sts)) of sts1@(((st1@(HappyState (action))):(_))) -> let drop_stk = happyDropStk k stk _ = nt :: Int new_state = action in happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) happyDrop (0) l = l happyDrop n ((_):(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 {-# LINE 267 "templates/GenericTemplate.hs" #-} happyGoto action j tk st = action j j tk (HappyState action) ----------------------------------------------------------------------------- -- Error recovery ((1) is the error token) -- parse error if we are in recovery and we fail again happyFail explist (1) tk old_st _ stk@(x `HappyStk` _) = let i = (case x of { HappyErrorToken (i) -> i }) in -- trace "failing" $ happyError_ explist i 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 (1) tk old_st (((HappyState (action))):(sts)) (saved_tok `HappyStk` _ `HappyStk` stk) = -- trace ("discarding state, depth " ++ show (length stk)) $ action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk)) -} -- Enter error recovery: generate an error token, -- save the old token and carry on. happyFail explist i tk (HappyState (action)) sts stk = -- trace "entering error recovery" $ action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk) -- Internal happy errors: notHappyAtAll :: a notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions ----------------------------------------------------------------------------- -- 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. {-# LINE 333 "templates/GenericTemplate.hs" #-} {-# 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.