ghc/tests/ghci/prog005/Parser.hs

   1 {-# OPTIONS -fglasgow-exts -cpp #-}
   2 -- parser produced by Happy Version 1.11
   3
   4 module Parser where
   5
   6 import Char
   7 import GlaExts
   8 import Array
   9 import IO
  10 import IOExts
  11
  12 data HappyAbsSyn
  13         = HappyTerminal Token
  14         | HappyErrorToken Int
  15         | HappyAbsSyn4 (Int)
  16
  17 happyActOffsets :: Addr
  18 happyActOffsets = A# "\x0a\x00\x0a\x00\x00\x00\xff\xff\x0a\x00\x0a\x00\x08\x00\x07\x00\x00\x00"#
  19
  20 happyGotoOffsets :: Addr
  21 happyGotoOffsets = A# "\x06\x00\x00\x00\x00\x00\x00\x00\x05\x00\x04\x00\x00\x00\x00\x00\x00\x00"#
  22
  23 happyDefActions :: Addr
  24 happyDefActions = A# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xfc\xff\xfd\xff"#
  25
  26 happyCheck :: Addr
  27 happyCheck = A# "\xff\xff\x02\x00\x03\x00\x04\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x02\x00\x02\x00\x01\x00\xff\xff\xff\xff\xff\xff"#
  28
  29 happyTable :: Addr
  30 happyTable = A# "\x00\x00\x05\x00\x06\x00\xff\xff\x06\x00\x07\x00\x03\x00\x00\x00\x00\x00\x00\x00\x05\x00\x03\x00\x00\x00\x00\x00\x00\x00"#
  31
  32 happyReduceArr = array (1, 3) [
  33         (1 , happyReduce_1),
  34         (2 , happyReduce_2),
  35         (3 , happyReduce_3)
  36         ]
  37
  38 happy_n_terms = 5 :: Int
  39 happy_n_nonterms = 1 :: Int
  40
  41 happyReduce_1 = happySpecReduce_1 0# happyReduction_1
  42 happyReduction_1 _
  43          =  HappyAbsSyn4
  44                  (1
  45         )
  46
  47 happyReduce_2 = happySpecReduce_3 0# happyReduction_2
  48 happyReduction_2 _
  49         _
  50         _
  51          =  HappyAbsSyn4
  52                  (2
  53         )
  54
  55 happyReduce_3 = happySpecReduce_3 0# happyReduction_3
  56 happyReduction_3 _
  57         _
  58         _
  59          =  HappyAbsSyn4
  60                  (3
  61         )
  62
  63 happyNewToken action sts stk [] =
  64         happyDoAction 4# (error "reading EOF!") action sts stk []
  65
  66 happyNewToken action sts stk (tk:tks) =
  67         let cont i = happyDoAction i tk action sts stk tks in
  68         case tk of {
  69         Tid -> cont 1#;
  70         Tgreater -> cont 2#;
  71         Tand -> cont 3#;
  72         }
  73
  74 happyThen = \m k -> k m
  75 happyReturn = \a -> a
  76 happyThen1 = happyThen
  77 happyReturn1 = \a tks -> a
  78
  79 parser tks = happyThen (happyParse 0# tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })
  80
  81 data Token = Tid | Tgreater | Tand
  82              deriving Show
  83
  84 happyError = error "parse error"
  85
  86 lexer :: String -> [Token]
  87 lexer = l
  88       where l ""         = []
  89             l ('\n':cs)  = l cs
  90             l ('a':'n':'d':cs) = Tand : l cs
  91             l (c:cs)
  92                 | isSpace c = l cs
  93                 | isAlpha c = let (_,rs) = span isAlpha (c:cs)
  94                               in Tid : l rs
  95             l ('>':cs)      = Tgreater : l cs
  96 {-# LINE 1 "GenericTemplate.hs" #-}
  97 {-# LINE 1 "GenericTemplate.hs" #-}
  98 -- $Id: Parser.hs,v 1.1 2002/01/31 13:46:38 simonmar Exp $
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112 {-# LINE 27 "GenericTemplate.hs" #-}
 113
 114
 115
 116 data Happy_IntList = HappyCons Int# Happy_IntList
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148 happyTrace string expr = unsafePerformIO $ do
 149     hPutStr stderr string
 150     return expr
 151
 152
 153
 154
 155 infixr 9 `HappyStk`
 156 data HappyStk a = HappyStk a (HappyStk a)
 157
 158 -----------------------------------------------------------------------------
 159 -- starting the parse
 160
 161 happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
 162
 163 -----------------------------------------------------------------------------
 164 -- Accepting the parse
 165
 166 happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j
 167                                                   (happyTcHack st))
 168                                            (happyReturn1 ans)
 169
 170 -----------------------------------------------------------------------------
 171 -- Arrays only: do the next action
 172
 173
 174
 175 happyDoAction i tk st
 176         = (happyTrace ("state: " ++ show (I# (st)) ++
 177                       ",\ttoken: " ++ show (I# (i)) ++
 178                       ",\taction: ")) $
 179           case action of
 180                 0#                -> (happyTrace ("fail.\n")) $
 181                                      happyFail i tk st
 182                 -1#       -> (happyTrace ("accept.\n")) $
 183                                      happyAccept i tk st
 184                 n | (n <# (0# :: Int#)) -> (happyTrace ("reduce (rule " ++ show rule
 185                                                  ++ ")")) $
 186                                      (happyReduceArr ! rule) i tk st
 187                                      where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
 188                 n                 -> (happyTrace ("shift, enter state "
 189                                                  ++ show (I# (new_state))
 190                                                  ++ "\n")) $
 191                                      happyShift new_state i tk st
 192                                      where new_state = (n -# (1# :: Int#))
 193    where off    = indexShortOffAddr happyActOffsets st
 194          off_i  = (off +# i)
 195          check  = if (off_i >=# (0# :: Int#))
 196                         then (indexShortOffAddr happyCheck off_i ==#  i)
 197                         else False
 198          action | check     = indexShortOffAddr happyTable off_i
 199                 | otherwise = indexShortOffAddr happyDefActions st
 200
 201
 202
 203
 204
 205
 206
 207 indexShortOffAddr (A# arr) off =
 208 #if __GLASGOW_HASKELL__ > 500
 209         narrow16Int# i
 210 #elif __GLASGOW_HASKELL__ == 500
 211         intToInt16# i
 212 #else
 213         (i `iShiftL#` 16#) `iShiftRA#` 16#
 214 #endif
 215   where
 216         i = word2Int# ((high `shiftL#` 8#) `or#` low)
 217         high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
 218         low  = int2Word# (ord# (indexCharOffAddr# arr off'))
 219         off' = off *# 2#
 220
 221
 222
 223
 224
 225
 226 -----------------------------------------------------------------------------
 227 -- HappyState data type (not arrays)
 228
 229 {-# LINE 153 "GenericTemplate.hs" #-}
 230
 231
 232 -----------------------------------------------------------------------------
 233 -- Shifting a token
 234
 235 happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
 236      let i = (case x of { HappyErrorToken (I# (i)) -> i }) in
 237 --     trace "shifting the error token" $
 238      happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
 239
 240 happyShift new_state i tk st sts stk =
 241      happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk)
 242
 243 -- happyReduce is specialised for the common cases.
 244
 245 happySpecReduce_0 i fn 0# tk st sts stk
 246      = happyFail 0# tk st sts stk
 247 happySpecReduce_0 nt fn j tk st@((action)) sts stk
 248      = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
 249
 250 happySpecReduce_1 i fn 0# tk st sts stk
 251      = happyFail 0# tk st sts stk
 252 happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
 253      = happyGoto nt j tk st sts (fn v1 `HappyStk` stk')
 254
 255 happySpecReduce_2 i fn 0# tk st sts stk
 256      = happyFail 0# tk st sts stk
 257 happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
 258      = happyGoto nt j tk st sts (fn v1 v2 `HappyStk` stk')
 259
 260 happySpecReduce_3 i fn 0# tk st sts stk
 261      = happyFail 0# tk st sts stk
 262 happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
 263      = happyGoto nt j tk st sts (fn v1 v2 v3 `HappyStk` stk')
 264
 265 happyReduce k i fn 0# tk st sts stk
 266      = happyFail 0# tk st sts stk
 267 happyReduce k nt fn j tk st sts stk = happyGoto nt j tk st1 sts1 (fn stk)
 268        where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
 269
 270 happyMonadReduce k nt fn 0# tk st sts stk
 271      = happyFail 0# tk st sts stk
 272 happyMonadReduce k nt fn j tk st sts stk =
 273         happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
 274        where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
 275              drop_stk = happyDropStk k stk
 276
 277 happyDrop 0# l = l
 278 happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t
 279
 280 happyDropStk 0# l = l
 281 happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs
 282
 283 -----------------------------------------------------------------------------
 284 -- Moving to a new state after a reduction
 285
 286
 287 happyGoto nt j tk st =
 288    (happyTrace (", goto state " ++ show (I# (new_state)) ++ "\n")) $
 289    happyDoAction j tk new_state
 290    where off    = indexShortOffAddr happyGotoOffsets st
 291          off_i  = (off +# nt)
 292          new_state = indexShortOffAddr happyTable off_i
 293
 294
 295
 296
 297 -----------------------------------------------------------------------------
 298 -- Error recovery (0# is the error token)
 299
 300 -- parse error if we are in recovery and we fail again
 301 happyFail  0# tk old_st _ stk =
 302 --      trace "failing" $
 303         happyError
 304
 305
 306 {-  We don't need state discarding for our restricted implementation of
 307     "error".  In fact, it can cause some bogus parses, so I've disabled it
 308     for now --SDM
 309
 310 -- discard a state
 311 happyFail  0# tk old_st (HappyCons ((action)) (sts))
 312                                                 (saved_tok `HappyStk` _ `HappyStk` stk) =
 313 --      trace ("discarding state, depth " ++ show (length stk))  $
 314         happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
 315 -}
 316
 317 -- Enter error recovery: generate an error token,
 318 --                       save the old token and carry on.
 319 happyFail  i tk (action) sts stk =
 320 --      trace "entering error recovery" $
 321         happyDoAction 0# tk action sts ( (HappyErrorToken (I# (i))) `HappyStk` stk)
 322
 323 -- Internal happy errors:
 324
 325 notHappyAtAll = error "Internal Happy error\n"
 326
 327 -----------------------------------------------------------------------------
 328 -- Hack to get the typechecker to accept our action functions
 329
 330
 331 happyTcHack :: Int# -> a -> a
 332 happyTcHack x y = y
 333 {-# INLINE happyTcHack #-}
 334
 335
 336 -----------------------------------------------------------------------------
 337 -- Don't inline any functions from the template.  GHC has a nasty habit
 338 -- of deciding to inline happyGoto everywhere, which increases the size of
 339 -- the generated parser quite a bit.
 340
 341
 342 {-# NOINLINE happyDoAction #-}
 343 {-# NOINLINE happyTable #-}
 344 {-# NOINLINE happyCheck #-}
 345 {-# NOINLINE happyActOffsets #-}
 346 {-# NOINLINE happyGotoOffsets #-}
 347 {-# NOINLINE happyDefActions #-}
 348
 349 {-# NOINLINE happyShift #-}
 350 {-# NOINLINE happySpecReduce_0 #-}
 351 {-# NOINLINE happySpecReduce_1 #-}
 352 {-# NOINLINE happySpecReduce_2 #-}
 353 {-# NOINLINE happySpecReduce_3 #-}
 354 {-# NOINLINE happyReduce #-}
 355 {-# NOINLINE happyMonadReduce #-}
 356 {-# NOINLINE happyGoto #-}
 357 {-# NOINLINE happyFail #-}
 358
 359 -- end of Happy Template.