{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell #-}
module Clash.Shake.Xilinx
( Target(..), targetPart
, Board(..)
, ise
, vivado
, papilioPro, papilioOne, nexysA750T, basys3
) where
import Clash.Shake
import Development.Shake
import Development.Shake.Command
import Development.Shake.FilePath
import Development.Shake.Config
import Text.Mustache
import qualified Text.Mustache.Compile.TH as TH
import Data.Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.IO as T
data Target = Target
{ Target -> String
targetFamily :: String
, Target -> String
targetDevice :: String
, Target -> String
targetPackage :: String
, Target -> Word
targetSpeed :: Word
}
targetPart :: Target -> String
targetPart :: Target -> String
targetPart Target{String
Word
targetSpeed :: Word
targetPackage :: String
targetDevice :: String
targetFamily :: String
targetSpeed :: Target -> Word
targetPackage :: Target -> String
targetDevice :: Target -> String
targetFamily :: Target -> String
..} = String
targetDevice String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
targetPackage String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
targetSpeed
targetMustache :: Target -> [Aeson.Pair]
targetMustache :: Target -> [Pair]
targetMustache target :: Target
target@Target{String
Word
targetSpeed :: Word
targetPackage :: String
targetDevice :: String
targetFamily :: String
targetSpeed :: Target -> Word
targetPackage :: Target -> String
targetDevice :: Target -> String
targetFamily :: Target -> String
..} =
[ Key
"targetFamily" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
targetFamily
, Key
"targetDevice" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
targetDevice
, Key
"targetPackage" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
targetPackage
, Key
"targetSpeed" Key -> Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word
targetSpeed
, Key
"part" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack (Target -> String
targetPart Target
target)
]
papilioPro :: Target
papilioPro :: Target
papilioPro = String -> String -> String -> Word -> Target
Target String
"Spartan6" String
"xc6slx9" String
"tqg144" Word
2
papilioOne :: Target
papilioOne :: Target
papilioOne = String -> String -> String -> Word -> Target
Target String
"Spartan3E" String
"xc3s500e" String
"vq100" Word
5
data Board = Board
{ Board -> String
boardSpec :: String
, Board -> Target
boardTarget :: Target
}
boardMustache :: Board -> [Aeson.Pair]
boardMustache :: Board -> [Pair]
boardMustache Board{String
Target
boardTarget :: Target
boardSpec :: String
boardTarget :: Board -> Target
boardSpec :: Board -> String
..} =
[ Key
"board" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
boardSpec
] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
Target -> [Pair]
targetMustache Target
boardTarget
nexysA750T :: Board
nexysA750T :: Board
nexysA750T = String -> Target -> Board
Board String
"digilentinc.com:nexys=a7-50t:part0:1.0" (Target -> Board) -> Target -> Board
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> Word -> Target
Target String
"artix7" String
"xc7a50t" String
"csg324" Word
1
basys3 :: Board
basys3 :: Board
basys3 = String -> Target -> Board
Board String
"digilentinc.com:basys3:part0:1.2" (Target -> Board) -> Target -> Board
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> Word -> Target
Target String
"artix7" String
"xc7a35t" String
"cpg236" Word
1
ise :: Target -> ClashKit -> FilePath -> FilePath -> String -> Rules SynthKit
ise :: Target -> ClashKit -> String -> String -> String -> Rules SynthKit
ise Target
fpga kit :: ClashKit
kit@ClashKit{Action [String]
manifestSrcs :: ClashKit -> Action [String]
manifestSrcs :: Action [String]
..} String
outDir String
srcDir String
topName = do
let projectName :: String
projectName = String
topName
rootDir :: String
rootDir = [String] -> String
joinPath ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a b. a -> b -> a
const String
"..") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
outDir
let ise :: String -> [String] -> Action ()
ise String
tool [String]
args = (CmdOption -> [String] -> Action ()) :-> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (String -> CmdOption
Cwd String
outDir) ([String] -> Action ()) -> Action [String] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> [String] -> Action [String]
toolchain String
"ISE" String
tool [String]
args
let getFiles :: String -> [String] -> Action [String]
getFiles String
dir [String]
pats = String -> [String] -> Action [String]
getDirectoryFiles String
srcDir [ String
dir String -> String -> String
</> String
pat | String
pat <- [String]
pats ]
hdlSrcs :: Action [String]
hdlSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.vhdl", String
"*.v", String
"*.ucf" ]
ipCores :: Action [String]
ipCores = String -> [String] -> Action [String]
getFiles String
"ipcore_dir" [String
"*.xco", String
"*.xaw"]
String
outDir String -> String -> String
<//> String
"*.tcl" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
srcs1 <- Action [String]
manifestSrcs
[String]
srcs2 <- Action [String]
hdlSrcs
[String]
cores <- Action [String]
ipCores
let template :: Template
template = $(TH.compileMustacheFile "template/xilinx-ise/project.tcl.mustache")
let values :: Value
values = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Key
"project" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
projectName ]
, [ Key
"top" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
topName ]
, Target -> [Pair]
targetMustache Target
fpga
, [ Key
"srcs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [[Value]] -> [Value]
forall a. Monoid a => [a] -> a
mconcat
[ [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
rootDir String -> String -> String
</> String
src) ] | String
src <- [String]
srcs1 ]
, [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
rootDir String -> String -> String
</> String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
srcs2 ]
, [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
core ] | String
core <- [String]
cores ]
]
]
, [ Key
"ipcores" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ [Pair] -> Value
object [ Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
takeBaseName String
core ] | String
core <- [String]
cores ] ]
]
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
out (String -> Action ()) -> (Text -> String) -> Text -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> Action ()) -> Text -> Action ()
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
renderMustache Template
template Value
values
String
outDir String -> String -> String
</> String
"ipcore_dir" String -> String -> String
<//> String
"*" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let src :: String
src = String
srcDir String -> String -> String
</> String -> String -> String
makeRelative String
outDir String
out
Partial => String -> String -> Action ()
String -> String -> Action ()
copyFileChanged String
src String
out
String
outDir String -> String -> String
</> String
topName String -> String -> String
<.> String
"bit" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
_out -> do
[String]
srcs1 <- Action [String]
manifestSrcs
[String]
srcs2 <- Action [String]
hdlSrcs
[String]
cores <- Action [String]
ipCores
Partial => [String] -> Action ()
[String] -> Action ()
need ([String] -> Action ()) -> [String] -> Action ()
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
[ [ String
outDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"tcl" ]
, [ String
src | String
src <- [String]
srcs1 ]
, [ String
srcDir String -> String -> String
</> String
src | String
src <- [String]
srcs2 ]
, [ String
outDir String -> String -> String
</> String
core | String
core <- [String]
cores ]
]
String -> [String] -> Action ()
ise String
"xtclsh" [String
projectName String -> String -> String
<.> String
"tcl", String
"rebuild_project"]
SynthKit -> Rules SynthKit
forall (m :: * -> *) a. Monad m => a -> m a
return (SynthKit -> Rules SynthKit) -> SynthKit -> Rules SynthKit
forall a b. (a -> b) -> a -> b
$ SynthKit :: String -> [(String, Action ())] -> SynthKit
SynthKit
{ bitfile :: String
bitfile = String
outDir String -> String -> String
</> String
topName String -> String -> String
<.> String
"bit"
, phonies :: [(String, Action ())]
phonies =
[ String
"ise" String -> Action () -> (String, Action ())
|> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
outDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"tcl"]
String -> [String] -> Action ()
ise String
"ise" [String
outDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"tcl"]
]
}
vivado :: Board -> ClashKit -> FilePath -> FilePath -> String -> Rules SynthKit
vivado :: Board -> ClashKit -> String -> String -> String -> Rules SynthKit
vivado Board
board kit :: ClashKit
kit@ClashKit{Action [String]
manifestSrcs :: Action [String]
manifestSrcs :: ClashKit -> Action [String]
..} String
outDir String
srcDir String
topName = do
let projectName :: String
projectName = String
topName
projectDir :: String
projectDir = String
outDir String -> String -> String
</> String
projectName
xpr :: String
xpr = String
projectDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"xpr"
rootDir :: String
rootDir = [String] -> String
joinPath ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a b. a -> b -> a
const String
"..") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
outDir
let vivado :: String -> [String] -> Action ()
vivado String
tool [String]
args = (CmdOption -> [String] -> Action ()) :-> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (String -> CmdOption
Cwd String
outDir) ([String] -> Action ()) -> Action [String] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> [String] -> Action [String]
toolchain String
"VIVADO" String
tool [String]
args
vivadoBatch :: String -> Action ()
vivadoBatch String
tcl = do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
outDir String -> String -> String
</> String
tcl]
String -> [String] -> Action ()
vivado String
"vivado"
[ String
"-mode", String
"batch"
, String
"-nojournal"
, String
"-nolog"
, String
"-source", String
tcl
]
let getFiles :: String -> [String] -> Action [String]
getFiles String
dir [String]
pats = String -> [String] -> Action [String]
getDirectoryFiles String
srcDir [ String
dir String -> String -> String
</> String
pat | String
pat <- [String]
pats ]
hdlSrcs :: Action [String]
hdlSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.vhdl", String
"*.v" ]
constrSrcs :: Action [String]
constrSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.xdc" ]
ipCores :: Action [String]
ipCores = String -> [String] -> Action [String]
getFiles String
"ip" [String
"*.xci"]
String
xpr Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> String -> Action ()
vivadoBatch String
"project.tcl"
String
outDir String -> String -> String
</> String
"project.tcl" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
srcs1 <- Action [String]
manifestSrcs
[String]
srcs2 <- Action [String]
hdlSrcs
[String]
cores <- Action [String]
ipCores
[String]
constrs <- Action [String]
constrSrcs
let template :: Template
template = $(TH.compileMustacheFile "template/xilinx-vivado/project.tcl.mustache")
let values :: Value
values = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Key
"rootDir" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
rootDir]
, [ Key
"project" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
projectName ]
, [ Key
"top" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
topName ]
, Board -> [Pair]
boardMustache Board
board
, [ Key
"srcs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [[Value]] -> [Value]
forall a. Monoid a => [a] -> a
mconcat
[ [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
src ] | String
src <- [String]
srcs1 ]
, [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
srcs2 ]
]
]
, [ Key
"coreSrcs" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"nonempty" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cores)
, Key
"items" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
srcDir String -> String -> String
</> String
core) ] | String
core <- [String]
cores ]
]
]
, [ Key
"ipcores" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ [Pair] -> Value
object [ Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> String
takeBaseName String
core ] | String
core <- [String]
cores ] ]
, [ Key
"constraintSrcs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ [Pair] -> Value
object [ Key
"fileName" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
constrs ] ]
]
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
out (String -> Action ()) -> (Text -> String) -> Text -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> Action ()) -> Text -> Action ()
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
renderMustache Template
template Value
values
String
outDir String -> String -> String
</> String
"build.tcl" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let template :: Template
template = $(TH.compileMustacheFile "template/xilinx-vivado/project-build.tcl.mustache")
let values :: Value
values = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Key
"project" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
projectName ]
, [ Key
"top" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
topName ]
]
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
out (String -> Action ()) -> (Text -> String) -> Text -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> Action ()) -> Text -> Action ()
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
renderMustache Template
template Value
values
String
outDir String -> String -> String
</> String
"upload.tcl" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let template :: Template
template = $(TH.compileMustacheFile "template/xilinx-vivado/upload.tcl.mustache")
let values :: Value
values = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Key
"project" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
projectName ]
, [ Key
"top" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
T.pack String
topName ]
, Board -> [Pair]
boardMustache Board
board
]
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
out (String -> Action ()) -> (Text -> String) -> Text -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> Action ()) -> Text -> Action ()
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
renderMustache Template
template Value
values
String
projectDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"runs" String -> String -> String
</> String
"impl_1" String -> String -> String
</> String
topName String -> String -> String
<.> String
"bit" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
xpr]
String -> Action ()
vivadoBatch String
"build.tcl"
SynthKit -> Rules SynthKit
forall (m :: * -> *) a. Monad m => a -> m a
return SynthKit :: String -> [(String, Action ())] -> SynthKit
SynthKit
{ bitfile :: String
bitfile = String
projectDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"runs" String -> String -> String
</> String
"impl_1" String -> String -> String
</> String
topName String -> String -> String
<.> String
"bit"
, phonies :: [(String, Action ())]
phonies =
[ String
"vivado" String -> Action () -> (String, Action ())
|> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
xpr]
String -> [String] -> Action ()
vivado String
"vivado" [String
xpr]
, String
"upload" String -> Action () -> (String, Action ())
|> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
projectDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"runs" String -> String -> String
</> String
"impl_1" String -> String -> String
</> String
topName String -> String -> String
<.> String
"bit"]
String -> Action ()
vivadoBatch String
"upload.tcl"
]
}