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

  Type and instance definitions for Netlist modules
-}

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE DeriveDataTypeable         #-}

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

module Clash.Netlist.Types
  ( Declaration (..,NetDecl)
  , module Clash.Netlist.Types
  )
where

import Control.DeepSeq
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail                   (MonadFail)
#endif
import Control.Monad.Reader                 (ReaderT, MonadReader)
import Control.Monad.State                  as Lazy (State)
import Control.Monad.State.Strict           as Strict
  (State,MonadIO, MonadState, StateT)
import Data.Bits                            (testBit)
import Data.Binary                          (Binary(..))
import Data.Hashable                        (Hashable)
import Data.HashMap.Strict                  (HashMap)
import Data.IntMap                          (IntMap, empty)
import qualified Data.Set                   as Set
import Data.Text                            (Text, pack)
import Data.Typeable                        (Typeable)
import Data.Text.Prettyprint.Doc.Extra      (Doc)
import GHC.Generics                         (Generic)
import Language.Haskell.TH.Syntax           (Lift)

import SrcLoc                               (SrcSpan)

import Clash.Annotations.TopEntity          (TopEntity)
import Clash.Backend                        (Backend)
import Clash.Core.Type                      (Type)
import Clash.Core.Var                       (Attr')
import Clash.Core.TyCon                     (TyConMap)
import Clash.Core.VarEnv                    (VarEnv)
import Clash.Driver.Types                   (BindingMap, ClashOpts)
import Clash.Netlist.BlackBox.Types         (BlackBoxTemplate)
import Clash.Netlist.Id                     (IdType)
import Clash.Primitives.Types               (CompiledPrimMap)
import Clash.Signal.Internal
  (ResetPolarity, ActiveEdge, ResetKind, InitBehavior)
import Clash.Util                           (makeLenses)

import Clash.Annotations.BitRepresentation.Internal
  (CustomReprs, DataRepr', ConstrRepr')

-- | Monad that caches generated components (StateT) and remembers hidden inputs
-- of components that are being generated (WriterT)
newtype NetlistMonad a =
  NetlistMonad { NetlistMonad a -> StateT NetlistState (ReaderT NetlistEnv IO) a
runNetlist :: StateT NetlistState (ReaderT NetlistEnv IO) a }
  deriving newtype (a -> NetlistMonad b -> NetlistMonad a
(a -> b) -> NetlistMonad a -> NetlistMonad b
(forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b)
-> (forall a b. a -> NetlistMonad b -> NetlistMonad a)
-> Functor NetlistMonad
forall a b. a -> NetlistMonad b -> NetlistMonad a
forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NetlistMonad b -> NetlistMonad a
$c<$ :: forall a b. a -> NetlistMonad b -> NetlistMonad a
fmap :: (a -> b) -> NetlistMonad a -> NetlistMonad b
$cfmap :: forall a b. (a -> b) -> NetlistMonad a -> NetlistMonad b
Functor, Applicative NetlistMonad
a -> NetlistMonad a
Applicative NetlistMonad =>
(forall a b.
 NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b)
-> (forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b)
-> (forall a. a -> NetlistMonad a)
-> Monad NetlistMonad
NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b
NetlistMonad a -> NetlistMonad b -> NetlistMonad b
forall a. a -> NetlistMonad a
forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b
forall a b.
NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NetlistMonad a
$creturn :: forall a. a -> NetlistMonad a
>> :: NetlistMonad a -> NetlistMonad b -> NetlistMonad b
$c>> :: forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b
>>= :: NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b
$c>>= :: forall a b.
NetlistMonad a -> (a -> NetlistMonad b) -> NetlistMonad b
$cp1Monad :: Applicative NetlistMonad
Monad, Functor NetlistMonad
a -> NetlistMonad a
Functor NetlistMonad =>
(forall a. a -> NetlistMonad a)
-> (forall a b.
    NetlistMonad (a -> b) -> NetlistMonad a -> NetlistMonad b)
-> (forall a b c.
    (a -> b -> c)
    -> NetlistMonad a -> NetlistMonad b -> NetlistMonad c)
-> (forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b)
-> (forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad a)
-> Applicative NetlistMonad
NetlistMonad a -> NetlistMonad b -> NetlistMonad b
NetlistMonad a -> NetlistMonad b -> NetlistMonad a
NetlistMonad (a -> b) -> NetlistMonad a -> NetlistMonad b
(a -> b -> c) -> NetlistMonad a -> NetlistMonad b -> NetlistMonad c
forall a. a -> NetlistMonad a
forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad a
forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b
forall a b.
NetlistMonad (a -> b) -> NetlistMonad a -> NetlistMonad b
forall a b c.
(a -> b -> c) -> NetlistMonad a -> NetlistMonad b -> NetlistMonad c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: NetlistMonad a -> NetlistMonad b -> NetlistMonad a
$c<* :: forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad a
*> :: NetlistMonad a -> NetlistMonad b -> NetlistMonad b
$c*> :: forall a b. NetlistMonad a -> NetlistMonad b -> NetlistMonad b
liftA2 :: (a -> b -> c) -> NetlistMonad a -> NetlistMonad b -> NetlistMonad c
$cliftA2 :: forall a b c.
(a -> b -> c) -> NetlistMonad a -> NetlistMonad b -> NetlistMonad c
<*> :: NetlistMonad (a -> b) -> NetlistMonad a -> NetlistMonad b
$c<*> :: forall a b.
NetlistMonad (a -> b) -> NetlistMonad a -> NetlistMonad b
pure :: a -> NetlistMonad a
$cpure :: forall a. a -> NetlistMonad a
$cp1Applicative :: Functor NetlistMonad
Applicative, MonadReader NetlistEnv,
                    MonadState NetlistState, Monad NetlistMonad
Monad NetlistMonad =>
(forall a. IO a -> NetlistMonad a) -> MonadIO NetlistMonad
IO a -> NetlistMonad a
forall a. IO a -> NetlistMonad a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> NetlistMonad a
$cliftIO :: forall a. IO a -> NetlistMonad a
$cp1MonadIO :: Monad NetlistMonad
MonadIO, Monad NetlistMonad
Monad NetlistMonad =>
(forall a. String -> NetlistMonad a) -> MonadFail NetlistMonad
String -> NetlistMonad a
forall a. String -> NetlistMonad a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> NetlistMonad a
$cfail :: forall a. String -> NetlistMonad a
$cp1MonadFail :: Monad NetlistMonad
MonadFail)

type HWMap = HashMap Type (Either String FilteredHWType)

-- | Environment of the NetlistMonad
data NetlistEnv
  = NetlistEnv
  { NetlistEnv -> Identifier
_prefixName  :: Identifier
  -- ^ Prefix for instance/register names
  , NetlistEnv -> Identifier
_suffixName :: Identifier
  -- ^ Postfix for instance/register names
  , NetlistEnv -> Maybe Identifier
_setName     :: Maybe Identifier
  -- ^ (Maybe) user given instance/register name
  }

-- | State of the NetlistMonad
data NetlistState
  = NetlistState
  { NetlistState -> BindingMap
_bindings       :: BindingMap
  -- ^ Global binders
  , NetlistState -> Int
_varCount       :: !Int
  -- ^ Number of signal declarations
  , NetlistState
-> VarEnv ([Bool], SrcSpan, HashMap Identifier Word, Component)
_components     :: VarEnv ([Bool],SrcSpan,HashMap Identifier Word,Component)
  -- ^ Cached components
  , NetlistState -> CompiledPrimMap
_primitives     :: CompiledPrimMap
  -- ^ Primitive Definitions
  , NetlistState
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
_typeTranslator :: CustomReprs -> TyConMap -> Type
                    -> Strict.State HWMap (Maybe (Either String FilteredHWType))
  -- ^ Hardcoded Type -> HWType translator
  , NetlistState -> TyConMap
_tcCache        :: TyConMap
  -- ^ TyCon cache
  , NetlistState -> (Identifier, SrcSpan)
_curCompNm      :: !(Identifier,SrcSpan)
  , NetlistState -> Int
_intWidth       :: Int
  , NetlistState -> IdType -> Identifier -> Identifier
_mkIdentifierFn :: IdType -> Identifier -> Identifier
  , NetlistState -> IdType -> Identifier -> Identifier -> Identifier
_extendIdentifierFn :: IdType -> Identifier -> Identifier -> Identifier
  , NetlistState -> HashMap Identifier Word
_seenIds        :: HashMap Identifier Word
  , NetlistState -> HashMap Identifier Word
_seenComps      :: HashMap Identifier Word
  , NetlistState -> Set Identifier
_seenPrimitives :: Set.Set Text
  -- ^ Keeps track of invocations of ´mkPrimitive´. It is currently used to
  -- filter duplicate warning invocations for dubious blackbox instantiations,
  -- see GitHub pull request #286.
  , NetlistState -> VarEnv Identifier
_componentNames :: VarEnv Identifier
  , NetlistState -> VarEnv (Type, Maybe TopEntity)
_topEntityAnns  :: VarEnv (Type, Maybe TopEntity)
  , NetlistState -> String
_hdlDir         :: FilePath
  , NetlistState -> Int
_curBBlvl       :: Int
  -- ^ The current scoping level assigned to black box contexts
  , NetlistState -> (Maybe Identifier, Maybe Identifier)
_componentPrefix :: (Maybe Identifier,Maybe Identifier)
  -- ^ Prefix for top-level components, and prefix for all other components
  , NetlistState -> CustomReprs
_customReprs    :: CustomReprs
  , NetlistState -> ClashOpts
_clashOpts      :: ClashOpts
  -- ^ Settings Clash was called with
  , NetlistState -> Bool
_isTestBench    :: Bool
  -- ^ Whether we're compiling a testbench (suppresses some warnings)
  , NetlistState -> Bool
_backEndITE :: Bool
  -- ^ Whether the backend supports ifThenElse expressions
  , NetlistState -> HWMap
_htyCache :: HWMap
  }

-- | Signal reference
type Identifier = Text

type Comment = Text

-- | Component: base unit of a Netlist
data Component
  = Component
  { Component -> Identifier
componentName :: !Identifier -- ^ Name of the component
  , Component -> [(Identifier, HWType)]
inputs        :: [(Identifier,HWType)] -- ^ Input ports
  , Component -> [(WireOrReg, (Identifier, HWType))]
outputs       :: [(WireOrReg,(Identifier,HWType))] -- ^ Output ports
  , Component -> [Declaration]
declarations  :: [Declaration] -- ^ Internal declarations
  }
  deriving Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show

instance NFData Component where
  rnf :: Component -> ()
rnf c :: Component
c = case Component
c of
    Component nm :: Identifier
nm inps :: [(Identifier, HWType)]
inps outps :: [(WireOrReg, (Identifier, HWType))]
outps decls :: [Declaration]
decls -> Identifier -> ()
forall a. NFData a => a -> ()
rnf Identifier
nm    () -> () -> ()
forall a b. a -> b -> b
`seq` [(Identifier, HWType)] -> ()
forall a. NFData a => a -> ()
rnf [(Identifier, HWType)]
inps () -> () -> ()
forall a b. a -> b -> b
`seq`
                                     [(WireOrReg, (Identifier, HWType))] -> ()
forall a. NFData a => a -> ()
rnf [(WireOrReg, (Identifier, HWType))]
outps () -> () -> ()
forall a b. a -> b -> b
`seq` [Declaration] -> ()
forall a. NFData a => a -> ()
rnf [Declaration]
decls

-- | Size indication of a type (e.g. bit-size or number of elements)
type Size = Int

type IsVoid = Bool

-- | Tree structure indicating which constructor fields were filtered from
-- a type due to them being void. We need this information to generate stable
-- and/or user-defined port mappings.
data FilteredHWType =
  FilteredHWType HWType [[(IsVoid, FilteredHWType)]]
    deriving (FilteredHWType -> FilteredHWType -> Bool
(FilteredHWType -> FilteredHWType -> Bool)
-> (FilteredHWType -> FilteredHWType -> Bool) -> Eq FilteredHWType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilteredHWType -> FilteredHWType -> Bool
$c/= :: FilteredHWType -> FilteredHWType -> Bool
== :: FilteredHWType -> FilteredHWType -> Bool
$c== :: FilteredHWType -> FilteredHWType -> Bool
Eq, Int -> FilteredHWType -> ShowS
[FilteredHWType] -> ShowS
FilteredHWType -> String
(Int -> FilteredHWType -> ShowS)
-> (FilteredHWType -> String)
-> ([FilteredHWType] -> ShowS)
-> Show FilteredHWType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilteredHWType] -> ShowS
$cshowList :: [FilteredHWType] -> ShowS
show :: FilteredHWType -> String
$cshow :: FilteredHWType -> String
showsPrec :: Int -> FilteredHWType -> ShowS
$cshowsPrec :: Int -> FilteredHWType -> ShowS
Show)

-- | Representable hardware types
data HWType
  = Void (Maybe HWType)
  -- ^ Empty type. @Just Size@ for "empty" Vectors so we can still have
  -- primitives that can traverse e.g. Vectors of unit and know the length of
  -- that vector.
  | String
  -- ^ String type
  | Integer
  -- ^ Integer type (for parameters only)
  | Bool
  -- ^ Boolean type
  | Bit
  -- ^ Bit type
  | BitVector !Size
  -- ^ BitVector of a specified size
  | Index !Integer
  -- ^ Unsigned integer with specified (exclusive) upper bounder
  | Signed !Size
  -- ^ Signed integer of a specified size
  | Unsigned !Size
  -- ^ Unsigned integer of a specified size
  | Vector !Size !HWType
  -- ^ Vector type
  | RTree !Size !HWType
  -- ^ RTree type
  | Sum !Identifier [Identifier]
  -- ^ Sum type: Name and Constructor names
  | Product !Identifier (Maybe [Text]) [HWType]
  -- ^ Product type: Name, field names, and field types. Field names will be
  -- populated when using records.
  | SP !Identifier [(Identifier,[HWType])]
  -- ^ Sum-of-Product type: Name and Constructor names + field types
  | Clock !Identifier
  -- ^ Clock type corresponding to domain /Identifier/
  | Reset !Identifier
  -- ^ Reset type corresponding to domain /Identifier/
  | BiDirectional !PortDirection !HWType
  -- ^ Tagging type indicating a bidirectional (inout) port
  | CustomSP !Identifier !DataRepr' !Size [(ConstrRepr', Identifier, [HWType])]
  -- ^ Same as Sum-Of-Product, but with a user specified bit representation. For
  -- more info, see: Clash.Annotations.BitRepresentations.
  | CustomSum !Identifier !DataRepr' !Size [(ConstrRepr', Identifier)]
  -- ^ Same as Sum, but with a user specified bit representation. For more info,
  -- see: Clash.Annotations.BitRepresentations.
  | Annotated [Attr'] !HWType
  -- ^ Annotated with HDL attributes
  | KnownDomain !Identifier !Integer !ActiveEdge !ResetKind !InitBehavior !ResetPolarity
  -- ^ Domain name, period, active edge, reset kind, initial value behavior
  deriving (HWType -> HWType -> Bool
(HWType -> HWType -> Bool)
-> (HWType -> HWType -> Bool) -> Eq HWType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HWType -> HWType -> Bool
$c/= :: HWType -> HWType -> Bool
== :: HWType -> HWType -> Bool
$c== :: HWType -> HWType -> Bool
Eq, Eq HWType
Eq HWType =>
(HWType -> HWType -> Ordering)
-> (HWType -> HWType -> Bool)
-> (HWType -> HWType -> Bool)
-> (HWType -> HWType -> Bool)
-> (HWType -> HWType -> Bool)
-> (HWType -> HWType -> HWType)
-> (HWType -> HWType -> HWType)
-> Ord HWType
HWType -> HWType -> Bool
HWType -> HWType -> Ordering
HWType -> HWType -> HWType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HWType -> HWType -> HWType
$cmin :: HWType -> HWType -> HWType
max :: HWType -> HWType -> HWType
$cmax :: HWType -> HWType -> HWType
>= :: HWType -> HWType -> Bool
$c>= :: HWType -> HWType -> Bool
> :: HWType -> HWType -> Bool
$c> :: HWType -> HWType -> Bool
<= :: HWType -> HWType -> Bool
$c<= :: HWType -> HWType -> Bool
< :: HWType -> HWType -> Bool
$c< :: HWType -> HWType -> Bool
compare :: HWType -> HWType -> Ordering
$ccompare :: HWType -> HWType -> Ordering
$cp1Ord :: Eq HWType
Ord, Int -> HWType -> ShowS
[HWType] -> ShowS
HWType -> String
(Int -> HWType -> ShowS)
-> (HWType -> String) -> ([HWType] -> ShowS) -> Show HWType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HWType] -> ShowS
$cshowList :: [HWType] -> ShowS
show :: HWType -> String
$cshow :: HWType -> String
showsPrec :: Int -> HWType -> ShowS
$cshowsPrec :: Int -> HWType -> ShowS
Show, (forall x. HWType -> Rep HWType x)
-> (forall x. Rep HWType x -> HWType) -> Generic HWType
forall x. Rep HWType x -> HWType
forall x. HWType -> Rep HWType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HWType x -> HWType
$cfrom :: forall x. HWType -> Rep HWType x
Generic, HWType -> ()
(HWType -> ()) -> NFData HWType
forall a. (a -> ()) -> NFData a
rnf :: HWType -> ()
$crnf :: HWType -> ()
NFData, Int -> HWType -> Int
HWType -> Int
(Int -> HWType -> Int) -> (HWType -> Int) -> Hashable HWType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HWType -> Int
$chash :: HWType -> Int
hashWithSalt :: Int -> HWType -> Int
$chashWithSalt :: Int -> HWType -> Int
Hashable)

-- | Extract hardware attributes from Annotated. Returns an empty list if
-- non-Annotated given or if Annotated has an empty list of attributes.
hwTypeAttrs :: HWType -> [Attr']
hwTypeAttrs :: HWType -> [Attr']
hwTypeAttrs (Annotated attrs :: [Attr']
attrs _type :: HWType
_type) = [Attr']
attrs
hwTypeAttrs _                       = []

-- | Internals of a Component
data Declaration
  -- | Signal assignment
  = Assignment
      !Identifier -- FIELD Signal to assign
      !Expr       -- FIELD Assigned expression

  -- | Conditional signal assignment:
  | CondAssignment
      !Identifier            -- FIELD Signal to assign
      !HWType                -- FIELD Type of the result/alternatives
      !Expr                  -- FIELD Scrutinized expression
      !HWType                -- FIELD Type of the scrutinee
      [(Maybe Literal,Expr)] -- FIELD List of: (Maybe expression scrutinized expression is compared with,RHS of alternative)

  -- | Instantiation of another component:
  | InstDecl
      EntityOrComponent                  -- FIELD Whether it's an entity or a component
      (Maybe Comment)                    -- FIELD Comment to add to the generated code
      !Identifier                        -- FIELD The component's (or entity's) name
      !Identifier                        -- FIELD Instance label
      [(Expr,HWType,Expr)]               -- FIELD List of parameters for this component (param name, param type, param value)
      [(Expr,PortDirection,HWType,Expr)] -- FIELD Ports (port name, port direction, type, assignment)

  -- | Instantiation of blackbox declaration
  | BlackBoxD
      !Text                    -- FIELD Primitive name
      [BlackBoxTemplate]       -- FIELD VHDL only: add @library@ declarations
      [BlackBoxTemplate]       -- FIELD VHDL only: add @use@ declarations
      [((Text,Text),BlackBox)] -- FIELD Intel Quartus only: create a @.qsys@ file from given template
      !BlackBox                -- FIELD Template tokens
      BlackBoxContext          -- FIELD Context in which tokens should be rendered

  -- | Signal declaration
  | NetDecl'
      (Maybe Comment)            -- FIELD Note; will be inserted as a comment in target hdl
      WireOrReg                  -- FIELD Wire or register
      !Identifier                -- FIELD Name of signal
      (Either Identifier HWType) -- FIELD Pointer to type of signal or type of signal
      -- ^ Signal declaration
  | TickDecl Comment
  -- ^ HDL tick corresponding to a Core tick
  deriving Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
(Int -> Declaration -> ShowS)
-> (Declaration -> String)
-> ([Declaration] -> ShowS)
-> Show Declaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show

data EntityOrComponent = Entity | Comp | Empty
  deriving Int -> EntityOrComponent -> ShowS
[EntityOrComponent] -> ShowS
EntityOrComponent -> String
(Int -> EntityOrComponent -> ShowS)
-> (EntityOrComponent -> String)
-> ([EntityOrComponent] -> ShowS)
-> Show EntityOrComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityOrComponent] -> ShowS
$cshowList :: [EntityOrComponent] -> ShowS
show :: EntityOrComponent -> String
$cshow :: EntityOrComponent -> String
showsPrec :: Int -> EntityOrComponent -> ShowS
$cshowsPrec :: Int -> EntityOrComponent -> ShowS
Show

data WireOrReg = Wire | Reg
  deriving (Int -> WireOrReg -> ShowS
[WireOrReg] -> ShowS
WireOrReg -> String
(Int -> WireOrReg -> ShowS)
-> (WireOrReg -> String)
-> ([WireOrReg] -> ShowS)
-> Show WireOrReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireOrReg] -> ShowS
$cshowList :: [WireOrReg] -> ShowS
show :: WireOrReg -> String
$cshow :: WireOrReg -> String
showsPrec :: Int -> WireOrReg -> ShowS
$cshowsPrec :: Int -> WireOrReg -> ShowS
Show,(forall x. WireOrReg -> Rep WireOrReg x)
-> (forall x. Rep WireOrReg x -> WireOrReg) -> Generic WireOrReg
forall x. Rep WireOrReg x -> WireOrReg
forall x. WireOrReg -> Rep WireOrReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WireOrReg x -> WireOrReg
$cfrom :: forall x. WireOrReg -> Rep WireOrReg x
Generic)

instance NFData WireOrReg

pattern NetDecl
  :: Maybe Comment
  -- ^ Note; will be inserted as a comment in target hdl
  -> Identifier
  -- ^ Name of signal
  -> HWType
  -- ^ Type of signal
  -> Declaration
pattern $bNetDecl :: Maybe Identifier -> Identifier -> HWType -> Declaration
$mNetDecl :: forall r.
Declaration
-> (Maybe Identifier -> Identifier -> HWType -> r)
-> (Void# -> r)
-> r
NetDecl note d ty <- NetDecl' note Wire d (Right ty)
  where
    NetDecl note :: Maybe Identifier
note d :: Identifier
d ty :: HWType
ty = Maybe Identifier
-> WireOrReg
-> Identifier
-> Either Identifier HWType
-> Declaration
NetDecl' Maybe Identifier
note WireOrReg
Wire Identifier
d (HWType -> Either Identifier HWType
forall a b. b -> Either a b
Right HWType
ty)

data PortDirection = In | Out
  deriving (PortDirection -> PortDirection -> Bool
(PortDirection -> PortDirection -> Bool)
-> (PortDirection -> PortDirection -> Bool) -> Eq PortDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortDirection -> PortDirection -> Bool
$c/= :: PortDirection -> PortDirection -> Bool
== :: PortDirection -> PortDirection -> Bool
$c== :: PortDirection -> PortDirection -> Bool
Eq,Eq PortDirection
Eq PortDirection =>
(PortDirection -> PortDirection -> Ordering)
-> (PortDirection -> PortDirection -> Bool)
-> (PortDirection -> PortDirection -> Bool)
-> (PortDirection -> PortDirection -> Bool)
-> (PortDirection -> PortDirection -> Bool)
-> (PortDirection -> PortDirection -> PortDirection)
-> (PortDirection -> PortDirection -> PortDirection)
-> Ord PortDirection
PortDirection -> PortDirection -> Bool
PortDirection -> PortDirection -> Ordering
PortDirection -> PortDirection -> PortDirection
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PortDirection -> PortDirection -> PortDirection
$cmin :: PortDirection -> PortDirection -> PortDirection
max :: PortDirection -> PortDirection -> PortDirection
$cmax :: PortDirection -> PortDirection -> PortDirection
>= :: PortDirection -> PortDirection -> Bool
$c>= :: PortDirection -> PortDirection -> Bool
> :: PortDirection -> PortDirection -> Bool
$c> :: PortDirection -> PortDirection -> Bool
<= :: PortDirection -> PortDirection -> Bool
$c<= :: PortDirection -> PortDirection -> Bool
< :: PortDirection -> PortDirection -> Bool
$c< :: PortDirection -> PortDirection -> Bool
compare :: PortDirection -> PortDirection -> Ordering
$ccompare :: PortDirection -> PortDirection -> Ordering
$cp1Ord :: Eq PortDirection
Ord,Int -> PortDirection -> ShowS
[PortDirection] -> ShowS
PortDirection -> String
(Int -> PortDirection -> ShowS)
-> (PortDirection -> String)
-> ([PortDirection] -> ShowS)
-> Show PortDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortDirection] -> ShowS
$cshowList :: [PortDirection] -> ShowS
show :: PortDirection -> String
$cshow :: PortDirection -> String
showsPrec :: Int -> PortDirection -> ShowS
$cshowsPrec :: Int -> PortDirection -> ShowS
Show,(forall x. PortDirection -> Rep PortDirection x)
-> (forall x. Rep PortDirection x -> PortDirection)
-> Generic PortDirection
forall x. Rep PortDirection x -> PortDirection
forall x. PortDirection -> Rep PortDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PortDirection x -> PortDirection
$cfrom :: forall x. PortDirection -> Rep PortDirection x
Generic,PortDirection -> ()
(PortDirection -> ()) -> NFData PortDirection
forall a. (a -> ()) -> NFData a
rnf :: PortDirection -> ()
$crnf :: PortDirection -> ()
NFData,Int -> PortDirection -> Int
PortDirection -> Int
(Int -> PortDirection -> Int)
-> (PortDirection -> Int) -> Hashable PortDirection
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PortDirection -> Int
$chash :: PortDirection -> Int
hashWithSalt :: Int -> PortDirection -> Int
$chashWithSalt :: Int -> PortDirection -> Int
Hashable)

instance NFData Declaration where
  rnf :: Declaration -> ()
rnf a :: Declaration
a = Declaration
a Declaration -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Expression Modifier
data Modifier
  = Indexed (HWType,Int,Int) -- ^ Index the expression: (Type of expression,DataCon tag,Field Tag)
  | DC (HWType,Int)          -- ^ See expression in a DataCon context: (Type of the expression, DataCon tag)
  | VecAppend                -- ^ See the expression in the context of a Vector append operation
  | RTreeAppend              -- ^ See the expression in the context of a Tree append operation
  | Sliced (HWType,Int,Int)  -- ^ Slice the identifier of the given type from start to end
  | Nested Modifier Modifier
  deriving Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show

-- | Expression used in RHS of a declaration
data Expr
  = Literal    !(Maybe (HWType,Size)) !Literal -- ^ Literal expression
  | DataCon    !HWType       !Modifier  [Expr] -- ^ DataCon application
  | Identifier !Identifier   !(Maybe Modifier) -- ^ Signal reference
  | DataTag    !HWType       !(Either Identifier Identifier) -- ^ @Left e@: tagToEnum\#, @Right e@: dataToTag\#

  -- | Instantiation of a BlackBox expression
  | BlackBoxE
      !Text                    -- FIELD Primitive name
      [BlackBoxTemplate]       -- FIELD VHDL only: add @library@ declarations
      [BlackBoxTemplate]       -- FIELD VHDL only: add @use@ declarations:
      [((Text,Text),BlackBox)] -- FIELD Intel/Quartus only: create a @.qsys@ file from given template.
      !BlackBox                -- FIELD Template tokens
      !BlackBoxContext         -- FIELD Context in which tokens should be rendered
      !Bool                    -- FIELD Wrap in paretheses?
  | ConvBV     (Maybe Identifier) HWType Bool Expr
  | IfThenElse Expr Expr Expr
  deriving Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show

-- | Literals used in an expression
data Literal
  = NumLit    !Integer          -- ^ Number literal
  | BitLit    !Bit              -- ^ Bit literal
  | BitVecLit !Integer !Integer -- ^ BitVector literal
  | BoolLit   !Bool             -- ^ Boolean literal
  | VecLit    [Literal]         -- ^ Vector literal
  | StringLit !String           -- ^ String literal
  deriving (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq,Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show)

-- | Bit literal
data Bit
  = H -- ^ High
  | L -- ^ Low
  | U -- ^ Undefined
  | Z -- ^ High-impedance
  deriving (Bit -> Bit -> Bool
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c== :: Bit -> Bit -> Bool
Eq,Int -> Bit -> ShowS
[Bit] -> ShowS
Bit -> String
(Int -> Bit -> ShowS)
-> (Bit -> String) -> ([Bit] -> ShowS) -> Show Bit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit] -> ShowS
$cshowList :: [Bit] -> ShowS
show :: Bit -> String
$cshow :: Bit -> String
showsPrec :: Int -> Bit -> ShowS
$cshowsPrec :: Int -> Bit -> ShowS
Show,Typeable,Bit -> Q Exp
(Bit -> Q Exp) -> Lift Bit
forall t. (t -> Q Exp) -> Lift t
lift :: Bit -> Q Exp
$clift :: Bit -> Q Exp
Lift)


toBit :: Integer -- ^ mask
      -> Integer -- ^ value
      -> Bit
toBit :: Integer -> Integer -> Bit
toBit m :: Integer
m i :: Integer
i = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
m 0
            then Bit
U
            else if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
i 0 then Bit
H else Bit
L

-- | Context used to fill in the holes of a BlackBox template
data BlackBoxContext
  = Context
  { BlackBoxContext -> Identifier
bbName      :: Text -- ^ Blackbox function name (for error reporting)
  , BlackBoxContext -> (Expr, HWType)
bbResult    :: (Expr,HWType) -- ^ Result name and type
  , BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs    :: [(Expr,HWType,Bool)] -- ^ Argument names, types, and whether it is a literal
  , BlackBoxContext
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
bbFunctions :: IntMap (Either BlackBox (Identifier,[Declaration])
                          ,WireOrReg
                          ,[BlackBoxTemplate]
                          ,[BlackBoxTemplate]
                          ,[((Text,Text),BlackBox)]
                          ,BlackBoxContext)
  -- ^ Function arguments (subset of inputs):
  --
  -- * ( Blackbox Template
  --   , Whether the result should be /reg/ or a /wire/ (Verilog only)
  --   , Partial Blackbox Context
  --   )
  , BlackBoxContext -> [Identifier]
bbQsysIncName :: [Identifier]
  , BlackBoxContext -> Int
bbLevel :: Int
  -- ^ The scoping level this context is associated with, ensures that
  -- @~ARGN[k][n]@ holes are only filled with values from this context if @k@
  -- is equal to the scoping level of this context.
  , BlackBoxContext -> Identifier
bbCompName :: Identifier
  -- ^ The component the BlackBox is instantiated in
  }
  deriving Int -> BlackBoxContext -> ShowS
[BlackBoxContext] -> ShowS
BlackBoxContext -> String
(Int -> BlackBoxContext -> ShowS)
-> (BlackBoxContext -> String)
-> ([BlackBoxContext] -> ShowS)
-> Show BlackBoxContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlackBoxContext] -> ShowS
$cshowList :: [BlackBoxContext] -> ShowS
show :: BlackBoxContext -> String
$cshow :: BlackBoxContext -> String
showsPrec :: Int -> BlackBoxContext -> ShowS
$cshowsPrec :: Int -> BlackBoxContext -> ShowS
Show

type BBName = String
type BBHash = Int

data BlackBox
  = BBTemplate BlackBoxTemplate
  | BBFunction BBName BBHash TemplateFunction
  deriving ((forall x. BlackBox -> Rep BlackBox x)
-> (forall x. Rep BlackBox x -> BlackBox) -> Generic BlackBox
forall x. Rep BlackBox x -> BlackBox
forall x. BlackBox -> Rep BlackBox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlackBox x -> BlackBox
$cfrom :: forall x. BlackBox -> Rep BlackBox x
Generic, BlackBox -> ()
(BlackBox -> ()) -> NFData BlackBox
forall a. (a -> ()) -> NFData a
rnf :: BlackBox -> ()
$crnf :: BlackBox -> ()
NFData, Get BlackBox
[BlackBox] -> Put
BlackBox -> Put
(BlackBox -> Put)
-> Get BlackBox -> ([BlackBox] -> Put) -> Binary BlackBox
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [BlackBox] -> Put
$cputList :: [BlackBox] -> Put
get :: Get BlackBox
$cget :: Get BlackBox
put :: BlackBox -> Put
$cput :: BlackBox -> Put
Binary)

data TemplateFunction where
  TemplateFunction
    :: [Int]
    -> (BlackBoxContext -> Bool)
    -> (forall s . Backend s => BlackBoxContext -> Lazy.State s Doc)
    -> TemplateFunction

instance Show BlackBox where
  show :: BlackBox -> String
show (BBTemplate t :: BlackBoxTemplate
t)  = BlackBoxTemplate -> String
forall a. Show a => a -> String
show BlackBoxTemplate
t
  show (BBFunction nm :: String
nm hsh :: Int
hsh _) =
    "<TemplateFunction(nm=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", hash=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hsh String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")>"

instance NFData TemplateFunction where
  rnf :: TemplateFunction -> ()
rnf (TemplateFunction is :: [Int]
is f :: BlackBoxContext -> Bool
f _) = [Int] -> ()
forall a. NFData a => a -> ()
rnf [Int]
is () -> () -> ()
forall a b. a -> b -> b
`seq` BlackBoxContext -> Bool
f (BlackBoxContext -> Bool) -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | __NB__: serialisation doesn't preserve the embedded function
instance Binary TemplateFunction where
  put :: TemplateFunction -> Put
put (TemplateFunction is :: [Int]
is _ _ ) = [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
is
  get :: Get TemplateFunction
get = (\is :: [Int]
is -> [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
is BlackBoxContext -> Bool
forall b a. b -> a
err forall s. Backend s => BlackBoxContext -> State s Doc
forall b a. b -> a
err) ([Int] -> TemplateFunction) -> Get [Int] -> Get TemplateFunction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Int]
forall t. Binary t => Get t
get
    where err :: b -> a
err = a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> a -> b -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error "TemplateFunction functions can't be preserved by serialisation"

emptyBBContext :: Text -> BlackBoxContext
emptyBBContext :: Identifier -> BlackBoxContext
emptyBBContext n :: Identifier
n
  = Context :: Identifier
-> (Expr, HWType)
-> [(Expr, HWType, Bool)]
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
-> [Identifier]
-> Int
-> Identifier
-> BlackBoxContext
Context
  { bbName :: Identifier
bbName        = Identifier
n
  , bbResult :: (Expr, HWType)
bbResult      = (Identifier -> Maybe Modifier -> Expr
Identifier (String -> Identifier
pack "__EMPTY__") Maybe Modifier
forall a. Maybe a
Nothing, Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing)
  , bbInputs :: [(Expr, HWType, Bool)]
bbInputs      = []
  , bbFunctions :: IntMap
  (Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)
bbFunctions   = IntMap
  (Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall a. IntMap a
empty
  , bbQsysIncName :: [Identifier]
bbQsysIncName = []
  , bbLevel :: Int
bbLevel       = (-1)
  , bbCompName :: Identifier
bbCompName    = String -> Identifier
pack "__NOCOMPNAME__"
  }

makeLenses ''NetlistEnv
makeLenses ''NetlistState