diff --git a/camfort.cabal b/camfort.cabal --- a/camfort.cabal +++ b/camfort.cabal @@ -1,5 +1,5 @@ name: camfort -version: 0.800 +version: 0.802 synopsis: CamFort - Cambridge Fortran infrastructure description: CamFort is a tool for the analysis, transformation, verification of Fortran code. @@ -85,7 +85,7 @@ Main build-depends: base < 5, - ghc-prim == 0.4.0.0, + ghc-prim >= 0.4.0.0, containers >= 0.5.0.0, template-haskell >=2.4, generic-deriving >=1.5.5, @@ -164,7 +164,7 @@ other-modules: build-depends: base < 5, - ghc-prim == 0.4.0.0, + ghc-prim >= 0.4.0.0, containers >= 0.5.0.0, template-haskell >=2.4, generic-deriving >=1.5.5, diff --git a/dist/build/Camfort/Specification/Stencils/Grammar.hs b/dist/build/Camfort/Specification/Stencils/Grammar.hs new file mode 100644 --- /dev/null +++ b/dist/build/Camfort/Specification/Stencils/Grammar.hs @@ -0,0 +1,883 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fglasgow-exts -cpp #-} +-- -*- 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 qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.19.5 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (Specification) -> (HappyAbsSyn ) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> (Specification) +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: ((String, Region)) -> (HappyAbsSyn ) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> ((String, Region)) +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (Region) -> (HappyAbsSyn ) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> (Region) +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (Bool) -> (HappyAbsSyn ) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (Bool) +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (Spec) -> (HappyAbsSyn ) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (Spec) +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (Mod) -> (HappyAbsSyn ) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (Mod) +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: ([Mod]) -> (HappyAbsSyn ) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> ([Mod]) +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (Mod) -> (HappyAbsSyn ) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (Mod) +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: ([String]) -> (HappyAbsSyn ) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> ([String]) +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x36\x00\x61\x00\x00\x00\x5d\x00\x5a\x00\xfe\xff\x23\x00\x5c\x00\x18\x00\x4b\x00\x0b\x00\x00\x00\x59\x00\x00\x00\x00\x00\x58\x00\x57\x00\x56\x00\x55\x00\x00\x00\x18\x00\x54\x00\x53\x00\x07\x00\x52\x00\x50\x00\x4f\x00\x4e\x00\x4c\x00\x23\x00\x00\x00\x2d\x00\x18\x00\x1f\x00\x51\x00\x18\x00\x18\x00\x00\x00\x4d\x00\x00\x00\x47\x00\x1f\x00\x4a\x00\x49\x00\x48\x00\x46\x00\x45\x00\x00\x00\x18\x00\x1f\x00\x44\x00\x43\x00\x41\x00\x40\x00\x3b\x00\x00\x00\x2e\x00\x42\x00\x3f\x00\x3e\x00\x00\x00\x3a\x00\x35\x00\x34\x00\x00\x00\x33\x00\x32\x00\x30\x00\x3d\x00\x3d\x00\x3d\x00\x29\x00\x00\x00\x28\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x2f\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x39\x00\x37\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x2b\x00\x00\x00\x1e\x00\x20\x00\x13\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0a\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xe9\xff\xeb\xff\x00\x00\xe8\xff\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xea\xff\xe9\xff\x00\x00\xee\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xe5\xff\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf1\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\x00\x00\x00\x00\xf2\xff\xf2\xff\xf2\xff\x00\x00\xf3\xff\x00\x00\x00\x00\xf9\xff\xfa\xff\xfb\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x02\x00\x06\x00\x07\x00\x03\x00\x06\x00\x07\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x04\x00\x03\x00\x06\x00\x07\x00\x02\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x12\x00\x13\x00\x10\x00\x04\x00\x08\x00\x17\x00\x06\x00\x07\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x08\x00\x02\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x02\x00\x16\x00\x00\x00\x01\x00\x12\x00\x13\x00\x06\x00\x07\x00\x12\x00\x13\x00\x01\x00\x02\x00\x08\x00\x02\x00\x02\x00\x05\x00\x01\x00\x17\x00\x17\x00\x17\x00\x11\x00\x05\x00\x11\x00\x11\x00\x17\x00\xff\xff\x09\x00\x09\x00\x15\x00\x15\x00\x09\x00\x11\x00\xff\xff\x03\x00\x15\x00\xff\xff\x11\x00\x11\x00\x0f\x00\x11\x00\x09\x00\xff\xff\x10\x00\x0a\x00\x0a\x00\x0a\x00\x15\x00\x17\x00\x15\x00\x15\x00\x15\x00\x13\x00\x10\x00\x10\x00\x02\x00\x10\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x14\x00\x14\x00\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x1d\x00\x0e\x00\x0f\x00\x47\x00\x1e\x00\x1f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x49\x00\x14\x00\x0d\x00\x4a\x00\x0e\x00\x0f\x00\x31\x00\x15\x00\x25\x00\x10\x00\x11\x00\x12\x00\x24\x00\x25\x00\x14\x00\x0d\x00\x37\x00\x30\x00\x1e\x00\x1f\x00\x15\x00\x26\x00\x10\x00\x11\x00\x12\x00\x27\x00\x06\x00\x14\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x29\x00\x15\x00\x04\x00\x02\x00\x24\x00\x25\x00\x0e\x00\x0f\x00\x24\x00\x25\x00\x06\x00\x04\x00\x2e\x00\x17\x00\x21\x00\x20\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x49\x00\x46\x00\x47\x00\x41\x00\x00\x00\x3e\x00\x3f\x00\x42\x00\x43\x00\x40\x00\x39\x00\x00\x00\x0c\x00\x44\x00\x00\x00\x3a\x00\x3b\x00\x3d\x00\x3c\x00\x2b\x00\x00\x00\x29\x00\x2c\x00\x2d\x00\x2e\x00\x34\x00\x33\x00\x35\x00\x36\x00\x37\x00\x25\x00\x29\x00\x29\x00\x04\x00\x17\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x23\x00\x16\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 26) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26) + ] + +happy_n_terms = 26 :: Int +happy_n_nonterms = 9 :: Int + +happyReduce_1 = happySpecReduce_1 0# happyReduction_1 +happyReduction_1 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4 + (RegionDec (fst happy_var_1) (snd happy_var_1) + )} + +happyReduce_2 = happyReduce 4# 0# happyReduction_2 +happyReduction_2 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + happyIn4 + (SpecDec happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_3 = happyReduce 5# 1# happyReduction_3 +happyReduction_3 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut6 happy_x_5 of { happy_var_5 -> + happyIn5 + ((happy_var_3, happy_var_5) + ) `HappyStk` happyRest}} + +happyReduce_4 = happyReduce 10# 2# happyReduction_4 +happyReduction_4 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Forward (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_5 = happyReduce 10# 2# happyReduction_5 +happyReduction_5 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Backward (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_6 = happyReduce 10# 2# happyReduction_6 +happyReduction_6 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Centered (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_7 = happyReduce 6# 2# happyReduction_7 +happyReduction_7 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + happyIn6 + (Centered 0 (read happy_var_5) True + ) `HappyStk` happyRest} + +happyReduce_8 = happySpecReduce_3 2# happyReduction_8 +happyReduction_8 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (Or happy_var_1 happy_var_3 + )}} + +happyReduce_9 = happySpecReduce_3 2# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (And happy_var_1 happy_var_3 + )}} + +happyReduce_10 = happySpecReduce_3 2# happyReduction_10 +happyReduction_10 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6 + (happy_var_2 + )} + +happyReduce_11 = happySpecReduce_1 2# happyReduction_11 +happyReduction_11 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6 + (Var happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 3# happyReduction_12 +happyReduction_12 happy_x_1 + = happyIn7 + (False + ) + +happyReduce_13 = happySpecReduce_0 3# happyReduction_13 +happyReduction_13 = happyIn7 + (True + ) + +happyReduce_14 = happyReduce 4# 4# happyReduction_14 +happyReduction_14 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (Temporal happy_var_3 False + ) `HappyStk` happyRest} + +happyReduce_15 = happyReduce 5# 4# happyReduction_15 +happyReduction_15 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (Temporal happy_var_3 True + ) `HappyStk` happyRest} + +happyReduce_16 = happySpecReduce_3 4# happyReduction_16 +happyReduction_16 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut10 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn8 + (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3 + )}}} + +happyReduce_17 = happySpecReduce_2 4# happyReduction_17 +happyReduction_17 happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8 + (Spatial [happy_var_1] happy_var_2 + )}} + +happyReduce_18 = happySpecReduce_2 4# happyReduction_18 +happyReduction_18 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8 + (Spatial [happy_var_1] happy_var_2 + )}} + +happyReduce_19 = happySpecReduce_1 4# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn8 + (Spatial [] happy_var_1 + )} + +happyReduce_20 = happySpecReduce_1 5# happyReduction_20 +happyReduction_20 happy_x_1 + = happyIn9 + (ReadOnce + ) + +happyReduce_21 = happySpecReduce_2 6# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn10 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_22 = happySpecReduce_1 6# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + ([happy_var_1] + )} + +happyReduce_23 = happySpecReduce_1 7# happyReduction_23 +happyReduction_23 happy_x_1 + = happyIn11 + (AtMost + ) + +happyReduce_24 = happySpecReduce_1 7# happyReduction_24 +happyReduction_24 happy_x_1 + = happyIn11 + (AtLeast + ) + +happyReduce_25 = happySpecReduce_2 8# happyReduction_25 +happyReduction_25 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn12 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_26 = happySpecReduce_1 8# happyReduction_26 +happyReduction_26 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn12 + ([happy_var_1] + )} + +happyNewToken action sts stk [] = + happyDoAction 25# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + TId "stencil" -> cont 1#; + TId "region" -> cont 2#; + TId "readonce" -> cont 3#; + TId "reflexive" -> cont 4#; + TId "irreflexive" -> cont 5#; + TId "atmost" -> cont 6#; + TId "atleast" -> cont 7#; + TId "dims" -> cont 8#; + TId "dim" -> cont 9#; + TId "depth" -> cont 10#; + TId "forward" -> cont 11#; + TId "backward" -> cont 12#; + TId "centered" -> cont 13#; + TId "dependency" -> cont 14#; + TId "mutual" -> cont 15#; + TId happy_dollar_dollar -> cont 16#; + TNum happy_dollar_dollar -> cont 17#; + TPlus -> cont 18#; + TStar -> cont 19#; + TDoubleColon -> cont 20#; + TEqual -> cont 21#; + TLParen -> cont 22#; + TRParen -> cont 23#; + TComma -> cont 24#; + _ -> happyError' (tk:tks) + } + +happyError_ 25# 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 0# tks) (\x -> happyReturn (happyOut4 x)) + +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 "" #-} +{-# LINE 19 "" #-} +{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 20 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + + +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif + +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + +{-# 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 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (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 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. + diff --git a/dist/build/Camfort/Specification/Units/Parser.hs b/dist/build/Camfort/Specification/Units/Parser.hs new file mode 100644 --- /dev/null +++ b/dist/build/Camfort/Specification/Units/Parser.hs @@ -0,0 +1,759 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fglasgow-exts -cpp #-} +-- -*- Mode: Haskell -*- + +{-# LANGUAGE DeriveDataTypeable #-} +module Camfort.Specification.Units.Parser ( unitParser + , UnitStatement(..) + , UnitOfMeasure(..) + , UnitPower(..) + ) where + +import Camfort.Analysis.CommentAnnotator +import Data.Data +import Data.List +import Data.Char (isLetter, isNumber, isAlphaNum, toLower) +import qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.19.5 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (UnitStatement) -> (HappyAbsSyn ) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> (UnitStatement) +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: (Maybe [String]) -> (HappyAbsSyn ) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (Maybe [String]) +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: ([String]) -> (HappyAbsSyn ) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> ([String]) +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (UnitPower) -> (HappyAbsSyn ) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (UnitPower) +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (Integer) -> (HappyAbsSyn ) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (Integer) +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (String) -> (HappyAbsSyn ) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (String) +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x44\x00\x41\x00\x0f\x00\x3c\x00\x05\x00\x2b\x00\x04\x00\x3d\x00\x00\x00\x00\x00\x3f\x00\xff\xff\x3b\x00\x01\x00\x34\x00\x00\x00\x35\x00\x10\x00\x36\x00\x0f\x00\x00\x00\x04\x00\x3a\x00\x00\x00\x39\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x19\x00\x0f\x00\x00\x00\x00\x00\x33\x00\xfd\xff\x00\x00\x38\x00\x00\x00\x19\x00\x00\x00\x2c\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x37\x00\x00\x00\x27\x00\x00\x00\x27\x00\x22\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1d\x00\x00\x00\x30\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x28\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xf8\xff\xf2\xff\xef\xff\xf7\xff\x00\x00\x00\x00\x00\x00\xf8\xff\xf7\xff\xf5\xff\x00\x00\x00\x00\xf4\xff\x00\x00\xfe\xff\x00\x00\x00\x00\xfc\xff\xf9\xff\xf3\xff\xf1\xff\xee\xff\xeb\xff\xe8\xff\xe9\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf0\xff\xfd\xff\x00\x00\xea\xff\x00\x00\xfa\xff\x00\x00\xed\xff\x00\x00\xec\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x02\x00\x02\x00\x08\x00\x02\x00\x02\x00\x03\x00\x0c\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x09\x00\x0b\x00\x0b\x00\x02\x00\x03\x00\x03\x00\x04\x00\x08\x00\x06\x00\x03\x00\x04\x00\x05\x00\x0b\x00\x0b\x00\x03\x00\x04\x00\x02\x00\x06\x00\x03\x00\x04\x00\x05\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x04\x00\x05\x00\x03\x00\x04\x00\x05\x00\x07\x00\x08\x00\x07\x00\x08\x00\x03\x00\x04\x00\x08\x00\x09\x00\x05\x00\x05\x00\x00\x00\x0c\x00\x07\x00\x02\x00\x08\x00\x02\x00\x07\x00\x05\x00\x0a\x00\x0c\x00\x02\x00\x01\x00\x08\x00\x07\x00\x01\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x09\x00\x0f\x00\x09\x00\x28\x00\x2a\x00\x09\x00\x09\x00\x0a\x00\x2b\x00\x0c\x00\x10\x00\x14\x00\x24\x00\x0b\x00\x14\x00\x0c\x00\x09\x00\x0a\x00\x1e\x00\x1f\x00\x26\x00\x20\x00\x24\x00\x06\x00\x07\x00\x0c\x00\x21\x00\x1e\x00\x1f\x00\x17\x00\x20\x00\x0c\x00\x0d\x00\x07\x00\x14\x00\x1a\x00\x1b\x00\x1c\x00\x0c\x00\x0d\x00\x07\x00\x05\x00\x06\x00\x07\x00\x2b\x00\x1c\x00\x25\x00\x1c\x00\x1e\x00\x1f\x00\x16\x00\x17\x00\x19\x00\x12\x00\x03\x00\x2d\x00\x12\x00\x19\x00\x16\x00\x19\x00\x12\x00\x28\x00\x22\x00\x23\x00\x11\x00\x03\x00\x16\x00\x12\x00\x05\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 23) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23) + ] + +happy_n_terms = 14 :: Int +happy_n_nonterms = 9 :: Int + +happyReduce_1 = happySpecReduce_3 0# happyReduction_1 +happyReduction_1 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4 + (UnitAssignment happy_var_3 happy_var_2 + )}} + +happyReduce_2 = happyReduce 5# 0# happyReduction_2 +happyReduction_2 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut7 happy_x_5 of { happy_var_5 -> + happyIn4 + (UnitAlias happy_var_3 happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_3 = happySpecReduce_2 1# happyReduction_3 +happyReduction_3 happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5 + (Just happy_var_2 + )} + +happyReduce_4 = happySpecReduce_0 1# happyReduction_4 +happyReduction_4 = happyIn5 + (Nothing + ) + +happyReduce_5 = happySpecReduce_3 2# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (happy_var_1 : happy_var_3 + )}} + +happyReduce_6 = happySpecReduce_1 2# happyReduction_6 +happyReduction_6 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6 + ([happy_var_1] + )} + +happyReduce_7 = happySpecReduce_1 3# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn7 + (happy_var_1 + )} + +happyReduce_8 = happySpecReduce_1 3# happyReduction_8 +happyReduction_8 happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_9 = happySpecReduce_3 3# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_10 = happySpecReduce_2 3# happyReduction_10 +happyReduction_10 happy_x_2 + happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_11 = happySpecReduce_2 4# happyReduction_11 +happyReduction_11 happy_x_2 + happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn8 + (UnitProduct happy_var_1 happy_var_2 + )}} + +happyReduce_12 = happySpecReduce_3 4# happyReduction_12 +happyReduction_12 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn8 + (UnitQuotient happy_var_1 happy_var_3 + )}} + +happyReduce_13 = happySpecReduce_1 4# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn8 + (happy_var_1 + )} + +happyReduce_14 = happySpecReduce_3 5# happyReduction_14 +happyReduction_14 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn9 + (UnitExponentiation happy_var_1 happy_var_3 + )}} + +happyReduce_15 = happySpecReduce_3 5# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn9 + (happy_var_2 + )} + +happyReduce_16 = happySpecReduce_1 5# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn9 + (UnitBasic happy_var_1 + )} + +happyReduce_17 = happySpecReduce_1 6# happyReduction_17 +happyReduction_17 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + (UnitPowerInteger happy_var_1 + )} + +happyReduce_18 = happySpecReduce_3 6# happyReduction_18 +happyReduction_18 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10 + (UnitPowerInteger happy_var_2 + )} + +happyReduce_19 = happyReduce 5# 6# happyReduction_19 +happyReduction_19 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut11 happy_x_2 of { happy_var_2 -> + case happyOut11 happy_x_4 of { happy_var_4 -> + happyIn10 + (UnitPowerRational happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_20 = happySpecReduce_1 7# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + (read happy_var_1 + )} + +happyReduce_21 = happySpecReduce_2 7# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn11 + (read $ '-' : happy_var_2 + )} + +happyReduce_22 = happySpecReduce_1 8# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOutTok happy_x_1 of { (TNum happy_var_1) -> + happyIn12 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_1 8# happyReduction_23 +happyReduction_23 happy_x_1 + = happyIn12 + ("1" + ) + +happyNewToken action sts stk [] = + happyDoAction 13# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + TId "unit" -> cont 1#; + TId happy_dollar_dollar -> cont 2#; + TNum "1" -> cont 3#; + TNum happy_dollar_dollar -> cont 4#; + TComma -> cont 5#; + TMinus -> cont 6#; + TExponentiation -> cont 7#; + TDivision -> cont 8#; + TDoubleColon -> cont 9#; + TEqual -> cont 10#; + TLeftPar -> cont 11#; + TRightPar -> cont 12#; + _ -> happyError' (tk:tks) + } + +happyError_ 13# 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 + +parseUnit tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +data UnitStatement = + UnitAssignment (Maybe [String]) UnitOfMeasure + | UnitAlias String UnitOfMeasure + deriving Data + +instance Show UnitStatement where + show (UnitAssignment (Just ss) uom) = "= unit (" ++ show uom ++ ") :: " ++ (intercalate "," ss) + show (UnitAssignment Nothing uom) = "= unit (" ++ show uom ++ ")" + show (UnitAlias s uom) = "= unit :: " ++ s ++ " = " ++ show uom + +data UnitOfMeasure = + Unitless + | UnitBasic String + | UnitProduct UnitOfMeasure UnitOfMeasure + | UnitQuotient UnitOfMeasure UnitOfMeasure + | UnitExponentiation UnitOfMeasure UnitPower + deriving Data + +instance Show UnitOfMeasure where + show Unitless = "1" + show (UnitBasic s) = s + show (UnitProduct uom1 uom2) = show uom1 ++ " " ++ show uom2 + show (UnitQuotient uom1 uom2) = show uom1 ++ " / " ++ show uom2 + show (UnitExponentiation uom exp) = show uom ++ "** (" ++ show exp ++ ")" + +data UnitPower = + UnitPowerInteger Integer + | UnitPowerRational Integer Integer + deriving Data + +instance Show UnitPower where + show (UnitPowerInteger i) = show i + show (UnitPowerRational i1 i2) = show i1 ++ "/" ++ show i2 + +data Token = + TUnit + | TComma + | TDoubleColon + | TExponentiation + | TDivision + | TMinus + | TEqual + | TLeftPar + | TRightPar + | TId String + | TNum String + deriving (Show) + +lexer :: String -> Either AnnotationParseError [ Token ] +lexer ('=':xs) = lexer' xs +lexer _ = Left NotAnnotation + +addToTokens :: Token -> String -> Either AnnotationParseError [ Token ] +addToTokens tok rest = do + tokens <- lexer' rest + return $ tok : tokens + +lexer' :: String -> Either AnnotationParseError [ Token ] +lexer' [] = Right [] +lexer' ['\n'] = Right [] +lexer' ['\r', '\n'] = Right [] +lexer' ['\r'] = Right [] -- windows +lexer' (' ':xs) = lexer' xs +lexer' ('\t':xs) = lexer' xs +lexer' (':':':':xs) = addToTokens TDoubleColon xs +lexer' ('*':'*':xs) = addToTokens TExponentiation xs +lexer' (',':xs) = addToTokens TComma xs +lexer' ('/':xs) = addToTokens TDivision xs +lexer' ('-':xs) = addToTokens TMinus xs +lexer' ('=':xs) = addToTokens TEqual xs +lexer' ('(':xs) = addToTokens TLeftPar xs +lexer' (')':xs) = addToTokens TRightPar xs +lexer' (x:xs) + | isLetter x = aux (\c -> isAlphaNum c || c `elem` ['\'','_','-']) TId + | isNumber x = aux isNumber TNum + | otherwise = failWith $ "Not valid unit syntax at " ++ show (x:xs) + where + aux p cons = + let (target, rest) = span p xs + in lexer' rest >>= (\tokens -> return $ cons (x:target) : tokens) + +unitParser :: String -> Either AnnotationParseError UnitStatement +unitParser src = do + tokens <- lexer $ map toLower src + parseUnit tokens + +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 "" #-} +{-# LINE 19 "" #-} +{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 20 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + + +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif + +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + +{-# 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 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (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 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. + diff --git a/dist/build/Camfort/camfort-tmp/Camfort/Specification/Stencils/Grammar.hs b/dist/build/Camfort/camfort-tmp/Camfort/Specification/Stencils/Grammar.hs new file mode 100644 --- /dev/null +++ b/dist/build/Camfort/camfort-tmp/Camfort/Specification/Stencils/Grammar.hs @@ -0,0 +1,883 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fglasgow-exts -cpp #-} +-- -*- 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 qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.19.5 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (Specification) -> (HappyAbsSyn ) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> (Specification) +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: ((String, Region)) -> (HappyAbsSyn ) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> ((String, Region)) +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (Region) -> (HappyAbsSyn ) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> (Region) +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (Bool) -> (HappyAbsSyn ) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (Bool) +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (Spec) -> (HappyAbsSyn ) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (Spec) +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (Mod) -> (HappyAbsSyn ) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (Mod) +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: ([Mod]) -> (HappyAbsSyn ) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> ([Mod]) +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (Mod) -> (HappyAbsSyn ) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (Mod) +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: ([String]) -> (HappyAbsSyn ) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> ([String]) +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x36\x00\x61\x00\x00\x00\x5d\x00\x5a\x00\xfe\xff\x23\x00\x5c\x00\x18\x00\x4b\x00\x0b\x00\x00\x00\x59\x00\x00\x00\x00\x00\x58\x00\x57\x00\x56\x00\x55\x00\x00\x00\x18\x00\x54\x00\x53\x00\x07\x00\x52\x00\x50\x00\x4f\x00\x4e\x00\x4c\x00\x23\x00\x00\x00\x2d\x00\x18\x00\x1f\x00\x51\x00\x18\x00\x18\x00\x00\x00\x4d\x00\x00\x00\x47\x00\x1f\x00\x4a\x00\x49\x00\x48\x00\x46\x00\x45\x00\x00\x00\x18\x00\x1f\x00\x44\x00\x43\x00\x41\x00\x40\x00\x3b\x00\x00\x00\x2e\x00\x42\x00\x3f\x00\x3e\x00\x00\x00\x3a\x00\x35\x00\x34\x00\x00\x00\x33\x00\x32\x00\x30\x00\x3d\x00\x3d\x00\x3d\x00\x29\x00\x00\x00\x28\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x2f\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x39\x00\x37\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x2b\x00\x00\x00\x1e\x00\x20\x00\x13\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0a\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xe9\xff\xeb\xff\x00\x00\xe8\xff\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xea\xff\xe9\xff\x00\x00\xee\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xe5\xff\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf1\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\x00\x00\x00\x00\xf2\xff\xf2\xff\xf2\xff\x00\x00\xf3\xff\x00\x00\x00\x00\xf9\xff\xfa\xff\xfb\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x02\x00\x06\x00\x07\x00\x03\x00\x06\x00\x07\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x04\x00\x03\x00\x06\x00\x07\x00\x02\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x12\x00\x13\x00\x10\x00\x04\x00\x08\x00\x17\x00\x06\x00\x07\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x08\x00\x02\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x02\x00\x16\x00\x00\x00\x01\x00\x12\x00\x13\x00\x06\x00\x07\x00\x12\x00\x13\x00\x01\x00\x02\x00\x08\x00\x02\x00\x02\x00\x05\x00\x01\x00\x17\x00\x17\x00\x17\x00\x11\x00\x05\x00\x11\x00\x11\x00\x17\x00\xff\xff\x09\x00\x09\x00\x15\x00\x15\x00\x09\x00\x11\x00\xff\xff\x03\x00\x15\x00\xff\xff\x11\x00\x11\x00\x0f\x00\x11\x00\x09\x00\xff\xff\x10\x00\x0a\x00\x0a\x00\x0a\x00\x15\x00\x17\x00\x15\x00\x15\x00\x15\x00\x13\x00\x10\x00\x10\x00\x02\x00\x10\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x14\x00\x14\x00\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x1d\x00\x0e\x00\x0f\x00\x47\x00\x1e\x00\x1f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x49\x00\x14\x00\x0d\x00\x4a\x00\x0e\x00\x0f\x00\x31\x00\x15\x00\x25\x00\x10\x00\x11\x00\x12\x00\x24\x00\x25\x00\x14\x00\x0d\x00\x37\x00\x30\x00\x1e\x00\x1f\x00\x15\x00\x26\x00\x10\x00\x11\x00\x12\x00\x27\x00\x06\x00\x14\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x29\x00\x15\x00\x04\x00\x02\x00\x24\x00\x25\x00\x0e\x00\x0f\x00\x24\x00\x25\x00\x06\x00\x04\x00\x2e\x00\x17\x00\x21\x00\x20\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x49\x00\x46\x00\x47\x00\x41\x00\x00\x00\x3e\x00\x3f\x00\x42\x00\x43\x00\x40\x00\x39\x00\x00\x00\x0c\x00\x44\x00\x00\x00\x3a\x00\x3b\x00\x3d\x00\x3c\x00\x2b\x00\x00\x00\x29\x00\x2c\x00\x2d\x00\x2e\x00\x34\x00\x33\x00\x35\x00\x36\x00\x37\x00\x25\x00\x29\x00\x29\x00\x04\x00\x17\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x23\x00\x16\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 26) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26) + ] + +happy_n_terms = 26 :: Int +happy_n_nonterms = 9 :: Int + +happyReduce_1 = happySpecReduce_1 0# happyReduction_1 +happyReduction_1 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4 + (RegionDec (fst happy_var_1) (snd happy_var_1) + )} + +happyReduce_2 = happyReduce 4# 0# happyReduction_2 +happyReduction_2 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + happyIn4 + (SpecDec happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_3 = happyReduce 5# 1# happyReduction_3 +happyReduction_3 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut6 happy_x_5 of { happy_var_5 -> + happyIn5 + ((happy_var_3, happy_var_5) + ) `HappyStk` happyRest}} + +happyReduce_4 = happyReduce 10# 2# happyReduction_4 +happyReduction_4 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Forward (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_5 = happyReduce 10# 2# happyReduction_5 +happyReduction_5 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Backward (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_6 = happyReduce 10# 2# happyReduction_6 +happyReduction_6 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6 + (Centered (read happy_var_5) (read happy_var_8) happy_var_9 + ) `HappyStk` happyRest}}} + +happyReduce_7 = happyReduce 6# 2# happyReduction_7 +happyReduction_7 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + happyIn6 + (Centered 0 (read happy_var_5) True + ) `HappyStk` happyRest} + +happyReduce_8 = happySpecReduce_3 2# happyReduction_8 +happyReduction_8 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (Or happy_var_1 happy_var_3 + )}} + +happyReduce_9 = happySpecReduce_3 2# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (And happy_var_1 happy_var_3 + )}} + +happyReduce_10 = happySpecReduce_3 2# happyReduction_10 +happyReduction_10 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6 + (happy_var_2 + )} + +happyReduce_11 = happySpecReduce_1 2# happyReduction_11 +happyReduction_11 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6 + (Var happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 3# happyReduction_12 +happyReduction_12 happy_x_1 + = happyIn7 + (False + ) + +happyReduce_13 = happySpecReduce_0 3# happyReduction_13 +happyReduction_13 = happyIn7 + (True + ) + +happyReduce_14 = happyReduce 4# 4# happyReduction_14 +happyReduction_14 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (Temporal happy_var_3 False + ) `HappyStk` happyRest} + +happyReduce_15 = happyReduce 5# 4# happyReduction_15 +happyReduction_15 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8 + (Temporal happy_var_3 True + ) `HappyStk` happyRest} + +happyReduce_16 = happySpecReduce_3 4# happyReduction_16 +happyReduction_16 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut10 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn8 + (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3 + )}}} + +happyReduce_17 = happySpecReduce_2 4# happyReduction_17 +happyReduction_17 happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8 + (Spatial [happy_var_1] happy_var_2 + )}} + +happyReduce_18 = happySpecReduce_2 4# happyReduction_18 +happyReduction_18 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8 + (Spatial [happy_var_1] happy_var_2 + )}} + +happyReduce_19 = happySpecReduce_1 4# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn8 + (Spatial [] happy_var_1 + )} + +happyReduce_20 = happySpecReduce_1 5# happyReduction_20 +happyReduction_20 happy_x_1 + = happyIn9 + (ReadOnce + ) + +happyReduce_21 = happySpecReduce_2 6# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn10 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_22 = happySpecReduce_1 6# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + ([happy_var_1] + )} + +happyReduce_23 = happySpecReduce_1 7# happyReduction_23 +happyReduction_23 happy_x_1 + = happyIn11 + (AtMost + ) + +happyReduce_24 = happySpecReduce_1 7# happyReduction_24 +happyReduction_24 happy_x_1 + = happyIn11 + (AtLeast + ) + +happyReduce_25 = happySpecReduce_2 8# happyReduction_25 +happyReduction_25 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn12 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_26 = happySpecReduce_1 8# happyReduction_26 +happyReduction_26 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn12 + ([happy_var_1] + )} + +happyNewToken action sts stk [] = + happyDoAction 25# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + TId "stencil" -> cont 1#; + TId "region" -> cont 2#; + TId "readonce" -> cont 3#; + TId "reflexive" -> cont 4#; + TId "irreflexive" -> cont 5#; + TId "atmost" -> cont 6#; + TId "atleast" -> cont 7#; + TId "dims" -> cont 8#; + TId "dim" -> cont 9#; + TId "depth" -> cont 10#; + TId "forward" -> cont 11#; + TId "backward" -> cont 12#; + TId "centered" -> cont 13#; + TId "dependency" -> cont 14#; + TId "mutual" -> cont 15#; + TId happy_dollar_dollar -> cont 16#; + TNum happy_dollar_dollar -> cont 17#; + TPlus -> cont 18#; + TStar -> cont 19#; + TDoubleColon -> cont 20#; + TEqual -> cont 21#; + TLParen -> cont 22#; + TRParen -> cont 23#; + TComma -> cont 24#; + _ -> happyError' (tk:tks) + } + +happyError_ 25# 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 0# tks) (\x -> happyReturn (happyOut4 x)) + +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 "" #-} +{-# LINE 19 "" #-} +{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 20 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + + +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif + +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + +{-# 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 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (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 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. + diff --git a/dist/build/Camfort/camfort-tmp/Camfort/Specification/Units/Parser.hs b/dist/build/Camfort/camfort-tmp/Camfort/Specification/Units/Parser.hs new file mode 100644 --- /dev/null +++ b/dist/build/Camfort/camfort-tmp/Camfort/Specification/Units/Parser.hs @@ -0,0 +1,759 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fglasgow-exts -cpp #-} +-- -*- Mode: Haskell -*- + +{-# LANGUAGE DeriveDataTypeable #-} +module Camfort.Specification.Units.Parser ( unitParser + , UnitStatement(..) + , UnitOfMeasure(..) + , UnitPower(..) + ) where + +import Camfort.Analysis.CommentAnnotator +import Data.Data +import Data.List +import Data.Char (isLetter, isNumber, isAlphaNum, toLower) +import qualified Data.Array as Happy_Data_Array +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.19.5 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +happyIn4 :: (UnitStatement) -> (HappyAbsSyn ) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn ) -> (UnitStatement) +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: (Maybe [String]) -> (HappyAbsSyn ) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (Maybe [String]) +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: ([String]) -> (HappyAbsSyn ) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> ([String]) +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (UnitOfMeasure) -> (HappyAbsSyn ) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (UnitOfMeasure) +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (UnitPower) -> (HappyAbsSyn ) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (UnitPower) +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: (Integer) -> (HappyAbsSyn ) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> (Integer) +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (String) -> (HappyAbsSyn ) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (String) +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyInTok :: (Token) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x44\x00\x41\x00\x0f\x00\x3c\x00\x05\x00\x2b\x00\x04\x00\x3d\x00\x00\x00\x00\x00\x3f\x00\xff\xff\x3b\x00\x01\x00\x34\x00\x00\x00\x35\x00\x10\x00\x36\x00\x0f\x00\x00\x00\x04\x00\x3a\x00\x00\x00\x39\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x19\x00\x0f\x00\x00\x00\x00\x00\x33\x00\xfd\xff\x00\x00\x38\x00\x00\x00\x19\x00\x00\x00\x2c\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x37\x00\x00\x00\x27\x00\x00\x00\x27\x00\x22\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1d\x00\x00\x00\x30\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x28\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xf8\xff\xf2\xff\xef\xff\xf7\xff\x00\x00\x00\x00\x00\x00\xf8\xff\xf7\xff\xf5\xff\x00\x00\x00\x00\xf4\xff\x00\x00\xfe\xff\x00\x00\x00\x00\xfc\xff\xf9\xff\xf3\xff\xf1\xff\xee\xff\xeb\xff\xe8\xff\xe9\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf0\xff\xfd\xff\x00\x00\xea\xff\x00\x00\xfa\xff\x00\x00\xed\xff\x00\x00\xec\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x02\x00\x02\x00\x08\x00\x02\x00\x02\x00\x03\x00\x0c\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x09\x00\x0b\x00\x0b\x00\x02\x00\x03\x00\x03\x00\x04\x00\x08\x00\x06\x00\x03\x00\x04\x00\x05\x00\x0b\x00\x0b\x00\x03\x00\x04\x00\x02\x00\x06\x00\x03\x00\x04\x00\x05\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x04\x00\x05\x00\x03\x00\x04\x00\x05\x00\x07\x00\x08\x00\x07\x00\x08\x00\x03\x00\x04\x00\x08\x00\x09\x00\x05\x00\x05\x00\x00\x00\x0c\x00\x07\x00\x02\x00\x08\x00\x02\x00\x07\x00\x05\x00\x0a\x00\x0c\x00\x02\x00\x01\x00\x08\x00\x07\x00\x01\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x09\x00\x0f\x00\x09\x00\x28\x00\x2a\x00\x09\x00\x09\x00\x0a\x00\x2b\x00\x0c\x00\x10\x00\x14\x00\x24\x00\x0b\x00\x14\x00\x0c\x00\x09\x00\x0a\x00\x1e\x00\x1f\x00\x26\x00\x20\x00\x24\x00\x06\x00\x07\x00\x0c\x00\x21\x00\x1e\x00\x1f\x00\x17\x00\x20\x00\x0c\x00\x0d\x00\x07\x00\x14\x00\x1a\x00\x1b\x00\x1c\x00\x0c\x00\x0d\x00\x07\x00\x05\x00\x06\x00\x07\x00\x2b\x00\x1c\x00\x25\x00\x1c\x00\x1e\x00\x1f\x00\x16\x00\x17\x00\x19\x00\x12\x00\x03\x00\x2d\x00\x12\x00\x19\x00\x16\x00\x19\x00\x12\x00\x28\x00\x22\x00\x23\x00\x11\x00\x03\x00\x16\x00\x12\x00\x05\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 23) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23) + ] + +happy_n_terms = 14 :: Int +happy_n_nonterms = 9 :: Int + +happyReduce_1 = happySpecReduce_3 0# happyReduction_1 +happyReduction_1 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut7 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4 + (UnitAssignment happy_var_3 happy_var_2 + )}} + +happyReduce_2 = happyReduce 5# 0# happyReduction_2 +happyReduction_2 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut7 happy_x_5 of { happy_var_5 -> + happyIn4 + (UnitAlias happy_var_3 happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_3 = happySpecReduce_2 1# happyReduction_3 +happyReduction_3 happy_x_2 + happy_x_1 + = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5 + (Just happy_var_2 + )} + +happyReduce_4 = happySpecReduce_0 1# happyReduction_4 +happyReduction_4 = happyIn5 + (Nothing + ) + +happyReduce_5 = happySpecReduce_3 2# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6 + (happy_var_1 : happy_var_3 + )}} + +happyReduce_6 = happySpecReduce_1 2# happyReduction_6 +happyReduction_6 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6 + ([happy_var_1] + )} + +happyReduce_7 = happySpecReduce_1 3# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn7 + (happy_var_1 + )} + +happyReduce_8 = happySpecReduce_1 3# happyReduction_8 +happyReduction_8 happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_9 = happySpecReduce_3 3# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_10 = happySpecReduce_2 3# happyReduction_10 +happyReduction_10 happy_x_2 + happy_x_1 + = happyIn7 + (Unitless + ) + +happyReduce_11 = happySpecReduce_2 4# happyReduction_11 +happyReduction_11 happy_x_2 + happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn8 + (UnitProduct happy_var_1 happy_var_2 + )}} + +happyReduce_12 = happySpecReduce_3 4# happyReduction_12 +happyReduction_12 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn8 + (UnitQuotient happy_var_1 happy_var_3 + )}} + +happyReduce_13 = happySpecReduce_1 4# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn8 + (happy_var_1 + )} + +happyReduce_14 = happySpecReduce_3 5# happyReduction_14 +happyReduction_14 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn9 + (UnitExponentiation happy_var_1 happy_var_3 + )}} + +happyReduce_15 = happySpecReduce_3 5# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn9 + (happy_var_2 + )} + +happyReduce_16 = happySpecReduce_1 5# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn9 + (UnitBasic happy_var_1 + )} + +happyReduce_17 = happySpecReduce_1 6# happyReduction_17 +happyReduction_17 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + (UnitPowerInteger happy_var_1 + )} + +happyReduce_18 = happySpecReduce_3 6# happyReduction_18 +happyReduction_18 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10 + (UnitPowerInteger happy_var_2 + )} + +happyReduce_19 = happyReduce 5# 6# happyReduction_19 +happyReduction_19 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut11 happy_x_2 of { happy_var_2 -> + case happyOut11 happy_x_4 of { happy_var_4 -> + happyIn10 + (UnitPowerRational happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_20 = happySpecReduce_1 7# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + (read happy_var_1 + )} + +happyReduce_21 = happySpecReduce_2 7# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn11 + (read $ '-' : happy_var_2 + )} + +happyReduce_22 = happySpecReduce_1 8# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOutTok happy_x_1 of { (TNum happy_var_1) -> + happyIn12 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_1 8# happyReduction_23 +happyReduction_23 happy_x_1 + = happyIn12 + ("1" + ) + +happyNewToken action sts stk [] = + happyDoAction 13# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + TId "unit" -> cont 1#; + TId happy_dollar_dollar -> cont 2#; + TNum "1" -> cont 3#; + TNum happy_dollar_dollar -> cont 4#; + TComma -> cont 5#; + TMinus -> cont 6#; + TExponentiation -> cont 7#; + TDivision -> cont 8#; + TDoubleColon -> cont 9#; + TEqual -> cont 10#; + TLeftPar -> cont 11#; + TRightPar -> cont 12#; + _ -> happyError' (tk:tks) + } + +happyError_ 13# 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 + +parseUnit tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +data UnitStatement = + UnitAssignment (Maybe [String]) UnitOfMeasure + | UnitAlias String UnitOfMeasure + deriving Data + +instance Show UnitStatement where + show (UnitAssignment (Just ss) uom) = "= unit (" ++ show uom ++ ") :: " ++ (intercalate "," ss) + show (UnitAssignment Nothing uom) = "= unit (" ++ show uom ++ ")" + show (UnitAlias s uom) = "= unit :: " ++ s ++ " = " ++ show uom + +data UnitOfMeasure = + Unitless + | UnitBasic String + | UnitProduct UnitOfMeasure UnitOfMeasure + | UnitQuotient UnitOfMeasure UnitOfMeasure + | UnitExponentiation UnitOfMeasure UnitPower + deriving Data + +instance Show UnitOfMeasure where + show Unitless = "1" + show (UnitBasic s) = s + show (UnitProduct uom1 uom2) = show uom1 ++ " " ++ show uom2 + show (UnitQuotient uom1 uom2) = show uom1 ++ " / " ++ show uom2 + show (UnitExponentiation uom exp) = show uom ++ "** (" ++ show exp ++ ")" + +data UnitPower = + UnitPowerInteger Integer + | UnitPowerRational Integer Integer + deriving Data + +instance Show UnitPower where + show (UnitPowerInteger i) = show i + show (UnitPowerRational i1 i2) = show i1 ++ "/" ++ show i2 + +data Token = + TUnit + | TComma + | TDoubleColon + | TExponentiation + | TDivision + | TMinus + | TEqual + | TLeftPar + | TRightPar + | TId String + | TNum String + deriving (Show) + +lexer :: String -> Either AnnotationParseError [ Token ] +lexer ('=':xs) = lexer' xs +lexer _ = Left NotAnnotation + +addToTokens :: Token -> String -> Either AnnotationParseError [ Token ] +addToTokens tok rest = do + tokens <- lexer' rest + return $ tok : tokens + +lexer' :: String -> Either AnnotationParseError [ Token ] +lexer' [] = Right [] +lexer' ['\n'] = Right [] +lexer' ['\r', '\n'] = Right [] +lexer' ['\r'] = Right [] -- windows +lexer' (' ':xs) = lexer' xs +lexer' ('\t':xs) = lexer' xs +lexer' (':':':':xs) = addToTokens TDoubleColon xs +lexer' ('*':'*':xs) = addToTokens TExponentiation xs +lexer' (',':xs) = addToTokens TComma xs +lexer' ('/':xs) = addToTokens TDivision xs +lexer' ('-':xs) = addToTokens TMinus xs +lexer' ('=':xs) = addToTokens TEqual xs +lexer' ('(':xs) = addToTokens TLeftPar xs +lexer' (')':xs) = addToTokens TRightPar xs +lexer' (x:xs) + | isLetter x = aux (\c -> isAlphaNum c || c `elem` ['\'','_','-']) TId + | isNumber x = aux isNumber TNum + | otherwise = failWith $ "Not valid unit syntax at " ++ show (x:xs) + where + aux p cons = + let (target, rest) = span p xs + in lexer' rest >>= (\tokens -> return $ cons (x:target) : tokens) + +unitParser :: String -> Either AnnotationParseError UnitStatement +unitParser src = do + tokens <- lexer $ map toLower src + parseUnit tokens + +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 "" #-} +{-# LINE 19 "" #-} +{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 20 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + + +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + + + +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. +#if __GLASGOW_HASKELL__ > 706 +#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) +#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) +#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) +#else +#define LT(n,m) (n Happy_GHC_Exts.<# m) +#define GTE(n,m) (n Happy_GHC_Exts.>=# m) +#define EQ(n,m) (n Happy_GHC_Exts.==# m) +#endif + +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + + + + + + +{-# 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 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + + +happyDoAction i tk st + = {- nothing -} + + + case action of + 0# -> {- nothing -} + happyFail i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = indexShortOffAddr happyActOffsets st + off_i = (off Happy_GHC_Exts.+# i) + check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) + then EQ(indexShortOffAddr happyCheck off_i, i) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + + + + + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + + + + +----------------------------------------------------------------------------- +-- HappyState data type (not arrays) + + +{-# LINE 170 "templates/GenericTemplate.hs" #-} + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = indexShortOffAddr happyGotoOffsets st1 + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (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 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. + diff --git a/src/Camfort/Analysis/IntermediateReps.hs b/src/Camfort/Analysis/IntermediateReps.hs --- a/src/Camfort/Analysis/IntermediateReps.hs +++ b/src/Camfort/Analysis/IntermediateReps.hs @@ -15,6 +15,7 @@ -} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} module Camfort.Analysis.IntermediateReps where diff --git a/src/Camfort/Functionality.hs b/src/Camfort/Functionality.hs --- a/src/Camfort/Functionality.hs +++ b/src/Camfort/Functionality.hs @@ -20,6 +20,8 @@ {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module Camfort.Functionality where diff --git a/src/Camfort/Output.hs b/src/Camfort/Output.hs --- a/src/Camfort/Output.hs +++ b/src/Camfort/Output.hs @@ -77,7 +77,7 @@ show' = show class OutputFiles t where - {-| Given a directory and list of triples of filenames, with their source + {-| Given a directory and list of triples of filenames, with their source text (if it exists) and their AST, write these to the directory -} mkOutputText :: FileOrDir -> t -> SourceText outputFile :: t -> Filename diff --git a/src/Camfort/Specification/Stencils/Grammar.hs b/src/Camfort/Specification/Stencils/Grammar.hs new file mode 100644 --- /dev/null +++ b/src/Camfort/Specification/Stencils/Grammar.hs @@ -0,0 +1,1131 @@ +{-# 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 "" #-} +{-# LINE 16 "" #-} +{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + + +{-# LINE 17 "" #-} +{-# 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. + diff --git a/src/Camfort/Specification/Units/InferenceBackend.hs b/src/Camfort/Specification/Units/InferenceBackend.hs --- a/src/Camfort/Specification/Units/InferenceBackend.hs +++ b/src/Camfort/Specification/Units/InferenceBackend.hs @@ -24,7 +24,11 @@ -} -{-# LANGUAGE ScopedTypeVariables, ImplicitParams, DoAndIfThenElse #-} +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module Camfort.Specification.Units.InferenceBackend where diff --git a/src/Camfort/Specification/Units/InferenceFrontend.hs b/src/Camfort/Specification/Units/InferenceFrontend.hs --- a/src/Camfort/Specification/Units/InferenceFrontend.hs +++ b/src/Camfort/Specification/Units/InferenceFrontend.hs @@ -24,8 +24,14 @@ -} -{-# LANGUAGE ScopedTypeVariables, ImplicitParams, DoAndIfThenElse, ConstraintKinds, - MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} module Camfort.Specification.Units.InferenceFrontend (doInferUnits) where @@ -206,7 +212,7 @@ unitsConverted <- convertUnit units case block of bl@(F.BlStatement ann span _ (F.StDeclaration _ _ _ _ decls)) -> - flip mapM_ vars (\var -> + flip mapM_ vars (\var -> mapM_ (processVar' (Just var) [unitsConverted]) (getNamesAndInits decls)) _ -> return () -- Found a derived unit declaration @@ -218,7 +224,7 @@ where processVar' varReal unitC (var, init, span) = do - hasDeclaration <<++ var + if (Just (realName var) == varReal) then hasDeclaration <<++ var else return () processVar varReal unitC (var, init, span) learnDerivedUnit (name, spec) = do denv <- gets derivedUnitEnv diff --git a/src/Camfort/Specification/Units/Solve.hs b/src/Camfort/Specification/Units/Solve.hs --- a/src/Camfort/Specification/Units/Solve.hs +++ b/src/Camfort/Specification/Units/Solve.hs @@ -19,7 +19,7 @@ import Data.Ratio import Data.List -import Data.Matrix +import qualified Data.Matrix as DM import qualified Data.Vector as V import Control.Exception import System.IO.Unsafe @@ -46,19 +46,19 @@ solveSystem' :: LinearSystem -> Col -> Row -> Consistency LinearSystem solveSystem' (matrix, vector) m k - | m > ncols matrix = efmap (cutSystem k) $ checkSystem (matrix, vector) k + | m > DM.ncols matrix = efmap (cutSystem k) $ checkSystem (matrix, vector) k | otherwise = elimRow (matrix, vector) n m k - where n = find (\n -> matrix ! (n, m) /= 0) [k .. nrows matrix] + where n = find (\n -> matrix DM.! (n, m) /= 0) [k .. DM.nrows matrix] cutSystem :: Int -> LinearSystem -> LinearSystem cutSystem k (matrix, vector) = (matrix', vector') - where matrix' = submatrix 1 (k - 1) 1 (ncols matrix) matrix + where matrix' = DM.submatrix 1 (k - 1) 1 (DM.ncols matrix) matrix vector' = take (k - 1) vector checkSystem :: LinearSystem -> Row -> Consistency LinearSystem checkSystem (matrix, vector) k - | k > nrows matrix = Ok (matrix, vector) - | vector !! (k - 1) /= Unitful [] = let vars = V.toList $ getRow k matrix + | k > DM.nrows matrix = Ok (matrix, vector) + | vector !! (k - 1) /= Unitful [] = let vars = V.toList $ DM.getRow k matrix bad = Bad (matrix, vector) k (vector !! (k - 1), vars) in bad | otherwise = checkSystem (matrix, vector) (k + 1) @@ -67,27 +67,27 @@ elimRow system Nothing m k = solveSystem' system (m + 1) k elimRow (matrix, vector) (Just n) m k = -- (show (m, k)) `D.trace` solveSystem' system' (m + 1) (k + 1) - where matrix' = let s = matrix ! (n, m) in - (if (k == n) then id else switchRows k n) - (if s == 1 then matrix else scaleRow (recip $ s) n matrix) - vector' = switchScaleElems k n (fromRational $ recip $ matrix ! (n, m)) vector + where matrix' = let s = matrix DM.! (n, m) in + (if (k == n) then id else DM.switchRows k n) + (if s == 1 then matrix else DM.scaleRow (recip $ s) n matrix) + vector' = switchScaleElems k n (fromRational $ recip $ matrix DM.! (n, m)) vector system' = elimRow' (matrix', vector') k m msteeper matrix k m = msteep matrix 1 where - r = nrows matrix + r = DM.nrows matrix msteep matrix n | n > r = matrix | n == k = msteep matrix (n+1) - | otherwise = let s = (- matrix ! (n, m)) + | otherwise = let s = (- matrix DM.! (n, m)) in if s == 0 then msteep matrix (n+1) - else msteep (combineRows n s k matrix) (n+1) + else msteep (DM.combineRows n s k matrix) (n+1) elimRow' :: LinearSystem -> Row -> Col -> LinearSystem elimRow' (matrix, vector) k m = (matrix', vector') - where mstep matrix n = let s = (- matrix ! (n, m)) in if s == 0 then matrix else combineRows n s k matrix - matrix' = foldl mstep matrix $ [1 .. k - 1] ++ [k + 1 .. nrows matrix] + where mstep matrix n = let s = (- matrix DM.! (n, m)) in if s == 0 then matrix else DM.combineRows n s k matrix + matrix' = foldl mstep matrix $ [1 .. k - 1] ++ [k + 1 .. DM.nrows matrix] --matrix' = msteeper matrix k m - vector'' = [x - fromRational (matrix ! (n, m)) * vector !! (k - 1) | (n, x) <- zip [1..] vector] + vector'' = [x - fromRational (matrix DM.! (n, m)) * vector !! (k - 1) | (n, x) <- zip [1..] vector] (a, _ : b) = splitAt (k - 1) vector'' vector' = a ++ vector !! (k - 1) : b @@ -101,7 +101,7 @@ solveSystemH :: LinearSystem -> Consistency LinearSystem solveSystemH system@(m,v) = case convertToHMatrix system of - Left (n:_) -> Bad system (nrows m) (v !! n, V.toList (getRow n m)) + Left (n:_) -> Bad system (DM.nrows m) (v !! n, V.toList (DM.getRow n m)) Right (m', units) -> Ok sys' where m2 = rref m' diff --git a/src/Camfort/Specification/Units/Synthesis.hs b/src/Camfort/Specification/Units/Synthesis.hs --- a/src/Camfort/Specification/Units/Synthesis.hs +++ b/src/Camfort/Specification/Units/Synthesis.hs @@ -38,6 +38,7 @@ import qualified Camfort.Output as O (srcSpanToSrcLocs) import Camfort.Analysis.Annotations hiding (Unitless) import Camfort.Specification.Units.Environment +import qualified Debug.Trace as D -- ************************************* -- Insert unit declarations into code @@ -96,7 +97,7 @@ -- Create a zero-length span for the new comment node span0 = FU.SrcSpan (lp {FU.posColumn = 0}) (lp {FU.posColumn = 0}) - -- Create new annotation which labesl this as a refactored node + -- Create new annotation which labels this as a refactored node ap = (prevAnnotation (FA.prevAnnotation a)) { refactored = Just loc } a' = a {FA.prevAnnotation = (FA.prevAnnotation a) { prevAnnotation = ap }} diff --git a/src/Camfort/Transformation/EquivalenceElim.hs b/src/Camfort/Transformation/EquivalenceElim.hs --- a/src/Camfort/Transformation/EquivalenceElim.hs +++ b/src/Camfort/Transformation/EquivalenceElim.hs @@ -15,6 +15,7 @@ -} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE FlexibleContexts #-} module Camfort.Transformation.EquivalenceElim where diff --git a/src/Camfort/Traverse.hs b/src/Camfort/Traverse.hs --- a/src/Camfort/Traverse.hs +++ b/src/Camfort/Traverse.hs @@ -45,11 +45,6 @@ import Debug.Trace -instance Monoid x => Monad ((,) x) where - return a = (mempty, a) - (x, a) >>= k = let (x', b) = k a - in (mappend x x', b) - -- Data-type generic comonad-style traversal extendBi :: (Biplate (from a) (to a), RComonad to) => (to a -> a) -> (from a) -> (from a) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -129,8 +129,8 @@ ("units-synth", (unitsSynth, "unit-of-measure synthesise specs.")) ] -- * Usage and about information -version = 0.800 -introMsg = "CamFort " ++ show version ++ " - Cambridge Fortran Infrastructure." +version = "0.802" +introMsg = "CamFort " ++ version ++ " - Cambridge Fortran Infrastructure." usage = "Usage: camfort [OUTPUT] [OPTIONS...]\n" menu = "Refactor functions:\n"