Rename Target fields: sources -> inputs, files -> outputs.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 26 Sep 2015 22:35:57 +0000 (23:35 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 26 Sep 2015 22:35:57 +0000 (23:35 +0100)
16 files changed:
doc/demo.txt
src/Expression.hs
src/Oracles/ArgsHash.hs
src/Predicates.hs
src/Rules/Actions.hs
src/Settings/Builders/Alex.hs
src/Settings/Builders/Ar.hs
src/Settings/Builders/Gcc.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/Haddock.hs
src/Settings/Builders/Happy.hs
src/Settings/Builders/HsCpp.hs
src/Settings/Builders/Hsc2Hs.hs
src/Settings/Builders/Ld.hs
src/Stage.hs
src/Target.hs

index 2c8bf75..7b3484b 100644 (file)
@@ -18,4 +18,6 @@
 * Alex3 variable not needed as Alex 3.1 is required\r
 * There are no generated *.y/*.ly files, hence they can never be in the build directory\r
 * hsc2hs gets multuple "--cflag=-I$1/$2/build/autogen" flags in one invokation\r
-* No generated Haskell files actually require copying of *.(l)hs-boot files
\ No newline at end of file
+* No generated Haskell files actually require copying of *.(l)hs-boot files\r
+* Postprocessing primops.txt to remove lines starting with '#pragma GCC'\r
+* Use of IRIX_MAJOR variable that is never set while generating ghc_platform_boot.h
\ No newline at end of file
index f3d08b5..208566c 100644 (file)
@@ -10,8 +10,8 @@ module Expression (
     Target, PartialTarget (..), fromPartial, fullTarget, fullTargetWithWay,
     apply, append, arg, remove, appendSub, appendSubD, filterSub, removeSub,
     interpret, interpretPartial, interpretWithStage, interpretDiff,
-    getStage, getPackage, getBuilder, getFiles, getSources, getWay,
-    getSource, getFile
+    getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
+    getInput, getOutput
     ) where
 
 import Base
@@ -152,25 +152,25 @@ getBuilder = asks builder
 getWay :: Expr Way
 getWay = asks way
 
-getSources :: Expr [FilePath]
-getSources = asks sources
+getInputs :: Expr [FilePath]
+getInputs = asks inputs
 
--- Run getSources and check that the result contains a single file only
-getSource :: Expr FilePath
-getSource = do
+-- Run getInputs and check that the result contains a single input file only
+getInput :: Expr FilePath
+getInput = do
     target <- ask
-    getSingleton getSources $
-        "getSource: exactly one source expected in target " ++ show target
+    getSingleton getInputs $
+        "getInput: exactly one input file expected in target " ++ show target
 
-getFiles :: Expr [FilePath]
-getFiles = asks files
+getOutputs :: Expr [FilePath]
+getOutputs = asks outputs
 
--- Run getFiles and check that the result contains a single file only
-getFile :: Expr FilePath
-getFile = do
+-- Run getOutputs and check that the result contains a output file only
+getOutput :: Expr FilePath
+getOutput = do
     target <- ask
-    getSingleton getFiles $
-        "getFile: exactly one file expected in target " ++ show target
+    getSingleton getOutputs $
+        "getOutput: exactly one output file expected in target " ++ show target
 
 getSingleton :: Expr [a] -> String -> Expr a
 getSingleton expr msg = do
index ab4993b..1f4c584 100644 (file)
@@ -22,7 +22,7 @@ newtype ArgsHashKey = ArgsHashKey Target
 -- TODO: Hash Target to improve accuracy and performance.
 checkArgsHash :: Target -> Action ()
 checkArgsHash target = when trackBuildSystem $ do
-    _ <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
+    _ <- askOracle . ArgsHashKey $ target { inputs = ["src"] } :: Action Int
     return ()
 
 -- Oracle for storing per-target argument list hashes
index 13482b7..be52d3a 100644 (file)
@@ -27,7 +27,7 @@ stagedBuilder :: (Stage -> Builder) -> Predicate
 stagedBuilder sb = (builder . sb) =<< getStage
 
 file :: FilePattern -> Predicate
-file f = fmap (any (f ?==)) getFiles
+file f = fmap (any (f ?==)) getOutputs
 
 way :: Way -> Predicate
 way w = fmap (w ==) getWay
index 5f15f3d..cdc2e17 100644 (file)
@@ -26,13 +26,13 @@ buildWithResources rs target = do
             Ar -> arCmd path argList
 
             HsCpp -> do
-                let file = head $ Target.files target  -- TODO: ugly
+                let file = head $ Target.outputs target  -- TODO: ugly
                 Stdout output <- cmd [path] argList
                 writeFileChanged file output
 
             GenPrimopCode -> do
-                let src  = head $ Target.sources target -- TODO: ugly
-                    file = head $ Target.files   target
+                let src  = head $ Target.inputs target -- TODO: ugly
+                    file = head $ Target.outputs target
                 input <- readFile' src
                 Stdout output <- cmd (Stdin input) [path] argList
                 writeFileChanged file output
index 257fd58..239ae85 100644 (file)
@@ -5,15 +5,12 @@ import GHC (compiler)
 import Predicates (builder, package)
 
 alexArgs :: Args
-alexArgs = builder Alex ? do
-    src  <- getSource
-    file <- getFile
-    mconcat [ arg "-g"
-            , package compiler ? arg "--latin1"
-            , arg src
-            , arg "-o", arg file ]
+alexArgs = builder Alex ? mconcat [ arg "-g"
+                                  , package compiler ? arg "--latin1"
+                                  , arg =<< getInput
+                                  , arg "-o", arg =<< getOutput ]
 
--- TODO:
+-- TODO: separate arguments into builder-specific and package-specific
 -- compilierArgs = package compiler ? builder Alex ? arg "awe"
 
 -- args = mconcat
index 7b6eb59..82d6204 100644 (file)
@@ -5,12 +5,9 @@ import Oracles
 import Predicates (builder)
 
 arArgs :: Args
-arArgs = builder Ar ? do
-    file <- getFile
-    objs <- getSources
-    mconcat [ arg "q"
-            , arg file
-            , append objs ]
+arArgs = builder Ar ? mconcat [ arg "q"
+                              , arg =<< getOutput
+                              , append =<< getInputs ]
 
 -- This count includes arg "q" and arg file parameters in arArgs (see above).
 -- Update this value appropriately when changing arArgs.
index a98a1f6..6a45740 100644 (file)
@@ -6,30 +6,24 @@ import Predicates (stagedBuilder)
 import Settings
 
 gccArgs :: Args
-gccArgs = stagedBuilder Gcc ? do
-    file <- getFile
-    src  <- getSource
-    mconcat [ commonGccArgs
-            , arg "-c"
-            , arg src
-            , arg "-o"
-            , arg file ]
+gccArgs = stagedBuilder Gcc ? mconcat [ commonGccArgs
+                                      , arg "-c", arg =<< getInput
+                                      , arg "-o", arg =<< getOutput ]
 
 -- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
 gccMArgs :: Args
 gccMArgs = stagedBuilder GccM ? do
-    file <- getFile
-    src  <- getSource
+    output <- getOutput
     mconcat [ arg "-E"
             , arg "-MM"
             , commonGccArgs
             , arg "-MF"
-            , arg file
+            , arg output
             , arg "-MT"
-            , arg $ dropExtension file -<.> "o"
+            , arg $ dropExtension output -<.> "o"
             , arg "-x"
             , arg "c"
-            , arg src ]
+            , arg =<< getInput ]
 
 commonGccArgs :: Args
 commonGccArgs = do
index 5ab520e..ad34e19 100644 (file)
@@ -11,30 +11,25 @@ import Settings
 --     $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
 --     $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
 ghcArgs :: Args
-ghcArgs = stagedBuilder Ghc ? do
-    file <- getFile
-    srcs <- getSources
-    mconcat [ commonGhcArgs
-            , arg "-H32m"
-            , stage0    ? arg "-O"
-            , notStage0 ? arg "-O2"
-            , arg "-Wall"
-            , arg "-fwarn-tabs"
-            , splitObjects ? arg "-split-objs"
-            , arg "-c", append srcs
-            , arg "-o", arg file ]
+ghcArgs = stagedBuilder Ghc ? mconcat [ commonGhcArgs
+                                      , arg "-H32m"
+                                      , stage0    ? arg "-O"
+                                      , notStage0 ? arg "-O2"
+                                      , arg "-Wall"
+                                      , arg "-fwarn-tabs"
+                                      , splitObjects ? arg "-split-objs"
+                                      , arg "-c", append =<< getInputs
+                                      , arg "-o", arg =<< getOutput ]
 
 ghcMArgs :: Args
 ghcMArgs = stagedBuilder GhcM ? do
     ways <- getWays
-    file <- getFile
-    srcs <- getSources
     mconcat [ arg "-M"
             , commonGhcArgs
             , arg "-include-pkg-deps"
-            , arg "-dep-makefile", arg file
+            , arg "-dep-makefile", arg =<< getOutput
             , append $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
-            , append srcs ]
+            , append =<< getInputs ]
 
 -- This is included into ghcArgs, ghcMArgs and haddockArgs.
 commonGhcArgs :: Args
index 2cd26d0..57e5abb 100644 (file)
@@ -8,8 +8,7 @@ import Settings.Builders.Ghc
 
 haddockArgs :: Args
 haddockArgs = builder Haddock ? do
-    file     <- getFile
-    srcs     <- getSources
+    output   <- getOutput
     pkg      <- getPackage
     path     <- getTargetPath
     version  <- getPkgData Version
@@ -19,10 +18,10 @@ haddockArgs = builder Haddock ? do
     depNames <- getPkgDataList DepNames
     ghcOpts  <- fromDiffExpr commonGhcArgs
     mconcat
-        [ arg $ "--odir=" ++ takeDirectory file
+        [ arg $ "--odir=" ++ takeDirectory output
         , arg "--verbosity=0"
         , arg "--no-tmp-comp-dir"
-        , arg $ "--dump-interface=" ++ file
+        , arg $ "--dump-interface=" ++ output
         , arg "--html"
         , arg "--hoogle"
         , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis
@@ -39,7 +38,7 @@ haddockArgs = builder Haddock ? do
         , specified HsColour ?
           arg "--source-entity=src/%{MODULE/./-}.html\\#%{NAME}"
         , customPackageArgs
-        , append srcs
+        , append =<< getInputs
         , arg "+RTS"
         , arg $ "-t" ++ path </> "haddock.t"
         , arg "--machine-readable" ]
index 685c30d..82a3c29 100644 (file)
@@ -4,10 +4,7 @@ import Expression
 import Predicates (builder)
 
 happyArgs :: Args
-happyArgs = builder Happy ? do
-    src  <- getSource
-    file <- getFile
-    mconcat [ arg "-agc"
-            , arg "--strict"
-            , arg src
-            , arg "-o", arg file ]
+happyArgs = builder Happy ? mconcat [ arg "-agc"
+                                    , arg "--strict"
+                                    , arg =<< getInput
+                                    , arg "-o", arg =<< getOutput ]
index cad2897..807d4d5 100644 (file)
@@ -5,16 +5,13 @@ import Oracles
 import Predicates (builder)
 import Settings.Builders.GhcCabal
 
--- TODO: why process the result with grep -v '^#pragma GCC'? No such lines!
 hsCppArgs :: Args
 hsCppArgs = builder HsCpp ? do
     stage <- getStage
-    src   <- getSource
-    args  <- getSettingList HsCppArgs
-    mconcat [ append args
+    mconcat [ append =<< getSettingList HsCppArgs
             , arg "-P"
             , cppArgs
             , arg $ "-Icompiler/stage" ++ show (succ stage)
             , arg "-x"
             , arg "c"
-            , arg src ]
+            , arg =<< getInput ]
index dcf44fc..0e31b4f 100644 (file)
@@ -9,8 +9,6 @@ import Settings.Builders.GhcCabal hiding (cppArgs)
 hsc2HsArgs :: Args
 hsc2HsArgs = builder Hsc2Hs ? do
     stage   <- getStage
-    src     <- getSource
-    file    <- getFile
     ccPath  <- lift . builderPath $ Gcc stage
     gmpDirs <- getSettingList GmpIncludeDirs
     cFlags  <- getCFlags
@@ -34,8 +32,8 @@ hsc2HsArgs = builder Hsc2Hs ? do
             , notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1")
             , notStage0 ? arg ("--cflag=-D" ++ tOs   ++ "_HOST_OS=1"  )
             , arg ("--cflag=-D__GLASGOW_HASKELL__=" ++ version)
-            , arg src
-            , arg "-o", arg file ]
+            , arg =<< getInput
+            , arg "-o", arg =<< getOutput ]
 
 getCFlags :: Expr [String]
 getCFlags = fromDiffExpr $ do
index 68d9878..1b61bb2 100644 (file)
@@ -6,10 +6,8 @@ import Predicates (builder)
 
 ldArgs :: Args
 ldArgs = builder Ld ? do
-    file <- getFile
-    objs <- getSources
     args <- getSettingList . ConfLdLinkerArgs =<< getStage
     mconcat [ append args
             , arg "-r"
-            , arg "-o", arg file
-            , append objs ]
+            , arg "-o", arg =<< getOutput
+            , append =<< getInputs ]
index e0a6124..f4e39b0 100644 (file)
@@ -4,7 +4,6 @@ module Stage (Stage (..)) where
 import Base
 import GHC.Generics (Generic)
 
--- TODO: rename to something more meaningful, e.g. 'Stage0' -> 'Boot'.
 -- TODO: explain stages
 data Stage = Stage0 | Stage1 | Stage2 | Stage3 deriving (Eq, Enum, Generic)
 
index 257a896..c70790d 100644 (file)
@@ -22,8 +22,8 @@ data Target = Target
         package :: Package,
         builder :: Builder,
         way     :: Way,
-        sources :: [FilePath], -- input
-        files   :: [FilePath]  -- output
+        inputs  :: [FilePath],
+        outputs :: [FilePath]
      }
      deriving (Show, Eq, Generic)
 
@@ -47,8 +47,8 @@ fromPartial (PartialTarget s p) = Target
         package = p,
         builder = error "fromPartial: builder not set",
         way     = error "fromPartial: way not set",
-        sources = error "fromPartial: sources not set",
-        files   = error "fromPartial: files not set"
+        inputs  = error "fromPartial: inputs not set",
+        outputs = error "fromPartial: outputs not set"
     }
 
 -- Construct a full target by augmenting a PartialTarget with missing fields.
@@ -60,8 +60,8 @@ fullTarget (PartialTarget s p) b srcs fs = Target
         package = p,
         builder = b,
         way     = vanilla,
-        sources = map unifyPath srcs,
-        files   = map unifyPath fs
+        inputs  = map unifyPath srcs,
+        outputs = map unifyPath fs
     }
 
 -- Use this function to be explicit about the build way.