diff --git a/Control/Hmk.lhs b/Control/Hmk.lhs
--- a/Control/Hmk.lhs
+++ b/Control/Hmk.lhs
@@ -85,10 +85,9 @@
> if x `Set.member` visited then
> error "Cycle detected." else
> case find (\r -> target r == x) rules of
-> Just rule -> mdo
-> let n = Node x ps rule
+> Just rule -> do
> ps <- local (Set.insert x) $ mapM aux (prereqs rule)
-> return n
+> return $ Node x ps rule
> Nothing -> error "Invariant 3 violated."
From the mk(1) manual:
diff --git a/Control/Hmk/IO.lhs b/Control/Hmk/IO.lhs
--- a/Control/Hmk/IO.lhs
+++ b/Control/Hmk/IO.lhs
@@ -19,8 +19,8 @@
This module should be imported qualified.
> module Control.Hmk.IO where
+>
> import Control.Hmk hiding (isStale)
-> import Control.Monad (foldM)
> import System.FilePath
> import System.Posix.Files
> import System.Exit
@@ -44,11 +44,3 @@
> testExitCode :: ExitCode -> IO Result
> testExitCode ExitSuccess = return TaskSuccess
> testExitCode (ExitFailure _) = return TaskFailure
-
-Perform each system action, aborting if an action returns
-non-zero exit code.
-
-> abortOnError :: [IO Result] -> IO Result
-> abortOnError = foldM f TaskSuccess where
-> f TaskSuccess k = k
-> f TaskFailure _ = error "Command exited with non-zero status."
diff --git a/Eval.lhs b/Eval.lhs
--- a/Eval.lhs
+++ b/Eval.lhs
@@ -13,7 +13,7 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see .
-> module Eval (Target(..), eval, evalNoMeta, Eval.isStale, substituteStem) where
+> module Eval (Target(..), Stem(..), eval, evalNoMeta, Eval.isStale, substituteStem) where
>
> import Parse
> import Control.Hmk
@@ -21,16 +21,17 @@
>
> import Data.Sequence (Seq)
> import qualified Data.Sequence as Seq
-> import qualified Data.Traversable as Seq
> import qualified Data.Foldable as Seq
+> import qualified Data.Traversable as Seq
+> import Data.Map (Map)
> import qualified Data.Map as Map
-> import qualified Data.Foldable as Map
> import qualified Data.Set as Set
> import Control.Applicative
> import Control.Monad.State
> import Control.Monad.Writer
> import Data.List (intercalate)
> import Data.Maybe (isNothing)
+> import Data.Char (isDigit)
>
> import System.IO
> import System.Directory
@@ -62,6 +63,7 @@
> data Target = File { name :: FilePath }
> | Virtual { name :: String }
> | Pattern { name :: String }
+> | REPattern { name :: String }
> deriving Show
> newtype RevAppend a = RevAppend a
@@ -104,15 +106,27 @@
because stems are synthesized as a by-product of meta-rule instantiaton, but
this instantiation is performed post evaluation.
-> type Stem = String
+> data Stem = Stem String | RESubMatches [String] | NoStem
>
> addVariable attr var val = do
-> modify (Map.insert var (val :: Seq String))
+> modify (fmap (Map.insert var (val :: Seq String)))
> case attr of
> Export -> liftIO $ setEnv var (freeze val) True
> Local -> return ()
->
-> lookupVariable var = Map.findWithDefault (Seq.empty) var <$> get
+
+The value of a variable is looked up by decreasing order of precedence in the
+following places:
+
+ - assignments on the command line,
+ - assignments in the mkfile,
+ - the environment.
+
+> lookupVariable var = do
+> maybe Seq.empty id . msum <$>
+> sequence [ Map.lookup var . fst <$> get
+> , Map.lookup var . snd <$> get
+> , fmap Seq.singleton <$> liftIO (getEnv var)
+> , return (Just Seq.empty) ]
>
> evalToken (Lit x) = return (Seq.singleton x)
> evalToken (Coll toks) = Seq.singleton <$> Seq.concat <$>
@@ -123,25 +137,24 @@
> var <- evalToken tok
> lookupVariable (freeze var)
>
-> eval :: Mkfile -> IO (Seq (Stem -> Rule IO Target))
-> eval mkfile = evalStateT (init >> go) Map.empty
+> eval :: Map String (Seq String) -> Mkfile -> IO (Seq (Stem -> Rule IO Target))
+> eval cmdline mkfile = evalStateT (init >> go) (cmdline, Map.empty)
> where init = addVariable Export "MKSHELL" (Seq.singleton defaultShell)
> go = mdo (rules, RevAppend virtuals) <- runWriterT (eval' virtuals mkfile)
> return rules
>
> eval' virtuals (Mkrule ts flags ps r cont) = do
-> let tag t = if t `elem` virtuals
-> then Virtual t
-> else case t of
-> '%':_ -> Pattern t
-> _ -> File t
+> flagsv <- evalFlags flags
+> let tag t | t `elem` virtuals = Virtual t
+> | Set.member Flag_R flagsv = REPattern t
+> | '%':_ <- t = Pattern t
+> | otherwise = File t
> tsv <- Seq.msum <$> Seq.mapM evalToken ts
> psv <- fmap tag <$> Seq.msum <$> Seq.mapM evalToken ps
-> flagsv <- evalFlags flags
> shell <- (`Seq.index` 0) <$> lookupVariable "MKSHELL"
-> let f tv stem = let t | Set.member Flag_V flagsv = Virtual tv
-> | '%':_ <- tv = Pattern tv
-> | otherwise = File tv
+> let f tv stem = let t = if Set.member Flag_V flagsv
+> then Virtual tv
+> else tag tv
> rv = if Set.member Flag_N flagsv && isNothing r
> then Just $ evalRecipe tsv t flagsv psv stem shell ("touch " ++ name t)
> else fmap (evalRecipe tsv t flagsv psv stem shell) r
@@ -183,8 +196,12 @@
(Note that unlike make, hmk feeds the entire recipe to the shell rather than
running each line of the recipe separately.)
-> substituteStem stem (Pattern ('%':suffix)) = File (stem ++ suffix)
-> substituteStem stem x = x
+> substituteStem (Stem stem) (Pattern ('%':suffix)) = File (stem ++ suffix)
+> substituteStem (RESubMatches matches) (REPattern pat) = File (subst pat)
+> where subst "" = ""
+> subst ('\\':n:xs) | isDigit n = matches !! (read [n] - 1) ++ subst xs
+> subst (x:xs) = x : subst xs
+> substituteStem _ x = x
>
> evalRecipe alltarget target flags prereq stem shell text newprereq = do
> pid <- show <$> getProcessID
@@ -194,7 +211,12 @@
> setEnv "nproc" (show 0) True
> setEnv "pid" pid True
> setEnv "prereq" (freeze (fmap (name . substituteStem stem) prereq)) True
-> setEnv "stem" stem True
+> case stem of
+> Stem stem -> setEnv "stem" stem True
+> RESubMatches stems -> do
+> let nstems = zip [1..] stems
+> mapM_ (\(n, stem) -> setEnv ("stem" ++ show n) stem True) nstems
+> NoStem -> return ()
> setEnv "target" (name $ substituteStem stem $ target) True
> let p = if Set.member Flag_Q flags
> then proc shell ["-e"]
@@ -248,5 +270,5 @@
Version of eval where stems are instantiated to the empty string.
-> evalNoMeta :: Mkfile -> IO (Seq (Rule IO Target))
-> evalNoMeta mkfile = fmap ($ "") <$> eval mkfile
+> evalNoMeta :: Map String (Seq String) -> Mkfile -> IO (Seq (Rule IO Target))
+> evalNoMeta cmdline mkfile = fmap ($ NoStem) <$> eval cmdline mkfile
diff --git a/Main.lhs b/Main.lhs
--- a/Main.lhs
+++ b/Main.lhs
@@ -34,6 +34,9 @@
> import Control.Applicative
> import qualified Data.Sequence as Seq
> import qualified Data.Foldable as Seq
+> import qualified Data.Map as Map
+> import Data.Either
+> import Data.Char (isAlphaNum)
> import System.IO
> import System.Environment
> import System.Exit
@@ -55,7 +58,7 @@
> , Option ['h'] ["help"] (NoArg OptHelp)
> "This usage information." ]
>
-> usage = "Usage: hmk [OPTION]... [TARGET]..."
+> usage = "Usage: hmk [OPTION]... [ASSIGNMENT]... [TARGET]..."
>
> printUsage = hPutStrLn stderr usage
>
@@ -64,7 +67,18 @@
> putStrLn (usageInfo header options)
>
> bailout = printUsage >> exitFailure
->
+
+The arguments given on the command line can be of the form a=b. This pins the
+value for variable $a to be 'b'. The following function splits out arguments
+of this form from the rest.
+
+> getAssignments :: [String] -> (Map.Map String (Seq.Seq String), [String])
+> getAssignments args = (Map.fromList assigns, targets) where
+> (assigns, targets) = partitionEithers $ map p_assignment args
+> p_assignment arg = case span isAlphaNum arg of
+> (var, '=':rest) -> Left (var, Seq.fromList $ words rest)
+> _ -> Right arg
+
> main :: IO ()
> main = do
> (opts, other, errs) <- getOpt RequireOrder options <$> getArgs
@@ -72,11 +86,11 @@
> hPutStr stderr (concat errs)
> exitFailure
> when (OptHelp `elem` opts) (printHelp >> exitSuccess)
-> let targets = map File other
+> let (assigns, targets) = fmap (map File) (getAssignments other)
> -- number of jobs to run simultaneously.
> slots = foldr (\x y -> case x of OptJobs j -> j; _ -> y) 1 opts
> mkfile = foldr (\x y -> case x of OptMkfile f -> f; _ -> y) "mkfile" opts
-> metarules <- eval =<< parse mkfile <$> readFile mkfile
+> metarules <- eval assigns =<< parse mkfile <$> readFile mkfile
> let rules = Seq.toList $ instantiateRecurse (Seq.fromList targets) metarules
> let arules = if OptAll `elem` opts
> then map (\r -> r{Control.Hmk.isStale = \_ _ -> return True}) rules
diff --git a/Metarule.lhs b/Metarule.lhs
--- a/Metarule.lhs
+++ b/Metarule.lhs
@@ -33,6 +33,7 @@
> 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
@@ -40,8 +41,6 @@
and then recursively instantiates meta-rules with the prerequesites of the
matching rules.
-> type Stem = String
->
> seqFilter :: (a -> Bool) -> Seq a -> Seq a
> seqFilter f = Seq.foldr (\x xs -> if f x then x Seq.<| xs else xs) Seq.empty
>
@@ -58,24 +57,46 @@
> collectMatches (Pattern ('%':suffix)) ts =
> let re = compile ("(.*)" ++ suffix ++ "$") [anchored, dollar_endonly]
> -- The prefix is in the captured sub-pattern at index 1.
-> in seqCatMaybes (fmap (\t -> fmap (!! 1) (match re t [])) (fmap name ts))
+> 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 ($ "") closures
+> where origrules = fmap ($ NoStem) closures
> go targets | Seq.null targets = return Seq.empty
> | otherwise = do
> seen <- get
-> let rules = instantiate targets closures
+> 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
diff --git a/Parse.lhs b/Parse.lhs
--- a/Parse.lhs
+++ b/Parse.lhs
@@ -24,7 +24,6 @@
> import Data.Sequence (Seq)
> import qualified Data.Sequence as Seq
> import Control.Applicative hiding ((<|>), many)
-> import System.FilePath (FilePath)
"A mkfile consists of assignments (described under `Environment') and rules. A
@@ -49,7 +48,7 @@
Rule flags, according to the mk manual for plan9:
- status, the target is deleted.
+D : If the recipe exits with a non-null status, the target is deleted.
E : Continue execution if the recipe draws errors.
diff --git a/hmk.cabal b/hmk.cabal
--- a/hmk.cabal
+++ b/hmk.cabal
@@ -1,5 +1,5 @@
name: hmk
-version: 0.9.5
+version: 0.9.6
author: Mathieu Boespflug
maintainer: Mathieu Boespflug
homepage: http://www.github.com/mboes/hmk
@@ -15,8 +15,8 @@
.
The documentation is embedded in the literate Haskell source.
.
- /Note:/ the library portion is released to the /public
- domain/. Those source files that are not part of the library
+ /Note:/ the library portion is released to the /public domain/.
+ Those source files that are not part of the library
are released under GPLv3 or later.
category: Control, Development, Distribution
license: GPL
@@ -28,7 +28,7 @@
library
build-depends: base < 5, containers
- extensions: RecursiveDo, PatternGuards
+ extensions: PatternGuards
exposed-modules: Control.Hmk
Control.Hmk.Analyze
Control.Hmk.IO
@@ -38,7 +38,7 @@
main-is: Main.lhs
ghc-options: -fwarn-unused-imports
other-modules: Parse, Eval, Metarule
- extensions: RecursiveDo, PatternGuards, NamedFieldPuns
+ extensions: PatternGuards, NamedFieldPuns
build-depends: base < 5, bytestring, containers,
directory, process, unix, filepath >= 1.1,
mtl, parsec >= 3.0.0, pcre-light >= 0.3