{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2017     , Myrtle Software Ltd,
                    2017-2018, Google Inc.
                    2020     , QBayLogic
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

  Type and instance definitions for Netlist modules
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}

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

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

import Control.DeepSeq
import qualified Control.Lens               as Lens
import Control.Lens                         (Lens', (.=))
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail                   (MonadFail)
#endif
import Control.Monad.Reader                 (ReaderT, MonadReader)
import qualified Control.Monad.State        as Lazy (State)
import qualified Control.Monad.State.Strict as Strict
  (State, MonadIO, MonadState, StateT)
import Data.Bits                            (testBit)
import Data.Binary                          (Binary(..))
import Data.Function                        (on)
import Data.Hashable                        (Hashable(hash,hashWithSalt))
import Data.HashMap.Strict                  (HashMap)
import Data.HashSet                         (HashSet)
import qualified Data.List                  as List
import Data.IntMap                          (IntMap, empty)
import Data.Maybe                           (mapMaybe)
import qualified Data.Set                   as Set
import Data.Text                            (Text)

import Data.Typeable                        (Typeable)
import Data.Text.Prettyprint.Doc.Extra      (Doc)
import Data.Semigroup.Monad                 (Mon(..))
import GHC.Generics                         (Generic)
import GHC.Stack
import Language.Haskell.TH.Syntax           (Lift)

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc                     (SrcSpan)
#else
import SrcLoc                               (SrcSpan)
#endif

import Clash.Annotations.BitRepresentation  (FieldAnn)
import Clash.Annotations.Primitive          (HDL(..))
import Clash.Annotations.TopEntity          (TopEntity)
import Clash.Backend                        (Backend)
import Clash.Core.Type                      (Type)
import Clash.Core.Var                       (Attr', Id, varType)
import Clash.Core.TyCon                     (TyConMap)
import Clash.Core.VarEnv                    (VarEnv)
import Clash.Driver.Types                   (BindingMap, ClashOpts)
import Clash.Netlist.BlackBox.Types         (BlackBoxTemplate)
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')

import {-# SOURCE #-} qualified Clash.Netlist.Id as Id

-- | Structure describing a top entity: it's id and its port annotations.
data TopEntityT = TopEntityT
  { TopEntityT -> Id
topId :: Id
  -- ^ Id of top entity
  , TopEntityT -> Maybe TopEntity
topAnnotation :: Maybe TopEntity
  -- ^ (Maybe) a topentity annotation
  , TopEntityT -> Bool
topIsTestBench :: Bool
  -- ^ Whether this entity is a test bench
  } deriving ((forall x. TopEntityT -> Rep TopEntityT x)
-> (forall x. Rep TopEntityT x -> TopEntityT) -> Generic TopEntityT
forall x. Rep TopEntityT x -> TopEntityT
forall x. TopEntityT -> Rep TopEntityT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopEntityT x -> TopEntityT
$cfrom :: forall x. TopEntityT -> Rep TopEntityT x
Generic, Int -> TopEntityT -> ShowS
[TopEntityT] -> ShowS
TopEntityT -> String
(Int -> TopEntityT -> ShowS)
-> (TopEntityT -> String)
-> ([TopEntityT] -> ShowS)
-> Show TopEntityT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopEntityT] -> ShowS
$cshowList :: [TopEntityT] -> ShowS
show :: TopEntityT -> String
$cshow :: TopEntityT -> String
showsPrec :: Int -> TopEntityT -> ShowS
$cshowsPrec :: Int -> TopEntityT -> ShowS
Show)

-- | Same as "TopEntity", but with all port names that end up in HDL specified
data ExpandedTopEntity a = ExpandedTopEntity
  { ExpandedTopEntity a -> [Maybe (ExpandedPortName a)]
et_inputs :: [Maybe (ExpandedPortName a)]
  -- ^ Inputs with fully expanded port names. /Nothing/ if port is void.
  , ExpandedTopEntity a -> Maybe (ExpandedPortName a)
et_output :: Maybe (ExpandedPortName a)
  -- ^ Output with fully expanded port names. /Nothing/ if port is void or
  -- BiDirectionalOut.
  } deriving (Int -> ExpandedTopEntity a -> ShowS
[ExpandedTopEntity a] -> ShowS
ExpandedTopEntity a -> String
(Int -> ExpandedTopEntity a -> ShowS)
-> (ExpandedTopEntity a -> String)
-> ([ExpandedTopEntity a] -> ShowS)
-> Show (ExpandedTopEntity a)
forall a. Show a => Int -> ExpandedTopEntity a -> ShowS
forall a. Show a => [ExpandedTopEntity a] -> ShowS
forall a. Show a => ExpandedTopEntity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpandedTopEntity a] -> ShowS
$cshowList :: forall a. Show a => [ExpandedTopEntity a] -> ShowS
show :: ExpandedTopEntity a -> String
$cshow :: forall a. Show a => ExpandedTopEntity a -> String
showsPrec :: Int -> ExpandedTopEntity a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExpandedTopEntity a -> ShowS
Show, a -> ExpandedTopEntity b -> ExpandedTopEntity a
(a -> b) -> ExpandedTopEntity a -> ExpandedTopEntity b
(forall a b.
 (a -> b) -> ExpandedTopEntity a -> ExpandedTopEntity b)
-> (forall a b. a -> ExpandedTopEntity b -> ExpandedTopEntity a)
-> Functor ExpandedTopEntity
forall a b. a -> ExpandedTopEntity b -> ExpandedTopEntity a
forall a b. (a -> b) -> ExpandedTopEntity a -> ExpandedTopEntity b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ExpandedTopEntity b -> ExpandedTopEntity a
$c<$ :: forall a b. a -> ExpandedTopEntity b -> ExpandedTopEntity a
fmap :: (a -> b) -> ExpandedTopEntity a -> ExpandedTopEntity b
$cfmap :: forall a b. (a -> b) -> ExpandedTopEntity a -> ExpandedTopEntity b
Functor, ExpandedTopEntity a -> Bool
(a -> m) -> ExpandedTopEntity a -> m
(a -> b -> b) -> b -> ExpandedTopEntity a -> b
(forall m. Monoid m => ExpandedTopEntity m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExpandedTopEntity a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExpandedTopEntity a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExpandedTopEntity a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExpandedTopEntity a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExpandedTopEntity a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExpandedTopEntity a -> b)
-> (forall a. (a -> a -> a) -> ExpandedTopEntity a -> a)
-> (forall a. (a -> a -> a) -> ExpandedTopEntity a -> a)
-> (forall a. ExpandedTopEntity a -> [a])
-> (forall a. ExpandedTopEntity a -> Bool)
-> (forall a. ExpandedTopEntity a -> Int)
-> (forall a. Eq a => a -> ExpandedTopEntity a -> Bool)
-> (forall a. Ord a => ExpandedTopEntity a -> a)
-> (forall a. Ord a => ExpandedTopEntity a -> a)
-> (forall a. Num a => ExpandedTopEntity a -> a)
-> (forall a. Num a => ExpandedTopEntity a -> a)
-> Foldable ExpandedTopEntity
forall a. Eq a => a -> ExpandedTopEntity a -> Bool
forall a. Num a => ExpandedTopEntity a -> a
forall a. Ord a => ExpandedTopEntity a -> a
forall m. Monoid m => ExpandedTopEntity m -> m
forall a. ExpandedTopEntity a -> Bool
forall a. ExpandedTopEntity a -> Int
forall a. ExpandedTopEntity a -> [a]
forall a. (a -> a -> a) -> ExpandedTopEntity a -> a
forall m a. Monoid m => (a -> m) -> ExpandedTopEntity a -> m
forall b a. (b -> a -> b) -> b -> ExpandedTopEntity a -> b
forall a b. (a -> b -> b) -> b -> ExpandedTopEntity a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ExpandedTopEntity a -> a
$cproduct :: forall a. Num a => ExpandedTopEntity a -> a
sum :: ExpandedTopEntity a -> a
$csum :: forall a. Num a => ExpandedTopEntity a -> a
minimum :: ExpandedTopEntity a -> a
$cminimum :: forall a. Ord a => ExpandedTopEntity a -> a
maximum :: ExpandedTopEntity a -> a
$cmaximum :: forall a. Ord a => ExpandedTopEntity a -> a
elem :: a -> ExpandedTopEntity a -> Bool
$celem :: forall a. Eq a => a -> ExpandedTopEntity a -> Bool
length :: ExpandedTopEntity a -> Int
$clength :: forall a. ExpandedTopEntity a -> Int
null :: ExpandedTopEntity a -> Bool
$cnull :: forall a. ExpandedTopEntity a -> Bool
toList :: ExpandedTopEntity a -> [a]
$ctoList :: forall a. ExpandedTopEntity a -> [a]
foldl1 :: (a -> a -> a) -> ExpandedTopEntity a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ExpandedTopEntity a -> a
foldr1 :: (a -> a -> a) -> ExpandedTopEntity a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ExpandedTopEntity a -> a
foldl' :: (b -> a -> b) -> b -> ExpandedTopEntity a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ExpandedTopEntity a -> b
foldl :: (b -> a -> b) -> b -> ExpandedTopEntity a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ExpandedTopEntity a -> b
foldr' :: (a -> b -> b) -> b -> ExpandedTopEntity a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ExpandedTopEntity a -> b
foldr :: (a -> b -> b) -> b -> ExpandedTopEntity a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ExpandedTopEntity a -> b
foldMap' :: (a -> m) -> ExpandedTopEntity a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ExpandedTopEntity a -> m
foldMap :: (a -> m) -> ExpandedTopEntity a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ExpandedTopEntity a -> m
fold :: ExpandedTopEntity m -> m
$cfold :: forall m. Monoid m => ExpandedTopEntity m -> m
Foldable, Functor ExpandedTopEntity
Foldable ExpandedTopEntity
Functor ExpandedTopEntity
-> Foldable ExpandedTopEntity
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    ExpandedTopEntity (f a) -> f (ExpandedTopEntity a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> ExpandedTopEntity a -> m (ExpandedTopEntity b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    ExpandedTopEntity (m a) -> m (ExpandedTopEntity a))
-> Traversable ExpandedTopEntity
(a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
ExpandedTopEntity (m a) -> m (ExpandedTopEntity a)
forall (f :: Type -> Type) a.
Applicative f =>
ExpandedTopEntity (f a) -> f (ExpandedTopEntity a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ExpandedTopEntity a -> m (ExpandedTopEntity b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b)
sequence :: ExpandedTopEntity (m a) -> m (ExpandedTopEntity a)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
ExpandedTopEntity (m a) -> m (ExpandedTopEntity a)
mapM :: (a -> m b) -> ExpandedTopEntity a -> m (ExpandedTopEntity b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ExpandedTopEntity a -> m (ExpandedTopEntity b)
sequenceA :: ExpandedTopEntity (f a) -> f (ExpandedTopEntity a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
ExpandedTopEntity (f a) -> f (ExpandedTopEntity a)
traverse :: (a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ExpandedTopEntity a -> f (ExpandedTopEntity b)
$cp2Traversable :: Foldable ExpandedTopEntity
$cp1Traversable :: Functor ExpandedTopEntity
Traversable)

-- | See "ExpandedTopEntity"
data ExpandedPortName a
  -- | Same as "PortName", but fully expanded
  = ExpandedPortName HWType a

  -- | Same as "PortProduct", but fully expanded
  | ExpandedPortProduct
      Text
      -- FIELD Name hint. Can be used to create intermediate signal names.
      HWType
      -- FIELD Type of product
      [ExpandedPortName a]
      -- FIELD Product fields
  deriving (Int -> ExpandedPortName a -> ShowS
[ExpandedPortName a] -> ShowS
ExpandedPortName a -> String
(Int -> ExpandedPortName a -> ShowS)
-> (ExpandedPortName a -> String)
-> ([ExpandedPortName a] -> ShowS)
-> Show (ExpandedPortName a)
forall a. Show a => Int -> ExpandedPortName a -> ShowS
forall a. Show a => [ExpandedPortName a] -> ShowS
forall a. Show a => ExpandedPortName a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpandedPortName a] -> ShowS
$cshowList :: forall a. Show a => [ExpandedPortName a] -> ShowS
show :: ExpandedPortName a -> String
$cshow :: forall a. Show a => ExpandedPortName a -> String
showsPrec :: Int -> ExpandedPortName a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExpandedPortName a -> ShowS
Show, a -> ExpandedPortName b -> ExpandedPortName a
(a -> b) -> ExpandedPortName a -> ExpandedPortName b
(forall a b. (a -> b) -> ExpandedPortName a -> ExpandedPortName b)
-> (forall a b. a -> ExpandedPortName b -> ExpandedPortName a)
-> Functor ExpandedPortName
forall a b. a -> ExpandedPortName b -> ExpandedPortName a
forall a b. (a -> b) -> ExpandedPortName a -> ExpandedPortName b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ExpandedPortName b -> ExpandedPortName a
$c<$ :: forall a b. a -> ExpandedPortName b -> ExpandedPortName a
fmap :: (a -> b) -> ExpandedPortName a -> ExpandedPortName b
$cfmap :: forall a b. (a -> b) -> ExpandedPortName a -> ExpandedPortName b
Functor, ExpandedPortName a -> Bool
(a -> m) -> ExpandedPortName a -> m
(a -> b -> b) -> b -> ExpandedPortName a -> b
(forall m. Monoid m => ExpandedPortName m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExpandedPortName a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExpandedPortName a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExpandedPortName a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExpandedPortName a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExpandedPortName a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExpandedPortName a -> b)
-> (forall a. (a -> a -> a) -> ExpandedPortName a -> a)
-> (forall a. (a -> a -> a) -> ExpandedPortName a -> a)
-> (forall a. ExpandedPortName a -> [a])
-> (forall a. ExpandedPortName a -> Bool)
-> (forall a. ExpandedPortName a -> Int)
-> (forall a. Eq a => a -> ExpandedPortName a -> Bool)
-> (forall a. Ord a => ExpandedPortName a -> a)
-> (forall a. Ord a => ExpandedPortName a -> a)
-> (forall a. Num a => ExpandedPortName a -> a)
-> (forall a. Num a => ExpandedPortName a -> a)
-> Foldable ExpandedPortName
forall a. Eq a => a -> ExpandedPortName a -> Bool
forall a. Num a => ExpandedPortName a -> a
forall a. Ord a => ExpandedPortName a -> a
forall m. Monoid m => ExpandedPortName m -> m
forall a. ExpandedPortName a -> Bool
forall a. ExpandedPortName a -> Int
forall a. ExpandedPortName a -> [a]
forall a. (a -> a -> a) -> ExpandedPortName a -> a
forall m a. Monoid m => (a -> m) -> ExpandedPortName a -> m
forall b a. (b -> a -> b) -> b -> ExpandedPortName a -> b
forall a b. (a -> b -> b) -> b -> ExpandedPortName a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ExpandedPortName a -> a
$cproduct :: forall a. Num a => ExpandedPortName a -> a
sum :: ExpandedPortName a -> a
$csum :: forall a. Num a => ExpandedPortName a -> a
minimum :: ExpandedPortName a -> a
$cminimum :: forall a. Ord a => ExpandedPortName a -> a
maximum :: ExpandedPortName a -> a
$cmaximum :: forall a. Ord a => ExpandedPortName a -> a
elem :: a -> ExpandedPortName a -> Bool
$celem :: forall a. Eq a => a -> ExpandedPortName a -> Bool
length :: ExpandedPortName a -> Int
$clength :: forall a. ExpandedPortName a -> Int
null :: ExpandedPortName a -> Bool
$cnull :: forall a. ExpandedPortName a -> Bool
toList :: ExpandedPortName a -> [a]
$ctoList :: forall a. ExpandedPortName a -> [a]
foldl1 :: (a -> a -> a) -> ExpandedPortName a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ExpandedPortName a -> a
foldr1 :: (a -> a -> a) -> ExpandedPortName a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ExpandedPortName a -> a
foldl' :: (b -> a -> b) -> b -> ExpandedPortName a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ExpandedPortName a -> b
foldl :: (b -> a -> b) -> b -> ExpandedPortName a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ExpandedPortName a -> b
foldr' :: (a -> b -> b) -> b -> ExpandedPortName a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ExpandedPortName a -> b
foldr :: (a -> b -> b) -> b -> ExpandedPortName a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ExpandedPortName a -> b
foldMap' :: (a -> m) -> ExpandedPortName a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ExpandedPortName a -> m
foldMap :: (a -> m) -> ExpandedPortName a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ExpandedPortName a -> m
fold :: ExpandedPortName m -> m
$cfold :: forall m. Monoid m => ExpandedPortName m -> m
Foldable, Functor ExpandedPortName
Foldable ExpandedPortName
Functor ExpandedPortName
-> Foldable ExpandedPortName
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> ExpandedPortName a -> f (ExpandedPortName b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    ExpandedPortName (f a) -> f (ExpandedPortName a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> ExpandedPortName a -> m (ExpandedPortName b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    ExpandedPortName (m a) -> m (ExpandedPortName a))
-> Traversable ExpandedPortName
(a -> f b) -> ExpandedPortName a -> f (ExpandedPortName b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a.
Monad m =>
ExpandedPortName (m a) -> m (ExpandedPortName a)
forall (f :: Type -> Type) a.
Applicative f =>
ExpandedPortName (f a) -> f (ExpandedPortName a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ExpandedPortName a -> m (ExpandedPortName b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ExpandedPortName a -> f (ExpandedPortName b)
sequence :: ExpandedPortName (m a) -> m (ExpandedPortName a)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
ExpandedPortName (m a) -> m (ExpandedPortName a)
mapM :: (a -> m b) -> ExpandedPortName a -> m (ExpandedPortName b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ExpandedPortName a -> m (ExpandedPortName b)
sequenceA :: ExpandedPortName (f a) -> f (ExpandedPortName a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
ExpandedPortName (f a) -> f (ExpandedPortName a)
traverse :: (a -> f b) -> ExpandedPortName a -> f (ExpandedPortName b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ExpandedPortName a -> f (ExpandedPortName b)
$cp2Traversable :: Foldable ExpandedPortName
$cp1Traversable :: Functor ExpandedPortName
Traversable)

-- | 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 :: Strict.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 :: Type -> Type).
(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 :: Type -> Type).
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 :: Type -> Type).
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,
                    Strict.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 :: Type -> Type).
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
Strict.MonadIO, Monad NetlistMonad
Monad NetlistMonad
-> (forall a. String -> NetlistMonad a) -> MonadFail NetlistMonad
String -> NetlistMonad a
forall a. String -> NetlistMonad a
forall (m :: Type -> Type).
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)

-- | See 'is_freshCache'
type FreshCache = HashMap Text (IntMap Word)

type IdentifierText = Text

-- | Whether to preserve casing in ids or converted everything to
--  lowercase. Influenced by '-fclash-lower-case-basic-identifiers'
data PreserveCase
  = PreserveCase
  | ToLower
  deriving (Int -> PreserveCase -> ShowS
[PreserveCase] -> ShowS
PreserveCase -> String
(Int -> PreserveCase -> ShowS)
-> (PreserveCase -> String)
-> ([PreserveCase] -> ShowS)
-> Show PreserveCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreserveCase] -> ShowS
$cshowList :: [PreserveCase] -> ShowS
show :: PreserveCase -> String
$cshow :: PreserveCase -> String
showsPrec :: Int -> PreserveCase -> ShowS
$cshowsPrec :: Int -> PreserveCase -> ShowS
Show, (forall x. PreserveCase -> Rep PreserveCase x)
-> (forall x. Rep PreserveCase x -> PreserveCase)
-> Generic PreserveCase
forall x. Rep PreserveCase x -> PreserveCase
forall x. PreserveCase -> Rep PreserveCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreserveCase x -> PreserveCase
$cfrom :: forall x. PreserveCase -> Rep PreserveCase x
Generic, PreserveCase -> ()
(PreserveCase -> ()) -> NFData PreserveCase
forall a. (a -> ()) -> NFData a
rnf :: PreserveCase -> ()
$crnf :: PreserveCase -> ()
NFData, PreserveCase -> PreserveCase -> Bool
(PreserveCase -> PreserveCase -> Bool)
-> (PreserveCase -> PreserveCase -> Bool) -> Eq PreserveCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreserveCase -> PreserveCase -> Bool
$c/= :: PreserveCase -> PreserveCase -> Bool
== :: PreserveCase -> PreserveCase -> Bool
$c== :: PreserveCase -> PreserveCase -> Bool
Eq, Get PreserveCase
[PreserveCase] -> Put
PreserveCase -> Put
(PreserveCase -> Put)
-> Get PreserveCase
-> ([PreserveCase] -> Put)
-> Binary PreserveCase
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [PreserveCase] -> Put
$cputList :: [PreserveCase] -> Put
get :: Get PreserveCase
$cget :: Get PreserveCase
put :: PreserveCase -> Put
$cput :: PreserveCase -> Put
Binary, Int -> PreserveCase -> Int
PreserveCase -> Int
(Int -> PreserveCase -> Int)
-> (PreserveCase -> Int) -> Hashable PreserveCase
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PreserveCase -> Int
$chash :: PreserveCase -> Int
hashWithSalt :: Int -> PreserveCase -> Int
$chashWithSalt :: Int -> PreserveCase -> Int
Hashable)

-- See: http://vhdl.renerta.com/mobile/source/vhd00037.htm
--      http://www.verilog.renerta.com/source/vrg00018.htm
data IdentifierType
  = Basic
  -- ^ A basic identifier: does not have to be escaped in order to be a valid
  -- identifier in HDL.
  | Extended
  -- ^ An extended identifier: has to be escaped, wrapped, or otherwise
  -- postprocessed before writhing it to HDL.
  deriving (Int -> IdentifierType -> ShowS
[IdentifierType] -> ShowS
IdentifierType -> String
(Int -> IdentifierType -> ShowS)
-> (IdentifierType -> String)
-> ([IdentifierType] -> ShowS)
-> Show IdentifierType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifierType] -> ShowS
$cshowList :: [IdentifierType] -> ShowS
show :: IdentifierType -> String
$cshow :: IdentifierType -> String
showsPrec :: Int -> IdentifierType -> ShowS
$cshowsPrec :: Int -> IdentifierType -> ShowS
Show, (forall x. IdentifierType -> Rep IdentifierType x)
-> (forall x. Rep IdentifierType x -> IdentifierType)
-> Generic IdentifierType
forall x. Rep IdentifierType x -> IdentifierType
forall x. IdentifierType -> Rep IdentifierType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentifierType x -> IdentifierType
$cfrom :: forall x. IdentifierType -> Rep IdentifierType x
Generic, IdentifierType -> ()
(IdentifierType -> ()) -> NFData IdentifierType
forall a. (a -> ()) -> NFData a
rnf :: IdentifierType -> ()
$crnf :: IdentifierType -> ()
NFData, IdentifierType -> IdentifierType -> Bool
(IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> Bool) -> Eq IdentifierType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentifierType -> IdentifierType -> Bool
$c/= :: IdentifierType -> IdentifierType -> Bool
== :: IdentifierType -> IdentifierType -> Bool
$c== :: IdentifierType -> IdentifierType -> Bool
Eq)

-- | A collection of unique identifiers. Allows for fast fresh identifier
-- generation.
--
-- __NB__: use the functions in Clash.Netlist.Id. Don't use the constructor directly.
data IdentifierSet
  = IdentifierSet {
      IdentifierSet -> Bool
is_allowEscaped :: !Bool
      -- ^ Allow escaped ids? If set to False, "make" will always behave like
      -- "makeBasic".
    , IdentifierSet -> PreserveCase
is_lowerCaseBasicIds :: !PreserveCase
      -- ^ Force all generated basic identifiers to lowercase.
    , IdentifierSet -> HDL
is_hdl :: !HDL
      -- ^ HDL to generate fresh identifiers for
    , IdentifierSet -> FreshCache
is_freshCache :: !FreshCache
      -- ^ Maps an 'i_baseNameCaseFold' to a map mapping the number of
      -- extensions (in 'i_extensionsRev') to the maximum word at that
      -- basename/level. For example, if a set would contain the identifiers:
      --
      --   [foo, foo_1, foo_2, bar_5, bar_7_8]
      --
      -- the map would look like:
      --
      --   [(foo, [(0, 0), (1, 2)]), (bar, [(1, 5), (2, 8)])]
      --
      -- This mapping makes sure we can quickly generate fresh identifiers. For
      -- example, generating a new id for "foo_1" would be a matter of looking
      -- up the base name in this map, concluding that the maximum identifier
      -- with this basename and this number of extensions is "foo_2",
      -- subsequently generating "foo_3".
      --
      -- Note that an identifier with no extensions is also stored in this map
      -- for practical purposes, but the maximum ext is invalid.
    , IdentifierSet -> HashSet Identifier
is_store :: !(HashSet Identifier)
      -- ^ Identifier store
    } deriving ((forall x. IdentifierSet -> Rep IdentifierSet x)
-> (forall x. Rep IdentifierSet x -> IdentifierSet)
-> Generic IdentifierSet
forall x. Rep IdentifierSet x -> IdentifierSet
forall x. IdentifierSet -> Rep IdentifierSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentifierSet x -> IdentifierSet
$cfrom :: forall x. IdentifierSet -> Rep IdentifierSet x
Generic, IdentifierSet -> ()
(IdentifierSet -> ()) -> NFData IdentifierSet
forall a. (a -> ()) -> NFData a
rnf :: IdentifierSet -> ()
$crnf :: IdentifierSet -> ()
NFData, Int -> IdentifierSet -> ShowS
[IdentifierSet] -> ShowS
IdentifierSet -> String
(Int -> IdentifierSet -> ShowS)
-> (IdentifierSet -> String)
-> ([IdentifierSet] -> ShowS)
-> Show IdentifierSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentifierSet] -> ShowS
$cshowList :: [IdentifierSet] -> ShowS
show :: IdentifierSet -> String
$cshow :: IdentifierSet -> String
showsPrec :: Int -> IdentifierSet -> ShowS
$cshowsPrec :: Int -> IdentifierSet -> ShowS
Show)

-- | HDL identifier. Consists of a base name and a number of extensions. An
-- identifier with a base name of "foo" and a list of extensions [1, 2] will be
-- rendered as "foo_1_2".
--
-- Note: The Eq instance of "Identifier" is case insensitive! E.g., two
-- identifiers with base names 'fooBar' and 'FoObAR' are considered the same.
-- However, identifiers are stored case preserving. This means Clash won't
-- generate two identifiers with differing case, but it will try to keep
-- capitalization.
--
-- The goal of this data structure is to greatly simplify how Clash deals with
-- identifiers internally. Any Identifier should be trivially printable to any
-- HDL.
--
-- __NB__: use the functions in Clash.Netlist.Id. Don't use these constructors
-- directly.
data Identifier
  -- | Unparsed identifier. Used for things such as port names, which should
  -- appear in the HDL exactly as the user specified.
  = RawIdentifier
      !Text
      -- FIELD An identifier exactly as given by the user
      (Maybe Identifier)
      -- FIELD Parsed version of raw identifier. Will not be populated if this
      -- identifier was created with an unsafe function.
      !CallStack
      -- ^ Stores where this identifier was generated. Tracking is only enabled
      -- is 'debugIsOn', otherwise this field will be populated by an empty
      -- callstack.

  -- | Parsed and sanitized identifier. See various fields for more information
  -- on its invariants.
  | UniqueIdentifier {
      Identifier -> Text
i_baseName :: !Text
    -- ^ Base name of identifier. 'make' makes sure this field:
    --
    --    * does not end in '_num' where 'num' is a digit.
    --    * is solely made up of printable ASCII characters
    --    * has no leading or trailing whitespace
    --
    , Identifier -> Text
i_baseNameCaseFold :: !Text
    -- ^ Same as 'i_baseName', but can be used for equality testing that doesn't
    -- depend on capitalization.
    , Identifier -> [Word]
i_extensionsRev :: [Word]
    -- ^ Extensions applied to base identifier. E.g., an identifier with a base
    -- name of 'foo' and an extension of [6, 5] would render as 'foo_5_6'. Note
    -- that extensions are stored in reverse order for easier manipulation.
    , Identifier -> IdentifierType
i_idType :: !IdentifierType
    -- ^ See "IdentifierType".
    , Identifier -> HDL
i_hdl :: !HDL
    -- ^ HDL this identifier is generated for.
    , Identifier -> CallStack
i_provenance :: !CallStack
    -- ^ Stores where this identifier was generated. Tracking is only enabled
    -- is 'debugIsOn', otherwise this field will be populated by an empty
    -- callstack.
    } deriving (Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show, (forall x. Identifier -> Rep Identifier x)
-> (forall x. Rep Identifier x -> Identifier) -> Generic Identifier
forall x. Rep Identifier x -> Identifier
forall x. Identifier -> Rep Identifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identifier x -> Identifier
$cfrom :: forall x. Identifier -> Rep Identifier x
Generic, Identifier -> ()
(Identifier -> ()) -> NFData Identifier
forall a. (a -> ()) -> NFData a
rnf :: Identifier -> ()
$crnf :: Identifier -> ()
NFData)

identifierKey# :: Identifier -> ((Text, Bool), [Word])
identifierKey# :: Identifier -> ((Text, Bool), [Word])
identifierKey# (RawIdentifier Text
t Maybe Identifier
_id CallStack
_) = ((Text
t, Bool
True), [])
identifierKey# Identifier
id_ = ((Identifier -> Text
i_baseNameCaseFold Identifier
id_, Bool
False), Identifier -> [Word]
i_extensionsRev Identifier
id_)

instance Hashable Identifier where
  hashWithSalt :: Int -> Identifier -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int -> Int) -> (Identifier -> Int) -> Identifier -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Int
forall a. Hashable a => a -> Int
hash
  hash :: Identifier -> Int
hash = ((Text, Bool) -> [Word] -> Int) -> ((Text, Bool), [Word]) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text, Bool) -> [Word] -> Int
forall a b (t :: Type -> Type).
(Hashable a, Hashable b, Foldable t, Num b) =>
a -> t b -> Int
hash# (((Text, Bool), [Word]) -> Int)
-> (Identifier -> ((Text, Bool), [Word])) -> Identifier -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> ((Text, Bool), [Word])
identifierKey#
   where
    hash# :: a -> t b -> Int
hash# a
a t b
extensions =
      -- 'hash' has an identity around zero, e.g. `hash (0, 2) == 2`. Because a
      -- lot of zeros can be expected, extensions are fuzzed in order to keep
      -- efficient `HashMap`s.
      let fuzz :: a -> a -> a
fuzz a
fuzzFactor a
ext = a
fuzzFactor a -> a -> a
forall a. Num a => a -> a -> a
* a
fuzzFactor a -> a -> a
forall a. Num a => a -> a -> a
* a
ext in
      (a, b) -> Int
forall a. Hashable a => a -> Int
hash (a
a, (b -> b -> b) -> b -> t b -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' b -> b -> b
forall a. Num a => a -> a -> a
fuzz b
2 t b
extensions)

instance Eq Identifier where
  Identifier
i1 == :: Identifier -> Identifier -> Bool
== Identifier
i2 = Identifier -> ((Text, Bool), [Word])
identifierKey# Identifier
i1 ((Text, Bool), [Word]) -> ((Text, Bool), [Word]) -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier -> ((Text, Bool), [Word])
identifierKey# Identifier
i2
  Identifier
i1 /= :: Identifier -> Identifier -> Bool
/= Identifier
i2 = Identifier -> ((Text, Bool), [Word])
identifierKey# Identifier
i1 ((Text, Bool), [Word]) -> ((Text, Bool), [Word]) -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier -> ((Text, Bool), [Word])
identifierKey# Identifier
i2

instance Ord Identifier where
  compare :: Identifier -> Identifier -> Ordering
compare = ((Text, Bool), [Word]) -> ((Text, Bool), [Word]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (((Text, Bool), [Word]) -> ((Text, Bool), [Word]) -> Ordering)
-> (Identifier -> ((Text, Bool), [Word]))
-> Identifier
-> Identifier
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Identifier -> ((Text, Bool), [Word])
identifierKey#

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

-- | State of the NetlistMonad
data NetlistState
  = NetlistState
  { NetlistState -> BindingMap
_bindings       :: BindingMap
  -- ^ Global binders
  , NetlistState -> VarEnv ([Bool], SrcSpan, IdentifierSet, Component)
_components     :: VarEnv ([Bool],SrcSpan,IdentifierSet,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 -> IdentifierSet
_seenIds        :: IdentifierSet
  -- ^ All names currently in scope.
  , NetlistState -> IdentifierSet
_seenComps      :: IdentifierSet
  -- ^ Components (to be) generated during this netlist run. This is always a
  -- subset of 'seenIds'. Reason d'etre: we currently generate components in a
  -- top down manner. E.g. given:
  --
  --   - A
  --   -- B
  --   -- C
  --
  -- we would generate component 'A' first. Before trying to generate 'B' and
  -- 'C'. 'A' might introduce a number of signal declarations. The names of these
  -- signals can't clash with the name of component 'B', hence we need to pick a
  -- name for B unique w.r.t. all these signal names. If we would postpone
  -- generating a unqiue name for 'B' til _after_ generating all the signal
  -- names, the signal names would get all the "nice" names. E.g., a signal
  -- would be called "foo", thereby forcing the component 'B' to be called
  -- "foo_1". Ideally, we'd use the "nice" names for components, and the "ugly"
  -- names for signals. To achieve this, we generate all the component names
  -- up front and subsequently store them in '_seenComps'.
  , NetlistState -> Set Text
_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
  -- ^ Names of components (to be) generated during this netlist run. Includes
  -- top entity names.
  , NetlistState -> VarEnv TopEntityT
_topEntityAnns  :: VarEnv TopEntityT
  , NetlistState -> String
_hdlDir         :: FilePath
  , NetlistState -> Int
_curBBlvl       :: Int
  -- ^ The current scoping level assigned to black box contexts
  , 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 -> SomeBackend
_backend :: SomeBackend
  -- ^ The current HDL backend
  , NetlistState -> HWMap
_htyCache :: HWMap
  }

data ComponentPrefix
  = ComponentPrefix
  { ComponentPrefix -> Maybe Text
componentPrefixTop :: Maybe Text
    -- ^ Prefix for top-level components
  , ComponentPrefix -> Maybe Text
componentPrefixOther :: Maybe Text
    -- ^ Prefix for all other components
  } deriving Int -> ComponentPrefix -> ShowS
[ComponentPrefix] -> ShowS
ComponentPrefix -> String
(Int -> ComponentPrefix -> ShowS)
-> (ComponentPrefix -> String)
-> ([ComponentPrefix] -> ShowS)
-> Show ComponentPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentPrefix] -> ShowS
$cshowList :: [ComponentPrefix] -> ShowS
show :: ComponentPrefix -> String
$cshow :: ComponentPrefix -> String
showsPrec :: Int -> ComponentPrefix -> ShowS
$cshowsPrec :: Int -> ComponentPrefix -> ShowS
Show

-- | Existentially quantified backend
data SomeBackend where
  SomeBackend :: Backend backend => backend -> SomeBackend

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), Maybe Expr)]
outputs       :: [(WireOrReg,(Identifier,HWType),Maybe Expr)] -- ^ 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 Component
c = case Component
c of
    Component Identifier
nm [(Identifier, HWType)]
inps [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outps [Declaration]
decls -> Identifier -> ()
forall a. NFData a => a -> ()
rnf Identifier
nm    () -> () -> ()
`seq` [(Identifier, HWType)] -> ()
forall a. NFData a => a -> ()
rnf [(Identifier, HWType)]
inps () -> () -> ()
`seq`
                                     [(WireOrReg, (Identifier, HWType), Maybe Expr)] -> ()
forall a. NFData a => a -> ()
rnf [(WireOrReg, (Identifier, HWType), Maybe Expr)]
outps () -> () -> ()
`seq` [Declaration] -> ()
forall a. NFData a => a -> ()
rnf [Declaration]
decls

-- | Find the name and domain name of each clock argument of a component.
--
findClocks :: Component -> [(Text, Text)]
findClocks :: Component -> [(Text, Text)]
findClocks (Component Identifier
_ [(Identifier, HWType)]
is [(WireOrReg, (Identifier, HWType), Maybe Expr)]
_ [Declaration]
_) =
  ((Identifier, HWType) -> Maybe (Text, Text))
-> [(Identifier, HWType)] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Identifier, HWType) -> Maybe (Text, Text)
isClock [(Identifier, HWType)]
is
 where
  isClock :: (Identifier, HWType) -> Maybe (Text, Text)
isClock (Identifier
i, Clock Text
d) = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Identifier -> Text
Id.toText Identifier
i, Text
d)
  isClock (Identifier
i, Annotated [Attr']
_ HWType
t) = (Identifier, HWType) -> Maybe (Text, Text)
isClock (Identifier
i,HWType
t)
  isClock (Identifier, HWType)
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing

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

type DomainName = Text

-- | 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 !Text [Text]
  -- ^ Sum type: Name and Constructor names
  | Product !Text (Maybe [Text]) [HWType]
  -- ^ Product type: Name, field names, and field types. Field names will be
  -- populated when using records.
  | SP !Text [(Text, [HWType])]
  -- ^ Sum-of-Product type: Name and Constructor names + field types
  | Clock !DomainName
  -- ^ Clock type corresponding to domain /DomainName/
  | Reset !DomainName
  -- ^ Reset type corresponding to domain /DomainName/
  | Enable !DomainName
  -- ^ Enable type corresponding to domain /DomainName/
  | BiDirectional !PortDirection !HWType
  -- ^ Tagging type indicating a bidirectional (inout) port
  | CustomSP !Text !DataRepr' !Size [(ConstrRepr', Text, [HWType])]
  -- ^ Same as Sum-Of-Product, but with a user specified bit representation. For
  -- more info, see: Clash.Annotations.BitRepresentations.
  | CustomSum !Text !DataRepr' !Size [(ConstrRepr', Text)]
  -- ^ Same as Sum, but with a user specified bit representation. For more info,
  -- see: Clash.Annotations.BitRepresentations.
  | CustomProduct !Text !DataRepr' !Size (Maybe [Text]) [(FieldAnn, HWType)]
  -- ^ Same as Product, but with a user specified bit representation. For more
  -- info, see: Clash.Annotations.BitRepresentations.
  | Annotated [Attr'] !HWType
  -- ^ Annotated with HDL attributes
  | KnownDomain !DomainName !Integer !ActiveEdge !ResetKind !InitBehavior !ResetPolarity
  -- ^ Domain name, period, active edge, reset kind, initial value behavior
  | FileType
  -- ^ File type for simulation-level I/O
  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)

hwTypeDomain :: HWType -> Maybe DomainName
hwTypeDomain :: HWType -> Maybe Text
hwTypeDomain = \case
  Clock Text
dom -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dom
  Reset Text
dom -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dom
  Enable Text
dom -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dom
  KnownDomain Text
dom Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dom
  HWType
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | 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 [Attr']
attrs HWType
_type) = [Attr']
attrs
hwTypeAttrs HWType
_                       = []

-- | Specifies how to wire up a component instance
data PortMap
  = IndexedPortMap [(PortDirection, HWType, Expr)]
  -- ^ Port map based on port positions (port direction, type, assignment)
  --
  -- HDL Example:
  --
  --     bytemaster bytemaster_ds
  --       ( clk_1
  --       , rst_1
  --       , bitCtrl_0 );
  --
  | NamedPortMap [(Expr, PortDirection, HWType, Expr)]
  -- ^ Port map based on port names (port name, port direction, type, assignment)
  --
  -- HDL Example:
  --
  --     bytemaster bytemaster_ds
  --       ( .clk (clk_1)
  --       , .rst (rst_1)
  --       , .bitCtrl (bitCtrl_0) );
  --
  deriving (Int -> PortMap -> ShowS
[PortMap] -> ShowS
PortMap -> String
(Int -> PortMap -> ShowS)
-> (PortMap -> String) -> ([PortMap] -> ShowS) -> Show PortMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortMap] -> ShowS
$cshowList :: [PortMap] -> ShowS
show :: PortMap -> String
$cshow :: PortMap -> String
showsPrec :: Int -> PortMap -> ShowS
$cshowsPrec :: Int -> PortMap -> ShowS
Show)

-- | 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 Text)                       -- FIELD Library instance is defined in
      [Attr']                            -- FIELD Attributes 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)
      PortMap

  -- | 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 IdentifierText HWType) -- FIELD Pointer to type of signal or type of signal
      (Maybe Expr)                   -- FIELD Initial value
      -- ^ Signal declaration
  | TickDecl Comment
  -- ^ HDL tick corresponding to a Core tick
  -- | Sequential statement
  | Seq [Seq]
  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

-- | Sequential statements
data Seq
  -- | Clocked sequential statements
  = AlwaysClocked
      ActiveEdge -- FIELD Edge of the clock the statement should be executed
      Expr       -- FIELD Clock expression
      [Seq]      -- FIELD Statements to be executed on the active clock edge
  -- | Statements running at simulator start
  | Initial
      [Seq] -- FIELD Statements to run at simulator start
  -- | Statements to run always
  | AlwaysComb
      [Seq] -- FIELD Statements to run always
  -- | Declaration in sequential form
  | SeqDecl
      Declaration -- FIELD The declaration
  -- | Branching statement
  | Branch
      !Expr                    -- FIELD Scrutinized expresson
      !HWType                  -- FIELD Type of the scrutinized expression
      [(Maybe Literal,[Seq])]  -- FIELD List of: (Maybe match, RHS of Alternative)
  deriving Int -> Seq -> ShowS
[Seq] -> ShowS
Seq -> String
(Int -> Seq -> ShowS)
-> (Seq -> String) -> ([Seq] -> ShowS) -> Show Seq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seq] -> ShowS
$cshowList :: [Seq] -> ShowS
show :: Seq -> String
$cshow :: Seq -> String
showsPrec :: Int -> Seq -> ShowS
$cshowsPrec :: Int -> Seq -> 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 Text -> Identifier -> HWType -> Declaration
$mNetDecl :: forall r.
Declaration
-> (Maybe Text -> Identifier -> HWType -> r) -> (Void# -> r) -> r
NetDecl note d ty <- NetDecl' note Wire d (Right ty) _
  where
    NetDecl Maybe Text
note Identifier
d HWType
ty = Maybe Text
-> WireOrReg
-> Identifier
-> Either Text HWType
-> Maybe Expr
-> Declaration
NetDecl' Maybe Text
note WireOrReg
Wire Identifier
d (HWType -> Either Text HWType
forall a b. b -> Either a b
Right HWType
ty) Maybe Expr
forall a. Maybe a
Nothing

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 Declaration
a = Declaration
a Declaration -> () -> ()
`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 parentheses?

  -- | Convert some type to a BitVector.
  | ToBv
      (Maybe Identifier) -- FIELD Type prefix
      HWType             -- FIELD Type to convert _from_
      Expr               -- FIELD Expression to convert to BitVector

  -- | Convert BitVector to some type.
  | FromBv
      (Maybe Identifier) -- FIELD Type prefix
      HWType             -- FIELD Type to convert _to_
      Expr               -- FIELD BitVector to convert

  | IfThenElse Expr Expr Expr
  -- | Do nothing
  | Noop
  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

instance NFData Expr where
  rnf :: Expr -> ()
rnf Expr
x = Expr
x Expr -> () -> ()
`seq` ()

-- | 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 (TExp Bit)
(Bit -> Q Exp) -> (Bit -> Q (TExp Bit)) -> Lift Bit
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Bit -> Q (TExp Bit)
$cliftTyped :: Bit -> Q (TExp Bit)
lift :: Bit -> Q Exp
$clift :: Bit -> Q Exp
Lift)


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

-- | Context used to fill in the holes of a BlackBox template
data BlackBoxContext
  = Context
  { BlackBoxContext -> Text
bbName :: Text
  -- ^ Blackbox function name (for error reporting)
  , BlackBoxContext -> [(Expr, HWType)]
bbResults :: [(Expr,HWType)]
  -- ^ Result names and types. Will typically be a list with a single item.
  -- Multiple result targets will be used for "multi result primitives". See
  -- 'Clash.Normalize.Transformations.setupMultiResultPrim'.
  , 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], [((Text, Text), 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 -> [Text]
bbQsysIncName :: [IdentifierText]
  , 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
  , BlackBoxContext -> Maybe Text
bbCtxName :: Maybe IdentifierText
  -- ^ The "context name", name set by `Clash.Magic.setName`, defaults to the
  -- name of the closest binder
  }
  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]
    -- FIELD Used arguments
    -> (BlackBoxContext -> Bool)
    -- FIELD Validation function. Should return 'False' if function can't render
    -- given a certain context.
    -> (forall s . Backend s => BlackBoxContext -> Lazy.State s Doc)
    -- FIELD Render function
    -> TemplateFunction

instance Show BlackBox where
  show :: BlackBox -> String
show (BBTemplate BlackBoxTemplate
t)  = String
"BBTemplate " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BlackBoxTemplate -> String
forall a. Show a => a -> String
show BlackBoxTemplate
t
  show (BBFunction String
nm Int
hsh TemplateFunction
_) =
    String
"<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]
++ String
", 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]
++ String
")>"

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

-- | __NB__: serialisation doesn't preserve the embedded function
instance Binary TemplateFunction where
  put :: TemplateFunction -> Put
put (TemplateFunction [Int]
is BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
_ ) = [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
is
  get :: Get TemplateFunction
get = (\[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 :: Type -> Type) 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 String
"TemplateFunction functions can't be preserved by serialisation"

-- | Netlist-level identifier
data NetlistId
  = NetlistId Identifier Type
  -- ^ Identifier generated in the NetlistMonad, always derived from another
  -- 'NetlistId'
  | CoreId Id
  -- ^ An original Core identifier
  | MultiId [Id]
  -- ^ A split identifier (into several sub-identifiers), needed to assign
  -- expressions of types that have to be split apart (e.g. tuples of Files)
  deriving Int -> NetlistId -> ShowS
[NetlistId] -> ShowS
NetlistId -> String
(Int -> NetlistId -> ShowS)
-> (NetlistId -> String)
-> ([NetlistId] -> ShowS)
-> Show NetlistId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetlistId] -> ShowS
$cshowList :: [NetlistId] -> ShowS
show :: NetlistId -> String
$cshow :: NetlistId -> String
showsPrec :: Int -> NetlistId -> ShowS
$cshowsPrec :: Int -> NetlistId -> ShowS
Show

-- | Eliminator for 'NetlistId'
netlistId
  :: (Identifier -> r)
  -- ^ Eliminator for Identifiers generated in the NetlistMonad
  -> (Id -> r)
  -- ^ Eliminator for original Core Identifiers
  -> NetlistId
  -> [r]
netlistId :: (Identifier -> r) -> (Id -> r) -> NetlistId -> [r]
netlistId Identifier -> r
f Id -> r
g = \case
  NetlistId Identifier
i Type
_ -> [Identifier -> r
f Identifier
i]
  CoreId Id
i -> [Id -> r
g Id
i]
  MultiId [Id]
is -> (Id -> r) -> [Id] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map Id -> r
g [Id]
is

-- | Eliminator for 'NetlistId', fails on 'MultiId'
netlistId1
  :: HasCallStack
  => (Identifier -> r)
  -- ^ Eliminator for Identifiers generated in the NetlistMonad
  -> (Id -> r)
  -- ^ Eliminator for original Core Identifiers
  -> NetlistId
  -> r
netlistId1 :: (Identifier -> r) -> (Id -> r) -> NetlistId -> r
netlistId1 Identifier -> r
f Id -> r
g = \case
  NetlistId Identifier
i Type
_ -> Identifier -> r
f Identifier
i
  CoreId Id
i -> Id -> r
g Id
i
  NetlistId
m -> String -> r
forall a. HasCallStack => String -> a
error (String
"netlistId1 MultiId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NetlistId -> String
forall a. Show a => a -> String
show NetlistId
m)

-- | Return the type(s) of a 'NetListId', returns multiple types when given a
-- 'MultiId'
netlistTypes
  :: NetlistId
  -> [Type]
netlistTypes :: NetlistId -> [Type]
netlistTypes = \case
  NetlistId Identifier
_ Type
t -> [Type
t]
  CoreId Id
i -> [Id -> Type
forall a. Var a -> Type
varType Id
i]
  MultiId [Id]
is -> (Id -> Type) -> [Id] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Type
forall a. Var a -> Type
varType [Id]
is

-- | Return the type of a 'NetlistId', fails on 'MultiId'
netlistTypes1
  :: HasCallStack
  => NetlistId
  -> Type
netlistTypes1 :: NetlistId -> Type
netlistTypes1 = \case
  NetlistId Identifier
_ Type
t -> Type
t
  CoreId Id
i -> Id -> Type
forall a. Var a -> Type
varType Id
i
  NetlistId
m -> String -> Type
forall a. HasCallStack => String -> a
error (String
"netlistTypes1 MultiId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NetlistId -> String
forall a. Show a => a -> String
show NetlistId
m)

-- | Type of declaration, concurrent or sequential
data DeclarationType
  = Concurrent
  | Sequential

emptyBBContext :: Text -> BlackBoxContext
emptyBBContext :: Text -> BlackBoxContext
emptyBBContext Text
name
  = Context :: Text
-> [(Expr, HWType)]
-> [(Expr, HWType, Bool)]
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
-> [Text]
-> Int
-> Identifier
-> Maybe Text
-> BlackBoxContext
Context
  { bbName :: Text
bbName        = Text
name
  , bbResults :: [(Expr, HWType)]
bbResults     = []
  , bbInputs :: [(Expr, HWType, Bool)]
bbInputs      = []
  , bbFunctions :: IntMap
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
    BlackBoxContext)]
bbFunctions   = IntMap
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
    BlackBoxContext)]
forall a. IntMap a
empty
  , bbQsysIncName :: [Text]
bbQsysIncName = []
  , bbLevel :: Int
bbLevel       = (-Int
1)
  , bbCompName :: Identifier
bbCompName    = Text
-> Text
-> [Word]
-> IdentifierType
-> HDL
-> CallStack
-> Identifier
UniqueIdentifier
                      Text
"__NOCOMPNAME__" Text
"__NOCOMPNAME__" []
                      IdentifierType
Basic HDL
VHDL CallStack
emptyCallStack
  , bbCtxName :: Maybe Text
bbCtxName     = Maybe Text
forall a. Maybe a
Nothing
  }

makeLenses ''NetlistEnv
makeLenses ''NetlistState

-- | Structures that hold an 'IdentifierSet'
class HasIdentifierSet s where
  identifierSet :: Lens' s IdentifierSet

instance HasIdentifierSet IdentifierSet where
  identifierSet :: (IdentifierSet -> f IdentifierSet)
-> IdentifierSet -> f IdentifierSet
identifierSet = (IdentifierSet -> f IdentifierSet)
-> IdentifierSet -> f IdentifierSet
forall a b. (a -> b) -> a -> b
($)

-- | An "IdentifierSetMonad" supports unique name generation for Clash Netlist
class Monad m => IdentifierSetMonad m where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> m IdentifierSet

instance IdentifierSetMonad NetlistMonad where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> NetlistMonad IdentifierSet
identifierSetM IdentifierSet -> IdentifierSet
f = do
    IdentifierSet
is0 <- Getting IdentifierSet NetlistState IdentifierSet
-> NetlistMonad IdentifierSet
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting IdentifierSet NetlistState IdentifierSet
Lens' NetlistState IdentifierSet
seenIds
    let is1 :: IdentifierSet
is1 = IdentifierSet -> IdentifierSet
f IdentifierSet
is0
    (IdentifierSet -> Identity IdentifierSet)
-> NetlistState -> Identity NetlistState
Lens' NetlistState IdentifierSet
seenIds ((IdentifierSet -> Identity IdentifierSet)
 -> NetlistState -> Identity NetlistState)
-> IdentifierSet -> NetlistMonad ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= IdentifierSet
is1
    IdentifierSet -> NetlistMonad IdentifierSet
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IdentifierSet
is1
  {-# INLINE identifierSetM #-}

instance HasIdentifierSet s => IdentifierSetMonad (Strict.State s) where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> State s IdentifierSet
identifierSetM IdentifierSet -> IdentifierSet
f = do
    IdentifierSet
is0 <- Getting IdentifierSet s IdentifierSet -> State s IdentifierSet
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting IdentifierSet s IdentifierSet
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet
    (IdentifierSet -> Identity IdentifierSet) -> s -> Identity s
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet ((IdentifierSet -> Identity IdentifierSet) -> s -> Identity s)
-> IdentifierSet -> StateT s Identity ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= IdentifierSet -> IdentifierSet
f IdentifierSet
is0
    Getting IdentifierSet s IdentifierSet -> State s IdentifierSet
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting IdentifierSet s IdentifierSet
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet
  {-# INLINE identifierSetM #-}

instance HasIdentifierSet s => IdentifierSetMonad (Lazy.State s) where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> State s IdentifierSet
identifierSetM IdentifierSet -> IdentifierSet
f = do
    IdentifierSet
is0 <- Getting IdentifierSet s IdentifierSet -> State s IdentifierSet
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting IdentifierSet s IdentifierSet
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet
    (IdentifierSet -> Identity IdentifierSet) -> s -> Identity s
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet ((IdentifierSet -> Identity IdentifierSet) -> s -> Identity s)
-> IdentifierSet -> StateT s Identity ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= IdentifierSet -> IdentifierSet
f IdentifierSet
is0
    Getting IdentifierSet s IdentifierSet -> State s IdentifierSet
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting IdentifierSet s IdentifierSet
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet
  {-# INLINE identifierSetM #-}

instance IdentifierSetMonad m => IdentifierSetMonad (Mon m) where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> Mon m IdentifierSet
identifierSetM = m IdentifierSet -> Mon m IdentifierSet
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (m IdentifierSet -> Mon m IdentifierSet)
-> ((IdentifierSet -> IdentifierSet) -> m IdentifierSet)
-> (IdentifierSet -> IdentifierSet)
-> Mon m IdentifierSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierSet -> IdentifierSet) -> m IdentifierSet
forall (m :: Type -> Type).
IdentifierSetMonad m =>
(IdentifierSet -> IdentifierSet) -> m IdentifierSet
identifierSetM