[commit: ghc] wip/nfs-locking: Add comments, rename interpretDiff to interpret. (238398a)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:58:35 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/238398a839967ceb0dfc8f6e013a23f8551d67f5/ghc

>---------------------------------------------------------------

commit 238398a839967ceb0dfc8f6e013a23f8551d67f5
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Jul 13 16:13:58 2015 +0100

    Add comments, rename interpretDiff to interpret.


>---------------------------------------------------------------

238398a839967ceb0dfc8f6e013a23f8551d67f5
 src/Expression.hs | 51 +++++++++++++++++++++++++++++++++++----------------
 src/Rules.hs      |  2 +-
 src/Rules/Data.hs |  2 +-
 3 files changed, 37 insertions(+), 18 deletions(-)

diff --git a/src/Expression.hs b/src/Expression.hs
index 46b3c40..88561eb 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -7,7 +7,7 @@ module Expression (
     Settings, Ways, Packages,
     Target (..), stageTarget, stagePackageTarget,
     append, appendM, remove, appendSub, appendSubD, filterSub, removeSub,
-    interpret, interpretDiff,
+    interpret, interpretExpr,
     applyPredicate, (?), (??), stage, package, builder, file, way,
     configKeyValue, configKeyValues
     ) where
@@ -19,6 +19,9 @@ import Package
 import Data.Monoid
 import Control.Monad.Reader
 
+-- Target captures parameters relevant to the current build target: Stage and
+-- Package being built, Builder that is to be invoked, file(s) that are to
+-- be built and the Way they are to be built.
 data Target = Target
      {
         getStage   :: Stage,
@@ -48,24 +51,40 @@ stagePackageTarget stage package = Target
         getWay     = error "stagePackageTarget: Way not set"
     }
 
+-- Expr a is a computation that produces a value of type Action a and can read
+-- parameters of the current build Target.
+type Expr a = ReaderT Target Action a
+
+-- If values of type a form a Monoid then so do computations of type Expr a:
+-- * the empty computation returns the identity element of the underlying type
+-- * two computations can be combined by combining their results
+instance Monoid a => Monoid (Expr a) where
+    mempty  = return mempty
+    mappend = liftM2 mappend
+
+-- Diff a holds functions of type a -> a and is equipped with a Monoid instance.
 -- We could use Dual (Endo a) instead of Diff a, but the former may look scary.
+-- The name comes from "difference lists".
 newtype Diff a = Diff { fromDiff :: a -> a }
 
+-- DiffExpr a is a computation that builds a difference list (i.e., a function
+-- of type Action (a -> a)) and can read parameters of the current build Target.
+type DiffExpr a = Expr (Diff a)
+
+-- Note the reverse order of function composition (y . x), which ensures that
+-- when two DiffExpr computations c1 and c2 are combined (c1 <> c2), then c1 is
+-- applied first, and c2 is applied second.
 instance Monoid (Diff a) where
     mempty = Diff id
     Diff x `mappend` Diff y = Diff $ y . x
 
-type Expr a = ReaderT Target Action a
-type DiffExpr a = Expr (Diff a)
-
-type Predicate       = Expr Bool
-type Settings        = DiffExpr [String] -- TODO: rename to Args
-type Ways            = DiffExpr [Way]
-type Packages        = DiffExpr [Package]
-
-instance Monoid a => Monoid (Expr a) where
-    mempty  = return mempty
-    mappend = liftM2 mappend
+-- The following expressions are used throughout the build system for
+-- specifying conditions (Predicate), lists of arguments (Settings), Ways and
+-- Packages.
+type Predicate = Expr Bool
+type Settings  = DiffExpr [String] -- TODO: rename to Args
+type Ways      = DiffExpr [Way]
+type Packages  = DiffExpr [Package]
 
 -- Basic operations on expressions:
 -- 1) append something to an expression
@@ -126,16 +145,16 @@ removeSub :: String -> [String] -> Settings
 removeSub prefix xs = filterSub prefix (`notElem` xs)
 
 -- Interpret a given expression in a given environment
-interpret :: Target -> Expr a -> Action a
-interpret = flip runReaderT
+interpretExpr :: Target -> Expr a -> Action a
+interpretExpr = flip runReaderT
 
 -- Extract an expression from a difference expression
 fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
 fromDiffExpr = fmap (($ mempty) . fromDiff)
 
 -- Interpret a given difference expression in a given environment
-interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
-interpretDiff target = interpret target . fromDiffExpr
+interpret :: Monoid a => Target -> DiffExpr a -> Action a
+interpret target = interpretExpr target . fromDiffExpr
 
 -- An equivalent of if-then-else for predicates
 (??) :: Monoid a => Predicate -> (Expr a, Expr a) -> Expr a
diff --git a/src/Rules.hs b/src/Rules.hs
index 6e1093b..852a6cf 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -17,7 +17,7 @@ import Settings.TargetDirectory
 generateTargets :: Rules ()
 generateTargets = action $
     forM_ [Stage0 ..] $ \stage -> do
-        pkgs <- interpretDiff (stageTarget stage) packages
+        pkgs <- interpret (stageTarget stage) packages
         forM_ pkgs $ \pkg -> do
             let dir = targetDirectory stage pkg
             need [pkgPath pkg </> dir </> "package-data.mk"]
diff --git a/src/Rules/Data.hs b/src/Rules/Data.hs
index 20f05f5..d608fea 100644
--- a/src/Rules/Data.hs
+++ b/src/Rules/Data.hs
@@ -44,7 +44,7 @@ buildPackageData target =
 -- TODO: This should probably go to Oracles.Builder
 run' :: Target -> Builder -> Action ()
 run' target builder = do
-    args <- interpret (target {getBuilder = builder}) $ fromDiffExpr settings
+    args <- interpret (target {getBuilder = builder}) settings
     putColoured Green (show args)
     run builder args
 



More information about the ghc-commits mailing list