packages feed

camfort 0.900 → 0.901

raw patch · 40 files changed

+5121/−256 lines, 40 filesdep ~fortran-srcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: fortran-src

API changes (from Hackage documentation)

+ Camfort.Specification.Units.Environment: doubleToRationalSubset :: Double -> Maybe Rational
- Camfort.Functionality: ast :: [Char] -> [Filename] -> [Char] -> t -> IO ()
+ Camfort.Functionality: ast :: FileOrDir -> [Filename] -> t1 -> t -> IO ()
- Camfort.Input: callAndSummarise :: (Monoid a1, Foldable t1) => (t3 -> t2 -> (a1, a)) -> t1 (t3, t, t2) -> (a1, [a])
+ Camfort.Input: callAndSummarise :: (Monoid a, Foldable t) => (t1 -> t3 -> (a, a1)) -> t (t1, t2, t3) -> (a, [a1])
- Camfort.Reprint: takeBounds' :: (Num t, Num t1, Ord t1, Eq t) => ((t1, t), (t1, t)) -> ByteString -> ByteString -> (ByteString, ByteString)
+ Camfort.Reprint: takeBounds' :: (Ord t1, Num t1, Num t, Eq t) => ((t1, t), (t1, t)) -> ByteString -> ByteString -> (ByteString, ByteString)
- Camfort.Specification.Stencils.Syntax: showRegion :: (Show a, Show a1) => [Char] -> a1 -> a -> Bool -> [Char]
+ Camfort.Specification.Stencils.Syntax: showRegion :: (Show a1, Show a) => [Char] -> a -> a1 -> Bool -> [Char]
- Camfort.Transformation.EquivalenceElim: equalTypes :: Eq b => Map Name b -> Expression a1 -> Expression a -> Maybe b
+ Camfort.Transformation.EquivalenceElim: equalTypes :: Eq b => Map Name b -> Expression a -> Expression a1 -> Maybe b

Files

camfort.cabal view
@@ -1,5 +1,5 @@ name:                   camfort-version:                0.900+version:                0.901 synopsis:               CamFort - Cambridge Fortran infrastructure description:            CamFort is a tool for the analysis, transformation, verification of Fortran code. @@ -17,9 +17,9 @@ cabal-version:          >= 1.18 tested-with:            GHC >= 7.8 -extra-source-files:     tests/Camfort/Specification/Stencils/*.f-                        tests/Camfort/Specification/Units/*.f90-                        tests/Camfort/Transformation/samples/*.f90+extra-source-files:     tests/fixtures/Specification/Stencils/*.f+                        tests/fixtures/Specification/Units/*.f90+			tests/fixtures/Transformation/*.f90  source-repository head   type: git@@ -76,7 +76,7 @@                         transformers >= 0.4,                         GenericPretty >= 1.2,                         QuickCheck >= 2.8,-                        fortran-src >= 0.1.0.3,+                        fortran-src >= 0.1.0.4,                         filepath,                         fgl >= 5.5,                         bytestring >= 0.10@@ -131,7 +131,7 @@                         transformers >= 0.4,                         vector >= 0.1,                         GenericPretty >= 1.2,-                        fortran-src >= 0.1.0.3,+                        fortran-src >= 0.1.0.4,                         filepath,                         bytestring >= 0.10,                         fgl >= 5.5@@ -156,11 +156,12 @@                         directory >= 1.2,                         hspec >= 2.2,                         QuickCheck >= 2.8,-                        fortran-src >= 0.1.0.3,+                        fortran-src >= 0.1.0.4,                         uniplate >= 1.6.10,                         mtl >= 2.1,                         bytestring >= 0.10,                         array >= 0.4,                         hmatrix >= 0.15,+                        text >= 0.11.2.3,                         camfort   default-language: Haskell2010
+ dist/build/Camfort/Specification/Stencils/Grammar.hs view
@@ -0,0 +1,980 @@+{-# 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 qualified Data.Text as T++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 :: ((Depth Int, Dim Int, Bool)) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> ((Depth Int, Dim Int, Bool))+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: ((Dim Int, Bool)) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> ((Dim Int, Bool))+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: ((Depth Int, Bool)) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> ((Depth Int, Bool))+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (Depth Int) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (Depth Int)+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Dim Int) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Dim Int)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (Bool) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (Bool)+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: (Spec) -> (HappyAbsSyn )+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> (Spec)+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (Mod) -> (HappyAbsSyn )+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> (Mod)+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: ([Mod]) -> (HappyAbsSyn )+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> ([Mod])+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: (Mod) -> (HappyAbsSyn )+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> (Mod)+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: ([String]) -> (HappyAbsSyn )+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> ([String])+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut17 #-}+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# "\x51\x00\x71\x00\x00\x00\x74\x00\x50\x00\xfe\xff\x41\x00\x73\x00\x0c\x00\x79\x00\x08\x00\x00\x00\x70\x00\x00\x00\x00\x00\x6f\x00\x6d\x00\x6c\x00\x00\x00\x0c\x00\x6e\x00\x6b\x00\x25\x00\x35\x00\x35\x00\x35\x00\x69\x00\x41\x00\x00\x00\x47\x00\x0c\x00\x3c\x00\x68\x00\x0c\x00\x0c\x00\x00\x00\x6a\x00\x00\x00\x67\x00\x3c\x00\x66\x00\x65\x00\x3d\x00\x36\x00\x40\x00\x00\x00\x64\x00\x4d\x00\x63\x00\x4c\x00\x00\x00\x0c\x00\x37\x00\x00\x00\x00\x00\x62\x00\x60\x00\x61\x00\x5f\x00\x00\x00\x5e\x00\x5d\x00\x00\x00\x5c\x00\x5a\x00\x00\x00\x56\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x2e\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x59\x00\x53\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x30\x00\x2a\x00\x24\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x57\x00\x00\x00\x4b\x00\x55\x00\x54\x00\x00\x00\x00\x00\x00\x00\x48\x00\x00\x00\x00\x00\x00\x00\xff\xff\x3b\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x49\x00\x00\x00\x42\x00\x3e\x00\x00\x00\x34\x00\x06\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"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xe3\xff\x00\x00\x00\x00\x00\x00\xe0\xff\xe2\xff\x00\x00\xdf\xff\xde\xff\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\xff\xe1\xff\xe0\xff\x00\x00\xe5\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xdc\xff\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf9\xff\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\xea\xff\x00\x00\xf3\xff\xed\xff\x00\x00\xfb\xff\x00\x00\xdd\xff\x00\x00\xef\xff\xee\xff\xeb\xff\xec\xff\xf0\xff\xf1\xff\xe8\xff\xe9\xff\xf8\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x04\x00\x06\x00\x07\x00\x07\x00\x08\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x04\x00\x07\x00\x06\x00\x07\x00\x04\x00\x13\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x02\x00\x13\x00\x02\x00\x06\x00\x07\x00\x13\x00\x07\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x03\x00\x0b\x00\x0c\x00\x06\x00\x07\x00\x08\x00\x03\x00\x00\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x0f\x00\x10\x00\x06\x00\x07\x00\x08\x00\x14\x00\x05\x00\x05\x00\x08\x00\x08\x00\x09\x00\x09\x00\x05\x00\x06\x00\x05\x00\x08\x00\x06\x00\x08\x00\x0f\x00\x10\x00\x08\x00\x09\x00\x08\x00\x0f\x00\x10\x00\x06\x00\x07\x00\x06\x00\x0f\x00\x10\x00\x01\x00\x02\x00\x02\x00\x0d\x00\x02\x00\x02\x00\x0d\x00\x02\x00\x02\x00\x02\x00\x01\x00\x0a\x00\x14\x00\x12\x00\x14\x00\x05\x00\x08\x00\x05\x00\x0e\x00\x15\x00\x09\x00\xff\xff\x09\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\xff\xff\x0e\x00\x08\x00\xff\xff\x02\x00\x0d\x00\x0d\x00\x12\x00\x14\x00\x12\x00\x14\x00\x10\x00\x0d\x00\x03\x00\x12\x00\xff\xff\x13\x00\x13\x00\xff\xff\x13\x00\x13\x00\x11\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x3e\x00\x0e\x00\x0f\x00\x3f\x00\x40\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0d\x00\x45\x00\x0e\x00\x0f\x00\x0d\x00\x14\x00\x10\x00\x11\x00\x12\x00\x13\x00\x10\x00\x11\x00\x12\x00\x13\x00\x06\x00\x14\x00\x1b\x00\x39\x00\x3a\x00\x14\x00\x4a\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x1c\x00\x1d\x00\x29\x00\x1c\x00\x1d\x00\x2a\x00\x2b\x00\x2c\x00\x30\x00\x04\x00\x02\x00\x2a\x00\x2b\x00\x2c\x00\x31\x00\x22\x00\x23\x00\x2a\x00\x2b\x00\x2c\x00\x33\x00\x2e\x00\x2e\x00\x46\x00\x2f\x00\x30\x00\x30\x00\x3b\x00\x3c\x00\x2e\x00\x3d\x00\x47\x00\x2f\x00\x22\x00\x23\x00\x2f\x00\x30\x00\x48\x00\x22\x00\x23\x00\x0e\x00\x0f\x00\x49\x00\x22\x00\x23\x00\x06\x00\x04\x00\x34\x00\x43\x00\x23\x00\x24\x00\x25\x00\x27\x00\x16\x00\x1f\x00\x02\x00\x1e\x00\x4e\x00\x38\x00\x36\x00\x2e\x00\x2f\x00\x2e\x00\x45\x00\xff\xff\x30\x00\x00\x00\x30\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x29\x00\x00\x00\x04\x00\x27\x00\x27\x00\x39\x00\x37\x00\x43\x00\x42\x00\x23\x00\x16\x00\x0c\x00\x34\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x1b\x00\x21\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 35) [+	(1 , happyReduce_1),+	(2 , happyReduce_2),+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27),+	(28 , happyReduce_28),+	(29 , happyReduce_29),+	(30 , happyReduce_30),+	(31 , happyReduce_31),+	(32 , happyReduce_32),+	(33 , happyReduce_33),+	(34 , happyReduce_34),+	(35 , happyReduce_35)+	]++happy_n_terms = 22 :: Int+happy_n_nonterms = 14 :: 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 happyOut13 happy_x_2 of { happy_var_2 -> +	case happyOut17 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 4# 2# happyReduction_4+happyReduction_4 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Forward  happy_var_3+	) `HappyStk` happyRest}++happyReduce_5 = happyReduce 4# 2# happyReduction_5+happyReduction_5 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Backward happy_var_3+	) `HappyStk` happyRest}++happyReduce_6 = happyReduce 4# 2# happyReduction_6+happyReduction_6 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Centered happy_var_3+	) `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_2  3# happyReduction_12+happyReduction_12 happy_x_2+	happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	case happyOut8 happy_x_2 of { happy_var_2 -> +	happyIn7+		 ((happy_var_1, fst happy_var_2, snd happy_var_2)+	)}}++happyReduce_13 = happySpecReduce_2  3# happyReduction_13+happyReduction_13 happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	case happyOut9 happy_x_2 of { happy_var_2 -> +	happyIn7+		 ((fst happy_var_2, happy_var_1, snd happy_var_2)+	)}}++happyReduce_14 = happySpecReduce_3  3# happyReduction_14+happyReduction_14 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut10 happy_x_2 of { happy_var_2 -> +	case happyOut11 happy_x_3 of { happy_var_3 -> +	happyIn7+		 ((happy_var_2, happy_var_3, happy_var_1)+	)}}}++happyReduce_15 = happySpecReduce_3  3# happyReduction_15+happyReduction_15 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut11 happy_x_2 of { happy_var_2 -> +	case happyOut10 happy_x_3 of { happy_var_3 -> +	happyIn7+		 ((happy_var_3, happy_var_2, happy_var_1)+	)}}}++happyReduce_16 = happySpecReduce_2  4# happyReduction_16+happyReduction_16 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut11 happy_x_2 of { happy_var_2 -> +	happyIn8+		 ((happy_var_2, happy_var_1)+	)}}++happyReduce_17 = happySpecReduce_2  4# happyReduction_17+happyReduction_17 happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn8+		 ((happy_var_1, happy_var_2)+	)}}++happyReduce_18 = happySpecReduce_1  4# happyReduction_18+happyReduction_18 happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	happyIn8+		 ((happy_var_1, True)+	)}++happyReduce_19 = happySpecReduce_2  5# happyReduction_19+happyReduction_19 happy_x_2+	happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn9+		 ((happy_var_1, happy_var_2)+	)}}++happyReduce_20 = happySpecReduce_2  5# happyReduction_20+happyReduction_20 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut10 happy_x_2 of { happy_var_2 -> +	happyIn9+		 ((happy_var_2, happy_var_1)+	)}}++happyReduce_21 = happySpecReduce_1  5# happyReduction_21+happyReduction_21 happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	happyIn9+		 ((happy_var_1, True)+	)}++happyReduce_22 = happySpecReduce_3  6# happyReduction_22+happyReduction_22 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_3 of { (TNum happy_var_3) -> +	happyIn10+		 (Depth $ read happy_var_3+	)}++happyReduce_23 = happySpecReduce_3  7# happyReduction_23+happyReduction_23 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_3 of { (TNum happy_var_3) -> +	happyIn11+		 (Dim $ read happy_var_3+	)}++happyReduce_24 = happySpecReduce_1  8# happyReduction_24+happyReduction_24 happy_x_1+	 =  happyIn12+		 (False+	)++happyReduce_25 = happySpecReduce_3  9# happyReduction_25+happyReduction_25 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> +	case happyOut14 happy_x_2 of { happy_var_2 -> +	case happyOut6 happy_x_3 of { happy_var_3 -> +	happyIn13+		 (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+	)}}}++happyReduce_26 = happySpecReduce_2  9# happyReduction_26+happyReduction_26 happy_x_2+	happy_x_1+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> +	case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn13+		 (Spatial [happy_var_1] happy_var_2+	)}}++happyReduce_27 = happySpecReduce_2  9# happyReduction_27+happyReduction_27 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn13+		 (Spatial [happy_var_1] happy_var_2+	)}}++happyReduce_28 = happySpecReduce_1  9# happyReduction_28+happyReduction_28 happy_x_1+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> +	happyIn13+		 (Spatial [] happy_var_1+	)}++happyReduce_29 = happySpecReduce_1  10# happyReduction_29+happyReduction_29 happy_x_1+	 =  happyIn14+		 (ReadOnce+	)++happyReduce_30 = happySpecReduce_2  11# happyReduction_30+happyReduction_30 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut15 happy_x_2 of { happy_var_2 -> +	happyIn15+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_31 = happySpecReduce_1  11# happyReduction_31+happyReduction_31 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn15+		 ([happy_var_1]+	)}++happyReduce_32 = happySpecReduce_1  12# happyReduction_32+happyReduction_32 happy_x_1+	 =  happyIn16+		 (AtMost+	)++happyReduce_33 = happySpecReduce_1  12# happyReduction_33+happyReduction_33 happy_x_1+	 =  happyIn16+		 (AtLeast+	)++happyReduce_34 = happySpecReduce_2  13# happyReduction_34+happyReduction_34 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TId happy_var_1) -> +	case happyOut17 happy_x_2 of { happy_var_2 -> +	happyIn17+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_35 = happySpecReduce_1  13# happyReduction_35+happyReduction_35 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TId happy_var_1) -> +	happyIn17+		 ([happy_var_1]+	)}++happyNewToken action sts stk [] =+	happyDoAction 21# 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 "dim" -> cont 8#;+	TId "depth" -> cont 9#;+	TId "forward" -> cont 10#;+	TId "backward" -> cont 11#;+	TId "centered" -> cont 12#;+	TId happy_dollar_dollar -> cont 13#;+	TNum happy_dollar_dollar -> cont 14#;+	TPlus -> cont 15#;+	TStar -> cont 16#;+	TDoubleColon -> cont 17#;+	TEqual -> cont 18#;+	TLParen -> cont 19#;+	TRParen -> cont 20#;+	_ -> happyError' (tk:tks)+	}++happyError_ 21# 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+++newtype Depth a = Depth a+newtype Dim a = Dim a++applyAttr :: (Int -> Int -> Bool -> Region)+          -> (Depth Int, Dim Int, Bool)+          -> Region+applyAttr constr (Depth d, Dim dim, irrefl) = constr d dim irrefl++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+  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++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+  case stripLeadingWhiteSpace input of+    -- Check the leading character is '=' for specification+    '=':input' -> testAnnotation input'+    '!':input' -> testAnnotation input'+    '>':input' -> testAnnotation input'+    '<':input' -> testAnnotation input'+    _ -> Left NotAnnotation+  where+    stripLeadingWhiteSpace = T.unpack . T.strip . T.pack+    testAnnotation inp =+      -- First test to see if the input looks like an actual+      -- specification of either a stencil or region+      if (inp `hasPrefix` "stencil" || inp `hasPrefix` "region")+      then lexer' inp+      else Left NotAnnotation+    hasPrefix []       str = False+    hasPrefix (' ':xs) str = hasPrefix xs str+    hasPrefix xs       str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' []                                              = return []+lexer' (' ':xs)                                        = lexer' xs+lexer' ('\t':xs)                                       = lexer' xs+lexer' (':':':':xs)                                    = addToTokens TDoubleColon xs+lexer' ('*':xs)                                        = addToTokens TStar xs+lexer' ('+':xs)                                        = addToTokens TPlus xs+lexer' ('=':xs)                                        = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+  | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+  | otherwise                                         = addToTokens TComma xs+lexer' ('(':xs)                                        = addToTokens TLParen xs+lexer' (')':xs)                                        = addToTokens TRParen xs+lexer' (x:xs)+  | isLetter x                                        = aux TId $ \ c -> isAlphaNum c || c == '_'+  | isNumber x                                        = aux TNum isNumber+  | otherwise+     = failWith $ "Not an indentifier " ++ show x+ where+   aux f p = (f target :) `fmap` lexer' rest+     where (target, rest) = span p (x:xs)+lexer' x+    = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+  do mods' <- modValidate' $ sort mods+     return $ SpecDec (Spatial mods' r) vars++  where    modValidate' [] = return $ []++           modValidate' (AtLeast : AtLeast : xs)+             = failWith "Duplicate 'atLeast' modifier; use at most one."++           modValidate' (AtMost : AtMost : xs)+             = failWith "Duplicate 'atMost' modifier; use at most one."++           modValidate' (ReadOnce : ReadOnce : xs)+             = failWith "Duplicate 'readOnce' modifier; use at most one."++           modValidate' (AtLeast : AtMost : xs)+             = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+                     ++ "'atMost' together"++           modValidate' (x : xs)+             = do xs' <- modValidate' xs+                  return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 19 "<built-in>" #-}+{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}+++++++++++++++++++{-# LINE 20 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp +++{-# LINE 13 "templates/GenericTemplate.hs" #-}++++++-- 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.+
+ dist/build/Camfort/Specification/Units/Parser.hs view
@@ -0,0 +1,766 @@+{-# 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.Text as T+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 [] = Left NotAnnotation+lexer (c:xs)+  | c `elem` ['=', '!', '>', '<'] =+      -- First test to see if the input looks like an actual unit specification+      if "unit" `isPrefixOf` (T.unpack . T.strip . T.toLower . T.pack $ xs)+      then lexer' xs+      else Left NotAnnotation+  | otherwise = 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) ++ "\n"+ 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 unit specification at: " ++ show t ++ "\n"+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 19 "<built-in>" #-}+{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}+++++++++++++++++++{-# LINE 20 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp +++{-# LINE 13 "templates/GenericTemplate.hs" #-}++++++-- 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.+
+ dist/build/Camfort/camfort-tmp/Camfort/Specification/Stencils/Grammar.hs view
@@ -0,0 +1,980 @@+{-# 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 qualified Data.Text as T++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 :: ((Depth Int, Dim Int, Bool)) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> ((Depth Int, Dim Int, Bool))+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: ((Dim Int, Bool)) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> ((Dim Int, Bool))+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: ((Depth Int, Bool)) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> ((Depth Int, Bool))+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (Depth Int) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (Depth Int)+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Dim Int) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Dim Int)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (Bool) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (Bool)+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: (Spec) -> (HappyAbsSyn )+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> (Spec)+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (Mod) -> (HappyAbsSyn )+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> (Mod)+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: ([Mod]) -> (HappyAbsSyn )+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> ([Mod])+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: (Mod) -> (HappyAbsSyn )+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> (Mod)+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: ([String]) -> (HappyAbsSyn )+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> ([String])+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut17 #-}+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# "\x51\x00\x71\x00\x00\x00\x74\x00\x50\x00\xfe\xff\x41\x00\x73\x00\x0c\x00\x79\x00\x08\x00\x00\x00\x70\x00\x00\x00\x00\x00\x6f\x00\x6d\x00\x6c\x00\x00\x00\x0c\x00\x6e\x00\x6b\x00\x25\x00\x35\x00\x35\x00\x35\x00\x69\x00\x41\x00\x00\x00\x47\x00\x0c\x00\x3c\x00\x68\x00\x0c\x00\x0c\x00\x00\x00\x6a\x00\x00\x00\x67\x00\x3c\x00\x66\x00\x65\x00\x3d\x00\x36\x00\x40\x00\x00\x00\x64\x00\x4d\x00\x63\x00\x4c\x00\x00\x00\x0c\x00\x37\x00\x00\x00\x00\x00\x62\x00\x60\x00\x61\x00\x5f\x00\x00\x00\x5e\x00\x5d\x00\x00\x00\x5c\x00\x5a\x00\x00\x00\x56\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x2e\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x59\x00\x53\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x30\x00\x2a\x00\x24\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x57\x00\x00\x00\x4b\x00\x55\x00\x54\x00\x00\x00\x00\x00\x00\x00\x48\x00\x00\x00\x00\x00\x00\x00\xff\xff\x3b\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x49\x00\x00\x00\x42\x00\x3e\x00\x00\x00\x34\x00\x06\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"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xe3\xff\x00\x00\x00\x00\x00\x00\xe0\xff\xe2\xff\x00\x00\xdf\xff\xde\xff\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\xff\xe1\xff\xe0\xff\x00\x00\xe5\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xdc\xff\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf9\xff\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\xea\xff\x00\x00\xf3\xff\xed\xff\x00\x00\xfb\xff\x00\x00\xdd\xff\x00\x00\xef\xff\xee\xff\xeb\xff\xec\xff\xf0\xff\xf1\xff\xe8\xff\xe9\xff\xf8\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x04\x00\x06\x00\x07\x00\x07\x00\x08\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x04\x00\x07\x00\x06\x00\x07\x00\x04\x00\x13\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x02\x00\x13\x00\x02\x00\x06\x00\x07\x00\x13\x00\x07\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x03\x00\x0b\x00\x0c\x00\x06\x00\x07\x00\x08\x00\x03\x00\x00\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x0f\x00\x10\x00\x06\x00\x07\x00\x08\x00\x14\x00\x05\x00\x05\x00\x08\x00\x08\x00\x09\x00\x09\x00\x05\x00\x06\x00\x05\x00\x08\x00\x06\x00\x08\x00\x0f\x00\x10\x00\x08\x00\x09\x00\x08\x00\x0f\x00\x10\x00\x06\x00\x07\x00\x06\x00\x0f\x00\x10\x00\x01\x00\x02\x00\x02\x00\x0d\x00\x02\x00\x02\x00\x0d\x00\x02\x00\x02\x00\x02\x00\x01\x00\x0a\x00\x14\x00\x12\x00\x14\x00\x05\x00\x08\x00\x05\x00\x0e\x00\x15\x00\x09\x00\xff\xff\x09\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\xff\xff\x0e\x00\x08\x00\xff\xff\x02\x00\x0d\x00\x0d\x00\x12\x00\x14\x00\x12\x00\x14\x00\x10\x00\x0d\x00\x03\x00\x12\x00\xff\xff\x13\x00\x13\x00\xff\xff\x13\x00\x13\x00\x11\x00\x11\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x3e\x00\x0e\x00\x0f\x00\x3f\x00\x40\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0d\x00\x45\x00\x0e\x00\x0f\x00\x0d\x00\x14\x00\x10\x00\x11\x00\x12\x00\x13\x00\x10\x00\x11\x00\x12\x00\x13\x00\x06\x00\x14\x00\x1b\x00\x39\x00\x3a\x00\x14\x00\x4a\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x1c\x00\x1d\x00\x29\x00\x1c\x00\x1d\x00\x2a\x00\x2b\x00\x2c\x00\x30\x00\x04\x00\x02\x00\x2a\x00\x2b\x00\x2c\x00\x31\x00\x22\x00\x23\x00\x2a\x00\x2b\x00\x2c\x00\x33\x00\x2e\x00\x2e\x00\x46\x00\x2f\x00\x30\x00\x30\x00\x3b\x00\x3c\x00\x2e\x00\x3d\x00\x47\x00\x2f\x00\x22\x00\x23\x00\x2f\x00\x30\x00\x48\x00\x22\x00\x23\x00\x0e\x00\x0f\x00\x49\x00\x22\x00\x23\x00\x06\x00\x04\x00\x34\x00\x43\x00\x23\x00\x24\x00\x25\x00\x27\x00\x16\x00\x1f\x00\x02\x00\x1e\x00\x4e\x00\x38\x00\x36\x00\x2e\x00\x2f\x00\x2e\x00\x45\x00\xff\xff\x30\x00\x00\x00\x30\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4d\x00\x29\x00\x00\x00\x04\x00\x27\x00\x27\x00\x39\x00\x37\x00\x43\x00\x42\x00\x23\x00\x16\x00\x0c\x00\x34\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x1b\x00\x21\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 35) [+	(1 , happyReduce_1),+	(2 , happyReduce_2),+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27),+	(28 , happyReduce_28),+	(29 , happyReduce_29),+	(30 , happyReduce_30),+	(31 , happyReduce_31),+	(32 , happyReduce_32),+	(33 , happyReduce_33),+	(34 , happyReduce_34),+	(35 , happyReduce_35)+	]++happy_n_terms = 22 :: Int+happy_n_nonterms = 14 :: 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 happyOut13 happy_x_2 of { happy_var_2 -> +	case happyOut17 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 4# 2# happyReduction_4+happyReduction_4 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Forward  happy_var_3+	) `HappyStk` happyRest}++happyReduce_5 = happyReduce 4# 2# happyReduction_5+happyReduction_5 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Backward happy_var_3+	) `HappyStk` happyRest}++happyReduce_6 = happyReduce 4# 2# happyReduction_6+happyReduction_6 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (applyAttr Centered happy_var_3+	) `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_2  3# happyReduction_12+happyReduction_12 happy_x_2+	happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	case happyOut8 happy_x_2 of { happy_var_2 -> +	happyIn7+		 ((happy_var_1, fst happy_var_2, snd happy_var_2)+	)}}++happyReduce_13 = happySpecReduce_2  3# happyReduction_13+happyReduction_13 happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	case happyOut9 happy_x_2 of { happy_var_2 -> +	happyIn7+		 ((fst happy_var_2, happy_var_1, snd happy_var_2)+	)}}++happyReduce_14 = happySpecReduce_3  3# happyReduction_14+happyReduction_14 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut10 happy_x_2 of { happy_var_2 -> +	case happyOut11 happy_x_3 of { happy_var_3 -> +	happyIn7+		 ((happy_var_2, happy_var_3, happy_var_1)+	)}}}++happyReduce_15 = happySpecReduce_3  3# happyReduction_15+happyReduction_15 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut11 happy_x_2 of { happy_var_2 -> +	case happyOut10 happy_x_3 of { happy_var_3 -> +	happyIn7+		 ((happy_var_3, happy_var_2, happy_var_1)+	)}}}++happyReduce_16 = happySpecReduce_2  4# happyReduction_16+happyReduction_16 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut11 happy_x_2 of { happy_var_2 -> +	happyIn8+		 ((happy_var_2, happy_var_1)+	)}}++happyReduce_17 = happySpecReduce_2  4# happyReduction_17+happyReduction_17 happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn8+		 ((happy_var_1, happy_var_2)+	)}}++happyReduce_18 = happySpecReduce_1  4# happyReduction_18+happyReduction_18 happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	happyIn8+		 ((happy_var_1, True)+	)}++happyReduce_19 = happySpecReduce_2  5# happyReduction_19+happyReduction_19 happy_x_2+	happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	case happyOut12 happy_x_2 of { happy_var_2 -> +	happyIn9+		 ((happy_var_1, happy_var_2)+	)}}++happyReduce_20 = happySpecReduce_2  5# happyReduction_20+happyReduction_20 happy_x_2+	happy_x_1+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> +	case happyOut10 happy_x_2 of { happy_var_2 -> +	happyIn9+		 ((happy_var_2, happy_var_1)+	)}}++happyReduce_21 = happySpecReduce_1  5# happyReduction_21+happyReduction_21 happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	happyIn9+		 ((happy_var_1, True)+	)}++happyReduce_22 = happySpecReduce_3  6# happyReduction_22+happyReduction_22 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_3 of { (TNum happy_var_3) -> +	happyIn10+		 (Depth $ read happy_var_3+	)}++happyReduce_23 = happySpecReduce_3  7# happyReduction_23+happyReduction_23 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_3 of { (TNum happy_var_3) -> +	happyIn11+		 (Dim $ read happy_var_3+	)}++happyReduce_24 = happySpecReduce_1  8# happyReduction_24+happyReduction_24 happy_x_1+	 =  happyIn12+		 (False+	)++happyReduce_25 = happySpecReduce_3  9# happyReduction_25+happyReduction_25 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> +	case happyOut14 happy_x_2 of { happy_var_2 -> +	case happyOut6 happy_x_3 of { happy_var_3 -> +	happyIn13+		 (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+	)}}}++happyReduce_26 = happySpecReduce_2  9# happyReduction_26+happyReduction_26 happy_x_2+	happy_x_1+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> +	case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn13+		 (Spatial [happy_var_1] happy_var_2+	)}}++happyReduce_27 = happySpecReduce_2  9# happyReduction_27+happyReduction_27 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn13+		 (Spatial [happy_var_1] happy_var_2+	)}}++happyReduce_28 = happySpecReduce_1  9# happyReduction_28+happyReduction_28 happy_x_1+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> +	happyIn13+		 (Spatial [] happy_var_1+	)}++happyReduce_29 = happySpecReduce_1  10# happyReduction_29+happyReduction_29 happy_x_1+	 =  happyIn14+		 (ReadOnce+	)++happyReduce_30 = happySpecReduce_2  11# happyReduction_30+happyReduction_30 happy_x_2+	happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	case happyOut15 happy_x_2 of { happy_var_2 -> +	happyIn15+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_31 = happySpecReduce_1  11# happyReduction_31+happyReduction_31 happy_x_1+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> +	happyIn15+		 ([happy_var_1]+	)}++happyReduce_32 = happySpecReduce_1  12# happyReduction_32+happyReduction_32 happy_x_1+	 =  happyIn16+		 (AtMost+	)++happyReduce_33 = happySpecReduce_1  12# happyReduction_33+happyReduction_33 happy_x_1+	 =  happyIn16+		 (AtLeast+	)++happyReduce_34 = happySpecReduce_2  13# happyReduction_34+happyReduction_34 happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (TId happy_var_1) -> +	case happyOut17 happy_x_2 of { happy_var_2 -> +	happyIn17+		 (happy_var_1 : happy_var_2+	)}}++happyReduce_35 = happySpecReduce_1  13# happyReduction_35+happyReduction_35 happy_x_1+	 =  case happyOutTok happy_x_1 of { (TId happy_var_1) -> +	happyIn17+		 ([happy_var_1]+	)}++happyNewToken action sts stk [] =+	happyDoAction 21# 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 "dim" -> cont 8#;+	TId "depth" -> cont 9#;+	TId "forward" -> cont 10#;+	TId "backward" -> cont 11#;+	TId "centered" -> cont 12#;+	TId happy_dollar_dollar -> cont 13#;+	TNum happy_dollar_dollar -> cont 14#;+	TPlus -> cont 15#;+	TStar -> cont 16#;+	TDoubleColon -> cont 17#;+	TEqual -> cont 18#;+	TLParen -> cont 19#;+	TRParen -> cont 20#;+	_ -> happyError' (tk:tks)+	}++happyError_ 21# 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+++newtype Depth a = Depth a+newtype Dim a = Dim a++applyAttr :: (Int -> Int -> Bool -> Region)+          -> (Depth Int, Dim Int, Bool)+          -> Region+applyAttr constr (Depth d, Dim dim, irrefl) = constr d dim irrefl++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+  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++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+  case stripLeadingWhiteSpace input of+    -- Check the leading character is '=' for specification+    '=':input' -> testAnnotation input'+    '!':input' -> testAnnotation input'+    '>':input' -> testAnnotation input'+    '<':input' -> testAnnotation input'+    _ -> Left NotAnnotation+  where+    stripLeadingWhiteSpace = T.unpack . T.strip . T.pack+    testAnnotation inp =+      -- First test to see if the input looks like an actual+      -- specification of either a stencil or region+      if (inp `hasPrefix` "stencil" || inp `hasPrefix` "region")+      then lexer' inp+      else Left NotAnnotation+    hasPrefix []       str = False+    hasPrefix (' ':xs) str = hasPrefix xs str+    hasPrefix xs       str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' []                                              = return []+lexer' (' ':xs)                                        = lexer' xs+lexer' ('\t':xs)                                       = lexer' xs+lexer' (':':':':xs)                                    = addToTokens TDoubleColon xs+lexer' ('*':xs)                                        = addToTokens TStar xs+lexer' ('+':xs)                                        = addToTokens TPlus xs+lexer' ('=':xs)                                        = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+  | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+  | otherwise                                         = addToTokens TComma xs+lexer' ('(':xs)                                        = addToTokens TLParen xs+lexer' (')':xs)                                        = addToTokens TRParen xs+lexer' (x:xs)+  | isLetter x                                        = aux TId $ \ c -> isAlphaNum c || c == '_'+  | isNumber x                                        = aux TNum isNumber+  | otherwise+     = failWith $ "Not an indentifier " ++ show x+ where+   aux f p = (f target :) `fmap` lexer' rest+     where (target, rest) = span p (x:xs)+lexer' x+    = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+  do mods' <- modValidate' $ sort mods+     return $ SpecDec (Spatial mods' r) vars++  where    modValidate' [] = return $ []++           modValidate' (AtLeast : AtLeast : xs)+             = failWith "Duplicate 'atLeast' modifier; use at most one."++           modValidate' (AtMost : AtMost : xs)+             = failWith "Duplicate 'atMost' modifier; use at most one."++           modValidate' (ReadOnce : ReadOnce : xs)+             = failWith "Duplicate 'readOnce' modifier; use at most one."++           modValidate' (AtLeast : AtMost : xs)+             = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+                     ++ "'atMost' together"++           modValidate' (x : xs)+             = do xs' <- modValidate' xs+                  return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 19 "<built-in>" #-}+{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}+++++++++++++++++++{-# LINE 20 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp +++{-# LINE 13 "templates/GenericTemplate.hs" #-}++++++-- 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.+
+ dist/build/Camfort/camfort-tmp/Camfort/Specification/Units/Parser.hs view
@@ -0,0 +1,766 @@+{-# 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.Text as T+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 [] = Left NotAnnotation+lexer (c:xs)+  | c `elem` ['=', '!', '>', '<'] =+      -- First test to see if the input looks like an actual unit specification+      if "unit" `isPrefixOf` (T.unpack . T.strip . T.toLower . T.pack $ xs)+      then lexer' xs+      else Left NotAnnotation+  | otherwise = 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) ++ "\n"+ 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 unit specification at: " ++ show t ++ "\n"+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 19 "<built-in>" #-}+{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}+++++++++++++++++++{-# LINE 20 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp +++{-# LINE 13 "templates/GenericTemplate.hs" #-}++++++-- 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.+
src/Camfort/Functionality.hs view
@@ -78,8 +78,8 @@ getExcludes = getOption  -- * Wrappers on all of the features-ast d excludes f _ = do-    xs <- readParseSrcDir (d ++ "/" ++ f) excludes+ast d excludes _ _ = do+    xs <- readParseSrcDir d excludes     print (map (\(_, _, p) -> p) xs)  countVarDecls inSrc excludes _ _ = do
src/Camfort/Output.hs view
@@ -144,7 +144,7 @@                  lb'      = leftOne lb                  (p0, _)  = takeBounds (cursor, lb') inp                  nl       = if null comment then B.empty else B.pack "\n"-             in put ub >> return (B.concat [p0, B.pack comment, nl], True)+             in (put ub >> return (B.concat [p0, B.pack comment, nl], True))      else return (B.empty, False)   where leftOne (FU.Position f c l) = FU.Position f (c-1) (l-1)
src/Camfort/Specification/Stencils/CheckFrontend.hs view
@@ -64,7 +64,7 @@      let gr    = FAB.superBBGrGraph sgr      -- get map of variable name ==> { defining AST-Block-IDs }      let dm    = FAD.genDefMap bm-     let pprint = map (\(span, spec) -> show span ++ "\t" ++ spec)+     let pprint = map (\(span, spec) -> show span ++ "    " ++ spec)      -- perform reaching definitions analysis      let rd    = FAD.reachingDefinitions dm gr      -- create graph of definition "flows"@@ -144,7 +144,7 @@          Just subs -> do             -- Create list of relative indices             ivmap <- snd <$> get-            -- Do inference+            -- Do analysis             let realName v   = v `fromMaybe` (v `M.lookup` ?nameMap)             let lhsN         = fromMaybe [] (neighbourIndex ivmap subs)             let correctNames = map (first realName)@@ -161,12 +161,14 @@               else do                 let correctNames2 =  map (first (map realName))                 let inferred = correctNames2 . fst . runWriter $ genSpecifications ivmap lhsN [s]-                tell [ (span, "Not well specified.\n"-                              ++ "\tSpecification is:\t "-                              ++ pprintSpecDecls specDecls-                              ++ "\tbut at " ++ show span' ++ " the code behaves as"-                              ++ "\n\t                 \t "-                              ++ pprintSpecDecls inferred) ]+                let sp = replicate 8 ' '+                tell [ (span,+                     "Not well specified.\n"+                  ++ sp ++ "Specification is:\n"+                  ++ sp ++ sp ++ pprintSpecDecls specDecls ++ "\n"+                  ++ sp ++ "but at " ++ show span' ++ " the code behaves as\n"+                  ++ sp ++ sp ++ pprintSpecDecls inferred) ]+             return b'          Nothing -> return b'
+ src/Camfort/Specification/Stencils/Grammar.hs view
@@ -0,0 +1,1275 @@+{-# 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 ((Depth Int, Dim Int, Bool))+	| HappyAbsSyn8 ((Dim Int, Bool))+	| HappyAbsSyn9 ((Depth Int, Bool))+	| HappyAbsSyn10 (Depth Int)+	| HappyAbsSyn11 (Dim Int)+	| HappyAbsSyn12 (Bool)+	| HappyAbsSyn13 (Spec)+	| HappyAbsSyn14 (Mod)+	| HappyAbsSyn15 ([Mod])+	| HappyAbsSyn17 ([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,+ action_77,+ action_78,+ action_79,+ action_80,+ action_81,+ action_82 :: () => 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,+ happyReduce_27,+ happyReduce_28,+ happyReduce_29,+ happyReduce_30,+ happyReduce_31,+ happyReduce_32,+ happyReduce_33,+ happyReduce_34,+ happyReduce_35,+ happyReduce_36,+ happyReduce_37 :: () => ({-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 (18) = happyShift action_5+action_0 (19) = happyShift action_3+action_0 (4) = happyGoto action_4+action_0 (5) = happyGoto action_2+action_0 _ = happyFail++action_1 (19) = happyShift action_3+action_1 (5) = happyGoto action_2+action_1 _ = happyFail++action_2 _ = happyReduce_1++action_3 (36) = happyShift action_21+action_3 _ = happyFail++action_4 (40) = happyAccept+action_4 _ = happyFail++action_5 (20) = happyShift action_11+action_5 (21) = happyShift action_12+action_5 (23) = happyShift action_13+action_5 (24) = happyShift action_14+action_5 (27) = happyShift action_15+action_5 (28) = happyShift action_16+action_5 (29) = happyShift action_17+action_5 (30) = happyShift action_18+action_5 (32) = happyShift action_19+action_5 (38) = happyShift action_20+action_5 (6) = happyGoto action_6+action_5 (13) = happyGoto action_7+action_5 (14) = happyGoto action_8+action_5 (15) = happyGoto action_9+action_5 (16) = happyGoto action_10+action_5 _ = happyFail++action_6 (34) = happyShift action_35+action_6 (35) = happyShift action_36+action_6 _ = happyReduce_30++action_7 (36) = happyShift action_34+action_7 _ = happyFail++action_8 (21) = happyShift action_12+action_8 (27) = happyShift action_15+action_8 (28) = happyShift action_16+action_8 (29) = happyShift action_17+action_8 (32) = happyShift action_19+action_8 (38) = happyShift action_20+action_8 (6) = happyGoto action_33+action_8 _ = happyFail++action_9 (20) = happyShift action_11+action_9 (14) = happyGoto action_32+action_9 _ = happyFail++action_10 (21) = happyShift action_12+action_10 (23) = happyShift action_13+action_10 (24) = happyShift action_14+action_10 (27) = happyShift action_15+action_10 (28) = happyShift action_16+action_10 (29) = happyShift action_17+action_10 (32) = happyShift action_19+action_10 (38) = happyShift action_20+action_10 (6) = happyGoto action_29+action_10 (15) = happyGoto action_30+action_10 (16) = happyGoto action_31+action_10 _ = happyReduce_33++action_11 _ = happyReduce_31++action_12 (38) = happyShift action_28+action_12 _ = happyFail++action_13 _ = happyReduce_34++action_14 _ = happyReduce_35++action_15 (38) = happyShift action_27+action_15 _ = happyFail++action_16 (38) = happyShift action_26+action_16 _ = happyFail++action_17 (38) = happyShift action_25+action_17 _ = happyFail++action_18 (38) = happyShift action_24+action_18 _ = happyFail++action_19 _ = happyReduce_11++action_20 (21) = happyShift action_12+action_20 (27) = happyShift action_15+action_20 (28) = happyShift action_16+action_20 (29) = happyShift action_17+action_20 (32) = happyShift action_19+action_20 (38) = happyShift action_20+action_20 (6) = happyGoto action_23+action_20 _ = happyFail++action_21 (32) = happyShift action_22+action_21 _ = happyFail++action_22 (37) = happyShift action_54+action_22 _ = happyFail++action_23 (34) = happyShift action_35+action_23 (35) = happyShift action_36+action_23 (39) = happyShift action_53+action_23 _ = happyFail++action_24 (32) = happyShift action_40+action_24 (17) = happyGoto action_52+action_24 _ = happyFail++action_25 (22) = happyShift action_47+action_25 (25) = happyShift action_48+action_25 (26) = happyShift action_49+action_25 (7) = happyGoto action_51+action_25 (10) = happyGoto action_44+action_25 (11) = happyGoto action_45+action_25 (12) = happyGoto action_46+action_25 _ = happyFail++action_26 (22) = happyShift action_47+action_26 (25) = happyShift action_48+action_26 (26) = happyShift action_49+action_26 (7) = happyGoto action_50+action_26 (10) = happyGoto action_44+action_26 (11) = happyGoto action_45+action_26 (12) = happyGoto action_46+action_26 _ = happyFail++action_27 (22) = happyShift action_47+action_27 (25) = happyShift action_48+action_27 (26) = happyShift action_49+action_27 (7) = happyGoto action_43+action_27 (10) = happyGoto action_44+action_27 (11) = happyGoto action_45+action_27 (12) = happyGoto action_46+action_27 _ = happyFail++action_28 (25) = happyShift action_42+action_28 _ = happyFail++action_29 (34) = happyShift action_35+action_29 (35) = happyShift action_36+action_29 _ = happyReduce_29++action_30 _ = happyReduce_32++action_31 (23) = happyShift action_13+action_31 (24) = happyShift action_14+action_31 (15) = happyGoto action_30+action_31 (16) = happyGoto action_31+action_31 _ = happyReduce_33++action_32 (21) = happyShift action_12+action_32 (27) = happyShift action_15+action_32 (28) = happyShift action_16+action_32 (29) = happyShift action_17+action_32 (32) = happyShift action_19+action_32 (38) = happyShift action_20+action_32 (6) = happyGoto action_41+action_32 _ = happyFail++action_33 (34) = happyShift action_35+action_33 (35) = happyShift action_36+action_33 _ = happyReduce_28++action_34 (32) = happyShift action_40+action_34 (17) = happyGoto action_39+action_34 _ = happyFail++action_35 (21) = happyShift action_12+action_35 (27) = happyShift action_15+action_35 (28) = happyShift action_16+action_35 (29) = happyShift action_17+action_35 (32) = happyShift action_19+action_35 (38) = happyShift action_20+action_35 (6) = happyGoto action_38+action_35 _ = happyFail++action_36 (21) = happyShift action_12+action_36 (27) = happyShift action_15+action_36 (28) = happyShift action_16+action_36 (29) = happyShift action_17+action_36 (32) = happyShift action_19+action_36 (38) = happyShift action_20+action_36 (6) = happyGoto action_37+action_36 _ = happyFail++action_37 _ = happyReduce_9++action_38 (35) = happyShift action_36+action_38 _ = happyReduce_8++action_39 _ = happyReduce_2++action_40 (32) = happyShift action_40+action_40 (17) = happyGoto action_71+action_40 _ = happyReduce_37++action_41 (34) = happyShift action_35+action_41 (35) = happyShift action_36+action_41 _ = happyReduce_27++action_42 (37) = happyShift action_70+action_42 _ = happyFail++action_43 (39) = happyShift action_69+action_43 _ = happyFail++action_44 (22) = happyShift action_47+action_44 (25) = happyShift action_48+action_44 (8) = happyGoto action_66+action_44 (11) = happyGoto action_67+action_44 (12) = happyGoto action_68+action_44 _ = happyFail++action_45 (22) = happyShift action_47+action_45 (26) = happyShift action_49+action_45 (9) = happyGoto action_63+action_45 (10) = happyGoto action_64+action_45 (12) = happyGoto action_65+action_45 _ = happyFail++action_46 (25) = happyShift action_48+action_46 (26) = happyShift action_49+action_46 (10) = happyGoto action_61+action_46 (11) = happyGoto action_62+action_46 _ = happyFail++action_47 _ = happyReduce_24++action_48 (37) = happyShift action_60+action_48 _ = happyFail++action_49 (37) = happyShift action_59+action_49 _ = happyFail++action_50 (39) = happyShift action_58+action_50 _ = happyFail++action_51 (39) = happyShift action_57+action_51 _ = happyFail++action_52 (39) = happyShift action_56+action_52 _ = happyFail++action_53 _ = happyReduce_10++action_54 (21) = happyShift action_12+action_54 (27) = happyShift action_15+action_54 (28) = happyShift action_16+action_54 (29) = happyShift action_17+action_54 (32) = happyShift action_19+action_54 (38) = happyShift action_20+action_54 (6) = happyGoto action_55+action_54 _ = happyFail++action_55 (34) = happyShift action_35+action_55 (35) = happyShift action_36+action_55 _ = happyReduce_3++action_56 (31) = happyShift action_81+action_56 _ = happyReduce_25++action_57 _ = happyReduce_6++action_58 _ = happyReduce_5++action_59 (33) = happyShift action_80+action_59 _ = happyFail++action_60 (33) = happyShift action_79+action_60 _ = happyFail++action_61 (25) = happyShift action_48+action_61 (11) = happyGoto action_78+action_61 _ = happyFail++action_62 (26) = happyShift action_49+action_62 (10) = happyGoto action_77+action_62 _ = happyFail++action_63 _ = happyReduce_13++action_64 (22) = happyShift action_47+action_64 (12) = happyGoto action_76+action_64 _ = happyReduce_21++action_65 (26) = happyShift action_49+action_65 (10) = happyGoto action_75+action_65 _ = happyFail++action_66 _ = happyReduce_12++action_67 (22) = happyShift action_47+action_67 (12) = happyGoto action_74+action_67 _ = happyReduce_18++action_68 (25) = happyShift action_48+action_68 (11) = happyGoto action_73+action_68 _ = happyFail++action_69 _ = happyReduce_4++action_70 (33) = happyShift action_72+action_70 _ = happyFail++action_71 _ = happyReduce_36++action_72 (39) = happyShift action_82+action_72 _ = happyFail++action_73 _ = happyReduce_16++action_74 _ = happyReduce_17++action_75 _ = happyReduce_20++action_76 _ = happyReduce_19++action_77 _ = happyReduce_15++action_78 _ = happyReduce_14++action_79 _ = happyReduce_23++action_80 _ = happyReduce_22++action_81 _ = happyReduce_26++action_82 _ = happyReduce_7++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 ((HappyAbsSyn17  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn13  happy_var_2) `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn4+		 (SpecDec happy_var_2 happy_var_4+	) `HappyStk` happyRest++happyReduce_3 = happyReduce 5 5 happyReduction_3+happyReduction_3 ((HappyAbsSyn6  happy_var_5) `HappyStk`+	_ `HappyStk`+	(HappyTerminal (TId happy_var_3)) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn5+		 ((happy_var_3, happy_var_5)+	) `HappyStk` happyRest++happyReduce_4 = happyReduce 4 6 happyReduction_4+happyReduction_4 (_ `HappyStk`+	(HappyAbsSyn7  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn6+		 (applyAttr Forward  happy_var_3+	) `HappyStk` happyRest++happyReduce_5 = happyReduce 4 6 happyReduction_5+happyReduction_5 (_ `HappyStk`+	(HappyAbsSyn7  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn6+		 (applyAttr Backward happy_var_3+	) `HappyStk` happyRest++happyReduce_6 = happyReduce 4 6 happyReduction_6+happyReduction_6 (_ `HappyStk`+	(HappyAbsSyn7  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn6+		 (applyAttr Centered happy_var_3+	) `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_2  7 happyReduction_12+happyReduction_12 (HappyAbsSyn8  happy_var_2)+	(HappyAbsSyn10  happy_var_1)+	 =  HappyAbsSyn7+		 ((happy_var_1, fst happy_var_2, snd happy_var_2)+	)+happyReduction_12 _ _  = notHappyAtAll ++happyReduce_13 = happySpecReduce_2  7 happyReduction_13+happyReduction_13 (HappyAbsSyn9  happy_var_2)+	(HappyAbsSyn11  happy_var_1)+	 =  HappyAbsSyn7+		 ((fst happy_var_2, happy_var_1, snd happy_var_2)+	)+happyReduction_13 _ _  = notHappyAtAll ++happyReduce_14 = happySpecReduce_3  7 happyReduction_14+happyReduction_14 (HappyAbsSyn11  happy_var_3)+	(HappyAbsSyn10  happy_var_2)+	(HappyAbsSyn12  happy_var_1)+	 =  HappyAbsSyn7+		 ((happy_var_2, happy_var_3, happy_var_1)+	)+happyReduction_14 _ _ _  = notHappyAtAll ++happyReduce_15 = happySpecReduce_3  7 happyReduction_15+happyReduction_15 (HappyAbsSyn10  happy_var_3)+	(HappyAbsSyn11  happy_var_2)+	(HappyAbsSyn12  happy_var_1)+	 =  HappyAbsSyn7+		 ((happy_var_3, happy_var_2, happy_var_1)+	)+happyReduction_15 _ _ _  = notHappyAtAll ++happyReduce_16 = happySpecReduce_2  8 happyReduction_16+happyReduction_16 (HappyAbsSyn11  happy_var_2)+	(HappyAbsSyn12  happy_var_1)+	 =  HappyAbsSyn8+		 ((happy_var_2, happy_var_1)+	)+happyReduction_16 _ _  = notHappyAtAll ++happyReduce_17 = happySpecReduce_2  8 happyReduction_17+happyReduction_17 (HappyAbsSyn12  happy_var_2)+	(HappyAbsSyn11  happy_var_1)+	 =  HappyAbsSyn8+		 ((happy_var_1, happy_var_2)+	)+happyReduction_17 _ _  = notHappyAtAll ++happyReduce_18 = happySpecReduce_1  8 happyReduction_18+happyReduction_18 (HappyAbsSyn11  happy_var_1)+	 =  HappyAbsSyn8+		 ((happy_var_1, True)+	)+happyReduction_18 _  = notHappyAtAll ++happyReduce_19 = happySpecReduce_2  9 happyReduction_19+happyReduction_19 (HappyAbsSyn12  happy_var_2)+	(HappyAbsSyn10  happy_var_1)+	 =  HappyAbsSyn9+		 ((happy_var_1, happy_var_2)+	)+happyReduction_19 _ _  = notHappyAtAll ++happyReduce_20 = happySpecReduce_2  9 happyReduction_20+happyReduction_20 (HappyAbsSyn10  happy_var_2)+	(HappyAbsSyn12  happy_var_1)+	 =  HappyAbsSyn9+		 ((happy_var_2, happy_var_1)+	)+happyReduction_20 _ _  = notHappyAtAll ++happyReduce_21 = happySpecReduce_1  9 happyReduction_21+happyReduction_21 (HappyAbsSyn10  happy_var_1)+	 =  HappyAbsSyn9+		 ((happy_var_1, True)+	)+happyReduction_21 _  = notHappyAtAll ++happyReduce_22 = happySpecReduce_3  10 happyReduction_22+happyReduction_22 (HappyTerminal (TNum happy_var_3))+	_+	_+	 =  HappyAbsSyn10+		 (Depth $ read happy_var_3+	)+happyReduction_22 _ _ _  = notHappyAtAll ++happyReduce_23 = happySpecReduce_3  11 happyReduction_23+happyReduction_23 (HappyTerminal (TNum happy_var_3))+	_+	_+	 =  HappyAbsSyn11+		 (Dim $ read happy_var_3+	)+happyReduction_23 _ _ _  = notHappyAtAll ++happyReduce_24 = happySpecReduce_1  12 happyReduction_24+happyReduction_24 _+	 =  HappyAbsSyn12+		 (False+	)++happyReduce_25 = happyReduce 4 13 happyReduction_25+happyReduction_25 (_ `HappyStk`+	(HappyAbsSyn17  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn13+		 (Temporal happy_var_3 False+	) `HappyStk` happyRest++happyReduce_26 = happyReduce 5 13 happyReduction_26+happyReduction_26 (_ `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn17  happy_var_3) `HappyStk`+	_ `HappyStk`+	_ `HappyStk`+	happyRest)+	 = HappyAbsSyn13+		 (Temporal happy_var_3 True+	) `HappyStk` happyRest++happyReduce_27 = happySpecReduce_3  13 happyReduction_27+happyReduction_27 (HappyAbsSyn6  happy_var_3)+	(HappyAbsSyn14  happy_var_2)+	(HappyAbsSyn15  happy_var_1)+	 =  HappyAbsSyn13+		 (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+	)+happyReduction_27 _ _ _  = notHappyAtAll ++happyReduce_28 = happySpecReduce_2  13 happyReduction_28+happyReduction_28 (HappyAbsSyn6  happy_var_2)+	(HappyAbsSyn14  happy_var_1)+	 =  HappyAbsSyn13+		 (Spatial [happy_var_1] happy_var_2+	)+happyReduction_28 _ _  = notHappyAtAll ++happyReduce_29 = happySpecReduce_2  13 happyReduction_29+happyReduction_29 (HappyAbsSyn6  happy_var_2)+	(HappyAbsSyn14  happy_var_1)+	 =  HappyAbsSyn13+		 (Spatial [happy_var_1] happy_var_2+	)+happyReduction_29 _ _  = notHappyAtAll ++happyReduce_30 = happySpecReduce_1  13 happyReduction_30+happyReduction_30 (HappyAbsSyn6  happy_var_1)+	 =  HappyAbsSyn13+		 (Spatial [] happy_var_1+	)+happyReduction_30 _  = notHappyAtAll ++happyReduce_31 = happySpecReduce_1  14 happyReduction_31+happyReduction_31 _+	 =  HappyAbsSyn14+		 (ReadOnce+	)++happyReduce_32 = happySpecReduce_2  15 happyReduction_32+happyReduction_32 (HappyAbsSyn15  happy_var_2)+	(HappyAbsSyn14  happy_var_1)+	 =  HappyAbsSyn15+		 (happy_var_1 : happy_var_2+	)+happyReduction_32 _ _  = notHappyAtAll ++happyReduce_33 = happySpecReduce_1  15 happyReduction_33+happyReduction_33 (HappyAbsSyn14  happy_var_1)+	 =  HappyAbsSyn15+		 ([happy_var_1]+	)+happyReduction_33 _  = notHappyAtAll ++happyReduce_34 = happySpecReduce_1  16 happyReduction_34+happyReduction_34 _+	 =  HappyAbsSyn14+		 (AtMost+	)++happyReduce_35 = happySpecReduce_1  16 happyReduction_35+happyReduction_35 _+	 =  HappyAbsSyn14+		 (AtLeast+	)++happyReduce_36 = happySpecReduce_2  17 happyReduction_36+happyReduction_36 (HappyAbsSyn17  happy_var_2)+	(HappyTerminal (TId happy_var_1))+	 =  HappyAbsSyn17+		 (happy_var_1 : happy_var_2+	)+happyReduction_36 _ _  = notHappyAtAll ++happyReduce_37 = happySpecReduce_1  17 happyReduction_37+happyReduction_37 (HappyTerminal (TId happy_var_1))+	 =  HappyAbsSyn17+		 ([happy_var_1]+	)+happyReduction_37 _  = notHappyAtAll ++happyNewToken action sts stk [] =+	action 40 40 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 18;+	TId "region" -> cont 19;+	TId "readonce" -> cont 20;+	TId "reflexive" -> cont 21;+	TId "irreflexive" -> cont 22;+	TId "atmost" -> cont 23;+	TId "atleast" -> cont 24;+	TId "dim" -> cont 25;+	TId "depth" -> cont 26;+	TId "forward" -> cont 27;+	TId "backward" -> cont 28;+	TId "centered" -> cont 29;+	TId "dependency" -> cont 30;+	TId "mutual" -> cont 31;+	TId happy_dollar_dollar -> cont 32;+	TNum happy_dollar_dollar -> cont 33;+	TPlus -> cont 34;+	TStar -> cont 35;+	TDoubleColon -> cont 36;+	TEqual -> cont 37;+	TLParen -> cont 38;+	TRParen -> cont 39;+	_ -> happyError' (tk:tks)+	}++happyError_ 40 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+++newtype Depth a = Depth a+newtype Dim a = Dim a++applyAttr :: (Int -> Int -> Bool -> Region)+          -> (Depth Int, Dim Int, Bool)+          -> Region+applyAttr constr (Depth d, Dim dim, irrefl) = constr d dim irrefl++data Specification+  = RegionDec String Region+  | SpecDec Spec [String]+  deriving (Show, Eq, Ord, Typeable, Data)++data Region+  = Forward Int Int Bool+  | Backward Int Int Bool+  | Centered Int Int Bool+  | Or Region Region+  | And Region Region+  | Var String+  deriving (Show, Eq, Ord, Typeable, Data)++data Spec+  = Spatial [Mod] Region+  | Temporal [String] Bool+  deriving (Show, Eq, Ord, Typeable, Data)++data Mod+  = AtLeast+  | AtMost+  | ReadOnce+  deriving (Show, Eq, Ord, Typeable, Data)++--------------------------------------------------++data Token+  = TDoubleColon+  | TStar+  | TPlus+  | TEqual+  | TComma+  | TLParen+  | TRParen+  | TId String+  | TNum String+ deriving (Show)++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++stripLeadingWhiteSpace (' ':xs)  = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\t':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\n':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace xs = xs+++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+  case stripLeadingWhiteSpace input of+    -- Check the leading character is '=' for specification+    '=':input' ->+           -- First test to see if the input looks like an actual+           -- specification of either a stencil or region+           if (input' `hasPrefix` "stencil" || input' `hasPrefix` "region")+           then lexer' input'+           else Left NotAnnotation+    _ -> Left NotAnnotation+   where+    hasPrefix []       str = False+    hasPrefix (' ':xs) str = hasPrefix xs str+    hasPrefix xs       str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' []                                              = return []+lexer' (' ':xs)                                        = lexer' xs+lexer' ('\t':xs)                                       = lexer' xs+lexer' (':':':':xs)                                    = addToTokens TDoubleColon xs+lexer' ('*':xs)                                        = addToTokens TStar xs+lexer' ('+':xs)                                        = addToTokens TPlus xs+lexer' ('=':xs)                                        = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+  | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+  | otherwise                                         = addToTokens TComma xs+lexer' ('(':xs)                                        = addToTokens TLParen xs+lexer' (')':xs)                                        = addToTokens TRParen xs+lexer' (x:xs)+  | isLetter x                                        = aux TId $ \ c -> isAlphaNum c || c == '_'+  | isNumber x                                        = aux TNum isNumber+  | otherwise+     = failWith $ "Not an indentifier " ++ show x+ where+   aux f p = (f target :) `fmap` lexer' rest+     where (target, rest) = span p (x:xs)+lexer' x+    = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+  do mods' <- modValidate' $ sort mods+     return $ SpecDec (Spatial mods' r) vars++  where    modValidate' [] = return $ []++           modValidate' (AtLeast : AtLeast : xs)+             = failWith "Duplicate 'atLeast' modifier; use at most one."++           modValidate' (AtMost : AtMost : xs)+             = failWith "Duplicate 'atMost' modifier; use at most one."++           modValidate' (ReadOnce : ReadOnce : xs)+             = failWith "Duplicate 'readOnce' modifier; use at most one."++           modValidate' (AtLeast : AtMost : xs)+             = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+                     ++ "'atMost' together"++           modValidate' (x : xs)+             = do xs' <- modValidate' xs+                  return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 16 "<built-in>" #-}+{-# LINE 1 "/usr/local/lib/ghc-7.10.2/include/ghcversion.h" #-}+++++++++++++++++++{-# LINE 17 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp +++{-# LINE 13 "templates/GenericTemplate.hs" #-}+++{-# LINE 46 "templates/GenericTemplate.hs" #-}++++++++++{-# LINE 67 "templates/GenericTemplate.hs" #-}+++{-# LINE 77 "templates/GenericTemplate.hs" #-}+++++++++++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is (1), it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =+        happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +         (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action+++{-# LINE 155 "templates/GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++++newtype HappyState b c = HappyState+        (Int ->                    -- token number+         Int ->                    -- token number (yes, again)+         b ->                           -- token semantic value+         HappyState b c ->              -- current state+         [HappyState b c] ->            -- state stack+         c)++++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state (1) tk st sts stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (i) -> i }) in+--     trace "shifting the error token" $+     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk+     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k - ((1) :: Int)) sts of+         sts1@(((st1@(HappyState (action))):(_))) ->+                let r = fn stk in  -- it doesn't hurt to always seq here...+                happyDoSeq r (action nt j tk st1 sts1 r)++happyMonadReduce k nt fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+      case happyDrop k ((st):(sts)) of+        sts1@(((st1@(HappyState (action))):(_))) ->+          let drop_stk = happyDropStk k stk in+          happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))++happyMonad2Reduce k nt fn (1) tk st sts stk+     = happyFail (1) tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+      case happyDrop k ((st):(sts)) of+        sts1@(((st1@(HappyState (action))):(_))) ->+         let drop_stk = happyDropStk k stk++++++             new_state = action++          in+          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))++happyDrop (0) l = l+happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t++happyDropStk (0) l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction++++++++++happyGoto action j tk st = action j j tk (HappyState action)+++-----------------------------------------------------------------------------+-- Error recovery ((1) is the error token)++-- parse error if we are in recovery and we fail again+happyFail (1) tk old_st _ stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (i) -> i }) in+--      trace "failing" $ +        happyError_ i tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  (1) tk old_st (((HappyState (action))):(sts)) +                                                (saved_tok `HappyStk` _ `HappyStk` stk) =+--      trace ("discarding state, depth " ++ show (length stk))  $+        action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail  i tk (HappyState (action)) sts stk =+--      trace "entering error recovery" $+        action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll :: a+notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions++++++++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--      happySeq = happyDoSeq+-- otherwise it emits+--      happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.++++++++++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.+
src/Camfort/Specification/Stencils/Grammar.y view
@@ -6,6 +6,7 @@ import Data.Char (isLetter, isNumber, isAlphaNum, toLower, isAlpha, isSpace) import Data.List (intersect, sort, isPrefixOf) import Data.Data+import qualified Data.Text as T  import Debug.Trace @@ -163,12 +164,6 @@  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@@ -179,6 +174,7 @@     '<':input' -> testAnnotation input'     _ -> Left NotAnnotation   where+    stripLeadingWhiteSpace = T.unpack . T.strip . T.pack     testAnnotation inp =       -- First test to see if the input looks like an actual       -- specification of either a stencil or region
src/Camfort/Specification/Stencils/InferenceFrontend.hs view
@@ -233,7 +233,7 @@                            else return []            -- Not an assign we are interested in            _ -> return [])-    if mode == Synth && not (null specs)+    if mode == Synth && not (null specs) && specs /= [[]]       then         let specComment = Synth.formatSpec (Just (tabs ++ '!':marker:" ")) ?nameMap (span, Left (concat specs'))             specs' = map (mapMaybe noSpecAlready) specs@@ -258,14 +258,14 @@       else return []      -- descend into the body of the do-statement-    body' <- mapM (descendBiM (perBlockInfer  mode marker)) body+    body' <- mapM (descendBiM (perBlockInfer mode marker)) body     -- Remove any induction variable from the state     return $ F.BlDo ann span lab cname lab' mDoSpec body' tlab  perBlockInfer mode marker b = do     -- Go inside child blocks-    mapM_ (descendBiM (perBlockInfer mode marker)) $ children b-    return b+    b' <- descendM (descendBiM (perBlockInfer mode marker)) $ b+    return b'  genSpecifications :: Params   => FAD.InductionVarMapByASTBlock@@ -349,12 +349,25 @@ genRHSsubscripts ::      F.Block (FA.Analysis A)   -> M.Map Variable [[F.Index (FA.Analysis A)]]-genRHSsubscripts b =-    collect [ (FA.varName exp, e)-      | F.ExpSubscript _ _ exp subs <- FA.rhsExprs b-      , isVariableExpr exp-      , let e = F.aStrip subs-      , not (null e)]+genRHSsubscripts b = genRHSsubscripts' (transformBi replaceModulo b)+  where+    -- Any occurence of an subscript "modulo(e, e')" is replaced with "e"+    replaceModulo :: F.Expression (FA.Analysis A) -> F.Expression (FA.Analysis A)+    replaceModulo e@(F.ExpSubscript _ _+                    (F.ExpValue _ _ (F.ValVariable "modulo")) subs) =+        -- We expect that the first parameter to modulo is being treated+        -- as an IxSingle element+        case (head $ F.aStrip subs) of+           (F.IxSingle _ _ _ e') -> e'+           _                     -> e+    replaceModulo e = e++    genRHSsubscripts' b =+       collect [ (FA.varName exp, e)+         | F.ExpSubscript _ _ exp subs <- FA.rhsExprs b+         , isVariableExpr exp+         , let e = F.aStrip subs+         , not (null e)]  getInductionVar :: Maybe (F.DoSpecification (FA.Analysis A)) -> [Variable] getInductionVar (Just (F.DoSpecification _ _ (F.StExpressionAssign _ _ e _) _ _))
src/Camfort/Specification/Stencils/Model.hs view
@@ -165,7 +165,7 @@     mkModel (Backward dep dim reflx) = fromList      [mkSingleEntryNeg i dim ?globalDimensionality | i <- [(-dep)..i0]]-       where i0 = if reflx then 0 else 1+       where i0 = if reflx then 0 else -1     mkModel (Centered dep dim reflx) = fromList      [mkSingleEntryNeg i dim ?globalDimensionality | i <- [(-dep)..dep] \\ i0]
src/Camfort/Specification/Stencils/Synthesis.hs view
@@ -62,7 +62,7 @@   where     realName v = v `fromMaybe` (v `M.lookup` nm)     prefix' = case prefix of-                Nothing -> show span ++ " \t"+                Nothing -> show span ++ "    "                 Just pr -> pr  formatSpec prefix nm (span, Left []) = ""@@ -70,7 +70,7 @@   (intercalate "\n" $ map (\s -> prefix' ++ doSpec s) specs)     where       prefix' = case prefix of-                   Nothing -> show span ++ " \t"+                   Nothing -> show span ++ "    "                    Just pr -> pr       commaSep                 = intercalate ", "       doSpec (arrayVar, spec)  =
src/Camfort/Specification/Units.hs view
@@ -69,22 +69,22 @@   | Left exc   <- eVars = (errReport exc, -1)   where     -- Format report-    okReport []   = (logs ++ "\n" ++ fname ++ ":\n"-                         ++ "No additional annotations are necessary.\n", 0)+    okReport []   = (logs ++ "\n" ++ fname+                         ++ ":No additional annotations are necessary.\n", 0)     okReport vars = (logs ++ "\n" ++ fname ++ ": "                          ++ show numVars                          ++ " variable declarations suggested to be given a specification:\n"-                         ++ unlines [ "\t" ++ expReport ei | ei <- expInfo ], numVars)+                         ++ unlines [ "    " ++ expReport ei | ei <- expInfo ], numVars)       where         names = map showVar vars-        expInfo = filter ((`elem` names) . FA.varName) $ declVariables pfUA+        expInfo = filter ((`elem` names) . FA.srcName) $ declVariables pfUA         numVars = length expInfo -    expReport e = "(" ++ showSrcSpan (FU.getSpan e) ++ ")\t" ++ FA.srcName e+    expReport e = "(" ++ showSrcSpan (FU.getSpan e) ++ ")    " ++ FA.srcName e      varReport     = intercalate ", " . map showVar -    showVar (UnitVar (_, s)) = s+    showVar (UnitVar (_, s))  = s     showVar (UnitLiteral _)   = "<literal>"     showVar _                 = "<bad>" @@ -106,8 +106,8 @@   | Left exc    <- eCons = errReport exc   where     -- Format report-    okReport Nothing = logs ++ "\n" ++ fname ++ "\t: Consistent. " ++ show nVars ++ " variables checked."-    okReport (Just cons) = logs ++ "\n" ++ fname ++ "\t: Inconsistent:\n" ++ reportErrors cons+    okReport Nothing = logs ++ "\n" ++ fname ++ ": Consistent. " ++ show nVars ++ " variables checked."+    okReport (Just cons) = logs ++ "\n" ++ fname ++ ": Inconsistent:\n" ++ reportErrors cons      reportErrors cons = unlines [ reportError con | con <- cons ]     reportError con = " - at " ++ srcSpan con@@ -159,7 +159,7 @@     showVar (UnitLiteral _)   = "<literal>" -- FIXME     showVar _                 = "<bad>" -    errReport exc = logs ++ "\n" ++ fname ++ ":\t " ++ show exc+    errReport exc = logs ++ "\n" ++ fname ++ ":  " ++ show exc      -- run inference     uOpts = uo { uoNameMap = nameMap }@@ -192,7 +192,7 @@      expReport (e, u) = "  " ++ showSrcSpan (FU.getSpan e) ++ " unit " ++ show u ++ " :: " ++ FA.srcName e -    errReport exc = logs ++ "\n" ++ fname ++ ":\t" ++ show exc+    errReport exc = logs ++ "\n" ++ fname ++ ":  " ++ show exc      -- run inference     uOpts = uo { uoNameMap = nameMap }@@ -221,7 +221,7 @@      expReport (e, u) = "  " ++ showSrcSpan (FU.getSpan e) ++ " unit " ++ show u ++ " :: " ++ FA.srcName e -    errReport exc = logs ++ "\n" ++ fname ++ ":\t" ++ show exc+    errReport exc = logs ++ "\n" ++ fname ++ ":  " ++ show exc      -- run inference     uOpts = uo { uoNameMap = nameMap }
src/Camfort/Specification/Units/Environment.hs view
@@ -33,6 +33,7 @@ import Data.List import Data.Matrix import Data.Ratio+import qualified Debug.Trace as D  import Text.Printf @@ -76,9 +77,17 @@     UnitMul u1 u2             -> maybeParenS u1 ++ " " ++ maybeParenS u2     UnitPow u 1               -> show u     UnitPow u 0               -> "1"-    UnitPow u k               -> printf "%s**%s" (maybeParen u) kStr-      where kStr | k < 0     = printf "(%f)" k-                 | otherwise = show k+    UnitPow u k               ->+      case doubleToRationalSubset k of+          Just r -> printf "%s**%s" (maybeParen u) (showRational r)+          Nothing -> error $+                      printf "Irrational unit exponent: %s**%f" (maybeParen u) k+       where showRational r+               | r < 0     = printf "(%s)" (showRational' r)+               | otherwise = showRational' r+             showRational' r+               | denominator r == 1 = show (numerator r)+               | otherwise = printf "%s / %s" (numerator r) (denominator r)     where       maybeParen x | all isAlphaNum s = s                    | otherwise        = "(" ++ s ++ ")"@@ -87,6 +96,30 @@                     | otherwise         = "(" ++ s ++ ")"         where s = show x       isUnitMulOk c = isSpace c || isAlphaNum c || c `elem` "*."++-- Converts doubles to a rational that can be expressed+-- as a rational with denominator at most 10+-- otherwise Noting+doubleToRationalSubset :: Double -> Maybe Rational+doubleToRationalSubset x | x < 0 =+    doubleToRationalSubset (abs x) >>= (\x -> return (-x))+doubleToRationalSubset x =+    doubleToRational' 0 1 (ceiling x) 1+  where+    -- The maximum common denominator, controls granularity+    n = 16+    doubleToRational' a b c d+         | b <= n && d <= n =+           let mediant = (fromIntegral (a+c))/(fromIntegral (b+d))+           in if x == mediant+              then if b + d <= n+                   then Just $ (a + c) % (b + d)+                   else Nothing+              else if x > mediant+                   then doubleToRational' (a+c) (b+d) c d+                   else doubleToRational' a b (a+c) (b+d)+         | b > n     = Just $ c % d+         | otherwise = Just $ a % b  -- | A relation between UnitInfos data Constraint
src/Camfort/Specification/Units/Parser.y view
@@ -11,6 +11,7 @@ import Data.Data import Data.List import Data.Char (isLetter, isNumber, isAlphaNum, toLower)+import qualified Data.Text as T }  %monad { Either AnnotationParseError } { >>= } { return }@@ -127,8 +128,13 @@  deriving (Show)  lexer :: String -> Either AnnotationParseError [ Token ]+lexer [] = Left NotAnnotation lexer (c:xs)-  | c `elem` ['=', '!', '>', '<'] = lexer' xs+  | c `elem` ['=', '!', '>', '<'] =+      -- First test to see if the input looks like an actual unit specification+      if "unit" `isPrefixOf` (T.unpack . T.strip . T.toLower . T.pack $ xs)+      then lexer' xs+      else Left NotAnnotation   | otherwise = Left NotAnnotation  addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]@@ -154,7 +160,7 @@ lexer' (x:xs)  | isLetter x = aux (\c -> isAlphaNum c || c `elem` ['\'','_','-']) TId  | isNumber x = aux isNumber TNum- | otherwise = Left NotAnnotation -- failWith $ "Not valid unit syntax at " ++ show (x:xs)+ | otherwise = failWith $ "Not valid unit syntax at " ++ show (x:xs) ++ "\n"  where    aux p cons =      let (target, rest) = span p xs@@ -166,6 +172,6 @@  parseUnit tokens  happyError :: [ Token ] -> Either AnnotationParseError a-happyError t = Left NotAnnotation -- failWith $ "Could not parse specification at: " ++ show t+happyError t = failWith $ "Could not parse unit specification at: " ++ show t ++ "\n"  }
src/Main.hs view
@@ -94,7 +94,7 @@   where header = introMsg ++ usage ++ menu ++ "\nOptions:"  -- * Which modes do not require an output-outputNotRequired = ["count"+outputNotRequired = ["count", "ast"                   , "stencils-infer", "stencils-check"                   , "units-infer", "units-check", "units-suggest"] @@ -128,13 +128,14 @@      ("units-synth", (unitsSynth, "unit-of-measure synthesise specs.")) ]  -- * Usage and about information-version = "0.900"+version = "0.902" introMsg = "CamFort " ++ version ++ " - Cambridge Fortran Infrastructure." usage = "Usage: camfort <MODE> <INPUT> [OUTPUT] [OPTIONS...]\n" menu =   "Refactor functions:\n"-  ++ concatMap (\(k, (_, info)) -> "\t" ++ k ++ replicate (15 - length k) ' '-  ++ "\t [" ++ info ++ "] \n") refactorings+  ++ concatMap (\(k, (_, info)) -> space ++ k ++ replicate (15 - length k) ' '+  ++ "   [" ++ info ++ "] \n") refactorings   ++ "\nAnalysis functions:\n"-  ++ concatMap (\(k, (_, info)) -> "\t" ++ k ++ replicate (15 - length k) ' '-  ++ "\t [" ++ info ++ "] \n") analyses+  ++ concatMap (\(k, (_, info)) -> space ++ k ++ replicate (15 - length k) ' '+  ++ "   [" ++ info ++ "] \n") analyses+  where space = replicate 5 ' '
tests/Camfort/Specification/Stencils/ModelSpec.hs view
@@ -51,6 +51,12 @@             Nothing       consistent centeredAcs spec `shouldBe` True +    it "1D backward irreflexive lower bound - positive" $ do+      let spec = Single $ Bound+            (Just $ Spatial $ Sum [ Product [ Backward 1 1 False ] ])+            Nothing+      consistent (Single [[-1]]) spec `shouldBe` True+     it "1D centered irreflexive upper bound - negative" $ do       let spec = Single $ Bound             Nothing
− tests/Camfort/Specification/Stencils/example2.f 
@@ -1,45 +0,0 @@-      program example2-      implicit none--      integer i, j, imax, jmax-      parameter (imax = 3, jmax = 3)-      real a(0:imax,0:jmax), b(0:imax,0:jmax), c, x--c= region :: r1 = centered(depth=1, dim=1)--c some kind of setup-      do 1 i = 0, imax-         do 2 j = 0, jmax-            a(i,j) = i+j- 2       continue- 1    continue--c compute mean-      do 3 i = 1, (imax-1)-         do 4 j = 1, (jmax-1)-            if (.true.) then-c= region :: r2 = centered(depth=1, dim=2)-               x = a(i-1,j) + a(i,j) + a(i+1,j) + abs(0)-c= stencil readOnce, (reflexive(dim=1))*r2 + (reflexive(dim=2))*r1 :: a               -             b(i,j) = (x + a(i,j-1) + a(i,j+1)) / 5.0-c No specification should be inferred here-             b(0,0) = a(i, j)-            end if- 4       continue-      x = a(i,0)-      y = a(i-1,0)-c= stencil readOnce, backward(depth=1, dim=1) :: a      -      b(i,0) = (x + y)/2.0- 3    continue--      b(i,j) = a(i,j)--      do i=1, imax-         do j=1, jmx-           x = a(1,j+1) + a(1,j-1)-           a(i,j) = a(i,1) + a(i+1 ,1) + a(i-1,1) + a(1,j) + x-           a(i,j) = a(i,j) + a(1,1)-         end do-      end do--      end
− tests/Camfort/Specification/Stencils/example3.f 
@@ -1,31 +0,0 @@-      program example3-      implicit none--      integer i, x, y, imax, xmax, ymax-      parameter (imax = 3, jmax = 3)--      real a(0:imax,0:jmax), b(0:imax,0:jmax), c(0:imax), d(0:imax), acc--      do i=1,imax-        do x=1,xmax-           do y=1,ymax-             acc = acc + a(x,y,i)-           end do-        end do- 1      b(1,i) = acc-      end do--      do i=1,imax-c     Label 1 should get same spec as this line-         b(1,i) = a(:,:,i)-      end do--      c(:) = d(:)-      c(:) = a(0,:)--c No spec here-      do i=1,imax-        c(i) = d(:)-      end do--      end
− tests/Camfort/Specification/Stencils/example4.f 
@@ -1,8 +0,0 @@-      program example4-      logical BAR = .true.-      integer X(0:5)-      integer J-      do J=1, 10-         IF (BAR)   X(J) = X(J)+1-       end do-      end
tests/Camfort/Specification/StencilsSpec.hs view
@@ -22,11 +22,18 @@ import Camfort.Analysis.Annotations import qualified Language.Fortran.AST as F import Language.Fortran.Util.Position+import Language.Fortran.ParserMonad+import Camfort.Reprint+import Camfort.Output  import Data.Map.Strict (toList) import qualified Data.IntMap as IM import qualified Data.Set as S+import Data.Functor.Identity+import qualified Data.ByteString.Char8 as B +import System.FilePath+ import Test.Hspec import Test.QuickCheck import Test.Hspec.QuickCheck@@ -246,39 +253,65 @@     -- Some integration tests     ------------------------- -    let file = "tests/Camfort/Specification/Stencils/example2.f"+    let file = "tests"+           </> "fixtures"+           </> "Specification"+           </> "Stencils"+           </> "example2.f"+    let fileSynthExpected = "tests"+           </> "fixtures"+           </> "Specification"+           </> "Stencils"+           </> "example2.expected.f"     program <- runIO $ readParseSrcDir file []+    programSrc       <- runIO $ readFile file+    synthExpectedSrc <- runIO $ readFile fileSynthExpected      describe "integration test on inference for example2.f" $ do       it "stencil infer" $          fst (callAndSummarise (infer AssignMode '=') program)            `shouldBe`-           "\ntests/Camfort/Specification/Stencils/example2.f\n\-            \(24:8)-(24:53) \tstencil readOnce, (reflexive(dim=1))*(centered(depth=1, dim=2)) \+           "\ntests/fixtures/Specification/Stencils/example2.f\n\+            \(24:8)-(24:53)    stencil readOnce, (reflexive(dim=1))*(centered(depth=1, dim=2)) \                                      \+ (reflexive(dim=2))*(centered(depth=1, dim=1)) :: a\n\-            \(32:7)-(32:26) \tstencil readOnce, (backward(depth=1, dim=1)) :: a\n\-            \(40:8)-(40:62) \tstencil readOnce, (centered(depth=1, dim=1)) \+            \(32:7)-(32:26)    stencil readOnce, (backward(depth=1, dim=1)) :: a\n\+            \(41:8)-(41:103)    stencil readOnce, (centered(depth=1, dim=1)) \                                                 \+ (centered(depth=1, dim=2)) :: a\n\-            \(41:8)-(41:35) \tstencil readOnce, (reflexive(dim=1))*(reflexive(dim=2)) :: a"+            \(42:8)-(42:37)    stencil readOnce, (reflexive(dim=1))*(reflexive(dim=2)) :: a"        it "stencil check" $          fst (callAndSummarise (\f p -> (check f p, p)) program)            `shouldBe`-           "\ntests/Camfort/Specification/Stencils/example2.f\n\-            \(23:1)-(23:86)\tCorrect.\n(31:1)-(31:56)\tCorrect."+           "\ntests/fixtures/Specification/Stencils/example2.f\n\+            \(23:1)-(23:86)    Correct.\n(31:1)-(31:56)    Correct." -    let file = "tests/Camfort/Specification/Stencils/example3.f"+      it "stencil synth" $+         (B.unpack . runIdentity+           $ reprint (refactoring Fortran77)+              (snd . head . snd $ synth AssignMode '=' (map (\(f, _, p) -> (f, p)) program))+              (B.pack programSrc))+          `shouldBe` synthExpectedSrc++    let file = "tests"+           </> "fixtures"+           </> "Specification"+           </> "Stencils"+           </> "example3.f"     program <- runIO $ readParseSrcDir file [] -    let file = "tests/Camfort/Specification/Stencils/example4.f"+    let file = "tests"+           </> "fixtures"+           </> "Specification"+           </> "Stencils"+           </> "example4.f"     program <- runIO $ readParseSrcDir file []      describe "integration test on inference for example4.f" $       it "stencil infer" $          fst (callAndSummarise (infer AssignMode '=') program)            `shouldBe`-            "\ntests/Camfort/Specification/Stencils/example4.f\n\-             \(6:8)-(6:33) \tstencil (reflexive(dim=1)) :: x"+            "\ntests/fixtures/Specification/Stencils/example4.f\n\+             \(6:8)-(6:33)    stencil (reflexive(dim=1)) :: x"   {- Properties of `spanBoundingBox`: idempotent and associative -}
− tests/Camfort/Specification/Units/ex1.f90 
@@ -1,29 +0,0 @@-program energy-  != unit :: speed = m/s--  != unit (m / s** (2)) :: gravity-  != unit (m) :: height-  != unit (kg) :: mass-  real, parameter :: mass = 3.00, gravity = 9.81, height = 4.20-  != unit (kg m** (2) / s** (2)) :: potential_energy-  real :: potential_energy--  != unit (1) :: half-  != unit (speed) :: velocity-  real, parameter :: half = 0.5, velocity = 4.00-  != unit (kg m** (2) / s** (2)) :: kinetic_energy-  != unit (kg m** (2) / s** (2)) :: total_energy-  real :: kinetic_energy, total_energy--  potential_energy = mass * gravity * height-  kinetic_energy = half * mass * square(velocity)--  total_energy = potential_energy + kinetic_energy--  contains--  real function square(x)-    real x-    square = x * x-  end function square-end program energy
− tests/Camfort/Specification/Units/ex2.f90 
@@ -1,11 +0,0 @@-program energy-- != unit (m) :: height- != unit (kg) :: mass-  real, parameter :: mass = 3.00, gravity = .81, height = 4.20-- != unit (kg m** (2) / s** (2)) :: potential_energy-  real :: potential_energy- -  potential_energy = mass * gravity * height-end program energy
− tests/Camfort/Specification/Units/ex3.f90 
@@ -1,14 +0,0 @@-program energy-- != unit (m) :: height- != unit (kg) :: mass- real, parameter :: mass = 3.00, gravity = .81, height = 4.20-- integer :: i = 0- integer :: j = i-  - != unit (kg m**2 / s**2) :: potential_energy- real :: potential_energy- - potential_energy = mass * gravity * height-end program energy
− tests/Camfort/Specification/Units/param.f90 
@@ -1,10 +0,0 @@-      program param-        implicit none-        != unit(m) :: x, y-        real, parameter :: x = 4, y = 5-        != unit(s) :: t-        real, parameter :: t = 2-        real :: v1, v2-        v1 = x / t-        v2 = y / t-      end program
tests/Camfort/Specification/UnitsSpec.hs view
@@ -21,6 +21,7 @@ import qualified Data.Array as A import qualified Numeric.LinearAlgebra as H import qualified Data.Map.Strict as M+import GHC.Real import Numeric.LinearAlgebra (     atIndex, (<>), (><), rank, (?), toLists, toList, fromLists, fromList, rows, cols,     takeRows, takeColumns, dropRows, dropColumns, subMatrix, diag, build, fromBlocks,@@ -111,6 +112,9 @@     describe "Infer Variables" $ do       it "testCons5" $ do         inferVariables testCons5 `shouldBe` testCons5_infer+    describe "Check that (restricted) double to ratios is consistent" $ do+      it "test all in -10/-10 ... 10/10, apart from /0" $+        do and [testDoubleToRationalSubset x y | x <- [-10..10], y <- [-10..10]]  -------------------------------------------------- @@ -182,6 +186,11 @@ testCons5_infer = [(("simple2_a11", "simple2_a11"),UnitMul (UnitPow (UnitName "m") 2.0) (UnitPow (UnitName "s") (-4.0)))                   ,(("simple2_a22", "simple2_a22"),UnitMul (UnitPow (UnitName "m") 1.0) (UnitPow (UnitName "s") (-2.0)))] +testDoubleToRationalSubset :: Integer -> Integer -> Bool+testDoubleToRationalSubset x y =+    if x <= 10 && y <= 10 && x >= -10 && y >= -10 && y /= 0+    then doubleToRationalSubset (fromIntegral x / fromIntegral y) == Just (x % y)+    else True --------------------------------------------------  litTest1 = flip fortranParser "litTest1.f90" . B.pack $ unlines
tests/Camfort/Transformation/CommonSpec.hs view
@@ -9,12 +9,9 @@ import Camfort.Functionality  samplesBase :: FilePath-samplesBase = "tests" </> "Camfort" </> "Transformation" </> "samples"+samplesBase = "tests" </> "fixtures" </> "Transformation"  data Example = Example FilePath FilePath--examples =-  [ Example "common.f90" "common.expected.f90" ]  readSample :: FilePath -> IO String readSample filename = do
tests/Camfort/Transformation/EquivalenceElimSpec.hs view
@@ -14,7 +14,6 @@    limitations under the License. -} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE FlexibleContexts #-}  module Camfort.Transformation.EquivalenceElimSpec where@@ -30,7 +29,7 @@ import Camfort.Input  samplesBase :: FilePath-samplesBase = "tests" </> "Camfort" </> "Transformation" </> "samples"+samplesBase = "tests" </> "fixtures" </> "Transformation"  readExpected :: FilePath -> IO String readExpected filename = do
− tests/Camfort/Transformation/samples/common.f90 
@@ -1,10 +0,0 @@-subroutine test(a,b, c)--integer :: c1, c2, c3-COMMON /cmn/  c1, c2, c3--real :: a, b, c--print *, a, b, c--end subroutine test
− tests/Camfort/Transformation/samples/equiv.f90 
@@ -1,20 +0,0 @@-program wrt -  implicit none-  integer :: x = 97-  character :: y-  character :: z(20)-  equivalence (x, y, z(2))--  z(1) = "c"--  write (*,'(i8,A)') x, y---  write (*,'(i8,A,A,A)') x, y, z(1), z(2)--  x = 97 + 98 * (2**8)--  write (*,'(i8,A,A,A,A)') x, y, z(1), z(2), z(3)---end program wrt
+ tests/fixtures/Specification/Stencils/example2.f view
@@ -0,0 +1,47 @@+      program example2+      implicit none++      integer i, j, imax, jmax+      parameter (imax = 3, jmax = 3)+      real a(0:imax,0:jmax), b(0:imax,0:jmax), c, x++c= region :: r1 = centered(depth=1, dim=1)++c some kind of setup+      do 1 i = 0, imax+         do 2 j = 0, jmax+            a(i,j) = i+j+ 2       continue+ 1    continue++c compute mean+      do 3 i = 1, (imax-1)+         do 4 j = 1, (jmax-1)+            if (.true.) then+c= region :: r2 = centered(depth=1, dim=2)+               x = a(i-1,j) + a(i,j) + a(i+1,j) + abs(0)+c= stencil readOnce, (reflexive(dim=1))*r2 + (reflexive(dim=2))*r1 :: a               +             b(i,j) = (x + a(i,j-1) + a(i,j+1)) / 5.0+c No specification should be inferred here+             b(0,0) = a(i, j)+            end if+ 4       continue+      x = a(i,0)+      y = a(i-1,0)+c= stencil readOnce, backward(depth=1, dim=1) :: a      +      b(i,0) = (x + y)/2.0+ 3    continue++      b(i,j) = a(i,j)++      do i=1, imax+         do j=1, jmx+            x = a(1,j+1) + a(1,j-1)+            if (.true.) then +             a(i,j) = a(modulo(i,imax),1) + a(modulo(i+1,imax) ,1) + a(modulo(i-1,imax),1) + a(1,j) + x+             a(i,j) = a(i,j) + a(1,1)+            end if+         end do+      end do++      end
+ tests/fixtures/Specification/Stencils/example3.f view
@@ -0,0 +1,31 @@+      program example3+      implicit none++      integer i, x, y, imax, xmax, ymax+      parameter (imax = 3, jmax = 3)++      real a(0:imax,0:jmax), b(0:imax,0:jmax), c(0:imax), d(0:imax), acc++      do i=1,imax+        do x=1,xmax+           do y=1,ymax+             acc = acc + a(x,y,i)+           end do+        end do+ 1      b(1,i) = acc+      end do++      do i=1,imax+c     Label 1 should get same spec as this line+         b(1,i) = a(:,:,i)+      end do++      c(:) = d(:)+      c(:) = a(0,:)++c No spec here+      do i=1,imax+        c(i) = d(:)+      end do++      end
+ tests/fixtures/Specification/Stencils/example4.f view
@@ -0,0 +1,8 @@+      program example4+      logical BAR = .true.+      integer X(0:5)+      integer J+      do J=1, 10+         IF (BAR)   X(J) = X(J)+1+       end do+      end
+ tests/fixtures/Specification/Units/ex1.f90 view
@@ -0,0 +1,29 @@+program energy+  != unit :: speed = m/s++  != unit (m / s** (2)) :: gravity+  != unit (m) :: height+  != unit (kg) :: mass+  real, parameter :: mass = 3.00, gravity = 9.81, height = 4.20+  != unit (kg m** (2) / s** (2)) :: potential_energy+  real :: potential_energy++  != unit (1) :: half+  != unit (speed) :: velocity+  real, parameter :: half = 0.5, velocity = 4.00+  != unit (kg m** (2) / s** (2)) :: kinetic_energy+  != unit (kg m** (2) / s** (2)) :: total_energy+  real :: kinetic_energy, total_energy++  potential_energy = mass * gravity * height+  kinetic_energy = half * mass * square(velocity)++  total_energy = potential_energy + kinetic_energy++  contains++  real function square(x)+    real x+    square = x * x+  end function square+end program energy
+ tests/fixtures/Specification/Units/ex2.f90 view
@@ -0,0 +1,11 @@+program energy++ != unit (m) :: height+ != unit (kg) :: mass+  real, parameter :: mass = 3.00, gravity = .81, height = 4.20++ != unit (kg m** (2) / s** (2)) :: potential_energy+  real :: potential_energy+ +  potential_energy = mass * gravity * height+end program energy
+ tests/fixtures/Specification/Units/ex3.f90 view
@@ -0,0 +1,14 @@+program energy++ != unit (m) :: height+ != unit (kg) :: mass+ real, parameter :: mass = 3.00, gravity = .81, height = 4.20++ integer :: i = 0+ integer :: j = i+  + != unit (kg m**2 / s**2) :: potential_energy+ real :: potential_energy+ + potential_energy = mass * gravity * height+end program energy
+ tests/fixtures/Specification/Units/param.f90 view
@@ -0,0 +1,10 @@+      program param+        implicit none+        != unit(m) :: x, y+        real, parameter :: x = 4, y = 5+        != unit(s) :: t+        real, parameter :: t = 2+        real :: v1, v2+        v1 = x / t+        v2 = y / t+      end program
+ tests/fixtures/Transformation/common.f90 view
@@ -0,0 +1,10 @@+subroutine test(a,b, c)++integer :: c1, c2, c3+COMMON /cmn/  c1, c2, c3++real :: a, b, c++print *, a, b, c++end subroutine test
+ tests/fixtures/Transformation/equiv.f90 view
@@ -0,0 +1,20 @@+program wrt +  implicit none+  integer :: x = 97+  character :: y+  character :: z(20)+  equivalence (x, y, z(2))++  z(1) = "c"++  write (*,'(i8,A)') x, y+++  write (*,'(i8,A,A,A)') x, y, z(1), z(2)++  x = 97 + 98 * (2**8)++  write (*,'(i8,A,A,A,A)') x, y, z(1), z(2), z(3)+++end program wrt