From 78b032ace9b0a82496b1a23a11eca10879e15f3a Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 28 Aug 2007 22:25:41 +0000 Subject: [PATCH] Moved castADI into TreeUtil and added more tag helper functions that fill the parameters with DontCare (named tag1d, tag2d, etc) --- RainPassTest.hs | 4 ---- TreeUtil.hs | 35 ++++++++++++++++++++++++++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/RainPassTest.hs b/RainPassTest.hs index 6c420f9..d58b5bf 100644 --- a/RainPassTest.hs +++ b/RainPassTest.hs @@ -50,10 +50,6 @@ simpleDefPattern n am sp = tag7 A.NameDef DontCare n n A.VariableName sp am A.Un skipP :: A.Structured skipP = A.OnlyP m (A.Skip m) -castADI :: (Typeable b) => Maybe AnyDataItem -> Maybe b -castADI (Just (ADI x)) = cast x -castADI Nothing = Nothing - castAssertADI :: (Typeable b) => Maybe AnyDataItem -> IO b castAssertADI x = case (castADI x) of Just y -> return y diff --git a/TreeUtil.hs b/TreeUtil.hs index e3af0c5..41e293f 100644 --- a/TreeUtil.hs +++ b/TreeUtil.hs @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module TreeUtil (MatchErrors, AnyDataItem(..), Items, assertPatternMatch, getMatchedItems, mkPattern, tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7, stopCaringPattern) where +module TreeUtil (MatchErrors, AnyDataItem(..), Items, castADI, assertPatternMatch, getMatchedItems, mkPattern, tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7, tag1d, tag2d, tag3d, tag4d, tag5d, tag6d, tag7d, stopCaringPattern) where import Test.HUnit hiding (State) import qualified Data.Map as Map @@ -47,6 +47,11 @@ instance Eq AnyDataItem where -- from arbitrary string keys to AnyDataItem, which is just a wrapper for any item of class Data type Items = Map.Map String AnyDataItem +castADI :: (Typeable b) => Maybe AnyDataItem -> Maybe b +castADI (Just (ADI x)) = cast x +castADI Nothing = Nothing + + -- | A function that takes a string key (of an item of interest), and a value. -- If the key has NOT been seen before, checkItem merely records its value in the set of items of interest -- If the key has been seen before, checkItem checks that the new (passed) value matches the old value. @@ -259,3 +264,31 @@ tag7 :: (Data a, Data b0, Data b1, Data b2, Data b3, Data b4, Data b5, Data b6) tag7 con x0 x1 x2 x3 x4 x5 x6 = (Match (toConstr con') [mkPattern x0,mkPattern x1,mkPattern x2,mkPattern x3,mkPattern x4,mkPattern x5,mkPattern x6]) where con' = con (undefined :: a0) (undefined :: a1) (undefined :: a2) (undefined :: a3) (undefined :: a4) (undefined :: a5) (undefined :: a6) + +-- | Like tag1, but with DontCare for all the sub-items +tag1d :: (Data a) => (a0 -> a) -> Pattern +tag1d x = tag1 x DontCare + +-- | Like tag2, but with DontCare for all the sub-items +tag2d :: (Data a) => (a0 -> a1 -> a) -> Pattern +tag2d x = tag2 x DontCare DontCare + +-- | Like tag3, but with DontCare for all the sub-items +tag3d :: (Data a) => (a0 -> a1 -> a2 -> a) -> Pattern +tag3d x = tag3 x DontCare DontCare DontCare + +-- | Like tag4, but with DontCare for all the sub-items +tag4d :: (Data a) => (a0 -> a1 -> a2 -> a3 -> a) -> Pattern +tag4d x = tag4 x DontCare DontCare DontCare DontCare + +-- | Like tag5, but with DontCare for all the sub-items +tag5d :: (Data a) => (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> Pattern +tag5d x = tag5 x DontCare DontCare DontCare DontCare DontCare + +-- | Like tag6, but with DontCare for all the sub-items +tag6d :: (Data a) => (a0 -> a1 -> a2 -> a3 -> a4 -> a5 -> a) -> Pattern +tag6d x = tag6 x DontCare DontCare DontCare DontCare DontCare DontCare + +-- | Like tag7, but with DontCare for all the sub-items +tag7d :: (Data a) => (a0 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a) -> Pattern +tag7d x = tag7 x DontCare DontCare DontCare DontCare DontCare DontCare DontCare