Moved castADI into TreeUtil and added more tag helper functions that fill the parameters with DontCare (named tag1d, tag2d, etc)

This commit is contained in:
Neil Brown 2007-08-28 22:25:41 +00:00
parent 005dbd4d87
commit 78b032ace9
2 changed files with 34 additions and 5 deletions

View File

@ -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

View File

@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>.
-}
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