{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell #-}
module Clash.Shake.F4PGA
    ( xilinx7
    , openFPGALoader
    ) where

import Clash.Shake
import qualified Clash.Shake.Xilinx as Xilinx

import Development.Shake
import Development.Shake.Command
import Development.Shake.FilePath
import Development.Shake.Config

xilinx7 :: Xilinx.Board -> ClashKit -> FilePath -> FilePath -> String -> Rules SynthKit
xilinx7 :: Board
-> ClashKit -> FilePath -> FilePath -> FilePath -> Rules SynthKit
xilinx7 Xilinx.Board{ boardTarget :: Board -> Target
boardTarget = target :: Target
target@Xilinx.Target{FilePath
Word
targetSpeed :: Target -> Word
targetPackage :: Target -> FilePath
targetDevice :: Target -> FilePath
targetFamily :: Target -> FilePath
targetSpeed :: Word
targetPackage :: FilePath
targetDevice :: FilePath
targetFamily :: FilePath
..} } kit :: ClashKit
kit@ClashKit{Action [FilePath]
manifestSrcs :: ClashKit -> Action [FilePath]
manifestSrcs :: Action [FilePath]
..} FilePath
outDir FilePath
srcDir FilePath
topName = do
    let rootDir :: FilePath
rootDir = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a b. a -> b -> a
const FilePath
"..") ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
outDir

    let symbiflow' :: String -> [String] -> Action ()
        symbiflow' :: FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
tool [FilePath]
args = (CmdOption -> CmdOption -> [FilePath] -> Action ()) :-> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (Bool -> CmdOption
EchoStdout Bool
False) (FilePath -> CmdOption
Cwd FilePath
outDir) ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> [FilePath] -> Action [FilePath]
toolchain FilePath
"SYMBIFLOW" FilePath
tool [FilePath]
args
        symbiflow :: String -> [String] -> Action ()
        symbiflow :: FilePath -> [FilePath] -> Action ()
symbiflow FilePath
tool [FilePath]
args = CmdOption -> [FilePath] -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (Bool -> CmdOption
EchoStdout Bool
False) ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> [FilePath] -> Action [FilePath]
toolchain FilePath
"SYMBIFLOW" FilePath
tool [FilePath]
args

    let getFiles :: FilePath -> [FilePath] -> Action [FilePath]
getFiles FilePath
dir [FilePath]
pats = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
srcDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> Action [FilePath] -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles FilePath
srcDir [ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
pat | FilePath
pat <- [FilePath]
pats ]
        verilogSrcs :: Action [FilePath]
verilogSrcs = FilePath -> [FilePath] -> Action [FilePath]
getFiles FilePath
"src-hdl" [FilePath
"*.v"]
        xdcSrcs :: Action [FilePath]
xdcSrcs = FilePath -> [FilePath] -> Action [FilePath]
getFiles FilePath
"src-hdl" [FilePath
"*.xdc" ]

    FilePath
outDir FilePath -> FilePath -> FilePath
</> FilePath
topName FilePath -> FilePath -> FilePath
<.> FilePath
"eblif" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        [FilePath]
srcs <- Action [FilePath]
manifestSrcs
        [FilePath]
verilogs <- Action [FilePath]
verilogSrcs
        [FilePath]
xdcs <- Action [FilePath]
xdcSrcs
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$ [FilePath]
srcs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
verilogs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
xdcs

        FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
"symbiflow_synth" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetFamily
          , FilePath
"-p", Target -> FilePath
Xilinx.targetPart Target
target
          , FilePath
"-t", FilePath
topName
          ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
          [ FilePath
"-v " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
src | FilePath
src <- [FilePath]
srcs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
verilogs ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
          [ FilePath
"-x " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
xdc | FilePath
xdc <- [FilePath]
xdcs ]

    FilePath
outDir FilePath -> FilePath -> FilePath
<//> FilePath
"*.net" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        let eblif :: FilePath
eblif = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"eblif"
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
eblif]
        FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
"symbiflow_pack" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetDevice FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_test"
          , FilePath
"-e", FilePath -> FilePath
takeFileName FilePath
eblif
          ]

    FilePath
outDir FilePath -> FilePath -> FilePath
<//> FilePath
"*.place" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        let eblif :: FilePath
eblif = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"eblif"
            net :: FilePath
net = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"net"
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
eblif, FilePath
net]
        FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
"symbiflow_place" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetDevice FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_test"
          , FilePath
"-P", Target -> FilePath
Xilinx.targetPart Target
target
          , FilePath
"-e", FilePath -> FilePath
takeFileName FilePath
eblif
          , FilePath
"-n", FilePath -> FilePath
takeFileName FilePath
net
          ]

    FilePath
outDir FilePath -> FilePath -> FilePath
<//> FilePath
"*.route" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        let eblif :: FilePath
eblif = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"eblif"
            place :: FilePath
place = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"place"
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
eblif, FilePath
place]
        FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
"symbiflow_route" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetDevice FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_test"
          , FilePath
"-e", FilePath -> FilePath
takeFileName FilePath
eblif
          ]

    FilePath
outDir FilePath -> FilePath -> FilePath
<//> FilePath
"*.fasm" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        let eblif :: FilePath
eblif = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"eblif"
            route :: FilePath
route = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"route"
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
eblif, FilePath
route]
        FilePath -> [FilePath] -> Action ()
symbiflow' FilePath
"symbiflow_write_fasm" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetDevice FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_test"
          , FilePath
"-e", FilePath -> FilePath
takeFileName FilePath
eblif
          ]

    FilePath
outDir FilePath -> FilePath -> FilePath
<//> FilePath
"*.bit" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> do
        let fasm :: FilePath
fasm = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"fasm"
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
fasm]
        FilePath -> [FilePath] -> Action ()
symbiflow FilePath
"symbiflow_write_bitstream" ([FilePath] -> Action ()) -> [FilePath] -> Action ()
forall a b. (a -> b) -> a -> b
$
          [ FilePath
"-d", FilePath
targetFamily
          , FilePath
"-p", Target -> FilePath
Xilinx.targetPart Target
target
          , FilePath
"-f", FilePath
fasm
          , FilePath
"-b", FilePath
out
          ]

    let bitfile :: FilePath
bitfile = FilePath
outDir FilePath -> FilePath -> FilePath
</> FilePath
topName FilePath -> FilePath -> FilePath
<.> FilePath
"bit"

    SynthKit -> Rules SynthKit
forall (m :: * -> *) a. Monad m => a -> m a
return SynthKit :: FilePath -> [(FilePath, Action ())] -> SynthKit
SynthKit
        { bitfile :: FilePath
bitfile = FilePath
bitfile
        , phonies :: [(FilePath, Action ())]
phonies =
            [ FilePath
"upload" FilePath -> Action () -> (FilePath, Action ())
|> [FilePath] -> FilePath -> Action ()
openFPGALoader [FilePath
"-c", FilePath
"digilent"] FilePath
bitfile
            ]
        }

openFPGALoader :: [String] -> FilePath -> Action ()
openFPGALoader :: [FilePath] -> FilePath -> Action ()
openFPGALoader [FilePath]
args FilePath
bitfile = do
    Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
bitfile]
    [FilePath] -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> [FilePath] -> Action [FilePath]
toolchain FilePath
"OPENFPGALOADER" FilePath
"openFPGALoader" ([FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
bitfile])