-- |
-- Module      : Verismith.Tool.Quartus
-- Description : Quartus synthesiser implementation.
-- Copyright   : (c) 2019, Yann Herklotz Grave
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
--
-- Quartus synthesiser implementation.
module Verismith.Tool.Quartus
  ( Quartus (..),
    defaultQuartus,
  )
where

import Control.DeepSeq (NFData, rnf, rwhnf)
import Data.Text (Text, unpack)
import Shelly
import Shelly.Lifted (liftSh)
import Verismith.Tool.Internal
import Verismith.Tool.Template
import Verismith.Verilog.AST
import Verismith.Verilog.CodeGen
import Prelude hiding (FilePath)

data Quartus = Quartus
  { Quartus -> Maybe FilePath
quartusBin :: !(Maybe FilePath),
    Quartus -> Text
quartusDesc :: !Text,
    Quartus -> FilePath
quartusOutput :: !FilePath
  }
  deriving (Quartus -> Quartus -> Bool
(Quartus -> Quartus -> Bool)
-> (Quartus -> Quartus -> Bool) -> Eq Quartus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quartus -> Quartus -> Bool
== :: Quartus -> Quartus -> Bool
$c/= :: Quartus -> Quartus -> Bool
/= :: Quartus -> Quartus -> Bool
Eq)

instance Tool Quartus where
  toText :: Quartus -> Text
toText (Quartus Maybe FilePath
_ Text
t FilePath
_) = Text
t

instance Show Quartus where
  show :: Quartus -> FilePath
show Quartus
t = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Quartus -> Text
forall a. Tool a => a -> Text
toText Quartus
t

instance Synthesiser Quartus where
  runSynth :: forall ann. Show ann => Quartus -> SourceInfo ann -> ResultSh ()
runSynth = Quartus -> SourceInfo ann -> ResultSh ()
forall ann. Show ann => Quartus -> SourceInfo ann -> ResultSh ()
runSynthQuartus
  synthOutput :: Quartus -> FilePath
synthOutput = Quartus -> FilePath
quartusOutput
  setSynthOutput :: Quartus -> FilePath -> Quartus
setSynthOutput (Quartus Maybe FilePath
a Text
b FilePath
_) = Maybe FilePath -> Text -> FilePath -> Quartus
Quartus Maybe FilePath
a Text
b

instance NFData Quartus where
  rnf :: Quartus -> ()
rnf = Quartus -> ()
forall a. a -> ()
rwhnf

defaultQuartus :: Quartus
defaultQuartus :: Quartus
defaultQuartus = Maybe FilePath -> Text -> FilePath -> Quartus
Quartus Maybe FilePath
forall a. Maybe a
Nothing Text
"quartus" FilePath
"syn_quartus.v"

runSynthQuartus :: (Show ann) => Quartus -> (SourceInfo ann) -> ResultSh ()
runSynthQuartus :: forall ann. Show ann => Quartus -> SourceInfo ann -> ResultSh ()
runSynthQuartus Quartus
sim (SourceInfo Text
top Verilog ann
src) = do
  FilePath
dir <- Sh FilePath -> ResultT Failed Sh FilePath
forall a. Sh a -> ResultT Failed Sh a
forall (m :: * -> *) a. MonadSh m => Sh a -> m a
liftSh Sh FilePath
pwd
  let ex :: FilePath -> [Text] -> ResultSh ()
ex = Failed -> FilePath -> Text -> FilePath -> [Text] -> ResultSh ()
forall (m :: * -> *).
(MonadSh m, Monad m) =>
Failed
-> FilePath -> Text -> FilePath -> [Text] -> ResultT Failed m ()
execute_ Failed
SynthFail FilePath
dir Text
"quartus"
  Sh () -> ResultSh ()
forall a. Sh a -> ResultT Failed Sh a
forall (m :: * -> *) a. MonadSh m => Sh a -> m a
liftSh (Sh () -> ResultSh ()) -> Sh () -> ResultSh ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Text -> Sh ()
writefile FilePath
inpf (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Verilog ann -> Text
forall a. Source a => a -> Text
genSource Verilog ann
src
    Sh () -> Sh ()
forall a. Sh a -> Sh a
noPrint (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> [Text] -> Sh ()
run_
        FilePath
"sed"
        [ Text
"-i",
          Text
"s/^module/(* multstyle = \"logic\" *) module/;",
          FilePath -> Text
toTextIgnore FilePath
inpf
        ]
    FilePath -> Text -> Sh ()
writefile FilePath
quartusSdc (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
"create_clock -period 5 -name clk [get_ports clock]"
    FilePath -> Text -> Sh ()
writefile FilePath
quartusTcl (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Quartus -> FilePath -> Text -> FilePath -> Text
forall a.
Synthesiser a =>
a -> FilePath -> Text -> FilePath -> Text
quartusSynthConfig Quartus
sim FilePath
quartusSdc Text
top FilePath
inpf
  FilePath -> [Text] -> ResultSh ()
ex (Text -> FilePath
exec Text
"quartus_sh") [Text
"-t", FilePath -> Text
toTextIgnore FilePath
quartusTcl]
  Sh () -> ResultSh ()
forall a. Sh a -> ResultT Failed Sh a
forall (m :: * -> *) a. MonadSh m => Sh a -> m a
liftSh (Sh () -> ResultSh ()) -> Sh () -> ResultSh ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> FilePath -> Sh ()
cp (Text -> FilePath
fromText Text
"simulation/vcs" FilePath -> ShowS
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> Text -> FilePath
fromText Text
top FilePath -> Text -> FilePath
forall filepath.
ToFilePath filepath =>
filepath -> Text -> FilePath
<.> Text
"vo") (FilePath -> Sh ()) -> FilePath -> Sh ()
forall a b. (a -> b) -> a -> b
$
      Quartus -> FilePath
forall a. Synthesiser a => a -> FilePath
synthOutput Quartus
sim
    FilePath -> [Text] -> Sh ()
run_
      FilePath
"sed"
      [ Text
"-ri",
        Text
"s,^// DATE.*,,; s,^tri1 (.*);,wire \\1 = 1;,; /^\\/\\/ +synopsys/ d;",
        FilePath -> Text
toTextIgnore (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Quartus -> FilePath
forall a. Synthesiser a => a -> FilePath
synthOutput Quartus
sim
      ]
  where
    inpf :: FilePath
inpf = FilePath
"rtl.v"
    exec :: Text -> FilePath
exec Text
s = FilePath -> ShowS -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> FilePath
fromText Text
s) (FilePath -> ShowS
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> Text -> FilePath
fromText Text
s) (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Quartus -> Maybe FilePath
quartusBin Quartus
sim
    quartusTcl :: FilePath
quartusTcl = Text -> FilePath
fromText Text
top FilePath -> Text -> FilePath
forall filepath.
ToFilePath filepath =>
filepath -> Text -> FilePath
<.> Text
"tcl"
    quartusSdc :: FilePath
quartusSdc = Text -> FilePath
fromText Text
top FilePath -> Text -> FilePath
forall filepath.
ToFilePath filepath =>
filepath -> Text -> FilePath
<.> Text
"sdc"