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

  Blackbox template functions for Clash.Intel.ClockGen
-}

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

module Clash.Primitives.Intel.ClockGen where

import Control.Monad.State
import Data.List (zip4)
import Data.List.Infinite (Infinite(..), (...))
import Data.Maybe (fromMaybe)
import Data.Text.Prettyprint.Doc.Extra
import Text.Show.Pretty (ppShow)

import Clash.Backend
import qualified Clash.Netlist.Id as Id
import Clash.Netlist.Types
import Clash.Netlist.Util
import qualified Clash.Primitives.DSL as DSL
import Clash.Signal (periodToHz)
import Data.Text.Extra (showt)

import qualified Data.String.Interpolate as I
import qualified Data.Text as TextS
import qualified Prettyprinter.Interpolate as I

data Variant = Altpll | AlteraPll

hdlUsed :: [Int]
hdlUsed :: [Int]
hdlUsed = [ 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
...)

hdlValid :: BlackBoxContext -> Bool
hdlValid :: BlackBoxContext -> Bool
hdlValid BlackBoxContext
bbCtx | [(Expr
_,Product {})] <- BlackBoxContext -> [(Expr, HWType)]
bbResults BlackBoxContext
bbCtx = Bool
True
hdlValid BlackBoxContext
_ = Bool
False

qsysUsed :: [Int]
qsysUsed :: [Int]
qsysUsed = [ Int
knownDomIn, Int
clocksCxt ]
 where
  Int
knownDomIn
    :< Int
_clocksClass
    :< Int
clocksCxt
    :< Infinite Int
_ = (Int
0Int -> Infinite Int
forall a. Enum a => a -> Infinite a
...)

altpllTF :: TemplateFunction
altpllTF :: TemplateFunction
altpllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
hdlUsed BlackBoxContext -> Bool
hdlValid (Variant -> BlackBoxContext -> State s Doc
forall s. Backend s => Variant -> BlackBoxContext -> State s Doc
hdlTemplate Variant
Altpll)

altpllQsysTF :: TemplateFunction
altpllQsysTF :: TemplateFunction
altpllQsysTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
qsysUsed BlackBoxContext -> Bool
forall b. b -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
altpllQsysTemplate
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

alteraPllTF :: TemplateFunction
alteraPllTF :: TemplateFunction
alteraPllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
hdlUsed BlackBoxContext -> Bool
hdlValid (Variant -> BlackBoxContext -> State s Doc
forall s. Backend s => Variant -> BlackBoxContext -> State s Doc
hdlTemplate Variant
AlteraPll)

alteraPllQsysTF :: TemplateFunction
alteraPllQsysTF :: TemplateFunction
alteraPllQsysTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
qsysUsed BlackBoxContext -> Bool
forall b. b -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
alteraPllQsysTemplate
 where
  valid :: b -> Bool
valid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True

hdlTemplate ::
  forall s .
  Backend s =>
  Variant ->
  BlackBoxContext ->
  State s Doc
hdlTemplate :: Variant -> BlackBoxContext -> State s Doc
hdlTemplate Variant
variant 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 Text
_ Maybe [Text]
_ ([HWType] -> [HWType]
forall a. [a] -> [a]
init -> [HWType]
pllOutTys) <- HWType
resultTy
  , [Text
compName] <- BlackBoxContext -> [Text]
bbQsysIncName BlackBoxContext
bbCtx
  = do
    let
      stdName :: Variant -> p
stdName Variant
Altpll = p
"altpll"
      stdName Variant
AlteraPll = p
"altera_pll"
      pllOutName :: Variant -> p
pllOutName Variant
Altpll = p
"c"
      pllOutName Variant
AlteraPll = p
"outclk_"
      clkInName :: Variant -> p
clkInName Variant
Altpll = p
"clk"
      clkInName Variant
AlteraPll = p
"refclk"
      rstName :: Variant -> p
rstName Variant
Altpll = p
"areset"
      rstName Variant
AlteraPll = p
"rst"

    Identifier
instName <- Text -> StateT s Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic (Text -> StateT s Identity Identifier)
-> Text -> StateT s Identity Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Variant -> Text
forall p. IsString p => Variant -> p
stdName Variant
variant) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> Maybe Text
bbCtxName BlackBoxContext
bbCtx

    -- TODO: unsafeMake is dubious here: I don't think we take names in
    -- TODO: bbQsysIncName into account when generating fresh ids
    let compNameId :: Identifier
compNameId = HasCallStack => Text -> Identifier
Text -> Identifier
Id.unsafeMake Text
compName

    BlackBoxContext
-> Text -> State (BlockState s) [TExpr] -> State s Doc
forall backend.
Backend backend =>
BlackBoxContext
-> Text -> State (BlockState backend) [TExpr] -> State backend Doc
DSL.declarationReturn BlackBoxContext
bbCtx (Variant -> Text
forall p. IsString p => Variant -> p
stdName Variant
variant Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_block") (State (BlockState s) [TExpr] -> State s Doc)
-> State (BlockState s) [TExpr] -> State s Doc
forall a b. (a -> b) -> a -> b
$ do

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

      let
        pllOutNames :: [Text]
pllOutNames =
          (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Variant -> Text
forall p. IsString p => Variant -> p
pllOutName Variant
variant Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
n)
            [Int
0 .. [HWType] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
pllOutTys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        compInps :: [(Text, HWType)]
compInps =
          [ (Variant -> Text
forall p. IsString p => Variant -> p
clkInName Variant
variant, TExpr -> HWType
DSL.ety TExpr
clk)
          , (Variant -> Text
forall p. IsString p => Variant -> p
rstName Variant
variant, TExpr -> HWType
DSL.ety TExpr
rstHigh)
          ]
        compOuts :: [(Text, HWType)]
compOuts = [Text] -> [HWType] -> [(Text, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
pllOutNames [HWType]
pllOutTys  [(Text, HWType)] -> [(Text, HWType)] -> [(Text, HWType)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"locked", HWType
Bit)]
        inps :: [(Text, TExpr)]
inps =
          [ (Variant -> Text
forall p. IsString p => Variant -> p
clkInName Variant
variant, TExpr
clk)
          , (Variant -> Text
forall p. IsString p => Variant -> p
rstName Variant
variant, TExpr
rstHigh)
          ]
        outs :: [(Text, TExpr)]
outs = [Text] -> [TExpr] -> [(Text, TExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
pllOutNames [TExpr]
pllOuts [(Text, TExpr)] -> [(Text, TExpr)] -> [(Text, TExpr)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"locked", TExpr
locked)]

      Text
-> [(Text, HWType)] -> [(Text, HWType)] -> State (BlockState s) ()
forall backend.
Backend backend =>
Text
-> [(Text, HWType)]
-> [(Text, HWType)]
-> State (BlockState backend) ()
DSL.compInBlock Text
compName [(Text, HWType)]
compInps [(Text, HWType)]
compOuts
      EntityOrComponent
-> Identifier
-> Identifier
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> State (BlockState s) ()
forall backend.
Backend backend =>
EntityOrComponent
-> Identifier
-> Identifier
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> [(Text, TExpr)]
-> State (BlockState backend) ()
DSL.instDecl EntityOrComponent
Empty Identifier
compNameId Identifier
instName [] [(Text, TExpr)]
inps [(Text, TExpr)]
outs

      [TExpr] -> State (BlockState s) [TExpr]
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

altpllQsysTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
altpllQsysTemplate :: BlackBoxContext -> State s Doc
altpllQsysTemplate BlackBoxContext
bbCtx
  |   (Expr
_,HWType -> HWType
stripVoid -> (KnownDomain Text
_ Integer
clkInPeriod ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_),Bool
_)
    : (Expr, HWType, Bool)
_clocksClass
    : (Expr
_,HWType -> HWType
stripVoid -> Product Text
_ Maybe [Text]
_ ([HWType] -> [HWType]
forall a. [a] -> [a]
init -> [HWType]
kdOuts),Bool
_)
    : [(Expr, HWType, Bool)]
_ <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  = let
    clkPeriod :: HWType -> Integer
clkPeriod (KnownDomain Text
_ Integer
p ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_) = Integer
p
    clkPeriod HWType
_ =
      [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
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

    clkFreq :: Integer -> Double
clkFreq Integer
p = 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

    clkOutPeriods :: [Integer]
clkOutPeriods = (HWType -> Integer) -> [HWType] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Integer
clkPeriod [HWType]
kdOuts
    clkLcms :: [Integer]
clkLcms = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
clkInPeriod) [Integer]
clkOutPeriods
    clkMults :: [Integer]
clkMults = (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot [Integer]
clkLcms [Integer]
clkOutPeriods
    clkDivs :: [Integer]
clkDivs = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
clkInPeriod) [Integer]
clkLcms
    clkOutFreqs :: [Double]
clkOutFreqs = (Integer -> Double) -> [Integer] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Double
clkFreq [Integer]
clkOutPeriods

    qsysParams :: Text
qsysParams = Text -> [Text] -> Text
TextS.intercalate Text
"\n  "
      [[I.__i|
        <parameter name="PORT_clk#{n}" value="PORT_USED" />
          <parameter name="CLK#{n}_MULTIPLY_BY" value="#{clkMult}" />
          <parameter name="CLK#{n}_DIVIDE_BY" value="#{clkDiv}" />
          <parameter name="CLK#{n}_DUTY_CYCLE" value="50" />
          <parameter name="CLK#{n}_PHASE_SHIFT" value="0" />
        |]
      | (Integer
clkMult, Integer
clkDiv, Word
n) <- [Integer] -> [Integer] -> [Word] -> [(Integer, Integer, Word)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Integer]
clkMults [Integer]
clkDivs [(Word
0 :: Word)..]
      ]

    qsysConsts :: Text
qsysConsts = Text -> [Text] -> Text
TextS.intercalate Text
"\n    "
      [[I.__i|
        CT\#PORT_clk#{n} PORT_USED
            CT\#CLK#{n}_MULTIPLY_BY #{clkMult}
            CT\#CLK#{n}_DIVIDE_BY #{clkDiv}
            CT\#CLK#{n}_DUTY_CYCLE 50
            CT\#CLK#{n}_PHASE_SHIFT 0
        |]
      | (Integer
clkMult, Integer
clkDiv, Word
n) <- [Integer] -> [Integer] -> [Word] -> [(Integer, Integer, Word)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Integer]
clkMults [Integer]
clkDivs [(Word
0 :: Word)..]
      ]

    qsysPorts :: Text
qsysPorts =
      Text -> [Text] -> Text
TextS.intercalate Text
"\n    "
        [[I.i|IF\#c#{n} {output 0}|] | Int
n <- [Int
0 .. [HWType] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
kdOuts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

    qsysPrivs :: Text
qsysPrivs = Text -> [Text] -> Text
TextS.intercalate Text
"\n    "
      [[I.__i|
        PT\#MULT_FACTOR#{n} #{clkMult}
            PT\#DIV_FACTOR#{n} #{clkDiv}
            PT\#EFF_OUTPUT_FREQ_VALUE#{n} #{clkOutFreq}
            PT\#DUTY_CYCLE#{n} 50.00000000
            PT\#PHASE_SHIFT0 0.00000000
        |]
      | (Integer
clkMult, Integer
clkDiv, Double
clkOutFreq, Word
n) <-
          [Integer]
-> [Integer]
-> [Double]
-> [Word]
-> [(Integer, Integer, Double, Word)]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [Integer]
clkMults [Integer]
clkDivs [Double]
clkOutFreqs [(Word
0 :: Word)..]
      ]

    -- Note [QSys file templates]
    -- This QSys file template was derived from a "full" QSys system with a single
    -- "altpll" IP. Module parameters were then stripped on a trial-and-error
    -- basis to get a template that has the minimal number of parameters, but
    -- still has the desired, working, configuration.
    bbText :: Doc ann
bbText = [I.__di|
      <?xml version="1.0" encoding="UTF-8"?>
      <system name="$${FILENAME}">
        <module
          name="altpll0"
          kind="altpll"
          enabled="1"
          autoexport="1">
        <parameter name="AVALON_USE_SEPARATE_SYSCLK" value="NO" />
        <parameter name="BANDWIDTH" value="" />
        <parameter name="BANDWIDTH_TYPE" value="AUTO" />
        #{qsysParams}
        <parameter name="COMPENSATE_CLOCK" value="CLK0" />
        <parameter name="INCLK0_INPUT_FREQUENCY" value="#{clkInPeriod}" />
        <parameter name="OPERATION_MODE" value="NORMAL" />
        <parameter name="PLL_TYPE" value="AUTO" />
        <parameter name="PORT_ARESET" value="PORT_USED" />
        <parameter name="PORT_INCLK0" value="PORT_USED" />
        <parameter name="PORT_LOCKED" value="PORT_USED" />
        <parameter name="HIDDEN_IS_FIRST_EDIT" value="0" />
        <parameter name="HIDDEN_CONSTANTS">
          #{qsysConsts}
          CT\#WIDTH_CLOCK 5
          CT\#LPM_TYPE altpll
          CT\#PLL_TYPE AUTO
          CT\#OPERATION_MODE NORMAL
          CT\#COMPENSATE_CLOCK CLK0
          CT\#INCLK0_INPUT_FREQUENCY #{clkInPeriod}
          CT\#PORT_INCLK0 PORT_USED
          CT\#PORT_ARESET PORT_USED
          CT\#BANDWIDTH_TYPE AUTO
          CT\#PORT_LOCKED PORT_USED</parameter>
        <parameter name="HIDDEN_IF_PORTS">
          IF\#phasecounterselect {input 4}
          IF\#locked {output 0}
          IF\#reset {input 0}
          IF\#clk {input 0}
          IF\#phaseupdown {input 0}
          IF\#scandone {output 0}
          IF\#readdata {output 32}
          IF\#write {input 0}
          IF\#scanclk {input 0}
          IF\#phasedone {output 0}
          IF\#address {input 2}
          #{qsysPorts}
          IF\#writedata {input 32}
          IF\#read {input 0}
          IF\#areset {input 0}
          IF\#scanclkena {input 0}
          IF\#scandataout {output 0}
          IF\#configupdate {input 0}
          IF\#phasestep {input 0}
          IF\#scandata {input 0}</parameter>
        <parameter name="HIDDEN_MF_PORTS">
          MF\#areset 1
          MF\#clk 1
          MF\#locked 1
          MF\#inclk 1</parameter>
        <parameter name="HIDDEN_PRIVATES">
          #{qsysPrivs}</parameter>
        </module>
      </system>
      |]
    in
      Doc -> State s Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
bbText
  | 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

alteraPllQsysTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
alteraPllQsysTemplate :: BlackBoxContext -> State s Doc
alteraPllQsysTemplate BlackBoxContext
bbCtx
  |   (Expr
_,HWType -> HWType
stripVoid -> HWType
kdIn,Bool
_)
    : (Expr, HWType, Bool)
_clocksClass
    : (Expr
_,HWType -> HWType
stripVoid -> Product Text
_ Maybe [Text]
_ ([HWType] -> [HWType]
forall a. [a] -> [a]
init -> [HWType]
kdOuts),Bool
_)
    : [(Expr, HWType, Bool)]
_ <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  = let
    clkFreq :: HWType -> Double
clkFreq (KnownDomain Text
_ Integer
p ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_)
      = Natural -> Double
forall a. (HasCallStack, Fractional a) => Natural -> a
periodToHz (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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

    clkOuts :: Text
clkOuts = Text -> [Text] -> Text
TextS.intercalate Text
"\n"
      [[I.i|  <parameter name="gui_output_clock_frequency#{n}" value="#{f}"/>|]
      | (Word
n,Double
f) <- [Word] -> [Double] -> [(Word, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Word
0 :: Word)..] ((HWType -> Double) -> [HWType] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Double
clkFreq [HWType]
kdOuts)
      ]

    -- See Note [QSys file templates] on how this qsys template was derived.
    bbText :: Doc ann
bbText = [I.__di|
      <?xml version="1.0" encoding="UTF-8"?>
      <system name="$${FILENAME}">
      <module
          name="pll_0"
          kind="altera_pll"
          enabled="1"
          autoexport="1">
        <parameter name="gui_feedback_clock" value="Global Clock" />
        <parameter name="gui_number_of_clocks" value="#{length kdOuts}" />
        <parameter name="gui_operation_mode" value="direct" />
      #{clkOuts}
        <parameter name="gui_pll_mode" value="Integer-N PLL" />
        <parameter name="gui_reference_clock_frequency" value="#{clkFreq kdIn}" />
        <parameter name="gui_use_locked" value="true" />
      </module>
      </system>
      |]
    in
      Doc -> State s Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
forall ann. Doc ann
bbText
  | 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