{-# LANGUAGE CPP, GADTs, RankNTypes, FlexibleContexts #-}
module Clash.Clashilator.Setup
( clashToVerilog
, buildVerilator
, clashilate
, clashilatorMain
, clashilatorBuildHook
) where
import qualified Clash.Main as Clash
import qualified Clash.Clashilator as Clashilator
import Clash.Clashilator.Cabal
import Clash.Driver.Manifest (Manifest, readManifest)
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Distribution.Simple.Program
import Distribution.Simple.Utils (infoNoWrap)
import Distribution.Verbosity
import Distribution.ModuleName
import Distribution.Types.UnqualComponentName
#if MIN_VERSION_Cabal(3,8,0)
import Distribution.Utils.Path
#endif
import Distribution.Types.Lens
import Control.Lens hiding ((<.>))
import Data.List (intercalate, sort, nub)
import Data.Maybe (fromMaybe)
import System.FilePath
import GHC (Ghc)
#if MIN_VERSION_ghc(9,4,0)
#elif MIN_VERSION_ghc(9,0,0)
#define RESET_LINKER
import GHC (getSession, setSession)
import GHC.Driver.Types (HscEnv(..))
import GHC.Runtime.Linker
#elif MIN_VERSION_ghc(8,10,0)
#define RESET_LINKER
import GHC (getSession, setSession)
import HscTypes (HscEnv(..))
import Linker
#endif
#if !MIN_VERSION_Cabal(3,8,0)
type SymbolicPath from to = FilePath
getSymbolicPath :: SymbolicPath from to -> FilePath
getSymbolicPath = id
unsafeMakeSymbolicPath :: FilePath -> SymbolicPath from to
unsafeMakeSymbolicPath = id
#endif
lookupX :: String -> BuildInfo -> Maybe String
lookupX :: String -> BuildInfo -> Maybe String
lookupX String
key BuildInfo
buildInfo = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
"x-clashilator-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
key) (Getting [(String, String)] BuildInfo [(String, String)]
-> BuildInfo -> [(String, String)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(String, String)] BuildInfo [(String, String)]
forall a. HasBuildInfo a => Lens' a [(String, String)]
Lens' BuildInfo [(String, String)]
customFieldsBI BuildInfo
buildInfo)
clashilatorBuildHook :: BuildHook
clashilatorBuildHook :: BuildHook
clashilatorBuildHook = ComponentHook -> BuildHook -> BuildHook
withComponentHook ComponentHook
clashilate (BuildHook -> BuildHook) -> BuildHook -> BuildHook
forall a b. (a -> b) -> a -> b
$ UserHooks -> BuildHook
buildHook UserHooks
simpleUserHooks
clashToVerilog :: Ghc () -> LocalBuildInfo -> BuildFlags -> [FilePath] -> BuildInfo -> ModuleName -> String -> FilePath -> IO (FilePath, Manifest)
clashToVerilog :: Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> [String]
-> BuildInfo
-> ModuleName
-> String
-> String
-> IO (String, Manifest)
clashToVerilog Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags [String]
srcDirs BuildInfo
buildInfo ModuleName
mod String
entity String
outDir = do
[PackageDB]
pkgdbs <- LocalBuildInfo -> BuildFlags -> IO [PackageDB]
packageDBs LocalBuildInfo
lbi BuildFlags
flags
let dbpaths :: [String]
dbpaths = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [ String
path | SpecificPackageDB String
path <- [PackageDB]
pkgdbs ]
dbflags :: [String]
dbflags = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-package-db", String
path] | String
path <- [String]
dbpaths ]
iflags :: [String]
iflags = [ String
"-i" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir | String
dir <- [String]
srcDirs ]
clashflags :: [String]
clashflags = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> BuildInfo -> Maybe String
lookupX String
"clash-flags" BuildInfo
buildInfo
let args :: [String]
args = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ String
"--verilog"
, String
"-outputdir", String
outDir
, String
"-main-is", String
entity
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." (ModuleName -> [String]
components ModuleName
mod)
]
, [String]
iflags
, [String]
dbflags
, [String]
clashflags
]
Verbosity -> String -> IO ()
infoNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Clash.defaultMain" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
Ghc () -> [String] -> IO ()
Clash.defaultMainWithAction Ghc ()
startAction [String]
args
let modDir :: String
modDir = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." (ModuleName -> [String]
components ModuleName
mod)
verilogDir :: String
verilogDir = String
outDir String -> String -> String
</> String
modDir String -> String -> String
<.> String
entity
Just Manifest
manifest <- String -> IO (Maybe Manifest)
forall a. FromJSON a => String -> IO (Maybe a)
readManifest (String
verilogDir String -> String -> String
</> String
"clash-manifest.json")
(String, Manifest) -> IO (String, Manifest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
verilogDir, Manifest
manifest)
where
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
buildVerilator :: Ghc () -> LocalBuildInfo -> BuildFlags -> Maybe UnqualComponentName -> BuildInfo -> IO BuildInfo
buildVerilator :: Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> Maybe UnqualComponentName
-> BuildInfo
-> IO BuildInfo
buildVerilator Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags Maybe UnqualComponentName
compName BuildInfo
buildInfo = case Maybe String
top of
Maybe String
Nothing -> BuildInfo -> IO BuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BuildInfo
buildInfo
Just String
mod -> Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> Maybe UnqualComponentName
-> BuildInfo
-> ModuleName
-> String
-> IO BuildInfo
buildVerilator' Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags Maybe UnqualComponentName
compName BuildInfo
buildInfo (String -> ModuleName
forall a. IsString a => String -> a
fromString String
mod) String
entity
where
top :: Maybe String
top = String -> BuildInfo -> Maybe String
lookupX String
"top-is" BuildInfo
buildInfo
entity :: String
entity = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"topEntity" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> BuildInfo -> Maybe String
lookupX String
"entity" BuildInfo
buildInfo
buildVerilator' :: Ghc () -> LocalBuildInfo -> BuildFlags -> Maybe UnqualComponentName -> BuildInfo -> ModuleName -> String -> IO BuildInfo
buildVerilator' :: Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> Maybe UnqualComponentName
-> BuildInfo
-> ModuleName
-> String
-> IO BuildInfo
buildVerilator' Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags Maybe UnqualComponentName
compName BuildInfo
buildInfo ModuleName
mod String
entity = do
String
cflags <- do
Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
pkgConfigProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
case Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig of
Maybe (ConfiguredProgram, ProgramDb)
Nothing -> String -> IO String
forall a. HasCallStack => String -> a
error String
"Cannot find pkg-config program"
Just (ConfiguredProgram
pkgConfig, ProgramDb
_) -> Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
pkgConfig [String
"--cflags", String
"verilator"]
(String
verilogDir, Manifest
manifest) <- Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> [String]
-> BuildInfo
-> ModuleName
-> String
-> String
-> IO (String, Manifest)
clashToVerilog Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags [String]
srcDirs BuildInfo
buildInfo ModuleName
mod String
entity String
synDir
Maybe String -> String -> String -> Maybe Text -> Manifest -> IO ()
Clashilator.generateFiles (String -> Maybe String
forall a. a -> Maybe a
Just String
cflags) String
verilogDir String
verilatorDir (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
clk) Manifest
manifest
String
_ <- Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput Verbosity
verbosity (ProgramInvocation -> IO String) -> ProgramInvocation -> IO String
forall a b. (a -> b) -> a -> b
$
String -> [String] -> ProgramInvocation
simpleProgramInvocation String
"make" [String
"-f", String
verilatorDir String -> String -> String
</> String
"Makefile"]
let incDir :: String
incDir = String
verilatorDir String -> String -> String
</> String
"src"
libDir :: String
libDir = String
verilatorDir String -> String -> String
</> String
"obj"
lib :: String
lib = String
"VerilatorFFI"
let fixupOptions :: (t -> v) -> PerCompilerFlavor t -> PerCompilerFlavor v
fixupOptions t -> v
f (PerCompilerFlavor t
x t
y) = v -> v -> PerCompilerFlavor v
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor (t -> v
f t
x) (t -> v
f t
y)
compileFlags :: [String]
compileFlags =
[ String
"-fPIC"
]
ldFlags :: [String]
ldFlags =
[ String
"-Wl,--whole-archive"
, String
"-Wl,-Bstatic"
, String
"-Wl,-l" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
lib
, String
"-Wl,-Bdynamic"
, String
"-Wl,--no-whole-archive"
]
BuildInfo -> IO BuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildInfo -> IO BuildInfo) -> BuildInfo -> IO BuildInfo
forall a b. (a -> b) -> a -> b
$ BuildInfo
buildInfo
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike Identity BuildInfo BuildInfo [String] [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' BuildInfo [String]
includeDirs LensLike Identity BuildInfo BuildInfo [String] [String]
-> ([String] -> [String]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
incDirString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike Identity BuildInfo BuildInfo [String] [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' BuildInfo [String]
extraLibDirs LensLike Identity BuildInfo BuildInfo [String] [String]
-> ([String] -> [String]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
libDirString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike Identity BuildInfo BuildInfo [String] [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' BuildInfo [String]
extraLibs LensLike Identity BuildInfo BuildInfo [String] [String]
-> ([String] -> [String]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
"stdc++"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike
Identity
BuildInfo
BuildInfo
(PerCompilerFlavor [String])
(PerCompilerFlavor [String])
forall a. HasBuildInfo a => Lens' a (PerCompilerFlavor [String])
Lens' BuildInfo (PerCompilerFlavor [String])
options LensLike
Identity
BuildInfo
BuildInfo
(PerCompilerFlavor [String])
(PerCompilerFlavor [String])
-> (PerCompilerFlavor [String] -> PerCompilerFlavor [String])
-> BuildInfo
-> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([String] -> [String])
-> PerCompilerFlavor [String] -> PerCompilerFlavor [String]
forall {t} {v}.
(t -> v) -> PerCompilerFlavor t -> PerCompilerFlavor v
fixupOptions ([String]
compileFlags[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike Identity BuildInfo BuildInfo [String] [String]
forall a. HasBuildInfo a => Lens' a [String]
Lens' BuildInfo [String]
ldOptions LensLike Identity BuildInfo BuildInfo [String] [String]
-> ([String] -> [String]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([String]
ldFlags[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike
Identity
BuildInfo
BuildInfo
[SymbolicPath PackageDir SourceDir]
[SymbolicPath PackageDir SourceDir]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPath PackageDir SourceDir]
Lens' BuildInfo [SymbolicPath PackageDir SourceDir]
hsSourceDirs LensLike
Identity
BuildInfo
BuildInfo
[SymbolicPath PackageDir SourceDir]
[SymbolicPath PackageDir SourceDir]
-> ([SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir])
-> BuildInfo
-> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String -> SymbolicPath PackageDir SourceDir
forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath String
incDirSymbolicPath PackageDir SourceDir
-> [SymbolicPath PackageDir SourceDir]
-> [SymbolicPath PackageDir SourceDir]
forall a. a -> [a] -> [a]
:)
BuildInfo -> (BuildInfo -> BuildInfo) -> BuildInfo
forall a b. a -> (a -> b) -> b
& LensLike Identity BuildInfo BuildInfo [ModuleName] [ModuleName]
forall a. HasBuildInfo a => Lens' a [ModuleName]
Lens' BuildInfo [ModuleName]
otherModules LensLike Identity BuildInfo BuildInfo [ModuleName] [ModuleName]
-> ([ModuleName] -> [ModuleName]) -> BuildInfo -> BuildInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String -> ModuleName
forall a. IsString a => String -> a
fromString String
"Clash.Clashilator.FFI"ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
:)
where
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
clk :: Maybe String
clk = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-clashilator-clock" ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Getting [(String, String)] BuildInfo [(String, String)]
-> BuildInfo -> [(String, String)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(String, String)] BuildInfo [(String, String)]
forall a. HasBuildInfo a => Lens' a [(String, String)]
Lens' BuildInfo [(String, String)]
customFieldsBI BuildInfo
buildInfo
srcDirs :: [String]
srcDirs = SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
[SymbolicPath PackageDir SourceDir]
BuildInfo
[SymbolicPath PackageDir SourceDir]
-> BuildInfo -> [SymbolicPath PackageDir SourceDir]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
[SymbolicPath PackageDir SourceDir]
BuildInfo
[SymbolicPath PackageDir SourceDir]
forall a.
HasBuildInfo a =>
Lens' a [SymbolicPath PackageDir SourceDir]
Lens' BuildInfo [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
buildInfo
outDir :: String
outDir = case Maybe UnqualComponentName
compName of
Maybe UnqualComponentName
Nothing -> LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi
Just UnqualComponentName
name -> LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name
verilatorDir :: String
verilatorDir = String
outDir String -> String -> String
</> String
"_clashilator" String -> String -> String
</> String
"verilator"
synDir :: String
synDir = String
outDir String -> String -> String
</> String
"_clashilator" String -> String -> String
</> String
"clash-syn"
clashilate :: LocalBuildInfo -> BuildFlags -> Component -> IO BuildInfo
clashilate :: ComponentHook
clashilate LocalBuildInfo
lbi BuildFlags
flags Component
c = do
#ifdef RESET_LINKER
linker <- uninitializedLinker
let startAction = do
env <- getSession
setSession (env {hsc_dynLinker = linker})
#else
let startAction :: Ghc ()
startAction = () -> Ghc ()
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
Ghc ()
-> LocalBuildInfo
-> BuildFlags
-> Maybe UnqualComponentName
-> BuildInfo
-> IO BuildInfo
buildVerilator Ghc ()
startAction LocalBuildInfo
lbi BuildFlags
flags (ComponentName -> Maybe UnqualComponentName
componentNameString (ComponentName -> Maybe UnqualComponentName)
-> ComponentName -> Maybe UnqualComponentName
forall a b. (a -> b) -> a -> b
$ Component -> ComponentName
componentName Component
c) (Component
c Component -> Getting BuildInfo Component BuildInfo -> BuildInfo
forall s a. s -> Getting a s a -> a
^. Getting BuildInfo Component BuildInfo
forall a. HasBuildInfo a => Lens' a BuildInfo
Lens' Component BuildInfo
buildInfo)
clashilatorMain :: IO ()
clashilatorMain :: IO ()
clashilatorMain = UserHooks -> IO ()
defaultMainWithHooks UserHooks
simpleUserHooks
{ buildHook = clashilatorBuildHook
}