Commit 489e385a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add a draft implementation for resolution of Config variables.

parent 0fe624fb
......@@ -118,7 +118,6 @@ argWithStagedBuilder :: (Stage -> Builder) -> Settings
argWithStagedBuilder f =
msum $ map (\s -> stage s ? argWithBuilder (f s)) [Stage0 ..]
-- Accessing key value pairs from package-data.mk files
argPackageKey :: Settings
argPackageKey = return $ PackageData "PACKAGE_KEY"
......@@ -165,35 +164,36 @@ argPrefix prefix = fmap (Fold Concat . (arg prefix |>) . return)
argPrefixPath :: String -> Settings -> Settings
argPrefixPath prefix = fmap (Fold ConcatPath . (arg prefix |>) . return)
-- Partially evaluate Settings using a truth-teller (compute a 'projection')
project :: (BuildVariable -> Maybe Bool) -> Settings -> Settings
-- Partially evaluate expression using a truth-teller (compute a 'projection')
project :: (BuildVariable -> Maybe Bool) -> BuildExpression v
-> BuildExpression v
project _ Epsilon = Epsilon
project t (Vertex v) = Vertex v -- TODO: go deeper
project t (Overlay l r) = Overlay (project t l) (project t r)
project t (Sequence l r) = Sequence (project t l) (project t r)
project t (Condition l r) = Condition (evaluate t l) (project t r)
-- Partial evaluation of settings
setPackage :: Package -> Settings -> Settings
-- Partial evaluation of setting
setPackage :: Package -> BuildExpression v -> BuildExpression v
setPackage = project . matchPackage
setBuilder :: Builder -> Settings -> Settings
setBuilder :: Builder -> BuildExpression v -> BuildExpression v
setBuilder = project . matchBuilder
setBuilderFamily :: (Stage -> Builder) -> Settings -> Settings
setBuilderFamily :: (Stage -> Builder) -> BuildExpression v
-> BuildExpression v
setBuilderFamily = project . matchBuilderFamily
setStage :: Stage -> Settings -> Settings
setStage :: Stage -> BuildExpression v -> BuildExpression v
setStage = project . matchStage
setWay :: Way -> Settings -> Settings
setWay :: Way -> BuildExpression v -> BuildExpression v
setWay = project . matchWay
setFile :: FilePath -> Settings -> Settings
setFile :: FilePath -> BuildExpression v -> BuildExpression v
setFile = project . matchFile
setConfig :: String -> String -> Settings -> Settings
setConfig :: String -> String -> BuildExpression v -> BuildExpression v
setConfig key = project . matchConfig key
--type ArgsTeller = Args -> Maybe [String]
......
......@@ -21,8 +21,8 @@ module Expression.Build (
import Control.Applicative
import Base
import Ways
import Package (Package)
import Oracles.Builder
import Package (Package)
import Expression.PG
-- Build variables that can be used in build predicates
......
{-# LANGUAGE FlexibleInstances #-}
module Expression.Resolve (
ResolveConfig (..)
) where
import Base
import Oracles.Base
import Expression.PG
import Expression.Predicate
import Expression.Base
import Expression.Build
-- Resolve configuration variables
class ResolveConfig a where
resolveConfig :: a -> Action a
-- resolveConfig = return . id
instance ResolveConfig BuildPredicate where
resolveConfig p @ (Evaluated _) = return p
resolveConfig (Unevaluated (ConfigVariable key value)) = do
lookup <- askConfig key
return $ Evaluated $ lookup == value
resolveConfig p @ (Unevaluated _) = return p
resolveConfig (Not p) = do
p' <- resolveConfig p
return $ Not p'
resolveConfig (And p q) = do
p' <- resolveConfig p
q' <- resolveConfig q
return $ And p' q'
resolveConfig (Or p q) = do
p' <- resolveConfig p
q' <- resolveConfig q
return $ Or p' q'
instance ResolveConfig (BuildExpression v) where
resolveConfig Epsilon = return Epsilon
resolveConfig v @ (Vertex _) = return v -- TODO: go deeper
resolveConfig (Overlay l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
return $ Overlay l' r'
resolveConfig (Sequence l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
return $ Sequence l' r'
resolveConfig (Condition l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
return $ Condition l' r'
......@@ -4,7 +4,9 @@ import Oracles
import Package
import Targets
import Settings
import Expression.Base
import Expression.Simplify
import Expression.Resolve
main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
oracleRules
......@@ -13,6 +15,40 @@ main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
--packageRules
action $ do
putNormal $ "targetPackages = " ++ show (simplify targetPackages)
putNormal $ "\ntargetWays = " ++ show (simplify targetWays)
putNormal $ "\ntargetPackages = " ++ show (simplify targetPackages)
putNormal $ "\n\ntargetWays = " ++ show (simplify targetWays)
putNormal $ "\n\n=============================\n"
-- Read config file
targetPackages' <- resolveConfig targetPackages
targetWays' <- resolveConfig targetWays
-- Build stages
forM_ [Stage0 ..] $ \stage -> do
putNormal $ "Stage = " ++ show stage
let packages = setStage stage targetPackages'
ways = setStage stage targetWays'
putNormal $ "\n packages = " ++ show (simplify packages)
putNormal $ "\n ways = " ++ show (simplify ways)
--forM_ targetPackages $ \pkg @ (Package name path _ todo) -> do
-- forM_ todo $ \todoItem @ (stage, dist, settings) -> do
-- -- Want top .o and .a files for the pkg/todo combo
-- -- We build *only one* vanilla .o file (not sure why)
-- -- We build .way_a file for each way (or its dynamic version).
-- -- TODO: Check BUILD_GHCI_LIB flag to decide if .o is needed
-- -- TODO: move this into a separate file (perhaps, to Targets.hs?)
-- action $ when (buildWhen settings) $ do
-- let pathDist = path </> dist
-- buildDir = pathDist </> "build"
-- key <- showArg (PackageKey pathDist)
-- let oFile = buildDir </> "Hs" ++ key <.> "o"
-- ways' <- ways settings
-- libFiles <- forM ways' $ \way -> do
-- extension <- libsuf way
-- return $ buildDir </> "libHs" ++ key <.> extension
-- need $ [oFile] ++ libFiles
-- -- Build rules for the package
-- buildPackage pkg todoItem
......@@ -26,7 +26,7 @@ targetPackages = msum
packagesStage0 :: Packages
packagesStage0 = msum
[ fromList [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
, windowsHost && not (targetOs "ios") ? return terminfo ]
, not windowsHost && not (targetOs "ios") ? return terminfo ]
packagesStage1 :: Packages
packagesStage1 = msum
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment