diff --git a/shake-ats.cabal b/shake-ats.cabal --- a/shake-ats.cabal +++ b/shake-ats.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: shake-ats -version: 1.5.0.7 +version: 1.5.0.8 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -37,11 +37,12 @@ ghc-options: -Wall build-depends: base >=4.7 && <5, + hashable, language-ats, shake-ext >=2.7.0.0, hs2ats >=0.2.0.1, directory -any, - microlens -any, + lens -any, text -any, dependency -any, shake -any, diff --git a/src/Development/Shake/ATS.hs b/src/Development/Shake/ATS.hs --- a/src/Development/Shake/ATS.hs +++ b/src/Development/Shake/ATS.hs @@ -7,26 +7,45 @@ module Development.Shake.ATS ( -- * Shake Rules cleanATS , atsBin - , atsLex - , cabalExport , cgen , genATS + , atsLex -- * Helper functions , getSubdirs , ccToDir , withPF + , defaultATSTarget + , defaultATSToolConfig -- * Environment/configuration , patscc , patsopt - -- Types + -- * Types , ForeignCabal (..) , ATSTarget (..) , ATSToolConfig (..) , CCompiler (..) , ArtifactType (..) + , ATSGen (..) + -- * Lenses + , atsTarget + , cFlags + , binTarget + , cc + , compilerVer + , genTargets + , hsLibs + , libVersion + , libs + , linkStatic + , linkTargets + , otherDeps + , src + , tgtType + , toolConfig ) where import Control.Arrow +import Control.Lens import Control.Monad import Control.Monad.IO.Class import Data.Bool (bool) @@ -43,7 +62,6 @@ import Development.Shake.FilePath import Development.Shake.Version import Language.ATS -import Lens.Micro import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist) import System.Environment (getEnv) import System.Exit (ExitCode (ExitSuccess)) @@ -62,9 +80,9 @@ command env patsc ["--output", out, "-dd", sourceFile, "-cc"] -- | Filter any generated errors with @pats-filter@. -withPF :: Bool -> Action (Exit, Stderr String, Stdout String) -> Action (Exit, Stderr String, Stdout String) -withPF False = id -withPF True = \act -> do +withPF :: Action (Exit, Stderr String, Stdout String) -- ^ Result of a 'cmd' or 'command' + -> Action (Exit, Stderr String, Stdout String) +withPF act = do ret@(Exit c, Stderr err, Stdout _) <- act :: Action (Exit, Stderr String, Stdout String) cmd_ [Stdin err] Shell "pats-filter" if c /= ExitSuccess @@ -78,7 +96,7 @@ -- Copy source files to the appropriate place. This is necessary because -- @#include@s in ATS are weird. copySources :: ATSToolConfig -> [FilePath] -> Action () -copySources (ATSToolConfig v v' _ _) sources = +copySources (ATSToolConfig v v' _ _ _) sources = forM_ sources $ \dep -> do h <- patsHome v' let home' = h ++ "lib/ats2-postiats-" ++ show v @@ -106,9 +124,6 @@ libToDirs = fmap (takeDirectory . TL.unpack . h) where h (ForeignCabal mpr cf _) = fromMaybe cf mpr -uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) -uncurry3 f (x, y, z) = f x y z - -- | Location of @patscc@ patscc :: MonadIO m => ATSToolConfig -> m String patscc = patsTool "patscc" @@ -119,23 +134,23 @@ patsTool :: MonadIO m => String -> ATSToolConfig -> m String patsTool tool tc = (<> prep) <$> ph - where ph = patsHome (compilerVer tc) - prep = "lib/ats2-postiats-" ++ show (libVersion tc) ++ "/bin/" ++ tool + where ph = patsHome (_compilerVer tc) + prep = "lib/ats2-postiats-" ++ show (_libVersion tc) ++ "/bin/" ++ tool cconfig :: MonadIO m => ATSToolConfig -> [String] -> Bool -> [String] -> m CConfig -cconfig tc libs gc extras = do - h <- patsHome (compilerVer tc) - let cc' = cc tc +cconfig tc libs' gc' extras = do + h <- patsHome (_compilerVer tc) + let cc' = _cc tc h' <- pkgHome cc' home' <- home tc - let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc + let libs'' = ("atslib" :) $ bool libs' ("gc" : libs') gc' -- TODO only include /ccomp/atslib/lib if it's not a cross build - pure $ CConfig [h ++ "ccomp/runtime/", h, h' ++ "include", ".atspkg/contrib"] libs' [h' ++ "lib", home' ++ "/ccomp/atslib/lib"] extras + pure $ CConfig [h ++ "ccomp/runtime/", h, h' ++ "include", ".atspkg/contrib"] libs'' [h' ++ "lib", home' ++ "/ccomp/atslib/lib"] extras (_linkStatic tc) home :: MonadIO m => ATSToolConfig -> m String home tc = do - h <- patsHome (compilerVer tc) - pure $ h ++ "lib/ats2-postiats-" ++ show (libVersion tc) + h <- patsHome (_compilerVer tc) + pure $ h ++ "lib/ats2-postiats-" ++ show (_libVersion tc) patsEnv :: FilePath -> FilePath -> [CmdOption] patsEnv home' path = EchoStderr False : @@ -147,7 +162,7 @@ atsToC = (-<.> "c") . (".atspkg/c/" <>) ghcV :: [ForeignCabal] -> Action String -ghcV hsLibs = case hsLibs of +ghcV hsLibs' = case hsLibs' of [] -> pure undefined _ -> ghcVersion @@ -155,50 +170,66 @@ doLib Executable = pure mempty doLib _ = id +defaultATSTarget :: [FilePath] -- ^ ATS source files + -> ArtifactType + -> FilePath -- ^ Target + -> ATSTarget +defaultATSTarget sources tgt' out = + ATSTarget mempty defaultATSToolConfig False mempty sources mempty mempty mempty out mempty tgt' + +defaultATSToolConfig :: ATSToolConfig +defaultATSToolConfig = + ATSToolConfig v v False (GCC Nothing) False + where v = Version [0,3,9] + +-- | Rules for generating binaries or libraries from ATS code. This is very +-- general; use 'defaultATSTarget' for sensible defaults that can be modified +-- with the provided lenses. atsBin :: ATSTarget -> Rules () atsBin ATSTarget{..} = do - mapM_ (uncurry genLinks) linkTargets + mapM_ (uncurry genLinks) _linkTargets - mapM_ (uncurry3 genATS) genTargets + mapM_ (\(ATSGen x y z) -> genATS x y z) _genTargets - mapM_ cabalExport hsLibs + mapM_ cabalExport _hsLibs - let cTargets = atsToC <$> src + let cTargets = atsToC <$> _src let h Executable = id h StaticLibrary = fmap (-<.> "o") h SharedLibrary = fmap (-<.> "o") - g Executable = ccAction + g Executable = binaryA g StaticLibrary = staticLibA g SharedLibrary = sharedLibA - h' = h tgtType + h' = h _tgtType - cconfig' <- cconfig toolConfig libs gc (makeCFlags cFlags mempty (pure undefined) gc) + cconfig' <- cconfig _toolConfig _libs _gc (makeCFlags _cFlags mempty (pure undefined) _gc) - let atsGen = (snd <$> linkTargets) <> ((^._2) <$> genTargets) - atsExtras = otherDeps <> (TL.unpack . objectFile <$> hsLibs) - zipWithM_ (cgen toolConfig atsExtras atsGen) src cTargets + let atsGen = (snd <$> _linkTargets) <> ((^.atsTarget) <$> _genTargets) + atsExtras = _otherDeps <> (TL.unpack . objectFile <$> _hsLibs) + zipWithM_ (cgen _toolConfig atsExtras atsGen) _src cTargets - doLib tgtType (zipWithM_ (objectFileR (cc toolConfig) cconfig') cTargets (h' cTargets)) + doLib _tgtType (zipWithM_ (objectFileR (_cc _toolConfig) cconfig') cTargets (h' cTargets)) - binTarget %> \_ -> do + _binTarget %> \_ -> do need (h' cTargets) - ghcV' <- ghcV hsLibs + ghcV' <- ghcV _hsLibs - cconfig'' <- cconfig toolConfig libs gc (makeCFlags cFlags hsLibs ghcV' gc) + cconfig'' <- cconfig _toolConfig _libs _gc (makeCFlags _cFlags _hsLibs ghcV' _gc) - unit $ g tgtType (cc toolConfig) (h' cTargets) binTarget cconfig'' + unit $ g _tgtType (_cc _toolConfig) (h' cTargets) _binTarget cconfig'' +-- | Generate C code from ATS code. cgen :: ATSToolConfig -> [FilePath] -- ^ Extra files to track -> [FilePath] -- ^ ATS source that may be generated. -> FilePath -- ^ ATS source -> FilePattern -- ^ Pattern for C file to be generated -> Rules () -cgen toolConfig extras atsGens atsSrc cFiles = +cgen toolConfig' extras atsGens atsSrc cFiles = cFiles %> \out -> do -- tell shake which files to track and copy them to the appropriate @@ -206,9 +237,9 @@ need extras sources <- transitiveDeps atsGens [atsSrc] need sources - copySources toolConfig sources + copySources toolConfig' sources - atsCommand toolConfig atsSrc out + atsCommand toolConfig' atsSrc out -- | This provides rules for generating C code from ATS source files in the trim :: String -> String diff --git a/src/Development/Shake/ATS/Environment.hs b/src/Development/Shake/ATS/Environment.hs --- a/src/Development/Shake/ATS/Environment.hs +++ b/src/Development/Shake/ATS/Environment.hs @@ -11,6 +11,9 @@ import Development.Shake.FilePath import System.Environment (getEnv) +-- | Given a C compiler, return the appropriate directory for its globally +-- installed artifacts. This is used to keep libraries built for different +-- platforms separate. ccToDir :: CCompiler -> String ccToDir (GCC (Just s)) = reverse (drop 1 $ reverse s) ++ "/" ccToDir _ = "" diff --git a/src/Development/Shake/ATS/Generate.hs b/src/Development/Shake/ATS/Generate.hs --- a/src/Development/Shake/ATS/Generate.hs +++ b/src/Development/Shake/ATS/Generate.hs @@ -1,9 +1,9 @@ module Development.Shake.ATS.Generate ( generateLinks ) where +import Control.Lens import Data.Semigroup import Language.ATS -import Lens.Micro generateLinks :: String -> Either ATSError String generateLinks = fmap (printATS . generateLinks') . parseM diff --git a/src/Development/Shake/ATS/Rules.hs b/src/Development/Shake/ATS/Rules.hs --- a/src/Development/Shake/ATS/Rules.hs +++ b/src/Development/Shake/ATS/Rules.hs @@ -21,13 +21,13 @@ -- | Given a plain Haskell source file, generate a @.sats@ file containing -- the equivalent types. genATS :: FilePath -- ^ Haskell source - -> FilePath -- ^ @.sats@ file to generate + -> FilePattern -- ^ @.sats@ file to generate -> Bool -- ^ Whether to call cpphs preprocessor -> Rules () -genATS src target cpphs = +genATS src' target cpphs' = target %> \out -> liftIO $ do createDirectoryIfMissing True (takeDirectory out) - genATSTypes src out cpphs + genATSTypes src' out cpphs' genLinks :: FilePath -> FilePath -> Rules () genLinks dats link = @@ -36,6 +36,7 @@ let proc = generateLinks contents writeFile out (either undefined id proc) +-- | Get subdirectories recursively. getSubdirs :: FilePath -> IO [FilePath] getSubdirs p = do ds <- listDirectory p @@ -46,10 +47,6 @@ ss <- mapM getSubdirs ds' pure $ ds' <> join ss --- libHSforeign-0.1.0.0-inplace-ghc8.2.2.so --- libHSforeign-0.1.0.0-inplace.a --- Foreign_stub.h - -- | These rules take a @.cabal@ file and the @.o@ file to be produced from -- them, building the @.o@ file. cabalExport :: ForeignCabal -> Rules () @@ -67,6 +64,7 @@ need (cf : fmap ((obfDir <> "/") <>) trDeps) command_ [Cwd obfDir] "cabal" ["new-build", "all"] + -- TODO move this to the @shake-ext@ package? ghcV <- quietly ghcVersion let subdir = takeDirectory cbp ++ "/" correctDir = (== "build") @@ -90,8 +88,9 @@ (Stdout contents) <- command [Stdin lats] "atslex" [] liftIO $ writeFile out contents -cleanATS :: Rules () -cleanATS = "clean" ~> do - removeFilesAfter "." ["//*.c", "//tags"] - removeFilesAfter ".atspkg" ["//*"] - removeFilesAfter "ats-deps" ["//*"] +-- | Clean up after an ATS build. +cleanATS :: Action () +cleanATS = + zipWithM_ removeFilesAfter + [".", ".atspkg", "ats-deps"] + [["//*.c", "//*_lats.dats", "//tags"], ["//*"], ["//*"]] diff --git a/src/Development/Shake/ATS/Type.hs b/src/Development/Shake/ATS/Type.hs --- a/src/Development/Shake/ATS/Type.hs +++ b/src/Development/Shake/ATS/Type.hs @@ -2,16 +2,38 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} module Development.Shake.ATS.Type ( ForeignCabal (..) , Version (..) , ATSTarget (..) , ArtifactType (..) , ATSToolConfig (..) + , ATSGen (..) + -- * Lenses + , atsTarget + , hasPretty + , cFlags + , otherDeps + , toolConfig + , cc + , linkStatic + , src + , gc + , binTarget + , genTargets + , hsLibs + , libs + , tgtType + , compilerVer + , libVersion + , linkTargets ) where +import Control.Lens import Data.Binary (Binary (..)) import Data.Dependency (Version (..)) +import Data.Hashable (Hashable) import qualified Data.Text.Lazy as TL import Development.Shake.C import GHC.Generics (Generic) @@ -52,28 +74,39 @@ deriving (Generic, Binary) -- | Information about where to find @patscc@ and @patsopt@. -data ATSToolConfig = ATSToolConfig { libVersion :: Version - , compilerVer :: Version - , hasPretty :: Bool -- ^ Whether to display errors via @pats-filter@ - , cc :: CCompiler -- ^ C compiler to be used +data ATSToolConfig = ATSToolConfig { _libVersion :: Version -- ^ Standard library version to be used. + , _compilerVer :: Version -- ^ Version of @patscc@ to be used. + , _hasPretty :: Bool -- ^ Whether to display errors via @pats-filter@ + , _cc :: CCompiler -- ^ C compiler to be used + , _linkStatic :: Bool -- ^ Force static linking } deriving (Generic, Binary) +data ATSGen = ATSGen { hsFile :: FilePath -- ^ Haskell file containing types + , _atsTarget :: FilePath -- ^ ATS file to be generated + , cpphs :: Bool -- ^ Whether to use the C preprocessor on the Haskell code + } deriving (Generic, Binary) + -- | Type for binary and library builds with ATS. -data ATSTarget = ATSTarget { cFlags :: [String] -- ^ Flags to be passed to the C compiler - , toolConfig :: ATSToolConfig - , gc :: Bool -- ^ Whether to configure build for use with the garbage collector. - , libs :: [String] -- ^ Libraries against which to link - , src :: [String] -- ^ ATS source files. If building an executable, at most one may contain @main0@. - , hsLibs :: [ForeignCabal] -- ^ Cabal-based Haskell libraries - , genTargets :: [(String, String, Bool)] -- ^ Files to be run through @hs2ats@. - , linkTargets :: [(String, String)] -- ^ Targets for @_link.hats@ generation. - , binTarget :: String -- ^ Binary target - , otherDeps :: [String] -- ^ Other files necessary to compile target - , tgtType :: ArtifactType -- ^ Build type +data ATSTarget = ATSTarget { _cFlags :: [String] -- ^ Flags to be passed to the C compiler + , _toolConfig :: ATSToolConfig -- ^ Configuration options for @patsopt@ + , _gc :: Bool -- ^ Whether to build with the garbage collection enabled + , _libs :: [String] -- ^ Libraries against which to link + , _src :: [FilePath] -- ^ ATS source files. If building an executable, at most one may contain @main0@. + , _hsLibs :: [ForeignCabal] -- ^ Cabal-based Haskell libraries. + , _genTargets :: [ATSGen] -- ^ Files to be run through @hs2ats@. + , _linkTargets :: [(FilePath, FilePath)] -- ^ Targets for @_link.hats@ generation. + , _binTarget :: FilePath -- ^ Target + , _otherDeps :: [FilePath] -- ^ Other files to track. + , _tgtType :: ArtifactType -- ^ Build type } deriving (Generic, Binary) --- | Data type containing information about Haskell components of a build. +-- | Data type containing information about Haskell components of a build. Any +-- functions exposed in the object file will be callable in C or ATS code. data ForeignCabal = ForeignCabal { projectFile :: Maybe TL.Text -- ^ @cabal.project@ file to track , cabalFile :: TL.Text -- ^ @.cabal@ file associated with the library , objectFile :: TL.Text -- ^ Object file to be generated - } deriving (Eq, Show, Generic, Binary) + } deriving (Eq, Show, Generic, Binary, Hashable) + +makeLenses ''ATSGen +makeLenses ''ATSTarget +makeLenses ''ATSToolConfig