{-|
  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
0Int -> Infinite Int
forall a. Enum a => a -> Infinite a
...)

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
      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
      DSL.declarationReturn bbCtx blockName $ do

        rstHigh <- DSL.unsafeToActiveHigh "reset" rst
        pllOuts <- DSL.declareN "pllOut" pllOutTys
        locked <- DSL.declare "locked" Bit
        pllLock <- DSL.boolFromBit "pllLock" locked

        let 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)]
compClkInps [(IdentifierText, HWType)]
-> [(IdentifierText, HWType)] -> [(IdentifierText, HWType)]
forall a. Semigroup a => a -> a -> a
<> [ (IdentifierText
"reset", HWType
Bit) ]
            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 = 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] -> [(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)]

        DSL.compInBlock compName compInps compOuts
        DSL.instDecl Empty (Id.unsafeMake compName) clkWizInstName [] inps outs

        pure [DSL.constructProduct resultTy (pllOuts <> [pllLock])]
  | Bool
otherwise
  = String -> State s Doc
forall a. HasCallStack => String -> a
error (String -> State s Doc) -> String -> State s Doc
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> String
forall a. Show a => a -> String
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
    = String -> [(a, TExpr)]
forall a. HasCallStack => String -> a
error (String -> [(a, TExpr)]) -> String -> [(a, TExpr)]
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> String
forall a. Show a => a -> String
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
_ =
      String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Internal error: not a KnownDomain\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> String
forall a. Show a => a -> String
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
forall a. Semigroup a => a -> a -> a
<>) ([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
  = String -> StateT s Identity Doc
forall a. HasCallStack => String -> a
error (String
"clockWizardTclTemplate: bad bbContext: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BlackBoxContext -> String
forall a. Show a => a -> String
show BlackBoxContext
bbCtx)