module Development.Shake.ATS ( cgen
, cgenPretty
, cleanATS
, atsBin
, patsHome
) where
import Control.Monad (filterM, forM_)
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup (..))
import Development.Shake
import Development.Shake.FilePath
import Language.ATS
import System.Directory (copyFile)
import System.Exit (ExitCode (ExitSuccess))
patsHome :: Action String
patsHome = fromMaybe "/usr/local/lib/ats2-postiats-0.3.8" <$> mh
where mh = fmap (++ "/.atspkg/compiler/") <$> getEnv "HOME"
atsCommand :: CmdResult r => String -> String -> Action r
atsCommand sourceFile out = do
let home = "/usr/local/lib/ats2-postiats-0.3.8"
let atsArgs = [EchoStderr False, AddEnv "PATSHOME" home]
patsc = "patsopt"
command atsArgs patsc ["--output", out, "-dd", sourceFile, "-cc"]
gcFlag :: Bool -> String
gcFlag False = "-DATS_MEMALLOC_LIBC"
gcFlag True = "-DATS_MEMALLOC_GCBDW"
atsBin :: Bool -> [String] -> String -> String -> Rules ()
atsBin gc libs sourceFile out =
out %> \_ -> do
need [sourceFile]
let home = "/usr/local/lib/ats2-postiats-0.3.8"
cmd_ ["mkdir", "-p", dropDirectory1 out]
let toLibs = fmap ("-l" <>)
command [EchoStderr False, AddEnv "PATSHOME" home] "patscc" ([sourceFile, "-atsccomp", "gcc -flto -I/usr/local/lib/ats2-postiats-0.3.8/ccomp/runtime/ -I/usr/local/lib/ats2-postiats-0.3.8/", gcFlag gc, "-o", out, "-cleanaft", "-O2", "-mtune=native"] <> toLibs libs)
cleanATS :: Rules ()
cleanATS =
"clean" ~> do
cmd_ ["sn", "c"]
removeFilesAfter "." ["//*.c", "//tags"]
removeFilesAfter ".shake" ["//*"]
removeFilesAfter "ats-deps" ["//*"]
cgen :: FilePath -> Rules ()
cgen dir = do
atsDeps
"//*.c" %> \out -> do
let sourceFile = dir ++ "/" ++ (dropDirectory1 out -<.> "dats")
need [sourceFile]
atsCommand sourceFile out
atsDeps :: Rules ()
atsDeps =
["//*.dats", "//*.sats"] |%> \out -> do
contents <- liftIO $ readFile out
let ats = fromRight mempty . parseATS . lexATS $ contents
deps <- filterM doesFileExist $ getDependencies ats
need deps
home <- patsHome
forM_ deps $ \dep ->
liftIO $ copyFile dep (home ++ "/" ++ dep)
cgenPretty :: Rules ()
cgenPretty = do
atsDeps
"//*.c" %> \out -> do
let sourceFile = "ats-src/" ++ (dropDirectory1 out -<.> "dats")
need [sourceFile]
(Exit c, Stderr err) :: (Exit, Stderr String) <- atsCommand sourceFile out
cmd_ [Stdin err] Shell "pats-filter"
if c /= ExitSuccess
then error "patscc failure"
else pure ()