-- |
-- Module      : Verismith.Tool.QuartusLight
-- Description : QuartusLight synthesiser implementation.
-- Copyright   : (c) 2019, Yann Herklotz Grave
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
--
-- QuartusLight synthesiser implementation.
module Verismith.Tool.QuartusLight
  ( QuartusLight (..),
    defaultQuartusLight,
  )
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 QuartusLight = QuartusLight
  { QuartusLight -> Maybe FilePath
quartusLightBin :: !(Maybe FilePath),
    QuartusLight -> Text
quartusLightDesc :: !Text,
    QuartusLight -> FilePath
quartusLightOutput :: !FilePath
  }
  deriving (QuartusLight -> QuartusLight -> Bool
(QuartusLight -> QuartusLight -> Bool)
-> (QuartusLight -> QuartusLight -> Bool) -> Eq QuartusLight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuartusLight -> QuartusLight -> Bool
== :: QuartusLight -> QuartusLight -> Bool
$c/= :: QuartusLight -> QuartusLight -> Bool
/= :: QuartusLight -> QuartusLight -> Bool
Eq)

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

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

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

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

defaultQuartusLight :: QuartusLight
defaultQuartusLight :: QuartusLight
defaultQuartusLight = Maybe FilePath -> Text -> FilePath -> QuartusLight
QuartusLight Maybe FilePath
forall a. Maybe a
Nothing Text
"quartus" FilePath
"syn_quartus.v"

runSynthQuartusLight :: (Show ann) => QuartusLight -> (SourceInfo ann) -> ResultSh ()
runSynthQuartusLight :: forall ann.
Show ann =>
QuartusLight -> SourceInfo ann -> ResultSh ()
runSynthQuartusLight QuartusLight
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
"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
$ QuartusLight -> FilePath -> Text -> FilePath -> Text
forall a.
Synthesiser a =>
a -> FilePath -> Text -> FilePath -> Text
quartusLightSynthConfig QuartusLight
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
$
      QuartusLight -> FilePath
forall a. Synthesiser a => a -> FilePath
synthOutput QuartusLight
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
$ QuartusLight -> FilePath
forall a. Synthesiser a => a -> FilePath
synthOutput QuartusLight
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
$ QuartusLight -> Maybe FilePath
quartusLightBin QuartusLight
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"