simplify the Profile type and remove the NameProfile type

This commit is contained in:
krasimir
2008-05-29 10:55:34 +00:00
parent 45e1eedff3
commit 64d3a1226d
8 changed files with 74 additions and 195 deletions

View File

@@ -309,66 +309,6 @@ forest2trees (FMeta) = [TMeta]
----------------------------------------------------------------------
-- * profiles
-- | Pairing a rule name with a profile
data NameProfile a = Name a [Profile (SyntaxForest a)]
deriving (Eq, Ord, Show)
name2fun :: NameProfile a -> a
name2fun (Name fun _) = fun
-- | A profile is a simple representation of a function on a number of arguments.
-- We only use lists of profiles
data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
-- 'Unify []' will become a metavariable,
-- 'Unify [a,b]' means that the arguments are equal,
| Constant a
deriving (Eq, Ord, Show)
instance Functor Profile where
fmap f (Constant a) = Constant (f a)
fmap f (Unify xs) = Unify xs
-- | a function name where the profile does not contain arguments
-- (i.e. denoting a constant, not a function)
constantNameToForest :: NameProfile a -> SyntaxForest a
constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile]
where unConstant (Constant a) = a
unConstant (Unify []) = FMeta
unConstant _ = error $ "constantNameToForest: the profile should not contain arguments"
-- | profile application; we need some way of unifying a list of arguments
applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
applyProfile unify profile args = map apply profile
where apply (Unify xs) = unify $ map (args !!) xs
apply (Constant a) = a
-- | monadic profile application
applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
applyProfileM unify profile args = mapM apply profile
where apply (Unify xs) = unify $ map (args !!) xs
apply (Constant a) = return a
-- | profile composition:
--
-- > applyProfile u z (ps `composeProfiles` qs) args
-- > ==
-- > applyProfile u z ps (applyProfile u z qs args)
--
-- compare with function composition
--
-- > (p . q) arg
-- > ==
-- > p (q arg)
--
-- Note that composing an 'Constant' with two or more arguments returns an error
-- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
composeProfiles ps qs = map compose ps
where compose (Unify [x]) = qs !! x
compose (Unify xs) = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
compose constant = constant
------------------------------------------------------------
-- pretty-printing
@@ -411,13 +351,3 @@ instance (Print s) => Print (SyntaxForest s) where
prt (FFloat f) = show f
prt (FMeta) = "?"
prtList = prtAfter "\n"
instance Print a => Print (Profile a) where
prt (Unify []) = "?"
prt (Unify args) = prtSep "=" args
prt (Constant a) = prt a
instance Print a => Print (NameProfile a) where
prt (Name fun profile) = prt fun ++ prt profile