diff options
Diffstat (limited to 'hadrian/src')
| -rw-r--r-- | hadrian/src/Rules/Generate.hs | 151 |
1 files changed, 90 insertions, 61 deletions
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index b156c9dfdf..f17ff0eb21 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -235,71 +235,100 @@ emptyTarget :: Context emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage") (error "Rules.Generate.emptyTarget: unknown package") --- | Files generated by query-replace from a template -templateResults :: [FilePath] -templateResults = - [ "compiler/ghc.cabal" - , "rts/rts.cabal" - , "driver/ghci/ghci-wrapper.cabal" - , "ghc/ghc-bin.cabal" - , "utils/iserv/iserv.cabal" - , "utils/iserv-proxy/iserv-proxy.cabal" - , "utils/remote-iserv/remote-iserv.cabal" - , "utils/runghc/runghc.cabal" - , "libraries/ghc-boot/ghc-boot.cabal" - , "libraries/ghc-boot-th/ghc-boot-th.cabal" - , "libraries/ghci/ghci.cabal" - , "libraries/ghc-heap/ghc-heap.cabal" - , "utils/ghc-pkg/ghc-pkg.cabal" - , "libraries/libiserv/libiserv.cabal" - , "libraries/template-haskell/template-haskell.cabal" - , "libraries/prologue.txt" +-- | A set of interpolation variable substitutions. +newtype Interpolations = Interpolations (Action [(String, String)]) + +instance Semigroup Interpolations where + Interpolations m <> Interpolations n = Interpolations ((++) <$> m <*> n) + +instance Monoid Interpolations where + mempty = Interpolations $ return [] + +-- | @interpolateVar var value@ is an interpolation which replaces @\@var\@@ +-- with the result of @value@. +interpolateVar :: String -> Action String -> Interpolations +interpolateVar var value = Interpolations $ do + val <- value + return [(var, val)] + +runInterpolations :: Interpolations -> String -> Action String +runInterpolations (Interpolations mk_substs) input = do + substs <- mk_substs + let subst :: String -> String + subst = foldr (.) id [replace ("@"++k++"@") v | (k,v) <- substs] + return (subst input) + +toCabalBool :: Bool -> String +toCabalBool True = "True" +toCabalBool False = "False" + +-- | Interpolate the given variable with the value of the given 'Flag', using +-- Cabal's boolean syntax. +interpolateCabalFlag :: String -> Flag -> Interpolations +interpolateCabalFlag name flg = interpolateVar name $ do + val <- flag flg + return (toCabalBool val) + +-- | Interpolate the given variable with the value of the given 'Setting'. +interpolateSetting :: String -> Setting -> Interpolations +interpolateSetting name settng = interpolateVar name $ setting settng + +-- | Interpolate the @ProjectVersion@ and @ProjectVersionMunged@ variables. +projectVersion :: Interpolations +projectVersion = mconcat + [ interpolateSetting "ProjectVersion" ProjectVersion + , interpolateSetting "ProjectVersionMunged" ProjectVersionMunged ] +rtsCabalFlags :: Interpolations +rtsCabalFlags = mconcat + [ flag "CabalMingwex" UseLibmingwex + , flag "CabalHaveLibdw" UseLibdw + , flag "CabalHaveLibm" UseLibm + , flag "CabalHaveLibrt" UseLibrt + , flag "CabalHaveLibdl" UseLibdl + , flag "CabalNeedLibpthread" UseLibpthread + , flag "CabalHaveLibbfd" UseLibbfd + , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalNeedLibatomic" NeedLibatomic + , flag "CabalUseSystemLibFFI" UseSystemFfi + , flag "CabalLibffiAdjustors" UseLibffiForAdjustors + , flag "CabalLeadingUnderscore" LeadingUnderscore + , interpolateVar "Cabal64bit" $ do + let settingWord :: Setting -> Action Word + settingWord s = read <$> setting s + ws <- settingWord TargetWordSize + return $ toCabalBool (ws == 8) + ] + where + flag = interpolateCabalFlag + +templateRule :: FilePath -> Interpolations -> Rules () +templateRule outPath interps = do + outPath %> \_ -> do + s <- readFile' (outPath <.> "in") + result <- runInterpolations interps s + writeFile' outPath result + putSuccess ("| Successfully generated " ++ outPath ++ " from its template") + templateRules :: Rules () templateRules = do - templateResults |%> \out -> do - let settingWord :: Setting -> Action Word - settingWord s = read <$> setting s - - project_version <- setting ProjectVersion - project_version_munged <- setting ProjectVersionMunged - target_word_size <- settingWord TargetWordSize - lib_dw <- flag UseLibdw - lib_numa <- flag UseLibnuma - lib_mingwex <- flag UseLibmingwex - lib_m <- flag UseLibm - lib_rt <- flag UseLibrt - lib_dl <- flag UseLibdl - lib_ffi <- flag UseSystemFfi - lib_ffi_adjustors <- flag UseLibffiForAdjustors - lib_bfd <- flag UseLibbfd - lib_pthread <- flag UseLibpthread - leading_underscore <- flag LeadingUnderscore - need_libatomic <- flag NeedLibatomic - - let cabal_bool True = "True" - cabal_bool False = "False" - - subst = replace "@ProjectVersion@" project_version - . replace "@ProjectVersionMunged@" project_version_munged - . replace "@Cabal64bit@" (cabal_bool (target_word_size == 8)) - . replace "@CabalMingwex@" (cabal_bool lib_mingwex) - . replace "@CabalHaveLibdw@" (cabal_bool lib_dw) - . replace "@CabalHaveLibm@" (cabal_bool lib_m) - . replace "@CabalHaveLibrt@" (cabal_bool lib_rt) - . replace "@CabalHaveLibdl@" (cabal_bool lib_dl) - . replace "@CabalUseSystemLibFFI@" (cabal_bool lib_ffi) - . replace "@CabalLibffiAdjustors@" (cabal_bool lib_ffi_adjustors) - . replace "@CabalNeedLibpthread@" (cabal_bool lib_pthread) - . replace "@CabalHaveLibbfd@" (cabal_bool lib_bfd) - . replace "@CabalHaveLibNuma@" (cabal_bool lib_numa) - . replace "@CabalLeadingUnderscore@" (cabal_bool leading_underscore) - . replace "@CabalNeedLibatomic@" (cabal_bool need_libatomic) - - s <- readFile' (out <.> "in") - writeFile' out (subst s) - putSuccess ("| Successfully generated " ++ out ++ " from its template") + templateRule "compiler/ghc.cabal" $ projectVersion + templateRule "rts/rts.cabal" $ rtsCabalFlags + templateRule "driver/ghci/ghci-wrapper.cabal" $ projectVersion + templateRule "ghc/ghc-bin.cabal" $ projectVersion + templateRule "utils/iserv/iserv.cabal" $ projectVersion + templateRule "utils/iserv-proxy/iserv-proxy.cabal" $ projectVersion + templateRule "utils/remote-iserv/remote-iserv.cabal" $ projectVersion + templateRule "utils/runghc/runghc.cabal" $ projectVersion + templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion + templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion + templateRule "libraries/ghci/ghci.cabal" $ projectVersion + templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion + templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion + templateRule "libraries/libiserv/libiserv.cabal" $ projectVersion + templateRule "libraries/template-haskell/template-haskell.cabal" $ projectVersion + -- Generators |