module Ideas.Common.Strategy.Prefix
( Prefix, emptyPrefix, makePrefix
, prefixToSteps, prefixTree, stepsToRules, lastStepInPrefix, activeLabels
) where
import Control.Monad
import Data.List
import Data.Maybe
import Ideas.Common.DerivationTree
import Ideas.Common.Rule
import Ideas.Common.Strategy.Abstract
import Ideas.Common.Strategy.Parsing
data Prefix a = P (State LabelInfo a)
prefixPair :: Prefix a -> (Int, [Bool])
prefixPair (P s) = (length (trace s), reverse (choices s))
prefixIntList :: Prefix a -> [Int]
prefixIntList = f . prefixPair
where
f (0, []) = []
f (n, bs) = n : map (\b -> if b then 0 else 1) bs
instance Show (Prefix a) where
show = show . prefixIntList
instance Eq (Prefix a) where
a == b = prefixPair a == prefixPair b
emptyPrefix :: LabeledStrategy a -> Prefix a
emptyPrefix = fromMaybe (error "emptyPrefix") . makePrefix []
makePrefix :: Monad m => [Int] -> LabeledStrategy a -> m (Prefix a)
makePrefix [] ls = makePrefix [0] ls
makePrefix (i:is) ls = liftM P $
replay i (map (==0) is) (mkCore ls)
where
mkCore = processLabelInfo id . toCore . toStrategy
prefixTree :: Bool -> Prefix a -> a -> DerivationTree (Prefix a) a
prefixTree search (P s) a = fmap value $ updateAnnotations (\_ _ -> P) $
parseDerivationTree search s {value = a}
prefixToSteps :: Prefix a -> [Step LabelInfo a]
prefixToSteps (P t) = reverse (trace t)
stepsToRules :: [Step l a] -> [Rule a]
stepsToRules xs = [ r | RuleStep _ r <- xs ]
lastStepInPrefix :: Prefix a -> Maybe (Step LabelInfo a)
lastStepInPrefix (P t) = listToMaybe (trace t)
activeLabels :: Prefix a -> [LabelInfo]
activeLabels p = nub [l | Enter l <- steps] \\ [l | Exit l <- steps]
where
steps = prefixToSteps p