Go back to passing the value to the type-contains function.

This'll make the modification to look at constructors cleaner.
This commit is contained in:
Adam Sampson 2008-04-02 16:11:13 +00:00
parent f515b5ce55
commit bd9c4dae98
2 changed files with 18 additions and 15 deletions

View File

@ -146,8 +146,7 @@ testTypeContains = TestList
Int -> Bool -> a -> b -> Test
test n exp start find
= TestCase $ assertEqual ("testTypeContains " ++ show n)
exp (typeContains (typeKey start)
(typeKey find))
exp (containsTypes start [typeKey find])
--Returns the list of tests:
tests :: Test

View File

@ -24,7 +24,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-- added to in the definition of 'contains').
module GenericUtils (
TypeKey, typeKey
, typeContains
, containsTypes
, gmapMFor
) where
@ -85,14 +85,21 @@ contains = IntMap.fromList [(typeKey t,
where
allTypes = containedTypes (undefined :: A.AST)
-- | Does one type contain another?
-- (A type always contains itself.)
typeContains :: TypeKey -> TypeKey -> Bool
typeContains start target
| start == target = True
| otherwise = case IntMap.lookup start contains of
Just set -> target `IntSet.member` set
Nothing -> True -- can't tell, so it might be
-- | Does a value contain any of the listed types?
-- (A value always contains its own type.)
containsTypes :: Data t => t -> [TypeKey] -> Bool
containsTypes x targets
= or $ map containsType targets
where
start :: TypeKey
start = typeKey x
containsType :: TypeKey -> Bool
containsType target
| start == target = True
| otherwise = case IntMap.lookup start contains of
Just set -> target `IntSet.member` set
Nothing -> True -- can't tell, so it might be
-- | Type-smart generic mapM.
-- This is like 'gmapM', but it only applies the function to arguments that
@ -106,7 +113,4 @@ gmapMFor targets f = gmapM (each f)
each :: (Monad m, Data t) =>
(forall s. Data s => s -> m s) -> (t -> m t)
each f x
= if cont then f x else return x
where
cont = or $ map (typeContains xKey) targets
xKey = typeKey x
= if containsTypes x targets then f x else return x