{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2017     , Myrtle Software Ltd
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Types used in BlackBox modules
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
-- since GHC 8.6 we can haddock individual contructor fields \o/
#if __GLASGOW_HASKELL__ >= 806
#define FIELD ^
#endif

module Clash.Netlist.BlackBox.Types
 ( BlackBoxMeta(..)
 , emptyBlackBoxMeta
 , BlackBoxFunction
 , BlackBoxTemplate
 , TemplateKind (..)
 , Element(..)
 , Decl(..)
 , HdlSyn(..)
 , RenderVoid(..)
 ) where

import                Control.DeepSeq            (NFData)
import                Data.Aeson                 (FromJSON)
import                Data.Binary                (Binary)
import                Data.Hashable              (Hashable)
import                Data.Text.Lazy             (Text)
import qualified      Data.Text                  as S
import                GHC.Generics               (Generic)

import                Clash.Core.Term            (Term)
import                Clash.Core.Type            (Type)
import {-# SOURCE #-} Clash.Netlist.Types
  (BlackBox, NetlistMonad)

import qualified      Clash.Signal.Internal      as Signal

-- | Whether this primitive should be rendered when its result type is void.
-- Defaults to 'NoRenderVoid'.
data RenderVoid
  = RenderVoid
  -- ^ Render blackbox, even if result type is void
  | NoRenderVoid
  -- ^ Don't render blackbox result type is void. Default for all blackboxes.
  deriving (Int -> RenderVoid -> ShowS
[RenderVoid] -> ShowS
RenderVoid -> String
(Int -> RenderVoid -> ShowS)
-> (RenderVoid -> String)
-> ([RenderVoid] -> ShowS)
-> Show RenderVoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderVoid] -> ShowS
$cshowList :: [RenderVoid] -> ShowS
show :: RenderVoid -> String
$cshow :: RenderVoid -> String
showsPrec :: Int -> RenderVoid -> ShowS
$cshowsPrec :: Int -> RenderVoid -> ShowS
Show, (forall x. RenderVoid -> Rep RenderVoid x)
-> (forall x. Rep RenderVoid x -> RenderVoid) -> Generic RenderVoid
forall x. Rep RenderVoid x -> RenderVoid
forall x. RenderVoid -> Rep RenderVoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenderVoid x -> RenderVoid
$cfrom :: forall x. RenderVoid -> Rep RenderVoid x
Generic, RenderVoid -> ()
(RenderVoid -> ()) -> NFData RenderVoid
forall a. (a -> ()) -> NFData a
rnf :: RenderVoid -> ()
$crnf :: RenderVoid -> ()
NFData, Get RenderVoid
[RenderVoid] -> Put
RenderVoid -> Put
(RenderVoid -> Put)
-> Get RenderVoid -> ([RenderVoid] -> Put) -> Binary RenderVoid
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [RenderVoid] -> Put
$cputList :: [RenderVoid] -> Put
get :: Get RenderVoid
$cget :: Get RenderVoid
put :: RenderVoid -> Put
$cput :: RenderVoid -> Put
Binary, RenderVoid -> RenderVoid -> Bool
(RenderVoid -> RenderVoid -> Bool)
-> (RenderVoid -> RenderVoid -> Bool) -> Eq RenderVoid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderVoid -> RenderVoid -> Bool
$c/= :: RenderVoid -> RenderVoid -> Bool
== :: RenderVoid -> RenderVoid -> Bool
$c== :: RenderVoid -> RenderVoid -> Bool
Eq, Eq RenderVoid
Eq RenderVoid
-> (Int -> RenderVoid -> Int)
-> (RenderVoid -> Int)
-> Hashable RenderVoid
Int -> RenderVoid -> Int
RenderVoid -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: RenderVoid -> Int
$chash :: RenderVoid -> Int
hashWithSalt :: Int -> RenderVoid -> Int
$chashWithSalt :: Int -> RenderVoid -> Int
$cp1Hashable :: Eq RenderVoid
Hashable, Value -> Parser [RenderVoid]
Value -> Parser RenderVoid
(Value -> Parser RenderVoid)
-> (Value -> Parser [RenderVoid]) -> FromJSON RenderVoid
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RenderVoid]
$cparseJSONList :: Value -> Parser [RenderVoid]
parseJSON :: Value -> Parser RenderVoid
$cparseJSON :: Value -> Parser RenderVoid
FromJSON)

data TemplateKind
  = TDecl
  | TExpr
  deriving (Int -> TemplateKind -> ShowS
[TemplateKind] -> ShowS
TemplateKind -> String
(Int -> TemplateKind -> ShowS)
-> (TemplateKind -> String)
-> ([TemplateKind] -> ShowS)
-> Show TemplateKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateKind] -> ShowS
$cshowList :: [TemplateKind] -> ShowS
show :: TemplateKind -> String
$cshow :: TemplateKind -> String
showsPrec :: Int -> TemplateKind -> ShowS
$cshowsPrec :: Int -> TemplateKind -> ShowS
Show, TemplateKind -> TemplateKind -> Bool
(TemplateKind -> TemplateKind -> Bool)
-> (TemplateKind -> TemplateKind -> Bool) -> Eq TemplateKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateKind -> TemplateKind -> Bool
$c/= :: TemplateKind -> TemplateKind -> Bool
== :: TemplateKind -> TemplateKind -> Bool
$c== :: TemplateKind -> TemplateKind -> Bool
Eq, (forall x. TemplateKind -> Rep TemplateKind x)
-> (forall x. Rep TemplateKind x -> TemplateKind)
-> Generic TemplateKind
forall x. Rep TemplateKind x -> TemplateKind
forall x. TemplateKind -> Rep TemplateKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateKind x -> TemplateKind
$cfrom :: forall x. TemplateKind -> Rep TemplateKind x
Generic, TemplateKind -> ()
(TemplateKind -> ()) -> NFData TemplateKind
forall a. (a -> ()) -> NFData a
rnf :: TemplateKind -> ()
$crnf :: TemplateKind -> ()
NFData, Get TemplateKind
[TemplateKind] -> Put
TemplateKind -> Put
(TemplateKind -> Put)
-> Get TemplateKind
-> ([TemplateKind] -> Put)
-> Binary TemplateKind
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [TemplateKind] -> Put
$cputList :: [TemplateKind] -> Put
get :: Get TemplateKind
$cget :: Get TemplateKind
put :: TemplateKind -> Put
$cput :: TemplateKind -> Put
Binary, Eq TemplateKind
Eq TemplateKind
-> (Int -> TemplateKind -> Int)
-> (TemplateKind -> Int)
-> Hashable TemplateKind
Int -> TemplateKind -> Int
TemplateKind -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TemplateKind -> Int
$chash :: TemplateKind -> Int
hashWithSalt :: Int -> TemplateKind -> Int
$chashWithSalt :: Int -> TemplateKind -> Int
$cp1Hashable :: Eq TemplateKind
Hashable)

-- | See @Clash.Primitives.Types.BlackBox@ for documentation on this record's
-- fields. (They are intentionally renamed to prevent name clashes.)
data BlackBoxMeta =
  BlackBoxMeta { BlackBoxMeta -> Bool
bbOutputReg :: Bool
               , BlackBoxMeta -> TemplateKind
bbKind :: TemplateKind
               , BlackBoxMeta -> [BlackBoxTemplate]
bbLibrary :: [BlackBoxTemplate]
               , BlackBoxMeta -> [BlackBoxTemplate]
bbImports :: [BlackBoxTemplate]
               , BlackBoxMeta -> [(Int, Int)]
bbFunctionPlurality :: [(Int, Int)]
               , BlackBoxMeta -> [((Text, Text), BlackBox)]
bbIncludes :: [((S.Text, S.Text), BlackBox)]
               , BlackBoxMeta -> RenderVoid
bbRenderVoid :: RenderVoid
               , BlackBoxMeta -> [BlackBox]
bbResultNames :: [BlackBox]
               , BlackBoxMeta -> [BlackBox]
bbResultInits :: [BlackBox]
               }

-- | Use this value in your blackbox template function if you do want to
-- accept the defaults as documented in @Clash.Primitives.Types.BlackBox@.
emptyBlackBoxMeta :: BlackBoxMeta
emptyBlackBoxMeta :: BlackBoxMeta
emptyBlackBoxMeta = Bool
-> TemplateKind
-> [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [(Int, Int)]
-> [((Text, Text), BlackBox)]
-> RenderVoid
-> [BlackBox]
-> [BlackBox]
-> BlackBoxMeta
BlackBoxMeta Bool
False TemplateKind
TExpr [] [] [] [] RenderVoid
NoRenderVoid [] []

-- | A BlackBox function generates a blackbox template, given the inputs and
-- result type of the function it should provide a blackbox for. This is useful
-- when having a need for blackbox functions, ... TODO: docs
type BlackBoxFunction
   = Bool
  -- ^ Indicates whether caller needs a declaration. If set, the function is
  -- still free to return an expression, but the caller will convert it to a
  -- declaration.
  -> S.Text
  -- ^ Name of primitive
  -> [Either Term Type]
  -- ^ Arguments
  -> [Type]
  -- ^ Result types
  -> NetlistMonad (Either String (BlackBoxMeta, BlackBox))

-- | A BlackBox Template is a List of Elements
-- TODO: Add name of function for better error messages
type BlackBoxTemplate = [Element]

-- | Elements of a blackbox context. If you extend this list, make sure to
-- update the following functions:
--
--  - Clash.Netlist.BlackBox.Types.prettyElem
--  - Clash.Netlist.BlackBox.Types.renderElem
--  - Clash.Netlist.BlackBox.Types.renderTag
--  - Clash.Netlist.BlackBox.Types.setSym
--  - Clash.Netlist.BlackBox.Types.getUsedArguments
--  - Clash.Netlist.BlackBox.Types.usedVariables
--  - Clash.Netlist.BlackBox.Types.verifyBlackBoxContext
--  - Clash.Netlist.BlackBox.Types.walkElement
data Element
  = Text !Text
  -- ^ Dumps given text without processing in HDL
  | Component !Decl
  -- ^ Component instantiation hole
  | Result
  -- ^ Output hole;
  | Arg !Int
  -- ^ Input hole
  | ArgGen !Int !Int
  -- ^ Like Arg, but its first argument is the scoping level. For use in
  -- in generated code only.
  | Const !Int
  -- ^ Like Arg, but input hole must be a constant.
  | Lit !Int
  -- ^ Like Arg, but input hole must be a literal
  | Name !Int
  -- ^ Name hole
  | ToVar [Element] !Int
  -- ^ Like Arg but only insert variable reference (creating an assignment
  -- elsewhere if necessary).
  | Sym !Text !Int
  -- ^ Symbol hole
  | Typ !(Maybe Int)
  -- ^ Type declaration hole
  | TypM !(Maybe Int)
  -- ^ Type root hole
  | Err !(Maybe Int)
  -- ^ Error value hole
  | TypElem !Element
  -- ^ Select element type from a vector type
  | CompName
  -- ^ Hole for the name of the component in which the blackbox is instantiated
  | IncludeName !Int
  | IndexType !Element
  -- ^ Index data type hole, the field is the (exclusive) maximum index
  | Size !Element
  -- ^ Size of a type hole
  | Length !Element
  -- ^ Length of a vector hole
  | Depth !Element
  -- ^ Depth of a tree hole
  | MaxIndex !Element
  -- ^ Max index into a vector
  | FilePath !Element
  -- ^ Hole containing a filepath for a data file
  | Template [Element] [Element]
  -- ^ Create data file <HOLE0> with contents <HOLE1>
  | Gen !Bool
  -- ^ Hole marking beginning (True) or end (False) of a generative construct
  | IF !Element [Element] [Element]
  | And [Element]
  | IW64
  -- ^ Hole indicating whether Int/Word/Integer are 64-Bit
  | CmpLE !Element !Element
  -- ^ Compare less-or-equal
  | HdlSyn HdlSyn
  -- ^ Hole indicating which synthesis tool we're generating HDL for
  | BV !Bool [Element] !Element
  -- ^ Convert to (True)/from(False) a bit-vector
  | Sel !Element !Int
  -- ^ Record selector of a type
  | IsLit !Int
  | IsVar !Int
  | IsActiveHigh !Int
  -- ^ Whether a domain's reset lines are synchronous.
  | Tag !Int
  -- ^ Tag of a domain.
  | Period !Int
  -- ^ Period of a domain.
  | ActiveEdge !Signal.ActiveEdge !Int
  -- ^ Test active edge of memory elements in a certain domain
  | IsSync !Int
  -- ^ Whether a domain's reset lines are synchronous. Errors if not applied to
  -- a KnownDomain.
  | IsInitDefined !Int
  | IsActiveEnable !Int
  -- ^ Whether given enable line is active. More specifically, whether the
  -- enable line is NOT set to a constant 'True'.
  | IsUndefined !Int
  -- ^ Whether argument is undefined. E.g., an XException, error call,
  -- removed argument, or primitive that is undefined. This template tag will
  -- always return 0 (False) if `-fclash-aggressive-x-optimization-blackboxes`
  -- is NOT set.
  | StrCmp [Element] !Int
  | OutputWireReg !Int
  | Vars !Int
  | GenSym [Element] !Int
  | Repeat [Element] [Element]
  -- ^ Repeat <hole> n times
  | DevNull [Element]
  -- ^ Evaluate <hole> but swallow output
  | SigD [Element] !(Maybe Int)
  | CtxName
  -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the
  -- name of the closest binder
  deriving (Int -> Element -> ShowS
BlackBoxTemplate -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String)
-> (BlackBoxTemplate -> ShowS)
-> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: BlackBoxTemplate -> ShowS
$cshowList :: BlackBoxTemplate -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show, (forall x. Element -> Rep Element x)
-> (forall x. Rep Element x -> Element) -> Generic Element
forall x. Rep Element x -> Element
forall x. Element -> Rep Element x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Element x -> Element
$cfrom :: forall x. Element -> Rep Element x
Generic, Element -> ()
(Element -> ()) -> NFData Element
forall a. (a -> ()) -> NFData a
rnf :: Element -> ()
$crnf :: Element -> ()
NFData, Get Element
BlackBoxTemplate -> Put
Element -> Put
(Element -> Put)
-> Get Element -> (BlackBoxTemplate -> Put) -> Binary Element
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: BlackBoxTemplate -> Put
$cputList :: BlackBoxTemplate -> Put
get :: Get Element
$cget :: Get Element
put :: Element -> Put
$cput :: Element -> Put
Binary, Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Eq Element
Eq Element
-> (Int -> Element -> Int) -> (Element -> Int) -> Hashable Element
Int -> Element -> Int
Element -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Element -> Int
$chash :: Element -> Int
hashWithSalt :: Int -> Element -> Int
$chashWithSalt :: Int -> Element -> Int
$cp1Hashable :: Eq Element
Hashable)

-- | Component instantiation hole. First argument indicates which function argument
-- to instantiate. Third argument corresponds to output and input assignments,
-- where the first element is the output assignment, and the subsequent elements
-- are the consecutive input assignments.
--
-- The LHS of the tuple is the name of the signal, while the RHS of the tuple
-- is the type of the signal
data Decl
  = Decl
      !Int
      -- FIELD Argument position of the function to instantiate
      !Int
      -- FIELD Subposition of function: blackboxes can request multiple instances
      -- to be rendered of their given functions. This subposition indicates the
      -- nth function instance to be rendered (zero-indexed).
      --
      -- This is a hack: the proper solution would postpone rendering the
      -- function until the very last moment. The blackbox language has no way
      -- to indicate the subposition, and every ~INST will default its subposition
      -- to zero. Haskell blackboxes can use this data type.
      [(BlackBoxTemplate,BlackBoxTemplate)]
      -- FIELD (name of signal, type of signal)
  deriving (Int -> Decl -> ShowS
[Decl] -> ShowS
Decl -> String
(Int -> Decl -> ShowS)
-> (Decl -> String) -> ([Decl] -> ShowS) -> Show Decl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decl] -> ShowS
$cshowList :: [Decl] -> ShowS
show :: Decl -> String
$cshow :: Decl -> String
showsPrec :: Int -> Decl -> ShowS
$cshowsPrec :: Int -> Decl -> ShowS
Show, (forall x. Decl -> Rep Decl x)
-> (forall x. Rep Decl x -> Decl) -> Generic Decl
forall x. Rep Decl x -> Decl
forall x. Decl -> Rep Decl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Decl x -> Decl
$cfrom :: forall x. Decl -> Rep Decl x
Generic, Decl -> ()
(Decl -> ()) -> NFData Decl
forall a. (a -> ()) -> NFData a
rnf :: Decl -> ()
$crnf :: Decl -> ()
NFData, Get Decl
[Decl] -> Put
Decl -> Put
(Decl -> Put) -> Get Decl -> ([Decl] -> Put) -> Binary Decl
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Decl] -> Put
$cputList :: [Decl] -> Put
get :: Get Decl
$cget :: Get Decl
put :: Decl -> Put
$cput :: Decl -> Put
Binary, Decl -> Decl -> Bool
(Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decl -> Decl -> Bool
$c/= :: Decl -> Decl -> Bool
== :: Decl -> Decl -> Bool
$c== :: Decl -> Decl -> Bool
Eq, Eq Decl
Eq Decl -> (Int -> Decl -> Int) -> (Decl -> Int) -> Hashable Decl
Int -> Decl -> Int
Decl -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Decl -> Int
$chash :: Decl -> Int
hashWithSalt :: Int -> Decl -> Int
$chashWithSalt :: Int -> Decl -> Int
$cp1Hashable :: Eq Decl
Hashable)

data HdlSyn = Vivado | Quartus | Other
  deriving (HdlSyn -> HdlSyn -> Bool
(HdlSyn -> HdlSyn -> Bool)
-> (HdlSyn -> HdlSyn -> Bool) -> Eq HdlSyn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HdlSyn -> HdlSyn -> Bool
$c/= :: HdlSyn -> HdlSyn -> Bool
== :: HdlSyn -> HdlSyn -> Bool
$c== :: HdlSyn -> HdlSyn -> Bool
Eq, Int -> HdlSyn -> ShowS
[HdlSyn] -> ShowS
HdlSyn -> String
(Int -> HdlSyn -> ShowS)
-> (HdlSyn -> String) -> ([HdlSyn] -> ShowS) -> Show HdlSyn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HdlSyn] -> ShowS
$cshowList :: [HdlSyn] -> ShowS
show :: HdlSyn -> String
$cshow :: HdlSyn -> String
showsPrec :: Int -> HdlSyn -> ShowS
$cshowsPrec :: Int -> HdlSyn -> ShowS
Show, ReadPrec [HdlSyn]
ReadPrec HdlSyn
Int -> ReadS HdlSyn
ReadS [HdlSyn]
(Int -> ReadS HdlSyn)
-> ReadS [HdlSyn]
-> ReadPrec HdlSyn
-> ReadPrec [HdlSyn]
-> Read HdlSyn
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HdlSyn]
$creadListPrec :: ReadPrec [HdlSyn]
readPrec :: ReadPrec HdlSyn
$creadPrec :: ReadPrec HdlSyn
readList :: ReadS [HdlSyn]
$creadList :: ReadS [HdlSyn]
readsPrec :: Int -> ReadS HdlSyn
$creadsPrec :: Int -> ReadS HdlSyn
Read, (forall x. HdlSyn -> Rep HdlSyn x)
-> (forall x. Rep HdlSyn x -> HdlSyn) -> Generic HdlSyn
forall x. Rep HdlSyn x -> HdlSyn
forall x. HdlSyn -> Rep HdlSyn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HdlSyn x -> HdlSyn
$cfrom :: forall x. HdlSyn -> Rep HdlSyn x
Generic, HdlSyn -> ()
(HdlSyn -> ()) -> NFData HdlSyn
forall a. (a -> ()) -> NFData a
rnf :: HdlSyn -> ()
$crnf :: HdlSyn -> ()
NFData, Get HdlSyn
[HdlSyn] -> Put
HdlSyn -> Put
(HdlSyn -> Put) -> Get HdlSyn -> ([HdlSyn] -> Put) -> Binary HdlSyn
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [HdlSyn] -> Put
$cputList :: [HdlSyn] -> Put
get :: Get HdlSyn
$cget :: Get HdlSyn
put :: HdlSyn -> Put
$cput :: HdlSyn -> Put
Binary, Eq HdlSyn
Eq HdlSyn
-> (Int -> HdlSyn -> Int) -> (HdlSyn -> Int) -> Hashable HdlSyn
Int -> HdlSyn -> Int
HdlSyn -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HdlSyn -> Int
$chash :: HdlSyn -> Int
hashWithSalt :: Int -> HdlSyn -> Int
$chashWithSalt :: Int -> HdlSyn -> Int
$cp1Hashable :: Eq HdlSyn
Hashable)