{-|
  Copyright   :  (C) 2018, Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Blackbox template functions for Clash.Intel.ClockGen.{alteraPll,altpll}
-}

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

module Clash.Primitives.Intel.ClockGen where

import Clash.Backend
import Clash.Netlist.BlackBox.Util
import Clash.Netlist.Id
import Clash.Netlist.Types

import Control.Monad.State

import Data.Semigroup.Monad
import Data.Text.Prettyprint.Doc.Extra

import qualified Data.Text as TextS

altpllTF :: TemplateFunction
altpllTF :: TemplateFunction
altpllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
altpllTemplate
 where
  used :: [Int]
used         = [0,1,2]
  valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
    | [(nm :: Expr
nm,_,_),_,_] <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
    , Just _ <- Expr -> Maybe String
exprToString Expr
nm
    , (Identifier _ Nothing,Product {}) <- BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
    = Bool
True
  valid _ = Bool
False

alteraPllTF :: TemplateFunction
alteraPllTF :: TemplateFunction
alteraPllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
alteraPllTemplate
 where
  used :: [Int]
used         = [1,2,3]
  valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
    | [_,(nm :: Expr
nm,_,_),_,_] <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
    , Just _ <- Expr -> Maybe String
exprToString Expr
nm
    , (Identifier _ Nothing,Product {}) <- BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
    = Bool
True
  valid _ = Bool
False

alteraPllTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
alteraPllTemplate :: BlackBoxContext -> State s Doc
alteraPllTemplate bbCtx :: BlackBoxContext
bbCtx = do
 let mkId :: Identifier -> State s Identifier
mkId = IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Basic
 Identifier
locked <- Identifier -> State s Identifier
mkId "locked"
 Identifier
pllLock <- Identifier -> State s Identifier
mkId "pllLock"
 Identifier
alteraPll <- Identifier -> State s Identifier
mkId "alteraPll"
 Identifier
alteraPll_inst <- Identifier -> State s Identifier
mkId "alterPll_inst"

 [Identifier]
clocks <- (Identifier -> State s Identifier)
-> [Identifier] -> StateT s Identity [Identifier]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Extended)
                    [String -> Identifier
TextS.pack ("pllOut" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) | Int
n <- [0..[HWType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HWType]
tys Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]]
 Mon (State s) Doc -> State s Doc
forall (f :: * -> *) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> [Declaration] -> Mon (State s) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
alteraPll ([Declaration] -> Mon (State s) Doc)
-> [Declaration] -> Mon (State s) Doc
forall a b. (a -> b) -> a -> b
$ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [[ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
locked  HWType
rstTy
   , Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pllLock HWType
Bool]
  ,[ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
clkNm HWType
ty | (clkNm :: Identifier
clkNm,ty :: HWType
ty) <- [Identifier] -> [HWType] -> [(Identifier, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
clocks [HWType]
tys]
  ,[ EntityOrComponent
-> Maybe Identifier
-> Identifier
-> Identifier
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl EntityOrComponent
Comp Maybe Identifier
forall a. Maybe a
Nothing Identifier
compName Identifier
alteraPll_inst [] ([(Expr, PortDirection, HWType, Expr)] -> Declaration)
-> [(Expr, PortDirection, HWType, Expr)] -> Declaration
forall a b. (a -> b) -> a -> b
$ [[(Expr, PortDirection, HWType, Expr)]]
-> [(Expr, PortDirection, HWType, Expr)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[(Identifier -> Maybe Modifier -> Expr
Identifier "refclk" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
clkTy,Expr
clk)
       ,(Identifier -> Maybe Modifier -> Expr
Identifier "rst" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
rstTy,Expr
rst)]
      ,[(Identifier -> Maybe Modifier -> Expr
Identifier (String -> Identifier
TextS.pack ("outclk_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
ty,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
k Maybe Modifier
forall a. Maybe a
Nothing)
       |(k :: Identifier
k,ty :: HWType
ty,n :: Int
n) <- [Identifier] -> [HWType] -> [Int] -> [(Identifier, HWType, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Identifier]
clocks [HWType]
tys [(0 :: Int)..]  ]
      ,[(Identifier -> Maybe Modifier -> Expr
Identifier "locked" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
rstTy,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing)]]
   , Identifier
-> HWType
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Declaration
CondAssignment Identifier
pllLock HWType
Bool (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing) HWType
rstTy
      [(Literal -> Maybe Literal
forall a. a -> Maybe a
Just (Bit -> Literal
BitLit Bit
H),Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
True))
      ,(Maybe Literal
forall a. Maybe a
Nothing        ,Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
False))]
   , Identifier -> Expr -> Declaration
Assignment Identifier
result (HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
resTy ((HWType, Int) -> Modifier
DC (HWType
resTy,0)) ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                          [[Identifier -> Maybe Modifier -> Expr
Identifier Identifier
k Maybe Modifier
forall a. Maybe a
Nothing | Identifier
k <- [Identifier]
clocks]
                          ,[Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllLock Maybe Modifier
forall a. Maybe a
Nothing]])

   ]
  ]
 where
  [_,(nm :: Expr
nm,_,_),(clk :: Expr
clk,clkTy :: HWType
clkTy,_),(rst :: Expr
rst,rstTy :: HWType
rstTy,_)] = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  (Identifier result :: Identifier
result Nothing,resTy :: HWType
resTy@(Product _ _ ([HWType] -> [HWType]
forall a. [a] -> [a]
tail -> [HWType]
tys))) = BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
  Just nm' :: String
nm' = Expr -> Maybe String
exprToString Expr
nm
  compName :: Identifier
compName = String -> Identifier
TextS.pack String
nm'

altpllTemplate
  :: Backend s
  => BlackBoxContext
  -> State s Doc
altpllTemplate :: BlackBoxContext -> State s Doc
altpllTemplate bbCtx :: BlackBoxContext
bbCtx = do
 let mkId :: Identifier -> State s Identifier
mkId = IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Basic
 Identifier
pllOut <- Identifier -> State s Identifier
mkId "pllOut"
 Identifier
locked <- Identifier -> State s Identifier
mkId "locked"
 Identifier
pllLock <- Identifier -> State s Identifier
mkId "pllLock"
 Identifier
alteraPll <- Identifier -> State s Identifier
mkId "altpll"
 Identifier
alteraPll_inst <- Identifier -> State s Identifier
mkId "altpll_inst"
 Mon (State s) Doc -> State s Doc
forall (f :: * -> *) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> [Declaration] -> Mon (State s) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
alteraPll
  [ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
locked  HWType
Bit
  , Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pllLock HWType
Bool
  , Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pllOut HWType
clkOutTy
  , EntityOrComponent
-> Maybe Identifier
-> Identifier
-> Identifier
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl EntityOrComponent
Comp Maybe Identifier
forall a. Maybe a
Nothing Identifier
compName Identifier
alteraPll_inst []
      [(Identifier -> Maybe Modifier -> Expr
Identifier "inclk0" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
clkTy,Expr
clk)
      ,(Identifier -> Maybe Modifier -> Expr
Identifier "areset" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
rstTy,Expr
rst)
      ,(Identifier -> Maybe Modifier -> Expr
Identifier "c0" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
clkOutTy,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllOut Maybe Modifier
forall a. Maybe a
Nothing)
      ,(Identifier -> Maybe Modifier -> Expr
Identifier "locked" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
Bit,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing)]
  , Identifier
-> HWType
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Declaration
CondAssignment Identifier
pllLock HWType
Bool (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing) HWType
rstTy
      [(Literal -> Maybe Literal
forall a. a -> Maybe a
Just (Bit -> Literal
BitLit Bit
H),Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
True))
      ,(Maybe Literal
forall a. Maybe a
Nothing        ,Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
False))]
  , Identifier -> Expr -> Declaration
Assignment Identifier
result (HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
resTy ((HWType, Int) -> Modifier
DC (HWType
resTy,0))
                        [Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllOut Maybe Modifier
forall a. Maybe a
Nothing
                        ,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllLock Maybe Modifier
forall a. Maybe a
Nothing])

  ]
 where
  [(nm :: Expr
nm,_,_),(clk :: Expr
clk,clkTy :: HWType
clkTy,_),(rst :: Expr
rst,rstTy :: HWType
rstTy,_)] = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
  (Identifier result :: Identifier
result Nothing,resTy :: HWType
resTy@(Product _ _ [clkOutTy :: HWType
clkOutTy,_])) = BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
  Just nm' :: String
nm' = Expr -> Maybe String
exprToString Expr
nm
  compName :: Identifier
compName = String -> Identifier
TextS.pack String
nm'