camfort-0.802: src/Camfort/Specification/Stencils/Grammar.hs
{-# OPTIONS_GHC -w #-}
-- -*- Mode: Haskell -*-
{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}
module Camfort.Specification.Stencils.Grammar
( specParser, Specification(..), Region(..), Spec(..), Mod(..), lexer ) where
import Data.Char (isLetter, isNumber, isAlphaNum, toLower, isAlpha, isSpace)
import Data.List (intersect, sort, isPrefixOf)
import Data.Data
import Debug.Trace
import Camfort.Analysis.CommentAnnotator
import Camfort.Specification.Stencils.Syntax (showL)
import Control.Applicative(Applicative(..))
import Control.Monad (ap)
-- parser produced by Happy Version 1.19.5
data HappyAbsSyn
= HappyTerminal (Token)
| HappyErrorToken Int
| HappyAbsSyn4 (Specification)
| HappyAbsSyn5 ((String, Region))
| HappyAbsSyn6 (Region)
| HappyAbsSyn7 (Bool)
| HappyAbsSyn8 (Spec)
| HappyAbsSyn9 (Mod)
| HappyAbsSyn10 ([Mod])
| HappyAbsSyn12 ([String])
{- 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
-> (Token)
-> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)
-> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Token)] -> 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 :: () => Int -> ({-HappyReduction (Either AnnotationParseError) = -}
Int
-> (Token)
-> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)
-> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)
happyReduce_1,
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 :: () => ({-HappyReduction (Either AnnotationParseError) = -}
Int
-> (Token)
-> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)
-> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)
action_0 (13) = happyShift action_5
action_0 (14) = happyShift action_3
action_0 (4) = happyGoto action_4
action_0 (5) = happyGoto action_2
action_0 _ = happyFail
action_1 (14) = happyShift action_3
action_1 (5) = happyGoto action_2
action_1 _ = happyFail
action_2 _ = happyReduce_1
action_3 (28) = happyShift action_21
action_3 _ = happyFail
action_4 (37) = happyAccept
action_4 _ = happyFail
action_5 (15) = happyShift action_11
action_5 (16) = happyShift action_12
action_5 (18) = happyShift action_13
action_5 (19) = happyShift action_14
action_5 (23) = happyShift action_15
action_5 (24) = happyShift action_16
action_5 (25) = happyShift action_17
action_5 (26) = happyShift action_18
action_5 (28) = happyShift action_19
action_5 (34) = happyShift action_20
action_5 (6) = happyGoto action_6
action_5 (8) = happyGoto action_7
action_5 (9) = happyGoto action_8
action_5 (10) = happyGoto action_9
action_5 (11) = happyGoto action_10
action_5 _ = happyFail
action_6 (30) = happyShift action_35
action_6 (31) = happyShift action_36
action_6 _ = happyReduce_19
action_7 (32) = happyShift action_34
action_7 _ = happyFail
action_8 (16) = happyShift action_12
action_8 (23) = happyShift action_15
action_8 (24) = happyShift action_16
action_8 (25) = happyShift action_17
action_8 (28) = happyShift action_19
action_8 (34) = happyShift action_20
action_8 (6) = happyGoto action_33
action_8 _ = happyFail
action_9 (15) = happyShift action_11
action_9 (9) = happyGoto action_32
action_9 _ = happyFail
action_10 (16) = happyShift action_12
action_10 (18) = happyShift action_13
action_10 (19) = happyShift action_14
action_10 (23) = happyShift action_15
action_10 (24) = happyShift action_16
action_10 (25) = happyShift action_17
action_10 (28) = happyShift action_19
action_10 (34) = happyShift action_20
action_10 (6) = happyGoto action_29
action_10 (10) = happyGoto action_30
action_10 (11) = happyGoto action_31
action_10 _ = happyReduce_22
action_11 _ = happyReduce_20
action_12 (34) = happyShift action_28
action_12 _ = happyFail
action_13 _ = happyReduce_23
action_14 _ = happyReduce_24
action_15 (34) = happyShift action_27
action_15 _ = happyFail
action_16 (34) = happyShift action_26
action_16 _ = happyFail
action_17 (34) = happyShift action_25
action_17 _ = happyFail
action_18 (34) = happyShift action_24
action_18 _ = happyFail
action_19 _ = happyReduce_11
action_20 (16) = happyShift action_12
action_20 (23) = happyShift action_15
action_20 (24) = happyShift action_16
action_20 (25) = happyShift action_17
action_20 (28) = happyShift action_19
action_20 (34) = happyShift action_20
action_20 (6) = happyGoto action_23
action_20 _ = happyFail
action_21 (33) = happyShift action_22
action_21 _ = happyFail
action_22 (16) = happyShift action_12
action_22 (23) = happyShift action_15
action_22 (24) = happyShift action_16
action_22 (25) = happyShift action_17
action_22 (28) = happyShift action_19
action_22 (34) = happyShift action_20
action_22 (6) = happyGoto action_48
action_22 _ = happyFail
action_23 (30) = happyShift action_35
action_23 (31) = happyShift action_36
action_23 (35) = happyShift action_47
action_23 _ = happyFail
action_24 (28) = happyShift action_40
action_24 (12) = happyGoto action_46
action_24 _ = happyFail
action_25 (22) = happyShift action_45
action_25 _ = happyFail
action_26 (22) = happyShift action_44
action_26 _ = happyFail
action_27 (22) = happyShift action_43
action_27 _ = happyFail
action_28 (21) = happyShift action_42
action_28 _ = happyFail
action_29 (30) = happyShift action_35
action_29 (31) = happyShift action_36
action_29 _ = happyReduce_18
action_30 _ = happyReduce_21
action_31 (18) = happyShift action_13
action_31 (19) = happyShift action_14
action_31 (10) = happyGoto action_30
action_31 (11) = happyGoto action_31
action_31 _ = happyReduce_22
action_32 (16) = happyShift action_12
action_32 (23) = happyShift action_15
action_32 (24) = happyShift action_16
action_32 (25) = happyShift action_17
action_32 (28) = happyShift action_19
action_32 (34) = happyShift action_20
action_32 (6) = happyGoto action_41
action_32 _ = happyFail
action_33 (30) = happyShift action_35
action_33 (31) = happyShift action_36
action_33 _ = happyReduce_17
action_34 (28) = happyShift action_40
action_34 (12) = happyGoto action_39
action_34 _ = happyFail
action_35 (16) = happyShift action_12
action_35 (23) = happyShift action_15
action_35 (24) = happyShift action_16
action_35 (25) = happyShift action_17
action_35 (28) = happyShift action_19
action_35 (34) = happyShift action_20
action_35 (6) = happyGoto action_38
action_35 _ = happyFail
action_36 (16) = happyShift action_12
action_36 (23) = happyShift action_15
action_36 (24) = happyShift action_16
action_36 (25) = happyShift action_17
action_36 (28) = happyShift action_19
action_36 (34) = happyShift action_20
action_36 (6) = happyGoto action_37
action_36 _ = happyFail
action_37 _ = happyReduce_9
action_38 (31) = happyShift action_36
action_38 _ = happyReduce_8
action_39 _ = happyReduce_2
action_40 (28) = happyShift action_40
action_40 (12) = happyGoto action_54
action_40 _ = happyReduce_26
action_41 (30) = happyShift action_35
action_41 (31) = happyShift action_36
action_41 _ = happyReduce_16
action_42 (33) = happyShift action_53
action_42 _ = happyFail
action_43 (33) = happyShift action_52
action_43 _ = happyFail
action_44 (33) = happyShift action_51
action_44 _ = happyFail
action_45 (33) = happyShift action_50
action_45 _ = happyFail
action_46 (35) = happyShift action_49
action_46 _ = happyFail
action_47 _ = happyReduce_10
action_48 (30) = happyShift action_35
action_48 (31) = happyShift action_36
action_48 _ = happyReduce_3
action_49 (27) = happyShift action_59
action_49 _ = happyReduce_14
action_50 (29) = happyShift action_58
action_50 _ = happyFail
action_51 (29) = happyShift action_57
action_51 _ = happyFail
action_52 (29) = happyShift action_56
action_52 _ = happyFail
action_53 (29) = happyShift action_55
action_53 _ = happyFail
action_54 _ = happyReduce_25
action_55 (35) = happyShift action_63
action_55 _ = happyFail
action_56 (21) = happyShift action_62
action_56 _ = happyFail
action_57 (21) = happyShift action_61
action_57 _ = happyFail
action_58 (21) = happyShift action_60
action_58 _ = happyFail
action_59 _ = happyReduce_15
action_60 (33) = happyShift action_66
action_60 _ = happyFail
action_61 (33) = happyShift action_65
action_61 _ = happyFail
action_62 (33) = happyShift action_64
action_62 _ = happyFail
action_63 _ = happyReduce_7
action_64 (29) = happyShift action_69
action_64 _ = happyFail
action_65 (29) = happyShift action_68
action_65 _ = happyFail
action_66 (29) = happyShift action_67
action_66 _ = happyFail
action_67 (17) = happyShift action_71
action_67 (7) = happyGoto action_73
action_67 _ = happyReduce_13
action_68 (17) = happyShift action_71
action_68 (7) = happyGoto action_72
action_68 _ = happyReduce_13
action_69 (17) = happyShift action_71
action_69 (7) = happyGoto action_70
action_69 _ = happyReduce_13
action_70 (35) = happyShift action_76
action_70 _ = happyFail
action_71 _ = happyReduce_12
action_72 (35) = happyShift action_75
action_72 _ = happyFail
action_73 (35) = happyShift action_74
action_73 _ = happyFail
action_74 _ = happyReduce_6
action_75 _ = happyReduce_5
action_76 _ = happyReduce_4
happyReduce_1 = happySpecReduce_1 4 happyReduction_1
happyReduction_1 (HappyAbsSyn5 happy_var_1)
= HappyAbsSyn4
(RegionDec (fst happy_var_1) (snd happy_var_1)
)
happyReduction_1 _ = notHappyAtAll
happyReduce_2 = happyReduce 4 4 happyReduction_2
happyReduction_2 ((HappyAbsSyn12 happy_var_4) `HappyStk`
_ `HappyStk`
(HappyAbsSyn8 happy_var_2) `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn4
(SpecDec happy_var_2 happy_var_4
) `HappyStk` happyRest
happyReduce_3 = happyReduce 4 5 happyReduction_3
happyReduction_3 ((HappyAbsSyn6 happy_var_4) `HappyStk`
_ `HappyStk`
(HappyTerminal (TId happy_var_2)) `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn5
((happy_var_2, happy_var_4)
) `HappyStk` happyRest
happyReduce_4 = happyReduce 10 6 happyReduction_4
happyReduction_4 (_ `HappyStk`
(HappyAbsSyn7 happy_var_9) `HappyStk`
(HappyTerminal (TNum happy_var_8)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
(HappyTerminal (TNum happy_var_5)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn6
(Forward (read happy_var_5) (read happy_var_8) happy_var_9
) `HappyStk` happyRest
happyReduce_5 = happyReduce 10 6 happyReduction_5
happyReduction_5 (_ `HappyStk`
(HappyAbsSyn7 happy_var_9) `HappyStk`
(HappyTerminal (TNum happy_var_8)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
(HappyTerminal (TNum happy_var_5)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn6
(Backward (read happy_var_5) (read happy_var_8) happy_var_9
) `HappyStk` happyRest
happyReduce_6 = happyReduce 10 6 happyReduction_6
happyReduction_6 (_ `HappyStk`
(HappyAbsSyn7 happy_var_9) `HappyStk`
(HappyTerminal (TNum happy_var_8)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
(HappyTerminal (TNum happy_var_5)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn6
(Centered (read happy_var_5) (read happy_var_8) happy_var_9
) `HappyStk` happyRest
happyReduce_7 = happyReduce 6 6 happyReduction_7
happyReduction_7 (_ `HappyStk`
(HappyTerminal (TNum happy_var_5)) `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn6
(Centered 0 (read happy_var_5) True
) `HappyStk` happyRest
happyReduce_8 = happySpecReduce_3 6 happyReduction_8
happyReduction_8 (HappyAbsSyn6 happy_var_3)
_
(HappyAbsSyn6 happy_var_1)
= HappyAbsSyn6
(Or happy_var_1 happy_var_3
)
happyReduction_8 _ _ _ = notHappyAtAll
happyReduce_9 = happySpecReduce_3 6 happyReduction_9
happyReduction_9 (HappyAbsSyn6 happy_var_3)
_
(HappyAbsSyn6 happy_var_1)
= HappyAbsSyn6
(And happy_var_1 happy_var_3
)
happyReduction_9 _ _ _ = notHappyAtAll
happyReduce_10 = happySpecReduce_3 6 happyReduction_10
happyReduction_10 _
(HappyAbsSyn6 happy_var_2)
_
= HappyAbsSyn6
(happy_var_2
)
happyReduction_10 _ _ _ = notHappyAtAll
happyReduce_11 = happySpecReduce_1 6 happyReduction_11
happyReduction_11 (HappyTerminal (TId happy_var_1))
= HappyAbsSyn6
(Var happy_var_1
)
happyReduction_11 _ = notHappyAtAll
happyReduce_12 = happySpecReduce_1 7 happyReduction_12
happyReduction_12 _
= HappyAbsSyn7
(False
)
happyReduce_13 = happySpecReduce_0 7 happyReduction_13
happyReduction_13 = HappyAbsSyn7
(True
)
happyReduce_14 = happyReduce 4 8 happyReduction_14
happyReduction_14 (_ `HappyStk`
(HappyAbsSyn12 happy_var_3) `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn8
(Temporal happy_var_3 False
) `HappyStk` happyRest
happyReduce_15 = happyReduce 5 8 happyReduction_15
happyReduction_15 (_ `HappyStk`
_ `HappyStk`
(HappyAbsSyn12 happy_var_3) `HappyStk`
_ `HappyStk`
_ `HappyStk`
happyRest)
= HappyAbsSyn8
(Temporal happy_var_3 True
) `HappyStk` happyRest
happyReduce_16 = happySpecReduce_3 8 happyReduction_16
happyReduction_16 (HappyAbsSyn6 happy_var_3)
(HappyAbsSyn9 happy_var_2)
(HappyAbsSyn10 happy_var_1)
= HappyAbsSyn8
(Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3
)
happyReduction_16 _ _ _ = notHappyAtAll
happyReduce_17 = happySpecReduce_2 8 happyReduction_17
happyReduction_17 (HappyAbsSyn6 happy_var_2)
(HappyAbsSyn9 happy_var_1)
= HappyAbsSyn8
(Spatial [happy_var_1] happy_var_2
)
happyReduction_17 _ _ = notHappyAtAll
happyReduce_18 = happySpecReduce_2 8 happyReduction_18
happyReduction_18 (HappyAbsSyn6 happy_var_2)
(HappyAbsSyn9 happy_var_1)
= HappyAbsSyn8
(Spatial [happy_var_1] happy_var_2
)
happyReduction_18 _ _ = notHappyAtAll
happyReduce_19 = happySpecReduce_1 8 happyReduction_19
happyReduction_19 (HappyAbsSyn6 happy_var_1)
= HappyAbsSyn8
(Spatial [] happy_var_1
)
happyReduction_19 _ = notHappyAtAll
happyReduce_20 = happySpecReduce_1 9 happyReduction_20
happyReduction_20 _
= HappyAbsSyn9
(ReadOnce
)
happyReduce_21 = happySpecReduce_2 10 happyReduction_21
happyReduction_21 (HappyAbsSyn10 happy_var_2)
(HappyAbsSyn9 happy_var_1)
= HappyAbsSyn10
(happy_var_1 : happy_var_2
)
happyReduction_21 _ _ = notHappyAtAll
happyReduce_22 = happySpecReduce_1 10 happyReduction_22
happyReduction_22 (HappyAbsSyn9 happy_var_1)
= HappyAbsSyn10
([happy_var_1]
)
happyReduction_22 _ = notHappyAtAll
happyReduce_23 = happySpecReduce_1 11 happyReduction_23
happyReduction_23 _
= HappyAbsSyn9
(AtMost
)
happyReduce_24 = happySpecReduce_1 11 happyReduction_24
happyReduction_24 _
= HappyAbsSyn9
(AtLeast
)
happyReduce_25 = happySpecReduce_2 12 happyReduction_25
happyReduction_25 (HappyAbsSyn12 happy_var_2)
(HappyTerminal (TId happy_var_1))
= HappyAbsSyn12
(happy_var_1 : happy_var_2
)
happyReduction_25 _ _ = notHappyAtAll
happyReduce_26 = happySpecReduce_1 12 happyReduction_26
happyReduction_26 (HappyTerminal (TId happy_var_1))
= HappyAbsSyn12
([happy_var_1]
)
happyReduction_26 _ = notHappyAtAll
happyNewToken action sts stk [] =
action 37 37 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 {
TId "stencil" -> cont 13;
TId "region" -> cont 14;
TId "readonce" -> cont 15;
TId "reflexive" -> cont 16;
TId "irreflexive" -> cont 17;
TId "atmost" -> cont 18;
TId "atleast" -> cont 19;
TId "dims" -> cont 20;
TId "dim" -> cont 21;
TId "depth" -> cont 22;
TId "forward" -> cont 23;
TId "backward" -> cont 24;
TId "centered" -> cont 25;
TId "dependency" -> cont 26;
TId "mutual" -> cont 27;
TId happy_dollar_dollar -> cont 28;
TNum happy_dollar_dollar -> cont 29;
TPlus -> cont 30;
TStar -> cont 31;
TDoubleColon -> cont 32;
TEqual -> cont 33;
TLParen -> cont 34;
TRParen -> cont 35;
TComma -> cont 36;
_ -> happyError' (tk:tks)
}
happyError_ 37 tk tks = happyError' tks
happyError_ _ tk tks = happyError' (tk:tks)
happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b
happyThen = (>>=)
happyReturn :: () => a -> Either AnnotationParseError a
happyReturn = (return)
happyThen1 m k tks = (>>=) m (\a -> k a tks)
happyReturn1 :: () => a -> b -> Either AnnotationParseError a
happyReturn1 = \a tks -> (return) a
happyError' :: () => [(Token)] -> Either AnnotationParseError a
happyError' = happyError
parseSpec tks = happySomeParser where
happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })
happySeq = happyDontSeq
data Specification
= RegionDec String Region
| SpecDec Spec [String]
deriving (Show, Eq, Ord, Typeable, Data)
data Region
= Forward Int Int Bool
| Backward Int Int Bool
| Centered Int Int Bool
| Or Region Region
| And Region Region
| Var String
deriving (Show, Eq, Ord, Typeable, Data)
data Spec
= Spatial [Mod] Region
| Temporal [String] Bool
deriving (Show, Eq, Ord, Typeable, Data)
data Mod
= AtLeast
| AtMost
| ReadOnce
deriving (Show, Eq, Ord, Typeable, Data)
--------------------------------------------------
data Token
= TDoubleColon
| TStar
| TPlus
| TEqual
| TComma
| TLParen
| TRParen
| TId String
| TNum String
deriving (Show)
addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]
addToTokens tok rest = do
tokens <- lexer' rest
return $ tok : tokens
stripLeadingWhiteSpace (' ':xs) = stripLeadingWhiteSpace xs
stripLeadingWhiteSpace ('\t':xs) = stripLeadingWhiteSpace xs
stripLeadingWhiteSpace ('\n':xs) = stripLeadingWhiteSpace xs
stripLeadingWhiteSpace xs = xs
lexer :: String -> Either AnnotationParseError [ Token ]
lexer input | length (stripLeadingWhiteSpace input) >= 2 =
case stripLeadingWhiteSpace input of
-- Check the leading character is '=' for specification
'=':input' ->
-- First test to see if the input looks like an actual
-- specification of either a stencil or region
if (input' `hasPrefix` "stencil" || input' `hasPrefix` "region")
then lexer' input'
else Left NotAnnotation
_ -> Left NotAnnotation
where
hasPrefix [] str = False
hasPrefix (' ':xs) str = hasPrefix xs str
hasPrefix xs str = isPrefixOf str xs
lexer _ = Left NotAnnotation
lexer' :: String -> Either AnnotationParseError [ Token ]
lexer' [] = return []
lexer' (' ':xs) = lexer' xs
lexer' ('\t':xs) = lexer' xs
lexer' (':':':':xs) = addToTokens TDoubleColon xs
lexer' ('*':xs) = addToTokens TStar xs
lexer' ('+':xs) = addToTokens TPlus xs
lexer' ('=':xs) = addToTokens TEqual xs
-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.
lexer' (',':xs)
| x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')
| otherwise = addToTokens TComma xs
lexer' ('(':xs) = addToTokens TLParen xs
lexer' (')':xs) = addToTokens TRParen xs
lexer' (x:xs)
| isLetter x = aux TId $ \ c -> isAlphaNum c || c == '_'
| isNumber x = aux TNum isNumber
| otherwise
= failWith $ "Not an indentifier " ++ show x
where
aux f p = (f target :) `fmap` lexer' rest
where (target, rest) = span p (x:xs)
lexer' x
= failWith $ "Not a valid piece of stencil syntax " ++ show x
--------------------------------------------------
-- specParser :: String -> Either AnnotationParseError Specification
specParser :: AnnotationParser Specification
specParser src = do
tokens <- lexer src
parseSpec tokens >>= modValidate
-- Check whether modifiers are used correctly
modValidate :: Specification -> Either AnnotationParseError Specification
modValidate (SpecDec (Spatial mods r) vars) =
do mods' <- modValidate' $ sort mods
return $ SpecDec (Spatial mods' r) vars
where modValidate' [] = return $ []
modValidate' (AtLeast : AtLeast : xs)
= failWith "Duplicate 'atLeast' modifier; use at most one."
modValidate' (AtMost : AtMost : xs)
= failWith "Duplicate 'atMost' modifier; use at most one."
modValidate' (ReadOnce : ReadOnce : xs)
= failWith "Duplicate 'readOnce' modifier; use at most one."
modValidate' (AtLeast : AtMost : xs)
= failWith $ "Conflicting modifiers: cannot use 'atLeast' and "
++ "'atMost' together"
modValidate' (x : xs)
= do xs' <- modValidate' xs
return $ x : xs'
modValidate x = return x
happyError :: [ Token ] -> Either AnnotationParseError a
happyError t = failWith $ "Could not parse specification at: " ++ show t
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 16 "<built-in>" #-}
{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}
{-# LINE 17 "<built-in>" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
{-# LINE 13 "templates/GenericTemplate.hs" #-}
{-# LINE 46 "templates/GenericTemplate.hs" #-}
{-# LINE 67 "templates/GenericTemplate.hs" #-}
{-# LINE 77 "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 155 "templates/GenericTemplate.hs" #-}
-----------------------------------------------------------------------------
-- 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
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
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 (1) tk old_st _ stk@(x `HappyStk` _) =
let i = (case x of { HappyErrorToken (i) -> i }) in
-- trace "failing" $
happyError_ 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 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.
{-# 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.