Copyright (C) 2009 Mathieu Boespflug
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
> module Metarule (instantiate, instantiateRecurse) where
>
> import Control.Hmk
> import Eval
>
> import Data.Sequence (Seq)
> import qualified Data.Sequence as Seq
> import qualified Data.Foldable as Seq
> import qualified Data.Set as Set
> import Control.Applicative
> import Control.Monad.State
>
> import Text.Regex.PCRE.Light.Char8
Remove any uninstantiated meta-rule.
> cleanup :: Seq (Rule a Target) -> Seq (Rule a Target)
> cleanup = Seq.foldr f Seq.empty where
> f r rs = case target r of
> Pattern _ -> rs
> REPattern _ -> rs
> _ -> r Seq.<| rs
Instantiation of meta-rules. 'instantiate' is a helper function for
'instantiateRecurse', which instantiates meta-rules based on current targets
and then recursively instantiates meta-rules with the prerequesites of the
matching rules.
> seqFilter :: (a -> Bool) -> Seq a -> Seq a
> seqFilter f = Seq.foldr (\x xs -> if f x then x Seq.<| xs else xs) Seq.empty
>
> seqCatMaybes :: Seq (Maybe a) -> Seq a
> seqCatMaybes = Seq.foldr (\x xs -> maybe xs (Seq.<| xs) x) Seq.empty
>
> instantiate :: Seq Target -- ^ Targets.
> -> Seq (Stem -> Rule a Target)
> -> Seq (Rule a Target)
> instantiate targets closures = join $ fmap f closures where
> f clo = let schema = target (clo undefined)
> stems = collectMatches schema targets
> in fmap (\stem -> expand stem (clo stem)) stems
> collectMatches (Pattern ('%':suffix)) ts =
> let re = compile ("(.*)" ++ suffix ++ "$") [anchored, dollar_endonly]
> -- The prefix is in the captured sub-pattern at index 1.
> in fmap Stem $ seqCatMaybes (fmap (\t -> fmap (!! 1) (match re t [])) (fmap name ts))
> collectMatches s ts = Seq.empty
> -- Substitute the stem for the percent characters in targets and
> -- prerequesites.
> expand stem r@Rule{target,prereqs} = r { target = substituteStem stem target
> , prereqs = map (substituteStem stem) prereqs }
Also instantiate meta-rules whose patterns are regular expressions.
> instantiateRE :: Seq Target -- ^ Targets.
> -> Seq (Stem -> Rule a Target)
> -> Seq (Rule a Target)
> instantiateRE targets closures = join $ fmap f closures where
> f clo = let schema = target (clo undefined)
> matchdata = collectMatches schema targets
> in fmap (\(match, subs) -> expand match subs (clo subs)) matchdata
> collectMatches (REPattern re_string) ts =
> let re = compile re_string []
> -- Match is first element, captured submatches are in the tail.
> in fmap (\xs -> (head xs, RESubMatches (tail xs))) $
> seqCatMaybes (fmap (\t -> match re t []) (fmap name ts))
> collectMatches s ts = Seq.empty
> -- Substitute match for target and submatches for references in
> -- prerequesites.
> expand match submatches r@Rule{target,prereqs} =
> r { target = File match
> , prereqs = map (substituteStem submatches) prereqs }
> instantiateRecurse :: Seq Target
> -> Seq (Stem -> Rule a Target)
> -> Seq (Rule a Target)
> instantiateRecurse targets closures =
> let new = evalState (go targets) Set.empty
> in cleanup origrules Seq.>< new
> where origrules = fmap ($ NoStem) closures
> go targets | Seq.null targets = return Seq.empty
> | otherwise = do
> seen <- get
> let rules = --instantiate targets closures Seq.><
> instantiateRE targets closures
> ts = (Set.\\ seen) $ Set.unions $ Seq.toList $
> fmap (Set.fromList . prereqs) $
> seqFilter (\r -> target r `Seq.elem` targets) origrules
> put (seen `Set.union` ts)
> (rules Seq.><) <$> go (Seq.fromList (Set.toList ts))