diff --git a/shake-ats.cabal b/shake-ats.cabal --- a/shake-ats.cabal +++ b/shake-ats.cabal @@ -1,5 +1,5 @@ name: shake-ats -version: 1.4.0.0 +version: 1.4.1.0 synopsis: Utilities for building ATS projects with shake description: Various helper functions for building [ATS](http://www.ats-lang.org/) with the [shake](http://shakebuild.com/) library homepage: https://github.com/vmchale/shake-ats#readme 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 @@ -20,6 +20,8 @@ , ccToDir , compatible , host + , patscc + , patsopt -- Types , Version (..) , ForeignCabal (..) @@ -37,34 +39,35 @@ import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup (..)) import qualified Data.Text.Lazy as TL -import Development.Shake +import Development.Shake hiding (doesFileExist) import Development.Shake.ATS.Environment import Development.Shake.ATS.Rules import Development.Shake.ATS.Type +import Development.Shake.C import Development.Shake.FilePath import Development.Shake.Version import Language.ATS import Lens.Micro -import System.Directory (copyFile, createDirectoryIfMissing) +import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist) import System.Exit (ExitCode (ExitSuccess)) -- | Whether generated libraries are to be considered compatible. compatible :: CCompiler -> CCompiler -> Bool -compatible (GCC Nothing Nothing) Clang = True -compatible Clang (GCC Nothing Nothing) = True -compatible x y = x == y +compatible GCCStd Clang = True +compatible Clang GCCStd = True +compatible x y = x == y --- | Run @patsopt@ given information about +-- | Run @patsopt@ given information about various things atsCommand :: CmdResult r => ATSToolConfig -> String -- ^ Source file -> String -- ^ C code to be generated -> Action r atsCommand tc sourceFile out = do - h <- patsHome (compilerVer tc) - let home = h ++ "lib/ats2-postiats-" ++ show (libVersion tc) - atsArgs = [EchoStderr False, AddEnv "PATSHOME" home] - patsc = home ++ "/bin/patsopt" - command atsArgs patsc ["--output", out, "-dd", sourceFile, "-cc"] + path <- fromMaybe "" <$> getEnv "PATH" + home' <- home tc + let env = patsEnv home' path + patsc <- patsopt tc + command env patsc ["--output", out, "-dd", sourceFile, "-cc"] gcFlag :: Bool -> String gcFlag False = "-DATS_MEMALLOC_LIBC" @@ -76,26 +79,25 @@ copySources (ATSToolConfig v v' _ _) sources = forM_ sources $ \dep -> do h <- patsHome v' - let home = h ++ "lib/ats2-postiats-" ++ show v - liftIO $ createDirectoryIfMissing True (home ++ "/" ++ takeDirectory dep) - liftIO $ copyFile dep (home ++ "/" ++ dep) + let home' = h ++ "lib/ats2-postiats-" ++ show v + liftIO $ createDirectoryIfMissing True (home' ++ "/" ++ takeDirectory dep) + liftIO $ copyFile dep (home' ++ "/" ++ dep) -- This is the @$PATSHOMELOCS@ variable to be passed to the shell. patsHomeLocs :: Int -> String patsHomeLocs n = intercalate ":" $ (<> ".atspkg/contrib") . ("./" <>) <$> g where g = [ join $ replicate i "../" | i <- [1..n] ] --- TODO depend on GHC version? makeCFlags :: [String] -- ^ Inputs -> [ForeignCabal] -- ^ Haskell libraries -> String -- ^ GHC version -> Bool -- ^ Whether to use the Garbage collector -> [String] -makeCFlags ss fc ghcV b = gcFlag' : (hsExtra <> ss) where +makeCFlags ss fc ghcV' b = gcFlag' : (hsExtra <> ss) where gcFlag' = bool ("-optc" <>) id noHs $ gcFlag b - hsExtra = bool (["--make", "-odir", ".atspkg", "-no-hs-main", "-package-db", "~/.cabal/store/ghc-" ++ ghcV ++ "/package.db/"] ++ packageDbs) mempty noHs + hsExtra = bool (["--make", "-I.", "-odir", ".atspkg", "-no-hs-main", "-package-db", "~/.cabal/store/ghc-" ++ ghcV' ++ "/package.db/"] ++ packageDbs) mempty noHs noHs = null fc - packageDbs = (\x -> ["-package-db", x ++ "/dist-newstyle/packagedb/ghc-" ++ ghcV]) =<< libToDirs fc + packageDbs = (\x -> ["-package-db", x ++ "/dist-newstyle/packagedb/ghc-" ++ ghcV']) =<< libToDirs fc libToDirs :: [ForeignCabal] -> [String] libToDirs = fmap (takeDirectory . TL.unpack . h) @@ -104,10 +106,54 @@ uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f (x, y, z) = f x y z --- TODO libraries should be linked against *cross-compiled* versions!! --- aka we need to compile atslib +-- Change architecture to use C stuff better? +-- Step 1: Use patsopt to generate C files +-- Step 2: Use gcc to generate `.o` files +-- Step 3: Generate library/binary from those files. + +-- | Location of @patscc@ +patscc :: MonadIO m => ATSToolConfig -> m String +patscc = patsTool "patscc" + +-- | Location of @patsopt@ +patsopt :: MonadIO m => ATSToolConfig -> m String +patsopt = patsTool "patsopt" + +patsTool :: MonadIO m => String -> ATSToolConfig -> m String +patsTool tool tc = do + h <- patsHome (compilerVer tc) + pure $ h ++ "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 + h' <- pkgHome cc' + home' <- home tc + let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc + pure $ CConfig [h ++ "ccomp/runtime/", h, h' ++ "include"] libs' [h' ++ "lib", home' ++ "/ccomp/atslib/lib"] extras + +home :: MonadIO m => ATSToolConfig -> m String +home tc = do + h <- patsHome (compilerVer tc) + pure $ h ++ "lib/ats2-postiats-" ++ show (libVersion tc) + +patsEnv :: FilePath -> FilePath -> [CmdOption] +patsEnv home' path = EchoStderr False : + zipWith AddEnv + ["PATSHOME", "PATH", "PATSHOMELOCS"] + [home', home' ++ "/bin:" ++ path, patsHomeLocs 5] + +atsToC :: FilePath -> FilePath +atsToC = (-<.> "c") . (".atspkg/c/" <>) + +ghcV :: [ForeignCabal] -> Action String +ghcV hsLibs = case hsLibs of + [] -> pure undefined + _ -> ghcVersion + atsBin :: BinaryTarget -> Rules () -atsBin BinaryTarget{..} = do +atsBin tgt@BinaryTarget{..} = do unless (null genTargets) $ mapM_ (uncurry3 genATS) genTargets @@ -115,35 +161,40 @@ unless (null hsLibs) $ mapM_ cabalExport hsLibs + let cTargets = atsToC <$> src + + foldr (>>) (pure ()) (atsCGen toolConfig tgt <$> src <*> cTargets) + binTarget %> \_ -> do - h <- patsHome (compilerVer toolConfig) - let cc' = cc toolConfig - h' <- pkgHome cc' - let home = h ++ "lib/ats2-postiats-" ++ show (libVersion toolConfig) - need otherDeps - sources <- (<> cDeps) <$> transitiveDeps ((^._2) <$> genTargets) [src] - b' <- doesFileExist "atspkg.dhall" - let hb = bool id ("atspkg.dhall" :) b' - need (hb (sources ++ (TL.unpack . objectFile <$> hsLibs))) - copySources toolConfig sources - let ccommand = unwords [ ccToString cc', "-I" ++ h ++ "ccomp/runtime/", "-I" ++ h, "-I" ++ h' ++ "include", "-L" ++ h' ++ "lib", "-L" ++ home ++ "/ccomp/atslib/lib"] - path <- fromMaybe "" <$> getEnv "PATH" - let toLibs = fmap ("-l" <>) - let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc -- TODO make atslib a configuration option - ghcV <- case hsLibs of - [] -> pure undefined - _ -> ghcVersion - command_ - [EchoStderr False, AddEnv "PATSHOME" home, AddEnv "PATH" (home ++ "/bin:" ++ path), AddEnv "PATSHOMELOCS" $ patsHomeLocs 5] - (home ++ "/bin/patscc") - (mconcat - [ [src, "-atsccomp", ccommand, "-o", binTarget, "-cleanaft"] - , makeCFlags cFlags hsLibs ghcV gc - , toLibs libs' - ]) + need cTargets --- given directory. + ghcV' <- ghcV hsLibs + + cconfig' <- cconfig toolConfig libs gc (makeCFlags cFlags hsLibs ghcV' gc) + + let g Executable = ccAction + g StaticLibrary = staticLibA + + unit $ g tgtType (cc toolConfig) cTargets binTarget cconfig' + +atsCGen :: ATSToolConfig + -> BinaryTarget + -> FilePath -- ^ ATS source + -> FilePattern -- ^ Pattern for C file to be generated + -> Rules () +atsCGen tc BinaryTarget{..} atsSrc cFiles = + cFiles %> \out -> do + + -- tell shake which files to track and copy them to the appropriate + -- directory + need (otherDeps ++ (TL.unpack . objectFile <$> hsLibs)) + sources <- (<> cDeps) <$> transitiveDeps ((^._2) <$> genTargets) [atsSrc] + need sources + copySources tc sources + + atsCommand tc atsSrc out + cgen :: ATSToolConfig -> FilePath -- ^ Directory containing ATS source code -> Rules () @@ -164,13 +215,13 @@ trim :: String -> String trim = init . drop 1 -transitiveDeps :: [FilePath] -> [FilePath] -> Action [FilePath] +transitiveDeps :: (MonadIO m) => [FilePath] -> [FilePath] -> m [FilePath] transitiveDeps _ [] = pure [] transitiveDeps gen ps = fmap join $ forM ps $ \p -> if p `elem` gen then pure mempty else do contents <- liftIO $ readFile p let ats = fromRight mempty . parse $ contents let dir = takeDirectory p - deps <- filterM (\f -> ((f `elem` gen) ||) <$> doesFileExist f) $ fixDir dir . trim <$> getDependencies ats + deps <- filterM (\f -> ((f `elem` gen) ||) <$> (liftIO . doesFileExist) f) $ fixDir dir . trim <$> getDependencies ats deps' <- transitiveDeps gen deps pure $ (p:deps) ++ deps' 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 @@ -2,58 +2,26 @@ , pkgHome , patsHome , ccToDir - , ccToString - , ccFromString - , host ) where -import Data.List (isPrefixOf, isSuffixOf) -import Data.Maybe (fromMaybe) +import Control.Monad.IO.Class import qualified Data.Text.Lazy as TL -import Development.Shake import Development.Shake.ATS.Type +import Development.Shake.C import Development.Shake.FilePath -import System.Info - -host :: String -host = arch ++ withManufacturer os - where withManufacturer "darwin" = "-apple-" ++ os - withManufacturer _ = "-unknown-" ++ os +import System.Environment (getEnv) ccToDir :: CCompiler -> String -ccToDir (GCC (Just s) _) = reverse (drop 1 $ reverse s) ++ "/" -ccToDir _ = "" - -ccToString :: CCompiler -> String -ccToString Clang = "clang" -ccToString (Other s) = s -ccToString (GCC pre suff) = mkQualified pre suff "gcc" -ccToString (GHC pre suff) = mkQualified pre suff "ghc" - -ccFromString :: String -> CCompiler -ccFromString "gcc" = GCC Nothing Nothing -ccFromString "clang" = Clang -ccFromString "ghc" = GHC Nothing Nothing -ccFromString s - | "gcc" `isSuffixOf` s = GCC (Just (reverse . drop 3 . reverse $ s)) Nothing - | "gcc" `isPrefixOf` s = GCC Nothing (Just $ drop 3 s) - | "ghc" `isSuffixOf` s = GHC (Just (reverse . drop 3 . reverse $ s)) Nothing - | "ghc" `isPrefixOf` s = GHC Nothing (Just $ drop 3 s) -ccFromString _ = GCC Nothing Nothing - -mkQualified :: Monoid a => Maybe a -> Maybe a -> a -> a -mkQualified pre suff = h (g <$> [pre, suff]) - where g = maybe id mappend - h = foldr fmap id +ccToDir (GCC (Just s)) = reverse (drop 1 $ reverse s) ++ "/" +ccToDir _ = "" -- | The directory @~/.atspkg@ -pkgHome :: CCompiler -> Action String -pkgHome cc' = fromMaybe "/usr/local/" <$> mh - where mh = fmap (++ ("/.atspkg/" ++ ccToDir cc')) <$> getEnv "HOME" +pkgHome :: MonadIO m => CCompiler -> m String +pkgHome cc' = liftIO $ (++ ("/.atspkg/" ++ ccToDir cc')) <$> getEnv "HOME" -- | The directory that will be @PATSHOME@. -patsHome :: Version -> Action String -patsHome v = fmap (++ (show v ++ "/")) (pkgHome (GCC Nothing Nothing)) +patsHome :: MonadIO m => Version -> m String +patsHome v = fmap (++ (show v ++ "/")) (pkgHome (GCC Nothing)) fixDir :: FilePath -> String -> String fixDir p = 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 @@ -51,7 +51,7 @@ obf %> \out -> do need (cf : fmap ((obfDir <> "/") <>) trDeps) - command_ [Cwd obfDir] "cabal" ["new-build"] + command_ [Cwd obfDir] "cabal" ["new-build", "-O2"] let subdir = takeDirectory cbp ++ "/" correctDir = (libName `isPrefixOf`) 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 @@ -1,30 +1,20 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE PatternSynonyms #-} - - --- gcc -c -o lib1.o lib1.c --- gcc ats-src/libnumbertheory.o -shared -o ats-src/libnumbertheory.so --- gcc number-theory-ffi_dats.c -c -fPIC -o ats-src/libnumbertheory.o -IATS2-Postiats-include-0.3.8/ -IATS2-Postiats-include-0.3.8/ccomp/runtime/ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} module Development.Shake.ATS.Type ( ForeignCabal (..) , Version (..) , BinaryTarget (..) , ArtifactType (..) , ATSToolConfig (..) - , CCompiler (GCC, Clang, GHC, Other, GCCStd, GHCStd) ) where -import Data.Binary (Binary (..)) -import Data.Dependency (Version (..)) -import qualified Data.Text.Lazy as TL -import GHC.Generics (Generic) - -pattern GCCStd :: CCompiler -pattern GCCStd = GCC Nothing Nothing - -pattern GHCStd :: CCompiler -pattern GHCStd = GHC Nothing Nothing +import Data.Binary (Binary (..)) +import Data.Dependency (Version (..)) +import qualified Data.Text.Lazy as TL +import Development.Shake.C +import GHC.Generics (Generic) -- We should have four build types: -- @@ -53,17 +43,13 @@ -- -- * Also binary caches are good. +deriving instance Generic CCompiler +deriving instance Binary CCompiler + data ArtifactType = StaticLibrary - | DynamicLibrary - | Binary Bool -- ^ Whether binary build should create a static binary + | Executable deriving (Generic, Binary) -data CCompiler = GCC { _prefix :: Maybe String, _suffix :: Maybe String } - | Clang - | Other String - | GHC { _prefix :: Maybe String, _suffix :: Maybe String } - deriving (Eq, Generic, Binary) - -- | Information about where to find @patscc@ and @patsopt@. data ATSToolConfig = ATSToolConfig { libVersion :: Version , compilerVer :: Version @@ -76,7 +62,7 @@ , toolConfig :: ATSToolConfig , gc :: Bool -- ^ Whether to configure build for use with the garbage collector. , libs :: [String] -- ^ Libraries against which to link - , src :: String -- ^ Source file for binary. + , 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@. , binTarget :: String -- ^ Binary target