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

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
0...)

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

    Identifier
instName <- 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 (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
stdName Variant
variant) (Maybe IdentifierText -> IdentifierText)
-> Maybe IdentifierText -> IdentifierText
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> Maybe IdentifierText
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 => IdentifierText -> Identifier
IdentifierText -> Identifier
Id.unsafeMake IdentifierText
compName

    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 (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
stdName Variant
variant IdentifierText -> IdentifierText -> IdentifierText
forall a. Semigroup a => a -> a -> a
<> IdentifierText
"_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 <- 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 -> Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
pllOutName Variant
variant IdentifierText -> IdentifierText -> IdentifierText
forall a. Semigroup a => a -> a -> a
<> Int -> IdentifierText
forall a. Show a => a -> IdentifierText
showt Int
n)
            [Int
0 .. [HWType] -> Int
forall a. [a] -> 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 :: [(IdentifierText, HWType)]
compInps =
          [ (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
clkInName Variant
variant, TExpr -> HWType
DSL.ety TExpr
clk)
          , (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
rstName Variant
variant, TExpr -> HWType
DSL.ety TExpr
rstHigh)
          ]
        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 =
          [ (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
clkInName Variant
variant, TExpr
clk)
          , (Variant -> IdentifierText
forall {a}. IsString a => Variant -> a
rstName Variant
variant, 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 Identifier
compNameId Identifier
instName [] [(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

altpllQsysTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
altpllQsysTemplate :: forall s. Backend s => BlackBoxContext -> State s Doc
altpllQsysTemplate BlackBoxContext
bbCtx
  |   (Expr
_,HWType -> HWType
stripVoid -> (KnownDomain IdentifierText
_ Integer
clkInPeriod ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_),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
  = let
    clkPeriod :: HWType -> Integer
clkPeriod (KnownDomain IdentifierText
_ 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 :: IdentifierText
qsysParams = IdentifierText -> [IdentifierText] -> IdentifierText
TextS.intercalate IdentifierText
"\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 :: IdentifierText
qsysConsts = IdentifierText -> [IdentifierText] -> IdentifierText
TextS.intercalate IdentifierText
"\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 :: IdentifierText
qsysPorts =
      IdentifierText -> [IdentifierText] -> IdentifierText
TextS.intercalate IdentifierText
"\n    "
        [[I.i|IF\#c#{n} {output 0}|] | Int
n <- [Int
0 .. [HWType] -> Int
forall a. [a] -> 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 :: IdentifierText
qsysPrivs = IdentifierText -> [IdentifierText] -> IdentifierText
TextS.intercalate IdentifierText
"\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 -> 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] -> StateT s Identity Doc)
-> [Char] -> StateT s Identity 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 :: forall s. Backend s => BlackBoxContext -> State s Doc
alteraPllQsysTemplate 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
  = 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 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 :: IdentifierText
clkOuts = IdentifierText -> [IdentifierText] -> IdentifierText
TextS.intercalate IdentifierText
"\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 -> 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] -> StateT s Identity Doc)
-> [Char] -> StateT s Identity Doc
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
ppShow BlackBoxContext
bbCtx