{-|
  Copyright   :  (C) 2023, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

  Blackbox template functions for
  Clash.Xilinx.ClockGen.{clockWizard,clockWizardDifferential}
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}

module Clash.Primitives.Xilinx.ClockGen
  ( clockWizardTF
  , clockWizardTclTF
  , clockWizardDifferentialTF
  , clockWizardDifferentialTclTF
  ) where

import Control.Monad.State (State)
import Data.List.Infinite (Infinite(..), (...))
import Data.Maybe (fromMaybe)
import Data.String.Interpolate (i)
import qualified Data.Text as T
import Prettyprinter.Interpolate (__di)
import Text.Show.Pretty (ppShow)

import Clash.Signal (periodToHz)

import Clash.Backend (Backend)
import qualified Clash.Netlist.Id as Id
import Clash.Netlist.Types
import Clash.Netlist.Util (stripVoid)
import qualified Clash.Primitives.DSL as DSL
import Data.Text.Extra (showt)
import Data.Text.Prettyprint.Doc.Extra (Doc)

usedArguments :: [Int]
usedArguments :: [Int]
usedArguments = [Int
knownDomIn, Int
clocksCxt, Int
clk, Int
rst]
 where
  Int
knownDomIn
    :< Int
_clocksClass
    :< Int
clocksCxt
    :< Int
_numOutClocks
    :< Int
clk
    :< Int
rst
    :< Infinite Int
_ = (Int
0...)

clockWizardTF :: TemplateFunction
clockWizardTF :: TemplateFunction
clockWizardTF =
  [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
usedArguments BlackBoxContext -> Bool
forall {b}. b -> Bool
valid (Bool -> BlackBoxContext -> State s Doc
forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTemplate Bool
False)
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

clockWizardDifferentialTF :: TemplateFunction
clockWizardDifferentialTF :: TemplateFunction
clockWizardDifferentialTF =
  [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
usedArguments BlackBoxContext -> Bool
forall {b}. b -> Bool
valid (Bool -> BlackBoxContext -> State s Doc
forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTemplate Bool
True)
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

clockWizardTemplate
  :: Backend s
  => Bool
  -> BlackBoxContext
  -> State s Doc
clockWizardTemplate :: forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTemplate Bool
isDifferential BlackBoxContext
bbCtx
  | [ TExpr
_knownDomIn
    , TExpr
_clocksClass
    , TExpr
_clocksCxt
    , TExpr
_numOutClocks
    , TExpr
clk
    , TExpr
rst
    ] <- ((TExpr, HWType) -> TExpr) -> [(TExpr, HWType)] -> [TExpr]
forall a b. (a -> b) -> [a] -> [b]
map (TExpr, HWType) -> TExpr
forall a b. (a, b) -> a
fst (BlackBoxContext -> [(TExpr, HWType)]
DSL.tInputs BlackBoxContext
bbCtx)
  , [TExpr -> HWType
DSL.ety -> HWType
resultTy] <- BlackBoxContext -> [TExpr]
DSL.tResults BlackBoxContext
bbCtx
  , Product IdentifierText
_ Maybe [IdentifierText]
_ ([HWType] -> [HWType]
forall a. HasCallStack => [a] -> [a]
init -> [HWType]
pllOutTys) <- HWType
resultTy
  , [IdentifierText
compName] <- BlackBoxContext -> [IdentifierText]
bbQsysIncName BlackBoxContext
bbCtx
  = do
      Identifier
clkWizInstName <- IdentifierText -> StateT s Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
IdentifierText -> m Identifier
Id.makeBasic (IdentifierText -> StateT s Identity Identifier)
-> IdentifierText -> StateT s Identity Identifier
forall a b. (a -> b) -> a -> b
$ IdentifierText -> Maybe IdentifierText -> IdentifierText
forall a. a -> Maybe a -> a
fromMaybe IdentifierText
"clk_wiz" (Maybe IdentifierText -> IdentifierText)
-> Maybe IdentifierText -> IdentifierText
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> Maybe IdentifierText
bbCtxName BlackBoxContext
bbCtx
      BlackBoxContext
-> IdentifierText -> State (BlockState s) [TExpr] -> State s Doc
forall backend.
Backend backend =>
BlackBoxContext
-> IdentifierText
-> State (BlockState backend) [TExpr]
-> State backend Doc
DSL.declarationReturn BlackBoxContext
bbCtx IdentifierText
blockName (State (BlockState s) [TExpr] -> State s Doc)
-> State (BlockState s) [TExpr] -> State s Doc
forall a b. (a -> b) -> a -> b
$ do

        TExpr
rstHigh <- IdentifierText -> TExpr -> State (BlockState s) TExpr
forall backend.
Backend backend =>
IdentifierText -> TExpr -> State (BlockState backend) TExpr
DSL.unsafeToActiveHigh IdentifierText
"reset" TExpr
rst
        [TExpr]
pllOuts <- IdentifierText -> [HWType] -> State (BlockState s) [TExpr]
forall backend.
Backend backend =>
IdentifierText -> [HWType] -> State (BlockState backend) [TExpr]
DSL.declareN IdentifierText
"pllOut" [HWType]
pllOutTys
        TExpr
locked <- IdentifierText -> HWType -> State (BlockState s) TExpr
forall backend.
Backend backend =>
IdentifierText -> HWType -> State (BlockState backend) TExpr
DSL.declare IdentifierText
"locked" HWType
Bit
        TExpr
pllLock <- IdentifierText -> TExpr -> State (BlockState s) TExpr
forall backend.
(HasCallStack, Backend backend) =>
IdentifierText -> TExpr -> State (BlockState backend) TExpr
DSL.boolFromBit IdentifierText
"pllLock" TExpr
locked

        let pllOutNames :: [IdentifierText]
pllOutNames =
              (Int -> IdentifierText) -> [Int] -> [IdentifierText]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> IdentifierText
"clk_out" IdentifierText -> IdentifierText -> IdentifierText
forall a. Semigroup a => a -> a -> a
<> Int -> IdentifierText
forall a. Show a => a -> IdentifierText
showt Int
n) [Int
1 .. [HWType] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
pllOutTys]
            compInps :: [(IdentifierText, HWType)]
compInps = [(IdentifierText, HWType)]
compClkInps [(IdentifierText, HWType)]
-> [(IdentifierText, HWType)] -> [(IdentifierText, HWType)]
forall a. Semigroup a => a -> a -> a
<> [ (IdentifierText
"reset", HWType
Bit) ]
            compOuts :: [(IdentifierText, HWType)]
compOuts = [IdentifierText] -> [HWType] -> [(IdentifierText, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IdentifierText]
pllOutNames [HWType]
pllOutTys [(IdentifierText, HWType)]
-> [(IdentifierText, HWType)] -> [(IdentifierText, HWType)]
forall a. Semigroup a => a -> a -> a
<> [(IdentifierText
"locked", HWType
Bit)]
            inps :: [(IdentifierText, TExpr)]
inps = TExpr -> [(IdentifierText, TExpr)]
forall {a}. IsString a => TExpr -> [(a, TExpr)]
clkInps TExpr
clk [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)] -> [(IdentifierText, TExpr)]
forall a. Semigroup a => a -> a -> a
<> [ (IdentifierText
"reset", TExpr
rstHigh) ]
            outs :: [(IdentifierText, TExpr)]
outs = [IdentifierText] -> [TExpr] -> [(IdentifierText, TExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IdentifierText]
pllOutNames [TExpr]
pllOuts [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)] -> [(IdentifierText, TExpr)]
forall a. Semigroup a => a -> a -> a
<> [(IdentifierText
"locked", TExpr
locked)]

        IdentifierText
-> [(IdentifierText, HWType)]
-> [(IdentifierText, HWType)]
-> State (BlockState s) ()
forall backend.
Backend backend =>
IdentifierText
-> [(IdentifierText, HWType)]
-> [(IdentifierText, HWType)]
-> State (BlockState backend) ()
DSL.compInBlock IdentifierText
compName [(IdentifierText, HWType)]
compInps [(IdentifierText, HWType)]
compOuts
        EntityOrComponent
-> Identifier
-> Identifier
-> [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)]
-> State (BlockState s) ()
forall backend.
Backend backend =>
EntityOrComponent
-> Identifier
-> Identifier
-> [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)]
-> [(IdentifierText, TExpr)]
-> State (BlockState backend) ()
DSL.instDecl EntityOrComponent
Empty (HasCallStack => IdentifierText -> Identifier
IdentifierText -> Identifier
Id.unsafeMake IdentifierText
compName) Identifier
clkWizInstName [] [(IdentifierText, TExpr)]
inps [(IdentifierText, TExpr)]
outs

        [TExpr] -> State (BlockState s) [TExpr]
forall a. a -> StateT (BlockState s) Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [HWType -> [TExpr] -> TExpr
DSL.constructProduct HWType
resultTy ([TExpr]
pllOuts [TExpr] -> [TExpr] -> [TExpr]
forall a. Semigroup a => a -> a -> a
<> [TExpr
pllLock])]
  | Bool
otherwise
  = [Char] -> State s Doc
forall a. HasCallStack => [Char] -> a
error ([Char] -> State s Doc) -> [Char] -> State s Doc
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
ppShow BlackBoxContext
bbCtx
 where
  blockName :: IdentifierText
blockName | Bool
isDifferential = IdentifierText
"clockWizardDifferential"
            | Bool
otherwise      = IdentifierText
"clockWizard"
  compClkInps :: [(IdentifierText, HWType)]
compClkInps | Bool
isDifferential = [ (IdentifierText
"clk_in1_p", HWType
Bit)
                                 , (IdentifierText
"clk_in1_n", HWType
Bit)
                                 ]
              | Bool
otherwise      = [ (IdentifierText
"clk_in1", HWType
Bit) ]
  clkInps :: TExpr -> [(a, TExpr)]
clkInps TExpr
clk
    | Bool
isDifferential
    , DataCon (Product IdentifierText
"Clash.Signal.Internal.DiffClock" Maybe [IdentifierText]
_ [HWType]
clkTys) Modifier
_ [Expr]
clkEs
      <- TExpr -> Expr
DSL.eex TExpr
clk
    , [clkP :: Expr
clkP@(Identifier Identifier
_ Maybe Modifier
Nothing), clkN :: Expr
clkN@(Identifier Identifier
_ Maybe Modifier
Nothing)] <- [Expr]
clkEs
    , [HWType
clkPTy, HWType
clkNTy] <- [HWType]
clkTys
    = [ (a
"clk_in1_p", HWType -> Expr -> TExpr
DSL.TExpr HWType
clkPTy Expr
clkP)
      , (a
"clk_in1_n", HWType -> Expr -> TExpr
DSL.TExpr HWType
clkNTy Expr
clkN)
      ]
    | Bool -> Bool
not Bool
isDifferential
    = [ (a
"clk_in1", TExpr
clk) ]
    | Bool
otherwise
    = [Char] -> [(a, TExpr)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(a, TExpr)]) -> [Char] -> [(a, TExpr)]
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
ppShow BlackBoxContext
bbCtx

clockWizardTclTF :: TemplateFunction
clockWizardTclTF :: TemplateFunction
clockWizardTclTF =
  [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
usedArguments BlackBoxContext -> Bool
forall {b}. b -> Bool
valid (Bool -> BlackBoxContext -> State s Doc
forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTclTemplate Bool
False)
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

clockWizardDifferentialTclTF :: TemplateFunction
clockWizardDifferentialTclTF :: TemplateFunction
clockWizardDifferentialTclTF =
  [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
usedArguments BlackBoxContext -> Bool
forall {b}. b -> Bool
valid (Bool -> BlackBoxContext -> State s Doc
forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTclTemplate Bool
True)
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

clockWizardTclTemplate
  :: Backend s
  => Bool
  -> BlackBoxContext
  -> State s Doc
clockWizardTclTemplate :: forall s. Backend s => Bool -> BlackBoxContext -> State s Doc
clockWizardTclTemplate Bool
isDifferential BlackBoxContext
bbCtx
  |   (Expr
_,HWType -> HWType
stripVoid -> HWType
kdIn,Bool
_)
    : (Expr, HWType, Bool)
_clocksClass
    : (Expr
_,HWType -> HWType
stripVoid -> Product IdentifierText
_ Maybe [IdentifierText]
_ ([HWType] -> [HWType]
forall a. HasCallStack => [a] -> [a]
init -> [HWType]
kdOuts),Bool
_)
    : [(Expr, HWType, Bool)]
_ <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  , [IdentifierText
compName] <- BlackBoxContext -> [IdentifierText]
bbQsysIncName BlackBoxContext
bbCtx
  = let
    clkFreq :: HWType -> Double
clkFreq (KnownDomain IdentifierText
_ Integer
p ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_) =
      Natural -> Double
forall a. (HasCallStack, Fractional a) => Natural -> a
periodToHz (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
p) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6 :: Double
    clkFreq HWType
_ =
      [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Internal error: not a KnownDomain\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
ppShow BlackBoxContext
bbCtx

    clkInFreq :: Double
clkInFreq = HWType -> Double
clkFreq HWType
kdIn
    clkOutFreqs :: [Double]
clkOutFreqs = (HWType -> Double) -> [HWType] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Double
clkFreq [HWType]
kdOuts

    clkOutProps :: [IdentifierText]
clkOutProps = [[IdentifierText]] -> [IdentifierText]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
      [ [ [i|CONFIG.CLKOUT#{n}_USED true \\|]
        , [i|CONFIG.CLKOUT#{n}_REQUESTED_OUT_FREQ #{clkOutFreq} \\|]
        ]
      | (Double
clkOutFreq, Word
n) <- [Double] -> [Word] -> [(Double, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
clkOutFreqs [(Word
1::Word)..]
      ]

    differentialPinString :: T.Text
    differentialPinString :: IdentifierText
differentialPinString = if Bool
isDifferential
      then IdentifierText
"Differential_clock_capable_pin"
      else IdentifierText
"Single_ended_clock_capable_pin"

    propIndent :: IdentifierText
propIndent = Int -> IdentifierText -> IdentifierText
T.replicate Int
18 IdentifierText
" "
    props :: IdentifierText
props = IdentifierText -> [IdentifierText] -> IdentifierText
T.intercalate IdentifierText
"\n"  ([IdentifierText] -> IdentifierText)
-> ([IdentifierText] -> [IdentifierText])
-> [IdentifierText]
-> IdentifierText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierText -> IdentifierText)
-> [IdentifierText] -> [IdentifierText]
forall a b. (a -> b) -> [a] -> [b]
map (IdentifierText
propIndent <>) ([IdentifierText] -> IdentifierText)
-> [IdentifierText] -> IdentifierText
forall a b. (a -> b) -> a -> b
$
      [ [i|CONFIG.PRIM_SOURCE #{differentialPinString} \\|]
      , [i|CONFIG.PRIM_IN_FREQ #{clkInFreq} \\|]
      ] [IdentifierText] -> [IdentifierText] -> [IdentifierText]
forall a. Semigroup a => a -> a -> a
<> [IdentifierText]
clkOutProps

    bbText :: Doc ann
bbText = [__di|
      namespace eval $tclIface {
        variable api 1
        variable scriptPurpose createIp
        variable ipName {#{compName}}

        proc createIp {ipName0 args} {
          create_ip \\
            -name clk_wiz \\
            -vendor xilinx.com \\
            -library ip \\
            -version 6.0 \\
            -module_name $ipName0 \\
            {*}$args

          set_property \\
            -dict [list \\
      #{props}
                  ] [get_ips $ipName0]
          return
        }
      }|]
    in Doc -> StateT s Identity Doc
forall a. a -> StateT s Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall {ann}. Doc ann
bbText
  | Bool
otherwise
  = [Char] -> StateT s Identity Doc
forall a. HasCallStack => [Char] -> a
error ([Char]
"clockWizardTclTemplate: bad bbContext: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
show BlackBoxContext
bbCtx)