    {-|
      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)