camfort 0.800 → 0.802
raw patch · 16 files changed
+4459/−34 lines, 16 filesdep ~ghc-prim
Dependency ranges changed: ghc-prim
Files
- camfort.cabal +3/−3
- dist/build/Camfort/Specification/Stencils/Grammar.hs +883/−0
- dist/build/Camfort/Specification/Units/Parser.hs +759/−0
- dist/build/Camfort/camfort-tmp/Camfort/Specification/Stencils/Grammar.hs +883/−0
- dist/build/Camfort/camfort-tmp/Camfort/Specification/Units/Parser.hs +759/−0
- src/Camfort/Analysis/IntermediateReps.hs +1/−0
- src/Camfort/Functionality.hs +2/−0
- src/Camfort/Output.hs +1/−1
- src/Camfort/Specification/Stencils/Grammar.hs +1131/−0
- src/Camfort/Specification/Units/InferenceBackend.hs +5/−1
- src/Camfort/Specification/Units/InferenceFrontend.hs +10/−4
- src/Camfort/Specification/Units/Solve.hs +17/−17
- src/Camfort/Specification/Units/Synthesis.hs +2/−1
- src/Camfort/Transformation/EquivalenceElim.hs +1/−0
- src/Camfort/Traverse.hs +0/−5
- src/Main.hs +2/−2
camfort.cabal view
@@ -1,5 +1,5 @@ name: camfort-version: 0.800+version: 0.802 synopsis: CamFort - Cambridge Fortran infrastructure description: CamFort is a tool for the analysis, transformation, verification of Fortran code. @@ -85,7 +85,7 @@ Main build-depends: base < 5,- ghc-prim == 0.4.0.0,+ ghc-prim >= 0.4.0.0, containers >= 0.5.0.0, template-haskell >=2.4, generic-deriving >=1.5.5,@@ -164,7 +164,7 @@ other-modules: build-depends: base < 5,- ghc-prim == 0.4.0.0,+ ghc-prim >= 0.4.0.0, containers >= 0.5.0.0, template-haskell >=2.4, generic-deriving >=1.5.5,
+ dist/build/Camfort/Specification/Stencils/Grammar.hs view
@@ -0,0 +1,883 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fglasgow-exts -cpp #-}+-- -*- Mode: Haskell -*-+{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}+module Camfort.Specification.Stencils.Grammar+( specParser, Specification(..), Region(..), Spec(..), Mod(..), lexer ) where++import Data.Char (isLetter, isNumber, isAlphaNum, toLower, isAlpha, isSpace)+import Data.List (intersect, sort, isPrefixOf)+import Data.Data++import Debug.Trace++import Camfort.Analysis.CommentAnnotator+import Camfort.Specification.Stencils.Syntax (showL)+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.5++newtype HappyAbsSyn = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = Happy_GHC_Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: (Specification) -> (HappyAbsSyn )+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> (Specification)+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: ((String, Region)) -> (HappyAbsSyn )+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> ((String, Region))+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: (Region) -> (HappyAbsSyn )+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> (Region)+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (Bool) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (Bool)+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (Spec) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (Spec)+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (Mod) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (Mod)+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: ([Mod]) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> ([Mod])+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Mod) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Mod)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: ([String]) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> ([String])+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyInTok :: (Token) -> (HappyAbsSyn )+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> (Token)+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x36\x00\x61\x00\x00\x00\x5d\x00\x5a\x00\xfe\xff\x23\x00\x5c\x00\x18\x00\x4b\x00\x0b\x00\x00\x00\x59\x00\x00\x00\x00\x00\x58\x00\x57\x00\x56\x00\x55\x00\x00\x00\x18\x00\x54\x00\x53\x00\x07\x00\x52\x00\x50\x00\x4f\x00\x4e\x00\x4c\x00\x23\x00\x00\x00\x2d\x00\x18\x00\x1f\x00\x51\x00\x18\x00\x18\x00\x00\x00\x4d\x00\x00\x00\x47\x00\x1f\x00\x4a\x00\x49\x00\x48\x00\x46\x00\x45\x00\x00\x00\x18\x00\x1f\x00\x44\x00\x43\x00\x41\x00\x40\x00\x3b\x00\x00\x00\x2e\x00\x42\x00\x3f\x00\x3e\x00\x00\x00\x3a\x00\x35\x00\x34\x00\x00\x00\x33\x00\x32\x00\x30\x00\x3d\x00\x3d\x00\x3d\x00\x29\x00\x00\x00\x28\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x2f\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x39\x00\x37\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x2b\x00\x00\x00\x1e\x00\x20\x00\x13\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0a\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xe9\xff\xeb\xff\x00\x00\xe8\xff\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xea\xff\xe9\xff\x00\x00\xee\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xe5\xff\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf1\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\x00\x00\x00\x00\xf2\xff\xf2\xff\xf2\xff\x00\x00\xf3\xff\x00\x00\x00\x00\xf9\xff\xfa\xff\xfb\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x02\x00\x06\x00\x07\x00\x03\x00\x06\x00\x07\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x04\x00\x03\x00\x06\x00\x07\x00\x02\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x12\x00\x13\x00\x10\x00\x04\x00\x08\x00\x17\x00\x06\x00\x07\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x08\x00\x02\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x02\x00\x16\x00\x00\x00\x01\x00\x12\x00\x13\x00\x06\x00\x07\x00\x12\x00\x13\x00\x01\x00\x02\x00\x08\x00\x02\x00\x02\x00\x05\x00\x01\x00\x17\x00\x17\x00\x17\x00\x11\x00\x05\x00\x11\x00\x11\x00\x17\x00\xff\xff\x09\x00\x09\x00\x15\x00\x15\x00\x09\x00\x11\x00\xff\xff\x03\x00\x15\x00\xff\xff\x11\x00\x11\x00\x0f\x00\x11\x00\x09\x00\xff\xff\x10\x00\x0a\x00\x0a\x00\x0a\x00\x15\x00\x17\x00\x15\x00\x15\x00\x15\x00\x13\x00\x10\x00\x10\x00\x02\x00\x10\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x14\x00\x14\x00\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x1d\x00\x0e\x00\x0f\x00\x47\x00\x1e\x00\x1f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x49\x00\x14\x00\x0d\x00\x4a\x00\x0e\x00\x0f\x00\x31\x00\x15\x00\x25\x00\x10\x00\x11\x00\x12\x00\x24\x00\x25\x00\x14\x00\x0d\x00\x37\x00\x30\x00\x1e\x00\x1f\x00\x15\x00\x26\x00\x10\x00\x11\x00\x12\x00\x27\x00\x06\x00\x14\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x29\x00\x15\x00\x04\x00\x02\x00\x24\x00\x25\x00\x0e\x00\x0f\x00\x24\x00\x25\x00\x06\x00\x04\x00\x2e\x00\x17\x00\x21\x00\x20\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x49\x00\x46\x00\x47\x00\x41\x00\x00\x00\x3e\x00\x3f\x00\x42\x00\x43\x00\x40\x00\x39\x00\x00\x00\x0c\x00\x44\x00\x00\x00\x3a\x00\x3b\x00\x3d\x00\x3c\x00\x2b\x00\x00\x00\x29\x00\x2c\x00\x2d\x00\x2e\x00\x34\x00\x33\x00\x35\x00\x36\x00\x37\x00\x25\x00\x29\x00\x29\x00\x04\x00\x17\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x23\x00\x16\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 26) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23),+ (24 , happyReduce_24),+ (25 , happyReduce_25),+ (26 , happyReduce_26)+ ]++happy_n_terms = 26 :: Int+happy_n_nonterms = 9 :: Int++happyReduce_1 = happySpecReduce_1 0# happyReduction_1+happyReduction_1 happy_x_1+ = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4+ (RegionDec (fst happy_var_1) (snd happy_var_1)+ )}++happyReduce_2 = happyReduce 4# 0# happyReduction_2+happyReduction_2 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + happyIn4+ (SpecDec happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_3 = happyReduce 5# 1# happyReduction_3+happyReduction_3 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut6 happy_x_5 of { happy_var_5 -> + happyIn5+ ((happy_var_3, happy_var_5)+ ) `HappyStk` happyRest}}++happyReduce_4 = happyReduce 10# 2# happyReduction_4+happyReduction_4 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Forward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_5 = happyReduce 10# 2# happyReduction_5+happyReduction_5 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Backward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_6 = happyReduce 10# 2# happyReduction_6+happyReduction_6 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Centered (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_7 = happyReduce 6# 2# happyReduction_7+happyReduction_7 (happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + happyIn6+ (Centered 0 (read happy_var_5) True+ ) `HappyStk` happyRest}++happyReduce_8 = happySpecReduce_3 2# happyReduction_8+happyReduction_8 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (Or happy_var_1 happy_var_3+ )}}++happyReduce_9 = happySpecReduce_3 2# happyReduction_9+happyReduction_9 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (And happy_var_1 happy_var_3+ )}}++happyReduce_10 = happySpecReduce_3 2# happyReduction_10+happyReduction_10 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6+ (happy_var_2+ )}++happyReduce_11 = happySpecReduce_1 2# happyReduction_11+happyReduction_11 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6+ (Var happy_var_1+ )}++happyReduce_12 = happySpecReduce_1 3# happyReduction_12+happyReduction_12 happy_x_1+ = happyIn7+ (False+ )++happyReduce_13 = happySpecReduce_0 3# happyReduction_13+happyReduction_13 = happyIn7+ (True+ )++happyReduce_14 = happyReduce 4# 4# happyReduction_14+happyReduction_14 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8+ (Temporal happy_var_3 False+ ) `HappyStk` happyRest}++happyReduce_15 = happyReduce 5# 4# happyReduction_15+happyReduction_15 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8+ (Temporal happy_var_3 True+ ) `HappyStk` happyRest}++happyReduce_16 = happySpecReduce_3 4# happyReduction_16+happyReduction_16 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn8+ (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+ )}}}++happyReduce_17 = happySpecReduce_2 4# happyReduction_17+happyReduction_17 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8+ (Spatial [happy_var_1] happy_var_2+ )}}++happyReduce_18 = happySpecReduce_2 4# happyReduction_18+happyReduction_18 happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8+ (Spatial [happy_var_1] happy_var_2+ )}}++happyReduce_19 = happySpecReduce_1 4# happyReduction_19+happyReduction_19 happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn8+ (Spatial [] happy_var_1+ )}++happyReduce_20 = happySpecReduce_1 5# happyReduction_20+happyReduction_20 happy_x_1+ = happyIn9+ (ReadOnce+ )++happyReduce_21 = happySpecReduce_2 6# happyReduction_21+happyReduction_21 happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn10+ (happy_var_1 : happy_var_2+ )}}++happyReduce_22 = happySpecReduce_1 6# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10+ ([happy_var_1]+ )}++happyReduce_23 = happySpecReduce_1 7# happyReduction_23+happyReduction_23 happy_x_1+ = happyIn11+ (AtMost+ )++happyReduce_24 = happySpecReduce_1 7# happyReduction_24+happyReduction_24 happy_x_1+ = happyIn11+ (AtLeast+ )++happyReduce_25 = happySpecReduce_2 8# happyReduction_25+happyReduction_25 happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn12+ (happy_var_1 : happy_var_2+ )}}++happyReduce_26 = happySpecReduce_1 8# happyReduction_26+happyReduction_26 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn12+ ([happy_var_1]+ )}++happyNewToken action sts stk [] =+ happyDoAction 25# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ TId "stencil" -> cont 1#;+ TId "region" -> cont 2#;+ TId "readonce" -> cont 3#;+ TId "reflexive" -> cont 4#;+ TId "irreflexive" -> cont 5#;+ TId "atmost" -> cont 6#;+ TId "atleast" -> cont 7#;+ TId "dims" -> cont 8#;+ TId "dim" -> cont 9#;+ TId "depth" -> cont 10#;+ TId "forward" -> cont 11#;+ TId "backward" -> cont 12#;+ TId "centered" -> cont 13#;+ TId "dependency" -> cont 14#;+ TId "mutual" -> cont 15#;+ TId happy_dollar_dollar -> cont 16#;+ TNum happy_dollar_dollar -> cont 17#;+ TPlus -> cont 18#;+ TStar -> cont 19#;+ TDoubleColon -> cont 20#;+ TEqual -> cont 21#;+ TLParen -> cont 22#;+ TRParen -> cont 23#;+ TComma -> cont 24#;+ _ -> happyError' (tk:tks)+ }++happyError_ 25# tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b+happyThen = (>>=)+happyReturn :: () => a -> Either AnnotationParseError a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Either AnnotationParseError a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(Token)] -> Either AnnotationParseError a+happyError' = happyError++parseSpec tks = happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++data Specification+ = RegionDec String Region+ | SpecDec Spec [String]+ deriving (Show, Eq, Ord, Typeable, Data)++data Region+ = Forward Int Int Bool+ | Backward Int Int Bool+ | Centered Int Int Bool+ | Or Region Region+ | And Region Region+ | Var String+ deriving (Show, Eq, Ord, Typeable, Data)++data Spec+ = Spatial [Mod] Region+ | Temporal [String] Bool+ deriving (Show, Eq, Ord, Typeable, Data)++data Mod+ = AtLeast+ | AtMost+ | ReadOnce+ deriving (Show, Eq, Ord, Typeable, Data)++--------------------------------------------------++data Token+ = TDoubleColon+ | TStar+ | TPlus+ | TEqual+ | TComma+ | TLParen+ | TRParen+ | TId String+ | TNum String+ deriving (Show)++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++stripLeadingWhiteSpace (' ':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\t':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\n':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace xs = xs+++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+ case stripLeadingWhiteSpace input of+ -- Check the leading character is '=' for specification+ '=':input' ->+ -- First test to see if the input looks like an actual+ -- specification of either a stencil or region+ if (input' `hasPrefix` "stencil" || input' `hasPrefix` "region")+ then lexer' input'+ else Left NotAnnotation+ _ -> Left NotAnnotation+ where+ hasPrefix [] str = False+ hasPrefix (' ':xs) str = hasPrefix xs str+ hasPrefix xs str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' [] = return []+lexer' (' ':xs) = lexer' xs+lexer' ('\t':xs) = lexer' xs+lexer' (':':':':xs) = addToTokens TDoubleColon xs+lexer' ('*':xs) = addToTokens TStar xs+lexer' ('+':xs) = addToTokens TPlus xs+lexer' ('=':xs) = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+ | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+ | otherwise = addToTokens TComma xs+lexer' ('(':xs) = addToTokens TLParen xs+lexer' (')':xs) = addToTokens TRParen xs+lexer' (x:xs)+ | isLetter x = aux TId $ \ c -> isAlphaNum c || c == '_'+ | isNumber x = aux TNum isNumber+ | otherwise+ = failWith $ "Not an indentifier " ++ show x+ where+ aux f p = (f target :) `fmap` lexer' rest+ where (target, rest) = span p (x:xs)+lexer' x+ = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+ do mods' <- modValidate' $ sort mods+ return $ SpecDec (Spatial mods' r) vars++ where modValidate' [] = return $ []++ modValidate' (AtLeast : AtLeast : xs)+ = failWith "Duplicate 'atLeast' modifier; use at most one."++ modValidate' (AtMost : AtMost : xs)+ = failWith "Duplicate 'atMost' modifier; use at most one."++ modValidate' (ReadOnce : ReadOnce : xs)+ = failWith "Duplicate 'readOnce' modifier; use at most one."++ modValidate' (AtLeast : AtMost : xs)+ = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+ ++ "'atMost' together"++ modValidate' (x : xs)+ = do xs' <- modValidate' xs+ return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<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,759 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fglasgow-exts -cpp #-}+-- -*- Mode: Haskell -*-++{-# LANGUAGE DeriveDataTypeable #-}+module Camfort.Specification.Units.Parser ( unitParser+ , UnitStatement(..)+ , UnitOfMeasure(..)+ , UnitPower(..)+ ) where++import Camfort.Analysis.CommentAnnotator+import Data.Data+import Data.List+import Data.Char (isLetter, isNumber, isAlphaNum, toLower)+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.5++newtype HappyAbsSyn = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = Happy_GHC_Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: (UnitStatement) -> (HappyAbsSyn )+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> (UnitStatement)+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: (Maybe [String]) -> (HappyAbsSyn )+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> (Maybe [String])+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: ([String]) -> (HappyAbsSyn )+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> ([String])+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (UnitPower) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (UnitPower)+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Integer) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Integer)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (String) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (String)+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyInTok :: (Token) -> (HappyAbsSyn )+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> (Token)+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x44\x00\x41\x00\x0f\x00\x3c\x00\x05\x00\x2b\x00\x04\x00\x3d\x00\x00\x00\x00\x00\x3f\x00\xff\xff\x3b\x00\x01\x00\x34\x00\x00\x00\x35\x00\x10\x00\x36\x00\x0f\x00\x00\x00\x04\x00\x3a\x00\x00\x00\x39\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x19\x00\x0f\x00\x00\x00\x00\x00\x33\x00\xfd\xff\x00\x00\x38\x00\x00\x00\x19\x00\x00\x00\x2c\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x37\x00\x00\x00\x27\x00\x00\x00\x27\x00\x22\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1d\x00\x00\x00\x30\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x28\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xf8\xff\xf2\xff\xef\xff\xf7\xff\x00\x00\x00\x00\x00\x00\xf8\xff\xf7\xff\xf5\xff\x00\x00\x00\x00\xf4\xff\x00\x00\xfe\xff\x00\x00\x00\x00\xfc\xff\xf9\xff\xf3\xff\xf1\xff\xee\xff\xeb\xff\xe8\xff\xe9\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf0\xff\xfd\xff\x00\x00\xea\xff\x00\x00\xfa\xff\x00\x00\xed\xff\x00\x00\xec\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x02\x00\x02\x00\x08\x00\x02\x00\x02\x00\x03\x00\x0c\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x09\x00\x0b\x00\x0b\x00\x02\x00\x03\x00\x03\x00\x04\x00\x08\x00\x06\x00\x03\x00\x04\x00\x05\x00\x0b\x00\x0b\x00\x03\x00\x04\x00\x02\x00\x06\x00\x03\x00\x04\x00\x05\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x04\x00\x05\x00\x03\x00\x04\x00\x05\x00\x07\x00\x08\x00\x07\x00\x08\x00\x03\x00\x04\x00\x08\x00\x09\x00\x05\x00\x05\x00\x00\x00\x0c\x00\x07\x00\x02\x00\x08\x00\x02\x00\x07\x00\x05\x00\x0a\x00\x0c\x00\x02\x00\x01\x00\x08\x00\x07\x00\x01\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x09\x00\x0f\x00\x09\x00\x28\x00\x2a\x00\x09\x00\x09\x00\x0a\x00\x2b\x00\x0c\x00\x10\x00\x14\x00\x24\x00\x0b\x00\x14\x00\x0c\x00\x09\x00\x0a\x00\x1e\x00\x1f\x00\x26\x00\x20\x00\x24\x00\x06\x00\x07\x00\x0c\x00\x21\x00\x1e\x00\x1f\x00\x17\x00\x20\x00\x0c\x00\x0d\x00\x07\x00\x14\x00\x1a\x00\x1b\x00\x1c\x00\x0c\x00\x0d\x00\x07\x00\x05\x00\x06\x00\x07\x00\x2b\x00\x1c\x00\x25\x00\x1c\x00\x1e\x00\x1f\x00\x16\x00\x17\x00\x19\x00\x12\x00\x03\x00\x2d\x00\x12\x00\x19\x00\x16\x00\x19\x00\x12\x00\x28\x00\x22\x00\x23\x00\x11\x00\x03\x00\x16\x00\x12\x00\x05\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 23) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23)+ ]++happy_n_terms = 14 :: Int+happy_n_nonterms = 9 :: Int++happyReduce_1 = happySpecReduce_3 0# happyReduction_1+happyReduction_1 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut7 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4+ (UnitAssignment happy_var_3 happy_var_2+ )}}++happyReduce_2 = happyReduce 5# 0# happyReduction_2+happyReduction_2 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut7 happy_x_5 of { happy_var_5 -> + happyIn4+ (UnitAlias happy_var_3 happy_var_5+ ) `HappyStk` happyRest}}++happyReduce_3 = happySpecReduce_2 1# happyReduction_3+happyReduction_3 happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5+ (Just happy_var_2+ )}++happyReduce_4 = happySpecReduce_0 1# happyReduction_4+happyReduction_4 = happyIn5+ (Nothing+ )++happyReduce_5 = happySpecReduce_3 2# happyReduction_5+happyReduction_5 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (happy_var_1 : happy_var_3+ )}}++happyReduce_6 = happySpecReduce_1 2# happyReduction_6+happyReduction_6 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6+ ([happy_var_1]+ )}++happyReduce_7 = happySpecReduce_1 3# happyReduction_7+happyReduction_7 happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn7+ (happy_var_1+ )}++happyReduce_8 = happySpecReduce_1 3# happyReduction_8+happyReduction_8 happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_9 = happySpecReduce_3 3# happyReduction_9+happyReduction_9 happy_x_3+ happy_x_2+ happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_10 = happySpecReduce_2 3# happyReduction_10+happyReduction_10 happy_x_2+ happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_11 = happySpecReduce_2 4# happyReduction_11+happyReduction_11 happy_x_2+ happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn8+ (UnitProduct happy_var_1 happy_var_2+ )}}++happyReduce_12 = happySpecReduce_3 4# happyReduction_12+happyReduction_12 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn8+ (UnitQuotient happy_var_1 happy_var_3+ )}}++happyReduce_13 = happySpecReduce_1 4# happyReduction_13+happyReduction_13 happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn8+ (happy_var_1+ )}++happyReduce_14 = happySpecReduce_3 5# happyReduction_14+happyReduction_14 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn9+ (UnitExponentiation happy_var_1 happy_var_3+ )}}++happyReduce_15 = happySpecReduce_3 5# happyReduction_15+happyReduction_15 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn9+ (happy_var_2+ )}++happyReduce_16 = happySpecReduce_1 5# happyReduction_16+happyReduction_16 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn9+ (UnitBasic happy_var_1+ )}++happyReduce_17 = happySpecReduce_1 6# happyReduction_17+happyReduction_17 happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10+ (UnitPowerInteger happy_var_1+ )}++happyReduce_18 = happySpecReduce_3 6# happyReduction_18+happyReduction_18 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10+ (UnitPowerInteger happy_var_2+ )}++happyReduce_19 = happyReduce 5# 6# happyReduction_19+happyReduction_19 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut11 happy_x_2 of { happy_var_2 -> + case happyOut11 happy_x_4 of { happy_var_4 -> + happyIn10+ (UnitPowerRational happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_20 = happySpecReduce_1 7# happyReduction_20+happyReduction_20 happy_x_1+ = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11+ (read happy_var_1+ )}++happyReduce_21 = happySpecReduce_2 7# happyReduction_21+happyReduction_21 happy_x_2+ happy_x_1+ = case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn11+ (read $ '-' : happy_var_2+ )}++happyReduce_22 = happySpecReduce_1 8# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOutTok happy_x_1 of { (TNum happy_var_1) -> + happyIn12+ (happy_var_1+ )}++happyReduce_23 = happySpecReduce_1 8# happyReduction_23+happyReduction_23 happy_x_1+ = happyIn12+ ("1"+ )++happyNewToken action sts stk [] =+ happyDoAction 13# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ TId "unit" -> cont 1#;+ TId happy_dollar_dollar -> cont 2#;+ TNum "1" -> cont 3#;+ TNum happy_dollar_dollar -> cont 4#;+ TComma -> cont 5#;+ TMinus -> cont 6#;+ TExponentiation -> cont 7#;+ TDivision -> cont 8#;+ TDoubleColon -> cont 9#;+ TEqual -> cont 10#;+ TLeftPar -> cont 11#;+ TRightPar -> cont 12#;+ _ -> happyError' (tk:tks)+ }++happyError_ 13# tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b+happyThen = (>>=)+happyReturn :: () => a -> Either AnnotationParseError a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Either AnnotationParseError a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(Token)] -> Either AnnotationParseError a+happyError' = happyError++parseUnit tks = happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++data UnitStatement =+ UnitAssignment (Maybe [String]) UnitOfMeasure+ | UnitAlias String UnitOfMeasure+ deriving Data++instance Show UnitStatement where+ show (UnitAssignment (Just ss) uom) = "= unit (" ++ show uom ++ ") :: " ++ (intercalate "," ss)+ show (UnitAssignment Nothing uom) = "= unit (" ++ show uom ++ ")"+ show (UnitAlias s uom) = "= unit :: " ++ s ++ " = " ++ show uom++data UnitOfMeasure =+ Unitless+ | UnitBasic String+ | UnitProduct UnitOfMeasure UnitOfMeasure+ | UnitQuotient UnitOfMeasure UnitOfMeasure+ | UnitExponentiation UnitOfMeasure UnitPower+ deriving Data++instance Show UnitOfMeasure where+ show Unitless = "1"+ show (UnitBasic s) = s+ show (UnitProduct uom1 uom2) = show uom1 ++ " " ++ show uom2+ show (UnitQuotient uom1 uom2) = show uom1 ++ " / " ++ show uom2+ show (UnitExponentiation uom exp) = show uom ++ "** (" ++ show exp ++ ")"++data UnitPower =+ UnitPowerInteger Integer+ | UnitPowerRational Integer Integer+ deriving Data++instance Show UnitPower where+ show (UnitPowerInteger i) = show i+ show (UnitPowerRational i1 i2) = show i1 ++ "/" ++ show i2++data Token =+ TUnit+ | TComma+ | TDoubleColon+ | TExponentiation+ | TDivision+ | TMinus+ | TEqual+ | TLeftPar+ | TRightPar+ | TId String+ | TNum String+ deriving (Show)++lexer :: String -> Either AnnotationParseError [ Token ]+lexer ('=':xs) = lexer' xs+lexer _ = Left NotAnnotation++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' [] = Right []+lexer' ['\n'] = Right []+lexer' ['\r', '\n'] = Right []+lexer' ['\r'] = Right [] -- windows+lexer' (' ':xs) = lexer' xs+lexer' ('\t':xs) = lexer' xs+lexer' (':':':':xs) = addToTokens TDoubleColon xs+lexer' ('*':'*':xs) = addToTokens TExponentiation xs+lexer' (',':xs) = addToTokens TComma xs+lexer' ('/':xs) = addToTokens TDivision xs+lexer' ('-':xs) = addToTokens TMinus xs+lexer' ('=':xs) = addToTokens TEqual xs+lexer' ('(':xs) = addToTokens TLeftPar xs+lexer' (')':xs) = addToTokens TRightPar xs+lexer' (x:xs)+ | isLetter x = aux (\c -> isAlphaNum c || c `elem` ['\'','_','-']) TId+ | isNumber x = aux isNumber TNum+ | otherwise = failWith $ "Not valid unit syntax at " ++ show (x:xs)+ where+ aux p cons =+ let (target, rest) = span p xs+ in lexer' rest >>= (\tokens -> return $ cons (x:target) : tokens)++unitParser :: String -> Either AnnotationParseError UnitStatement+unitParser src = do+ tokens <- lexer $ map toLower src+ parseUnit tokens++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<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,883 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fglasgow-exts -cpp #-}+-- -*- Mode: Haskell -*-+{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}+module Camfort.Specification.Stencils.Grammar+( specParser, Specification(..), Region(..), Spec(..), Mod(..), lexer ) where++import Data.Char (isLetter, isNumber, isAlphaNum, toLower, isAlpha, isSpace)+import Data.List (intersect, sort, isPrefixOf)+import Data.Data++import Debug.Trace++import Camfort.Analysis.CommentAnnotator+import Camfort.Specification.Stencils.Syntax (showL)+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.5++newtype HappyAbsSyn = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = Happy_GHC_Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: (Specification) -> (HappyAbsSyn )+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> (Specification)+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: ((String, Region)) -> (HappyAbsSyn )+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> ((String, Region))+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: (Region) -> (HappyAbsSyn )+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> (Region)+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (Bool) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (Bool)+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (Spec) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (Spec)+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (Mod) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (Mod)+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: ([Mod]) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> ([Mod])+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Mod) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Mod)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: ([String]) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> ([String])+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyInTok :: (Token) -> (HappyAbsSyn )+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> (Token)+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x36\x00\x61\x00\x00\x00\x5d\x00\x5a\x00\xfe\xff\x23\x00\x5c\x00\x18\x00\x4b\x00\x0b\x00\x00\x00\x59\x00\x00\x00\x00\x00\x58\x00\x57\x00\x56\x00\x55\x00\x00\x00\x18\x00\x54\x00\x53\x00\x07\x00\x52\x00\x50\x00\x4f\x00\x4e\x00\x4c\x00\x23\x00\x00\x00\x2d\x00\x18\x00\x1f\x00\x51\x00\x18\x00\x18\x00\x00\x00\x4d\x00\x00\x00\x47\x00\x1f\x00\x4a\x00\x49\x00\x48\x00\x46\x00\x45\x00\x00\x00\x18\x00\x1f\x00\x44\x00\x43\x00\x41\x00\x40\x00\x3b\x00\x00\x00\x2e\x00\x42\x00\x3f\x00\x3e\x00\x00\x00\x3a\x00\x35\x00\x34\x00\x00\x00\x33\x00\x32\x00\x30\x00\x3d\x00\x3d\x00\x3d\x00\x29\x00\x00\x00\x28\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x2f\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x39\x00\x37\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x2b\x00\x00\x00\x1e\x00\x20\x00\x13\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0a\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xe9\xff\xeb\xff\x00\x00\xe8\xff\xe7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xea\xff\xe9\xff\x00\x00\xee\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf7\xff\xfd\xff\xe5\xff\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xfc\xff\xf1\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\x00\x00\x00\x00\xf2\xff\xf2\xff\xf2\xff\x00\x00\xf3\xff\x00\x00\x00\x00\xf9\xff\xfa\xff\xfb\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x02\x00\x06\x00\x07\x00\x03\x00\x06\x00\x07\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x04\x00\x03\x00\x06\x00\x07\x00\x02\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x12\x00\x13\x00\x10\x00\x04\x00\x08\x00\x17\x00\x06\x00\x07\x00\x16\x00\x02\x00\x0b\x00\x0c\x00\x0d\x00\x08\x00\x02\x00\x10\x00\x04\x00\x05\x00\x06\x00\x07\x00\x02\x00\x16\x00\x00\x00\x01\x00\x12\x00\x13\x00\x06\x00\x07\x00\x12\x00\x13\x00\x01\x00\x02\x00\x08\x00\x02\x00\x02\x00\x05\x00\x01\x00\x17\x00\x17\x00\x17\x00\x11\x00\x05\x00\x11\x00\x11\x00\x17\x00\xff\xff\x09\x00\x09\x00\x15\x00\x15\x00\x09\x00\x11\x00\xff\xff\x03\x00\x15\x00\xff\xff\x11\x00\x11\x00\x0f\x00\x11\x00\x09\x00\xff\xff\x10\x00\x0a\x00\x0a\x00\x0a\x00\x15\x00\x17\x00\x15\x00\x15\x00\x15\x00\x13\x00\x10\x00\x10\x00\x02\x00\x10\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x14\x00\x14\x00\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x0c\x00\x0d\x00\x1d\x00\x0e\x00\x0f\x00\x47\x00\x1e\x00\x1f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x49\x00\x14\x00\x0d\x00\x4a\x00\x0e\x00\x0f\x00\x31\x00\x15\x00\x25\x00\x10\x00\x11\x00\x12\x00\x24\x00\x25\x00\x14\x00\x0d\x00\x37\x00\x30\x00\x1e\x00\x1f\x00\x15\x00\x26\x00\x10\x00\x11\x00\x12\x00\x27\x00\x06\x00\x14\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x29\x00\x15\x00\x04\x00\x02\x00\x24\x00\x25\x00\x0e\x00\x0f\x00\x24\x00\x25\x00\x06\x00\x04\x00\x2e\x00\x17\x00\x21\x00\x20\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x49\x00\x46\x00\x47\x00\x41\x00\x00\x00\x3e\x00\x3f\x00\x42\x00\x43\x00\x40\x00\x39\x00\x00\x00\x0c\x00\x44\x00\x00\x00\x3a\x00\x3b\x00\x3d\x00\x3c\x00\x2b\x00\x00\x00\x29\x00\x2c\x00\x2d\x00\x2e\x00\x34\x00\x33\x00\x35\x00\x36\x00\x37\x00\x25\x00\x29\x00\x29\x00\x04\x00\x17\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x23\x00\x16\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 26) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23),+ (24 , happyReduce_24),+ (25 , happyReduce_25),+ (26 , happyReduce_26)+ ]++happy_n_terms = 26 :: Int+happy_n_nonterms = 9 :: Int++happyReduce_1 = happySpecReduce_1 0# happyReduction_1+happyReduction_1 happy_x_1+ = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4+ (RegionDec (fst happy_var_1) (snd happy_var_1)+ )}++happyReduce_2 = happyReduce 4# 0# happyReduction_2+happyReduction_2 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut8 happy_x_2 of { happy_var_2 -> + case happyOut12 happy_x_4 of { happy_var_4 -> + happyIn4+ (SpecDec happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_3 = happyReduce 5# 1# happyReduction_3+happyReduction_3 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut6 happy_x_5 of { happy_var_5 -> + happyIn5+ ((happy_var_3, happy_var_5)+ ) `HappyStk` happyRest}}++happyReduce_4 = happyReduce 10# 2# happyReduction_4+happyReduction_4 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Forward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_5 = happyReduce 10# 2# happyReduction_5+happyReduction_5 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Backward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_6 = happyReduce 10# 2# happyReduction_6+happyReduction_6 (happy_x_10 `HappyStk`+ happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + case happyOutTok happy_x_8 of { (TNum happy_var_8) -> + case happyOut7 happy_x_9 of { happy_var_9 -> + happyIn6+ (Centered (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest}}}++happyReduce_7 = happyReduce 6# 2# happyReduction_7+happyReduction_7 (happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_5 of { (TNum happy_var_5) -> + happyIn6+ (Centered 0 (read happy_var_5) True+ ) `HappyStk` happyRest}++happyReduce_8 = happySpecReduce_3 2# happyReduction_8+happyReduction_8 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (Or happy_var_1 happy_var_3+ )}}++happyReduce_9 = happySpecReduce_3 2# happyReduction_9+happyReduction_9 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (And happy_var_1 happy_var_3+ )}}++happyReduce_10 = happySpecReduce_3 2# happyReduction_10+happyReduction_10 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6+ (happy_var_2+ )}++happyReduce_11 = happySpecReduce_1 2# happyReduction_11+happyReduction_11 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6+ (Var happy_var_1+ )}++happyReduce_12 = happySpecReduce_1 3# happyReduction_12+happyReduction_12 happy_x_1+ = happyIn7+ (False+ )++happyReduce_13 = happySpecReduce_0 3# happyReduction_13+happyReduction_13 = happyIn7+ (True+ )++happyReduce_14 = happyReduce 4# 4# happyReduction_14+happyReduction_14 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8+ (Temporal happy_var_3 False+ ) `HappyStk` happyRest}++happyReduce_15 = happyReduce 5# 4# happyReduction_15+happyReduction_15 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn8+ (Temporal happy_var_3 True+ ) `HappyStk` happyRest}++happyReduce_16 = happySpecReduce_3 4# happyReduction_16+happyReduction_16 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn8+ (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+ )}}}++happyReduce_17 = happySpecReduce_2 4# happyReduction_17+happyReduction_17 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8+ (Spatial [happy_var_1] happy_var_2+ )}}++happyReduce_18 = happySpecReduce_2 4# happyReduction_18+happyReduction_18 happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn8+ (Spatial [happy_var_1] happy_var_2+ )}}++happyReduce_19 = happySpecReduce_1 4# happyReduction_19+happyReduction_19 happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn8+ (Spatial [] happy_var_1+ )}++happyReduce_20 = happySpecReduce_1 5# happyReduction_20+happyReduction_20 happy_x_1+ = happyIn9+ (ReadOnce+ )++happyReduce_21 = happySpecReduce_2 6# happyReduction_21+happyReduction_21 happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn10+ (happy_var_1 : happy_var_2+ )}}++happyReduce_22 = happySpecReduce_1 6# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10+ ([happy_var_1]+ )}++happyReduce_23 = happySpecReduce_1 7# happyReduction_23+happyReduction_23 happy_x_1+ = happyIn11+ (AtMost+ )++happyReduce_24 = happySpecReduce_1 7# happyReduction_24+happyReduction_24 happy_x_1+ = happyIn11+ (AtLeast+ )++happyReduce_25 = happySpecReduce_2 8# happyReduction_25+happyReduction_25 happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn12+ (happy_var_1 : happy_var_2+ )}}++happyReduce_26 = happySpecReduce_1 8# happyReduction_26+happyReduction_26 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn12+ ([happy_var_1]+ )}++happyNewToken action sts stk [] =+ happyDoAction 25# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ TId "stencil" -> cont 1#;+ TId "region" -> cont 2#;+ TId "readonce" -> cont 3#;+ TId "reflexive" -> cont 4#;+ TId "irreflexive" -> cont 5#;+ TId "atmost" -> cont 6#;+ TId "atleast" -> cont 7#;+ TId "dims" -> cont 8#;+ TId "dim" -> cont 9#;+ TId "depth" -> cont 10#;+ TId "forward" -> cont 11#;+ TId "backward" -> cont 12#;+ TId "centered" -> cont 13#;+ TId "dependency" -> cont 14#;+ TId "mutual" -> cont 15#;+ TId happy_dollar_dollar -> cont 16#;+ TNum happy_dollar_dollar -> cont 17#;+ TPlus -> cont 18#;+ TStar -> cont 19#;+ TDoubleColon -> cont 20#;+ TEqual -> cont 21#;+ TLParen -> cont 22#;+ TRParen -> cont 23#;+ TComma -> cont 24#;+ _ -> happyError' (tk:tks)+ }++happyError_ 25# tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b+happyThen = (>>=)+happyReturn :: () => a -> Either AnnotationParseError a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Either AnnotationParseError a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(Token)] -> Either AnnotationParseError a+happyError' = happyError++parseSpec tks = happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++data Specification+ = RegionDec String Region+ | SpecDec Spec [String]+ deriving (Show, Eq, Ord, Typeable, Data)++data Region+ = Forward Int Int Bool+ | Backward Int Int Bool+ | Centered Int Int Bool+ | Or Region Region+ | And Region Region+ | Var String+ deriving (Show, Eq, Ord, Typeable, Data)++data Spec+ = Spatial [Mod] Region+ | Temporal [String] Bool+ deriving (Show, Eq, Ord, Typeable, Data)++data Mod+ = AtLeast+ | AtMost+ | ReadOnce+ deriving (Show, Eq, Ord, Typeable, Data)++--------------------------------------------------++data Token+ = TDoubleColon+ | TStar+ | TPlus+ | TEqual+ | TComma+ | TLParen+ | TRParen+ | TId String+ | TNum String+ deriving (Show)++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++stripLeadingWhiteSpace (' ':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\t':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\n':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace xs = xs+++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+ case stripLeadingWhiteSpace input of+ -- Check the leading character is '=' for specification+ '=':input' ->+ -- First test to see if the input looks like an actual+ -- specification of either a stencil or region+ if (input' `hasPrefix` "stencil" || input' `hasPrefix` "region")+ then lexer' input'+ else Left NotAnnotation+ _ -> Left NotAnnotation+ where+ hasPrefix [] str = False+ hasPrefix (' ':xs) str = hasPrefix xs str+ hasPrefix xs str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' [] = return []+lexer' (' ':xs) = lexer' xs+lexer' ('\t':xs) = lexer' xs+lexer' (':':':':xs) = addToTokens TDoubleColon xs+lexer' ('*':xs) = addToTokens TStar xs+lexer' ('+':xs) = addToTokens TPlus xs+lexer' ('=':xs) = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+ | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+ | otherwise = addToTokens TComma xs+lexer' ('(':xs) = addToTokens TLParen xs+lexer' (')':xs) = addToTokens TRParen xs+lexer' (x:xs)+ | isLetter x = aux TId $ \ c -> isAlphaNum c || c == '_'+ | isNumber x = aux TNum isNumber+ | otherwise+ = failWith $ "Not an indentifier " ++ show x+ where+ aux f p = (f target :) `fmap` lexer' rest+ where (target, rest) = span p (x:xs)+lexer' x+ = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+ do mods' <- modValidate' $ sort mods+ return $ SpecDec (Spatial mods' r) vars++ where modValidate' [] = return $ []++ modValidate' (AtLeast : AtLeast : xs)+ = failWith "Duplicate 'atLeast' modifier; use at most one."++ modValidate' (AtMost : AtMost : xs)+ = failWith "Duplicate 'atMost' modifier; use at most one."++ modValidate' (ReadOnce : ReadOnce : xs)+ = failWith "Duplicate 'readOnce' modifier; use at most one."++ modValidate' (AtLeast : AtMost : xs)+ = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+ ++ "'atMost' together"++ modValidate' (x : xs)+ = do xs' <- modValidate' xs+ return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<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,759 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fglasgow-exts -cpp #-}+-- -*- Mode: Haskell -*-++{-# LANGUAGE DeriveDataTypeable #-}+module Camfort.Specification.Units.Parser ( unitParser+ , UnitStatement(..)+ , UnitOfMeasure(..)+ , UnitPower(..)+ ) where++import Camfort.Analysis.CommentAnnotator+import Data.Data+import Data.List+import Data.Char (isLetter, isNumber, isAlphaNum, toLower)+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.5++newtype HappyAbsSyn = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = Happy_GHC_Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: (UnitStatement) -> (HappyAbsSyn )+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> (UnitStatement)+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: (Maybe [String]) -> (HappyAbsSyn )+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> (Maybe [String])+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: ([String]) -> (HappyAbsSyn )+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> ([String])+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (UnitOfMeasure) -> (HappyAbsSyn )+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (UnitOfMeasure)+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (UnitPower) -> (HappyAbsSyn )+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (UnitPower)+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Integer) -> (HappyAbsSyn )+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Integer)+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (String) -> (HappyAbsSyn )+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (String)+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyInTok :: (Token) -> (HappyAbsSyn )+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> (Token)+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x44\x00\x41\x00\x0f\x00\x3c\x00\x05\x00\x2b\x00\x04\x00\x3d\x00\x00\x00\x00\x00\x3f\x00\xff\xff\x3b\x00\x01\x00\x34\x00\x00\x00\x35\x00\x10\x00\x36\x00\x0f\x00\x00\x00\x04\x00\x3a\x00\x00\x00\x39\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x19\x00\x0f\x00\x00\x00\x00\x00\x33\x00\xfd\xff\x00\x00\x38\x00\x00\x00\x19\x00\x00\x00\x2c\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x37\x00\x00\x00\x27\x00\x00\x00\x27\x00\x22\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1d\x00\x00\x00\x30\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x28\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xf8\xff\xf2\xff\xef\xff\xf7\xff\x00\x00\x00\x00\x00\x00\xf8\xff\xf7\xff\xf5\xff\x00\x00\x00\x00\xf4\xff\x00\x00\xfe\xff\x00\x00\x00\x00\xfc\xff\xf9\xff\xf3\xff\xf1\xff\xee\xff\xeb\xff\xe8\xff\xe9\xff\x00\x00\x00\x00\x00\x00\xf6\xff\xf0\xff\xfd\xff\x00\x00\xea\xff\x00\x00\xfa\xff\x00\x00\xed\xff\x00\x00\xec\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x02\x00\x02\x00\x08\x00\x02\x00\x02\x00\x03\x00\x0c\x00\x0b\x00\x0c\x00\x0b\x00\x0c\x00\x09\x00\x0b\x00\x0b\x00\x02\x00\x03\x00\x03\x00\x04\x00\x08\x00\x06\x00\x03\x00\x04\x00\x05\x00\x0b\x00\x0b\x00\x03\x00\x04\x00\x02\x00\x06\x00\x03\x00\x04\x00\x05\x00\x01\x00\x06\x00\x07\x00\x08\x00\x03\x00\x04\x00\x05\x00\x03\x00\x04\x00\x05\x00\x07\x00\x08\x00\x07\x00\x08\x00\x03\x00\x04\x00\x08\x00\x09\x00\x05\x00\x05\x00\x00\x00\x0c\x00\x07\x00\x02\x00\x08\x00\x02\x00\x07\x00\x05\x00\x0a\x00\x0c\x00\x02\x00\x01\x00\x08\x00\x07\x00\x01\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x09\x00\x0f\x00\x09\x00\x28\x00\x2a\x00\x09\x00\x09\x00\x0a\x00\x2b\x00\x0c\x00\x10\x00\x14\x00\x24\x00\x0b\x00\x14\x00\x0c\x00\x09\x00\x0a\x00\x1e\x00\x1f\x00\x26\x00\x20\x00\x24\x00\x06\x00\x07\x00\x0c\x00\x21\x00\x1e\x00\x1f\x00\x17\x00\x20\x00\x0c\x00\x0d\x00\x07\x00\x14\x00\x1a\x00\x1b\x00\x1c\x00\x0c\x00\x0d\x00\x07\x00\x05\x00\x06\x00\x07\x00\x2b\x00\x1c\x00\x25\x00\x1c\x00\x1e\x00\x1f\x00\x16\x00\x17\x00\x19\x00\x12\x00\x03\x00\x2d\x00\x12\x00\x19\x00\x16\x00\x19\x00\x12\x00\x28\x00\x22\x00\x23\x00\x11\x00\x03\x00\x16\x00\x12\x00\x05\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (1, 23) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23)+ ]++happy_n_terms = 14 :: Int+happy_n_nonterms = 9 :: Int++happyReduce_1 = happySpecReduce_3 0# happyReduction_1+happyReduction_1 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut7 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4+ (UnitAssignment happy_var_3 happy_var_2+ )}}++happyReduce_2 = happyReduce 5# 0# happyReduction_2+happyReduction_2 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_3 of { (TId happy_var_3) -> + case happyOut7 happy_x_5 of { happy_var_5 -> + happyIn4+ (UnitAlias happy_var_3 happy_var_5+ ) `HappyStk` happyRest}}++happyReduce_3 = happySpecReduce_2 1# happyReduction_3+happyReduction_3 happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn5+ (Just happy_var_2+ )}++happyReduce_4 = happySpecReduce_0 1# happyReduction_4+happyReduction_4 = happyIn5+ (Nothing+ )++happyReduce_5 = happySpecReduce_3 2# happyReduction_5+happyReduction_5 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn6+ (happy_var_1 : happy_var_3+ )}}++happyReduce_6 = happySpecReduce_1 2# happyReduction_6+happyReduction_6 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn6+ ([happy_var_1]+ )}++happyReduce_7 = happySpecReduce_1 3# happyReduction_7+happyReduction_7 happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn7+ (happy_var_1+ )}++happyReduce_8 = happySpecReduce_1 3# happyReduction_8+happyReduction_8 happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_9 = happySpecReduce_3 3# happyReduction_9+happyReduction_9 happy_x_3+ happy_x_2+ happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_10 = happySpecReduce_2 3# happyReduction_10+happyReduction_10 happy_x_2+ happy_x_1+ = happyIn7+ (Unitless+ )++happyReduce_11 = happySpecReduce_2 4# happyReduction_11+happyReduction_11 happy_x_2+ happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn8+ (UnitProduct happy_var_1 happy_var_2+ )}}++happyReduce_12 = happySpecReduce_3 4# happyReduction_12+happyReduction_12 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn8+ (UnitQuotient happy_var_1 happy_var_3+ )}}++happyReduce_13 = happySpecReduce_1 4# happyReduction_13+happyReduction_13 happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn8+ (happy_var_1+ )}++happyReduce_14 = happySpecReduce_3 5# happyReduction_14+happyReduction_14 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn9+ (UnitExponentiation happy_var_1 happy_var_3+ )}}++happyReduce_15 = happySpecReduce_3 5# happyReduction_15+happyReduction_15 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut8 happy_x_2 of { happy_var_2 -> + happyIn9+ (happy_var_2+ )}++happyReduce_16 = happySpecReduce_1 5# happyReduction_16+happyReduction_16 happy_x_1+ = case happyOutTok happy_x_1 of { (TId happy_var_1) -> + happyIn9+ (UnitBasic happy_var_1+ )}++happyReduce_17 = happySpecReduce_1 6# happyReduction_17+happyReduction_17 happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10+ (UnitPowerInteger happy_var_1+ )}++happyReduce_18 = happySpecReduce_3 6# happyReduction_18+happyReduction_18 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10+ (UnitPowerInteger happy_var_2+ )}++happyReduce_19 = happyReduce 5# 6# happyReduction_19+happyReduction_19 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut11 happy_x_2 of { happy_var_2 -> + case happyOut11 happy_x_4 of { happy_var_4 -> + happyIn10+ (UnitPowerRational happy_var_2 happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_20 = happySpecReduce_1 7# happyReduction_20+happyReduction_20 happy_x_1+ = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11+ (read happy_var_1+ )}++happyReduce_21 = happySpecReduce_2 7# happyReduction_21+happyReduction_21 happy_x_2+ happy_x_1+ = case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn11+ (read $ '-' : happy_var_2+ )}++happyReduce_22 = happySpecReduce_1 8# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOutTok happy_x_1 of { (TNum happy_var_1) -> + happyIn12+ (happy_var_1+ )}++happyReduce_23 = happySpecReduce_1 8# happyReduction_23+happyReduction_23 happy_x_1+ = happyIn12+ ("1"+ )++happyNewToken action sts stk [] =+ happyDoAction 13# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ TId "unit" -> cont 1#;+ TId happy_dollar_dollar -> cont 2#;+ TNum "1" -> cont 3#;+ TNum happy_dollar_dollar -> cont 4#;+ TComma -> cont 5#;+ TMinus -> cont 6#;+ TExponentiation -> cont 7#;+ TDivision -> cont 8#;+ TDoubleColon -> cont 9#;+ TEqual -> cont 10#;+ TLeftPar -> cont 11#;+ TRightPar -> cont 12#;+ _ -> happyError' (tk:tks)+ }++happyError_ 13# tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b+happyThen = (>>=)+happyReturn :: () => a -> Either AnnotationParseError a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Either AnnotationParseError a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(Token)] -> Either AnnotationParseError a+happyError' = happyError++parseUnit tks = happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++data UnitStatement =+ UnitAssignment (Maybe [String]) UnitOfMeasure+ | UnitAlias String UnitOfMeasure+ deriving Data++instance Show UnitStatement where+ show (UnitAssignment (Just ss) uom) = "= unit (" ++ show uom ++ ") :: " ++ (intercalate "," ss)+ show (UnitAssignment Nothing uom) = "= unit (" ++ show uom ++ ")"+ show (UnitAlias s uom) = "= unit :: " ++ s ++ " = " ++ show uom++data UnitOfMeasure =+ Unitless+ | UnitBasic String+ | UnitProduct UnitOfMeasure UnitOfMeasure+ | UnitQuotient UnitOfMeasure UnitOfMeasure+ | UnitExponentiation UnitOfMeasure UnitPower+ deriving Data++instance Show UnitOfMeasure where+ show Unitless = "1"+ show (UnitBasic s) = s+ show (UnitProduct uom1 uom2) = show uom1 ++ " " ++ show uom2+ show (UnitQuotient uom1 uom2) = show uom1 ++ " / " ++ show uom2+ show (UnitExponentiation uom exp) = show uom ++ "** (" ++ show exp ++ ")"++data UnitPower =+ UnitPowerInteger Integer+ | UnitPowerRational Integer Integer+ deriving Data++instance Show UnitPower where+ show (UnitPowerInteger i) = show i+ show (UnitPowerRational i1 i2) = show i1 ++ "/" ++ show i2++data Token =+ TUnit+ | TComma+ | TDoubleColon+ | TExponentiation+ | TDivision+ | TMinus+ | TEqual+ | TLeftPar+ | TRightPar+ | TId String+ | TNum String+ deriving (Show)++lexer :: String -> Either AnnotationParseError [ Token ]+lexer ('=':xs) = lexer' xs+lexer _ = Left NotAnnotation++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' [] = Right []+lexer' ['\n'] = Right []+lexer' ['\r', '\n'] = Right []+lexer' ['\r'] = Right [] -- windows+lexer' (' ':xs) = lexer' xs+lexer' ('\t':xs) = lexer' xs+lexer' (':':':':xs) = addToTokens TDoubleColon xs+lexer' ('*':'*':xs) = addToTokens TExponentiation xs+lexer' (',':xs) = addToTokens TComma xs+lexer' ('/':xs) = addToTokens TDivision xs+lexer' ('-':xs) = addToTokens TMinus xs+lexer' ('=':xs) = addToTokens TEqual xs+lexer' ('(':xs) = addToTokens TLeftPar xs+lexer' (')':xs) = addToTokens TRightPar xs+lexer' (x:xs)+ | isLetter x = aux (\c -> isAlphaNum c || c `elem` ['\'','_','-']) TId+ | isNumber x = aux isNumber TNum+ | otherwise = failWith $ "Not valid unit syntax at " ++ show (x:xs)+ where+ aux p cons =+ let (target, rest) = span p xs+ in lexer' rest >>= (\tokens -> return $ cons (x:target) : tokens)++unitParser :: String -> Either AnnotationParseError UnitStatement+unitParser src = do+ tokens <- lexer $ map toLower src+ parseUnit tokens++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<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/Analysis/IntermediateReps.hs view
@@ -15,6 +15,7 @@ -} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-} module Camfort.Analysis.IntermediateReps where
src/Camfort/Functionality.hs view
@@ -20,6 +20,8 @@ {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Camfort.Functionality where
src/Camfort/Output.hs view
@@ -77,7 +77,7 @@ show' = show class OutputFiles t where- {-| Given a directory and list of triples of filenames, with their source+ {-| Given a directory and list of triples of filenames, with their source text (if it exists) and their AST, write these to the directory -} mkOutputText :: FileOrDir -> t -> SourceText outputFile :: t -> Filename
+ src/Camfort/Specification/Stencils/Grammar.hs view
@@ -0,0 +1,1131 @@+{-# OPTIONS_GHC -w #-}+-- -*- Mode: Haskell -*-+{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}+module Camfort.Specification.Stencils.Grammar+( specParser, Specification(..), Region(..), Spec(..), Mod(..), lexer ) where++import Data.Char (isLetter, isNumber, isAlphaNum, toLower, isAlpha, isSpace)+import Data.List (intersect, sort, isPrefixOf)+import Data.Data++import Debug.Trace++import Camfort.Analysis.CommentAnnotator+import Camfort.Specification.Stencils.Syntax (showL)+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.5++data HappyAbsSyn + = HappyTerminal (Token)+ | HappyErrorToken Int+ | HappyAbsSyn4 (Specification)+ | HappyAbsSyn5 ((String, Region))+ | HappyAbsSyn6 (Region)+ | HappyAbsSyn7 (Bool)+ | HappyAbsSyn8 (Spec)+ | HappyAbsSyn9 (Mod)+ | HappyAbsSyn10 ([Mod])+ | HappyAbsSyn12 ([String])++{- to allow type-synonyms as our monads (likely+ - with explicitly-specified bind and return)+ - in Haskell98, it seems that with+ - /type M a = .../, then /(HappyReduction M)/+ - is not allowed. But Happy is a+ - code-generator that can just substitute it.+type HappyReduction m = + Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> m HappyAbsSyn+-}++action_0,+ action_1,+ action_2,+ action_3,+ action_4,+ action_5,+ action_6,+ action_7,+ action_8,+ action_9,+ action_10,+ action_11,+ action_12,+ action_13,+ action_14,+ action_15,+ action_16,+ action_17,+ action_18,+ action_19,+ action_20,+ action_21,+ action_22,+ action_23,+ action_24,+ action_25,+ action_26,+ action_27,+ action_28,+ action_29,+ action_30,+ action_31,+ action_32,+ action_33,+ action_34,+ action_35,+ action_36,+ action_37,+ action_38,+ action_39,+ action_40,+ action_41,+ action_42,+ action_43,+ action_44,+ action_45,+ action_46,+ action_47,+ action_48,+ action_49,+ action_50,+ action_51,+ action_52,+ action_53,+ action_54,+ action_55,+ action_56,+ action_57,+ action_58,+ action_59,+ action_60,+ action_61,+ action_62,+ action_63,+ action_64,+ action_65,+ action_66,+ action_67,+ action_68,+ action_69,+ action_70,+ action_71,+ action_72,+ action_73,+ action_74,+ action_75,+ action_76 :: () => Int -> ({-HappyReduction (Either AnnotationParseError) = -}+ Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)++happyReduce_1,+ happyReduce_2,+ happyReduce_3,+ happyReduce_4,+ happyReduce_5,+ happyReduce_6,+ happyReduce_7,+ happyReduce_8,+ happyReduce_9,+ happyReduce_10,+ happyReduce_11,+ happyReduce_12,+ happyReduce_13,+ happyReduce_14,+ happyReduce_15,+ happyReduce_16,+ happyReduce_17,+ happyReduce_18,+ happyReduce_19,+ happyReduce_20,+ happyReduce_21,+ happyReduce_22,+ happyReduce_23,+ happyReduce_24,+ happyReduce_25,+ happyReduce_26 :: () => ({-HappyReduction (Either AnnotationParseError) = -}+ Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Either AnnotationParseError) HappyAbsSyn)++action_0 (13) = happyShift action_5+action_0 (14) = happyShift action_3+action_0 (4) = happyGoto action_4+action_0 (5) = happyGoto action_2+action_0 _ = happyFail++action_1 (14) = happyShift action_3+action_1 (5) = happyGoto action_2+action_1 _ = happyFail++action_2 _ = happyReduce_1++action_3 (28) = happyShift action_21+action_3 _ = happyFail++action_4 (37) = happyAccept+action_4 _ = happyFail++action_5 (15) = happyShift action_11+action_5 (16) = happyShift action_12+action_5 (18) = happyShift action_13+action_5 (19) = happyShift action_14+action_5 (23) = happyShift action_15+action_5 (24) = happyShift action_16+action_5 (25) = happyShift action_17+action_5 (26) = happyShift action_18+action_5 (28) = happyShift action_19+action_5 (34) = happyShift action_20+action_5 (6) = happyGoto action_6+action_5 (8) = happyGoto action_7+action_5 (9) = happyGoto action_8+action_5 (10) = happyGoto action_9+action_5 (11) = happyGoto action_10+action_5 _ = happyFail++action_6 (30) = happyShift action_35+action_6 (31) = happyShift action_36+action_6 _ = happyReduce_19++action_7 (32) = happyShift action_34+action_7 _ = happyFail++action_8 (16) = happyShift action_12+action_8 (23) = happyShift action_15+action_8 (24) = happyShift action_16+action_8 (25) = happyShift action_17+action_8 (28) = happyShift action_19+action_8 (34) = happyShift action_20+action_8 (6) = happyGoto action_33+action_8 _ = happyFail++action_9 (15) = happyShift action_11+action_9 (9) = happyGoto action_32+action_9 _ = happyFail++action_10 (16) = happyShift action_12+action_10 (18) = happyShift action_13+action_10 (19) = happyShift action_14+action_10 (23) = happyShift action_15+action_10 (24) = happyShift action_16+action_10 (25) = happyShift action_17+action_10 (28) = happyShift action_19+action_10 (34) = happyShift action_20+action_10 (6) = happyGoto action_29+action_10 (10) = happyGoto action_30+action_10 (11) = happyGoto action_31+action_10 _ = happyReduce_22++action_11 _ = happyReduce_20++action_12 (34) = happyShift action_28+action_12 _ = happyFail++action_13 _ = happyReduce_23++action_14 _ = happyReduce_24++action_15 (34) = happyShift action_27+action_15 _ = happyFail++action_16 (34) = happyShift action_26+action_16 _ = happyFail++action_17 (34) = happyShift action_25+action_17 _ = happyFail++action_18 (34) = happyShift action_24+action_18 _ = happyFail++action_19 _ = happyReduce_11++action_20 (16) = happyShift action_12+action_20 (23) = happyShift action_15+action_20 (24) = happyShift action_16+action_20 (25) = happyShift action_17+action_20 (28) = happyShift action_19+action_20 (34) = happyShift action_20+action_20 (6) = happyGoto action_23+action_20 _ = happyFail++action_21 (33) = happyShift action_22+action_21 _ = happyFail++action_22 (16) = happyShift action_12+action_22 (23) = happyShift action_15+action_22 (24) = happyShift action_16+action_22 (25) = happyShift action_17+action_22 (28) = happyShift action_19+action_22 (34) = happyShift action_20+action_22 (6) = happyGoto action_48+action_22 _ = happyFail++action_23 (30) = happyShift action_35+action_23 (31) = happyShift action_36+action_23 (35) = happyShift action_47+action_23 _ = happyFail++action_24 (28) = happyShift action_40+action_24 (12) = happyGoto action_46+action_24 _ = happyFail++action_25 (22) = happyShift action_45+action_25 _ = happyFail++action_26 (22) = happyShift action_44+action_26 _ = happyFail++action_27 (22) = happyShift action_43+action_27 _ = happyFail++action_28 (21) = happyShift action_42+action_28 _ = happyFail++action_29 (30) = happyShift action_35+action_29 (31) = happyShift action_36+action_29 _ = happyReduce_18++action_30 _ = happyReduce_21++action_31 (18) = happyShift action_13+action_31 (19) = happyShift action_14+action_31 (10) = happyGoto action_30+action_31 (11) = happyGoto action_31+action_31 _ = happyReduce_22++action_32 (16) = happyShift action_12+action_32 (23) = happyShift action_15+action_32 (24) = happyShift action_16+action_32 (25) = happyShift action_17+action_32 (28) = happyShift action_19+action_32 (34) = happyShift action_20+action_32 (6) = happyGoto action_41+action_32 _ = happyFail++action_33 (30) = happyShift action_35+action_33 (31) = happyShift action_36+action_33 _ = happyReduce_17++action_34 (28) = happyShift action_40+action_34 (12) = happyGoto action_39+action_34 _ = happyFail++action_35 (16) = happyShift action_12+action_35 (23) = happyShift action_15+action_35 (24) = happyShift action_16+action_35 (25) = happyShift action_17+action_35 (28) = happyShift action_19+action_35 (34) = happyShift action_20+action_35 (6) = happyGoto action_38+action_35 _ = happyFail++action_36 (16) = happyShift action_12+action_36 (23) = happyShift action_15+action_36 (24) = happyShift action_16+action_36 (25) = happyShift action_17+action_36 (28) = happyShift action_19+action_36 (34) = happyShift action_20+action_36 (6) = happyGoto action_37+action_36 _ = happyFail++action_37 _ = happyReduce_9++action_38 (31) = happyShift action_36+action_38 _ = happyReduce_8++action_39 _ = happyReduce_2++action_40 (28) = happyShift action_40+action_40 (12) = happyGoto action_54+action_40 _ = happyReduce_26++action_41 (30) = happyShift action_35+action_41 (31) = happyShift action_36+action_41 _ = happyReduce_16++action_42 (33) = happyShift action_53+action_42 _ = happyFail++action_43 (33) = happyShift action_52+action_43 _ = happyFail++action_44 (33) = happyShift action_51+action_44 _ = happyFail++action_45 (33) = happyShift action_50+action_45 _ = happyFail++action_46 (35) = happyShift action_49+action_46 _ = happyFail++action_47 _ = happyReduce_10++action_48 (30) = happyShift action_35+action_48 (31) = happyShift action_36+action_48 _ = happyReduce_3++action_49 (27) = happyShift action_59+action_49 _ = happyReduce_14++action_50 (29) = happyShift action_58+action_50 _ = happyFail++action_51 (29) = happyShift action_57+action_51 _ = happyFail++action_52 (29) = happyShift action_56+action_52 _ = happyFail++action_53 (29) = happyShift action_55+action_53 _ = happyFail++action_54 _ = happyReduce_25++action_55 (35) = happyShift action_63+action_55 _ = happyFail++action_56 (21) = happyShift action_62+action_56 _ = happyFail++action_57 (21) = happyShift action_61+action_57 _ = happyFail++action_58 (21) = happyShift action_60+action_58 _ = happyFail++action_59 _ = happyReduce_15++action_60 (33) = happyShift action_66+action_60 _ = happyFail++action_61 (33) = happyShift action_65+action_61 _ = happyFail++action_62 (33) = happyShift action_64+action_62 _ = happyFail++action_63 _ = happyReduce_7++action_64 (29) = happyShift action_69+action_64 _ = happyFail++action_65 (29) = happyShift action_68+action_65 _ = happyFail++action_66 (29) = happyShift action_67+action_66 _ = happyFail++action_67 (17) = happyShift action_71+action_67 (7) = happyGoto action_73+action_67 _ = happyReduce_13++action_68 (17) = happyShift action_71+action_68 (7) = happyGoto action_72+action_68 _ = happyReduce_13++action_69 (17) = happyShift action_71+action_69 (7) = happyGoto action_70+action_69 _ = happyReduce_13++action_70 (35) = happyShift action_76+action_70 _ = happyFail++action_71 _ = happyReduce_12++action_72 (35) = happyShift action_75+action_72 _ = happyFail++action_73 (35) = happyShift action_74+action_73 _ = happyFail++action_74 _ = happyReduce_6++action_75 _ = happyReduce_5++action_76 _ = happyReduce_4++happyReduce_1 = happySpecReduce_1 4 happyReduction_1+happyReduction_1 (HappyAbsSyn5 happy_var_1)+ = HappyAbsSyn4+ (RegionDec (fst happy_var_1) (snd happy_var_1)+ )+happyReduction_1 _ = notHappyAtAll ++happyReduce_2 = happyReduce 4 4 happyReduction_2+happyReduction_2 ((HappyAbsSyn12 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn8 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn4+ (SpecDec happy_var_2 happy_var_4+ ) `HappyStk` happyRest++happyReduce_3 = happyReduce 4 5 happyReduction_3+happyReduction_3 ((HappyAbsSyn6 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyTerminal (TId happy_var_2)) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn5+ ((happy_var_2, happy_var_4)+ ) `HappyStk` happyRest++happyReduce_4 = happyReduce 10 6 happyReduction_4+happyReduction_4 (_ `HappyStk`+ (HappyAbsSyn7 happy_var_9) `HappyStk`+ (HappyTerminal (TNum happy_var_8)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ (HappyTerminal (TNum happy_var_5)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn6+ (Forward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest++happyReduce_5 = happyReduce 10 6 happyReduction_5+happyReduction_5 (_ `HappyStk`+ (HappyAbsSyn7 happy_var_9) `HappyStk`+ (HappyTerminal (TNum happy_var_8)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ (HappyTerminal (TNum happy_var_5)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn6+ (Backward (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest++happyReduce_6 = happyReduce 10 6 happyReduction_6+happyReduction_6 (_ `HappyStk`+ (HappyAbsSyn7 happy_var_9) `HappyStk`+ (HappyTerminal (TNum happy_var_8)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ (HappyTerminal (TNum happy_var_5)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn6+ (Centered (read happy_var_5) (read happy_var_8) happy_var_9+ ) `HappyStk` happyRest++happyReduce_7 = happyReduce 6 6 happyReduction_7+happyReduction_7 (_ `HappyStk`+ (HappyTerminal (TNum happy_var_5)) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn6+ (Centered 0 (read happy_var_5) True+ ) `HappyStk` happyRest++happyReduce_8 = happySpecReduce_3 6 happyReduction_8+happyReduction_8 (HappyAbsSyn6 happy_var_3)+ _+ (HappyAbsSyn6 happy_var_1)+ = HappyAbsSyn6+ (Or happy_var_1 happy_var_3+ )+happyReduction_8 _ _ _ = notHappyAtAll ++happyReduce_9 = happySpecReduce_3 6 happyReduction_9+happyReduction_9 (HappyAbsSyn6 happy_var_3)+ _+ (HappyAbsSyn6 happy_var_1)+ = HappyAbsSyn6+ (And happy_var_1 happy_var_3+ )+happyReduction_9 _ _ _ = notHappyAtAll ++happyReduce_10 = happySpecReduce_3 6 happyReduction_10+happyReduction_10 _+ (HappyAbsSyn6 happy_var_2)+ _+ = HappyAbsSyn6+ (happy_var_2+ )+happyReduction_10 _ _ _ = notHappyAtAll ++happyReduce_11 = happySpecReduce_1 6 happyReduction_11+happyReduction_11 (HappyTerminal (TId happy_var_1))+ = HappyAbsSyn6+ (Var happy_var_1+ )+happyReduction_11 _ = notHappyAtAll ++happyReduce_12 = happySpecReduce_1 7 happyReduction_12+happyReduction_12 _+ = HappyAbsSyn7+ (False+ )++happyReduce_13 = happySpecReduce_0 7 happyReduction_13+happyReduction_13 = HappyAbsSyn7+ (True+ )++happyReduce_14 = happyReduce 4 8 happyReduction_14+happyReduction_14 (_ `HappyStk`+ (HappyAbsSyn12 happy_var_3) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn8+ (Temporal happy_var_3 False+ ) `HappyStk` happyRest++happyReduce_15 = happyReduce 5 8 happyReduction_15+happyReduction_15 (_ `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn12 happy_var_3) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn8+ (Temporal happy_var_3 True+ ) `HappyStk` happyRest++happyReduce_16 = happySpecReduce_3 8 happyReduction_16+happyReduction_16 (HappyAbsSyn6 happy_var_3)+ (HappyAbsSyn9 happy_var_2)+ (HappyAbsSyn10 happy_var_1)+ = HappyAbsSyn8+ (Spatial (happy_var_1 ++ [happy_var_2]) happy_var_3+ )+happyReduction_16 _ _ _ = notHappyAtAll ++happyReduce_17 = happySpecReduce_2 8 happyReduction_17+happyReduction_17 (HappyAbsSyn6 happy_var_2)+ (HappyAbsSyn9 happy_var_1)+ = HappyAbsSyn8+ (Spatial [happy_var_1] happy_var_2+ )+happyReduction_17 _ _ = notHappyAtAll ++happyReduce_18 = happySpecReduce_2 8 happyReduction_18+happyReduction_18 (HappyAbsSyn6 happy_var_2)+ (HappyAbsSyn9 happy_var_1)+ = HappyAbsSyn8+ (Spatial [happy_var_1] happy_var_2+ )+happyReduction_18 _ _ = notHappyAtAll ++happyReduce_19 = happySpecReduce_1 8 happyReduction_19+happyReduction_19 (HappyAbsSyn6 happy_var_1)+ = HappyAbsSyn8+ (Spatial [] happy_var_1+ )+happyReduction_19 _ = notHappyAtAll ++happyReduce_20 = happySpecReduce_1 9 happyReduction_20+happyReduction_20 _+ = HappyAbsSyn9+ (ReadOnce+ )++happyReduce_21 = happySpecReduce_2 10 happyReduction_21+happyReduction_21 (HappyAbsSyn10 happy_var_2)+ (HappyAbsSyn9 happy_var_1)+ = HappyAbsSyn10+ (happy_var_1 : happy_var_2+ )+happyReduction_21 _ _ = notHappyAtAll ++happyReduce_22 = happySpecReduce_1 10 happyReduction_22+happyReduction_22 (HappyAbsSyn9 happy_var_1)+ = HappyAbsSyn10+ ([happy_var_1]+ )+happyReduction_22 _ = notHappyAtAll ++happyReduce_23 = happySpecReduce_1 11 happyReduction_23+happyReduction_23 _+ = HappyAbsSyn9+ (AtMost+ )++happyReduce_24 = happySpecReduce_1 11 happyReduction_24+happyReduction_24 _+ = HappyAbsSyn9+ (AtLeast+ )++happyReduce_25 = happySpecReduce_2 12 happyReduction_25+happyReduction_25 (HappyAbsSyn12 happy_var_2)+ (HappyTerminal (TId happy_var_1))+ = HappyAbsSyn12+ (happy_var_1 : happy_var_2+ )+happyReduction_25 _ _ = notHappyAtAll ++happyReduce_26 = happySpecReduce_1 12 happyReduction_26+happyReduction_26 (HappyTerminal (TId happy_var_1))+ = HappyAbsSyn12+ ([happy_var_1]+ )+happyReduction_26 _ = notHappyAtAll ++happyNewToken action sts stk [] =+ action 37 37 notHappyAtAll (HappyState action) sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = action i i tk (HappyState action) sts stk tks in+ case tk of {+ TId "stencil" -> cont 13;+ TId "region" -> cont 14;+ TId "readonce" -> cont 15;+ TId "reflexive" -> cont 16;+ TId "irreflexive" -> cont 17;+ TId "atmost" -> cont 18;+ TId "atleast" -> cont 19;+ TId "dims" -> cont 20;+ TId "dim" -> cont 21;+ TId "depth" -> cont 22;+ TId "forward" -> cont 23;+ TId "backward" -> cont 24;+ TId "centered" -> cont 25;+ TId "dependency" -> cont 26;+ TId "mutual" -> cont 27;+ TId happy_dollar_dollar -> cont 28;+ TNum happy_dollar_dollar -> cont 29;+ TPlus -> cont 30;+ TStar -> cont 31;+ TDoubleColon -> cont 32;+ TEqual -> cont 33;+ TLParen -> cont 34;+ TRParen -> cont 35;+ TComma -> cont 36;+ _ -> happyError' (tk:tks)+ }++happyError_ 37 tk tks = happyError' tks+happyError_ _ tk tks = happyError' (tk:tks)++happyThen :: () => Either AnnotationParseError a -> (a -> Either AnnotationParseError b) -> Either AnnotationParseError b+happyThen = (>>=)+happyReturn :: () => a -> Either AnnotationParseError a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Either AnnotationParseError a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [(Token)] -> Either AnnotationParseError a+happyError' = happyError++parseSpec tks = happySomeParser where+ happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })++happySeq = happyDontSeq+++data Specification+ = RegionDec String Region+ | SpecDec Spec [String]+ deriving (Show, Eq, Ord, Typeable, Data)++data Region+ = Forward Int Int Bool+ | Backward Int Int Bool+ | Centered Int Int Bool+ | Or Region Region+ | And Region Region+ | Var String+ deriving (Show, Eq, Ord, Typeable, Data)++data Spec+ = Spatial [Mod] Region+ | Temporal [String] Bool+ deriving (Show, Eq, Ord, Typeable, Data)++data Mod+ = AtLeast+ | AtMost+ | ReadOnce+ deriving (Show, Eq, Ord, Typeable, Data)++--------------------------------------------------++data Token+ = TDoubleColon+ | TStar+ | TPlus+ | TEqual+ | TComma+ | TLParen+ | TRParen+ | TId String+ | TNum String+ deriving (Show)++addToTokens :: Token -> String -> Either AnnotationParseError [ Token ]+addToTokens tok rest = do+ tokens <- lexer' rest+ return $ tok : tokens++stripLeadingWhiteSpace (' ':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\t':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace ('\n':xs) = stripLeadingWhiteSpace xs+stripLeadingWhiteSpace xs = xs+++lexer :: String -> Either AnnotationParseError [ Token ]+lexer input | length (stripLeadingWhiteSpace input) >= 2 =+ case stripLeadingWhiteSpace input of+ -- Check the leading character is '=' for specification+ '=':input' ->+ -- First test to see if the input looks like an actual+ -- specification of either a stencil or region+ if (input' `hasPrefix` "stencil" || input' `hasPrefix` "region")+ then lexer' input'+ else Left NotAnnotation+ _ -> Left NotAnnotation+ where+ hasPrefix [] str = False+ hasPrefix (' ':xs) str = hasPrefix xs str+ hasPrefix xs str = isPrefixOf str xs+lexer _ = Left NotAnnotation+++lexer' :: String -> Either AnnotationParseError [ Token ]+lexer' [] = return []+lexer' (' ':xs) = lexer' xs+lexer' ('\t':xs) = lexer' xs+lexer' (':':':':xs) = addToTokens TDoubleColon xs+lexer' ('*':xs) = addToTokens TStar xs+lexer' ('+':xs) = addToTokens TPlus xs+lexer' ('=':xs) = addToTokens TEqual xs+-- Comma hack: drop commas that are not separating numbers, in order to avoid need for 2-token lookahead.+lexer' (',':xs)+ | x':xs' <- dropWhile isSpace xs, not (isNumber x') = lexer' (x':xs')+ | otherwise = addToTokens TComma xs+lexer' ('(':xs) = addToTokens TLParen xs+lexer' (')':xs) = addToTokens TRParen xs+lexer' (x:xs)+ | isLetter x = aux TId $ \ c -> isAlphaNum c || c == '_'+ | isNumber x = aux TNum isNumber+ | otherwise+ = failWith $ "Not an indentifier " ++ show x+ where+ aux f p = (f target :) `fmap` lexer' rest+ where (target, rest) = span p (x:xs)+lexer' x+ = failWith $ "Not a valid piece of stencil syntax " ++ show x++--------------------------------------------------++-- specParser :: String -> Either AnnotationParseError Specification+specParser :: AnnotationParser Specification+specParser src = do+ tokens <- lexer src+ parseSpec tokens >>= modValidate++-- Check whether modifiers are used correctly+modValidate :: Specification -> Either AnnotationParseError Specification+modValidate (SpecDec (Spatial mods r) vars) =+ do mods' <- modValidate' $ sort mods+ return $ SpecDec (Spatial mods' r) vars++ where modValidate' [] = return $ []++ modValidate' (AtLeast : AtLeast : xs)+ = failWith "Duplicate 'atLeast' modifier; use at most one."++ modValidate' (AtMost : AtMost : xs)+ = failWith "Duplicate 'atMost' modifier; use at most one."++ modValidate' (ReadOnce : ReadOnce : xs)+ = failWith "Duplicate 'readOnce' modifier; use at most one."++ modValidate' (AtLeast : AtMost : xs)+ = failWith $ "Conflicting modifiers: cannot use 'atLeast' and "+ ++ "'atMost' together"++ modValidate' (x : xs)+ = do xs' <- modValidate' xs+ return $ x : xs'+modValidate x = return x++happyError :: [ Token ] -> Either AnnotationParseError a+happyError t = failWith $ "Could not parse specification at: " ++ show t+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<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/Units/InferenceBackend.hs view
@@ -24,7 +24,11 @@ -} -{-# LANGUAGE ScopedTypeVariables, ImplicitParams, DoAndIfThenElse #-}+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Camfort.Specification.Units.InferenceBackend where
src/Camfort/Specification/Units/InferenceFrontend.hs view
@@ -24,8 +24,14 @@ -} -{-# LANGUAGE ScopedTypeVariables, ImplicitParams, DoAndIfThenElse, ConstraintKinds,- MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} module Camfort.Specification.Units.InferenceFrontend (doInferUnits) where @@ -206,7 +212,7 @@ unitsConverted <- convertUnit units case block of bl@(F.BlStatement ann span _ (F.StDeclaration _ _ _ _ decls)) ->- flip mapM_ vars (\var -> + flip mapM_ vars (\var -> mapM_ (processVar' (Just var) [unitsConverted]) (getNamesAndInits decls)) _ -> return () -- Found a derived unit declaration@@ -218,7 +224,7 @@ where processVar' varReal unitC (var, init, span) = do- hasDeclaration <<++ var+ if (Just (realName var) == varReal) then hasDeclaration <<++ var else return () processVar varReal unitC (var, init, span) learnDerivedUnit (name, spec) = do denv <- gets derivedUnitEnv
src/Camfort/Specification/Units/Solve.hs view
@@ -19,7 +19,7 @@ import Data.Ratio import Data.List-import Data.Matrix+import qualified Data.Matrix as DM import qualified Data.Vector as V import Control.Exception import System.IO.Unsafe@@ -46,19 +46,19 @@ solveSystem' :: LinearSystem -> Col -> Row -> Consistency LinearSystem solveSystem' (matrix, vector) m k- | m > ncols matrix = efmap (cutSystem k) $ checkSystem (matrix, vector) k+ | m > DM.ncols matrix = efmap (cutSystem k) $ checkSystem (matrix, vector) k | otherwise = elimRow (matrix, vector) n m k- where n = find (\n -> matrix ! (n, m) /= 0) [k .. nrows matrix]+ where n = find (\n -> matrix DM.! (n, m) /= 0) [k .. DM.nrows matrix] cutSystem :: Int -> LinearSystem -> LinearSystem cutSystem k (matrix, vector) = (matrix', vector')- where matrix' = submatrix 1 (k - 1) 1 (ncols matrix) matrix+ where matrix' = DM.submatrix 1 (k - 1) 1 (DM.ncols matrix) matrix vector' = take (k - 1) vector checkSystem :: LinearSystem -> Row -> Consistency LinearSystem checkSystem (matrix, vector) k- | k > nrows matrix = Ok (matrix, vector)- | vector !! (k - 1) /= Unitful [] = let vars = V.toList $ getRow k matrix+ | k > DM.nrows matrix = Ok (matrix, vector)+ | vector !! (k - 1) /= Unitful [] = let vars = V.toList $ DM.getRow k matrix bad = Bad (matrix, vector) k (vector !! (k - 1), vars) in bad | otherwise = checkSystem (matrix, vector) (k + 1)@@ -67,27 +67,27 @@ elimRow system Nothing m k = solveSystem' system (m + 1) k elimRow (matrix, vector) (Just n) m k = -- (show (m, k)) `D.trace` solveSystem' system' (m + 1) (k + 1)- where matrix' = let s = matrix ! (n, m) in- (if (k == n) then id else switchRows k n)- (if s == 1 then matrix else scaleRow (recip $ s) n matrix)- vector' = switchScaleElems k n (fromRational $ recip $ matrix ! (n, m)) vector+ where matrix' = let s = matrix DM.! (n, m) in+ (if (k == n) then id else DM.switchRows k n)+ (if s == 1 then matrix else DM.scaleRow (recip $ s) n matrix)+ vector' = switchScaleElems k n (fromRational $ recip $ matrix DM.! (n, m)) vector system' = elimRow' (matrix', vector') k m msteeper matrix k m = msteep matrix 1 where- r = nrows matrix+ r = DM.nrows matrix msteep matrix n | n > r = matrix | n == k = msteep matrix (n+1)- | otherwise = let s = (- matrix ! (n, m))+ | otherwise = let s = (- matrix DM.! (n, m)) in if s == 0 then msteep matrix (n+1)- else msteep (combineRows n s k matrix) (n+1)+ else msteep (DM.combineRows n s k matrix) (n+1) elimRow' :: LinearSystem -> Row -> Col -> LinearSystem elimRow' (matrix, vector) k m = (matrix', vector')- where mstep matrix n = let s = (- matrix ! (n, m)) in if s == 0 then matrix else combineRows n s k matrix- matrix' = foldl mstep matrix $ [1 .. k - 1] ++ [k + 1 .. nrows matrix]+ where mstep matrix n = let s = (- matrix DM.! (n, m)) in if s == 0 then matrix else DM.combineRows n s k matrix+ matrix' = foldl mstep matrix $ [1 .. k - 1] ++ [k + 1 .. DM.nrows matrix] --matrix' = msteeper matrix k m- vector'' = [x - fromRational (matrix ! (n, m)) * vector !! (k - 1) | (n, x) <- zip [1..] vector]+ vector'' = [x - fromRational (matrix DM.! (n, m)) * vector !! (k - 1) | (n, x) <- zip [1..] vector] (a, _ : b) = splitAt (k - 1) vector'' vector' = a ++ vector !! (k - 1) : b @@ -101,7 +101,7 @@ solveSystemH :: LinearSystem -> Consistency LinearSystem solveSystemH system@(m,v) = case convertToHMatrix system of- Left (n:_) -> Bad system (nrows m) (v !! n, V.toList (getRow n m))+ Left (n:_) -> Bad system (DM.nrows m) (v !! n, V.toList (DM.getRow n m)) Right (m', units) -> Ok sys' where m2 = rref m'
src/Camfort/Specification/Units/Synthesis.hs view
@@ -38,6 +38,7 @@ import qualified Camfort.Output as O (srcSpanToSrcLocs) import Camfort.Analysis.Annotations hiding (Unitless) import Camfort.Specification.Units.Environment+import qualified Debug.Trace as D -- ************************************* -- Insert unit declarations into code@@ -96,7 +97,7 @@ -- Create a zero-length span for the new comment node span0 = FU.SrcSpan (lp {FU.posColumn = 0}) (lp {FU.posColumn = 0}) - -- Create new annotation which labesl this as a refactored node+ -- Create new annotation which labels this as a refactored node ap = (prevAnnotation (FA.prevAnnotation a)) { refactored = Just loc } a' = a {FA.prevAnnotation = (FA.prevAnnotation a) { prevAnnotation = ap }}
src/Camfort/Transformation/EquivalenceElim.hs view
@@ -15,6 +15,7 @@ -} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE FlexibleContexts #-} module Camfort.Transformation.EquivalenceElim where
src/Camfort/Traverse.hs view
@@ -45,11 +45,6 @@ import Debug.Trace -instance Monoid x => Monad ((,) x) where- return a = (mempty, a)- (x, a) >>= k = let (x', b) = k a- in (mappend x x', b)- -- Data-type generic comonad-style traversal extendBi :: (Biplate (from a) (to a), RComonad to) => (to a -> a) -> (from a) -> (from a)
src/Main.hs view
@@ -129,8 +129,8 @@ ("units-synth", (unitsSynth, "unit-of-measure synthesise specs.")) ] -- * Usage and about information-version = 0.800-introMsg = "CamFort " ++ show version ++ " - Cambridge Fortran Infrastructure."+version = "0.802"+introMsg = "CamFort " ++ version ++ " - Cambridge Fortran Infrastructure." usage = "Usage: camfort <MODE> <INPUT> [OUTPUT] [OPTIONS...]\n" menu = "Refactor functions:\n"