{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2017     , Myrtle Software Ltd,
                    2017-2018, Google Inc.
                    2020-2023, QBayLogic B.V.
                    2022-2023, Google Inc.
  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 #-}

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.Aeson                           (FromJSON(..))
import qualified Data.Aeson as Aeson
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.Map.Ordered                     (OMap)
import Data.Map                             (Map)
import qualified Data.Map as Map
import Data.Maybe                           (mapMaybe)
import Data.Monoid                          (Ap(..))
import qualified Data.Set                   as Set
import Data.Text                            (Text)

import Data.Typeable                        (Typeable)
import Data.Text.Prettyprint.Doc.Extra      (Doc)
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.SynthesisAttributes(Attr)
import Clash.Annotations.BitRepresentation  (FieldAnn)
import Clash.Annotations.Primitive          (HDL(..))
import Clash.Annotations.TopEntity          (TopEntity)
import Clash.Backend                        (Backend, HasUsageMap (..))
import Clash.Core.HasType
import Clash.Core.Type                      (Type)
import Clash.Core.Var                       (Id)
import Clash.Core.TyCon                     (TyConMap)
import Clash.Core.VarEnv                    (VarEnv)
import Clash.Driver.Types
  (BindingMap, ClashEnv(..), ClashOpts(..))
import Clash.Netlist.BlackBox.Types         (BlackBoxTemplate)
import Clash.Primitives.Types               (CompiledPrimMap)
import Clash.Signal.Internal
  (ResetPolarity, ActiveEdge, ResetKind, InitBehavior)
import Clash.Unique                         (Unique)

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

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

-- | 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, TopEntityT -> TopEntityT -> Bool
(TopEntityT -> TopEntityT -> Bool)
-> (TopEntityT -> TopEntityT -> Bool) -> Eq TopEntityT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopEntityT -> TopEntityT -> Bool
$c/= :: TopEntityT -> TopEntityT -> Bool
== :: TopEntityT -> TopEntityT -> Bool
$c== :: TopEntityT -> TopEntityT -> Bool
Eq)

-- | 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
      -- ^ Name hint. Can be used to create intermediate signal names.
      HWType
      -- ^ Type of product
      [ExpandedPortName a]
      -- ^ 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 = Map 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, Eq PreserveCase
Eq PreserveCase
-> (Int -> PreserveCase -> Int)
-> (PreserveCase -> Int)
-> Hashable PreserveCase
Int -> PreserveCase -> Int
PreserveCase -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PreserveCase -> Int
$chash :: PreserveCase -> Int
hashWithSalt :: Int -> PreserveCase -> Int
$chashWithSalt :: Int -> PreserveCase -> Int
$cp1Hashable :: Eq PreserveCase
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
      -- ^ An identifier exactly as given by the user
      (Maybe Identifier)
      -- ^ 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 -> ClashEnv
_clashEnv :: ClashEnv
  , 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
  }

data ComponentMeta = ComponentMeta
  { ComponentMeta -> [Bool]
cmWereVoids :: [Bool]
  , ComponentMeta -> SrcSpan
cmLoc :: SrcSpan
  , ComponentMeta -> IdentifierSet
cmScope :: IdentifierSet
  , ComponentMeta -> UsageMap
cmUsage :: UsageMap
  } deriving ((forall x. ComponentMeta -> Rep ComponentMeta x)
-> (forall x. Rep ComponentMeta x -> ComponentMeta)
-> Generic ComponentMeta
forall x. Rep ComponentMeta x -> ComponentMeta
forall x. ComponentMeta -> Rep ComponentMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentMeta x -> ComponentMeta
$cfrom :: forall x. ComponentMeta -> Rep ComponentMeta x
Generic, Int -> ComponentMeta -> ShowS
[ComponentMeta] -> ShowS
ComponentMeta -> String
(Int -> ComponentMeta -> ShowS)
-> (ComponentMeta -> String)
-> ([ComponentMeta] -> ShowS)
-> Show ComponentMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentMeta] -> ShowS
$cshowList :: [ComponentMeta] -> ShowS
show :: ComponentMeta -> String
$cshow :: ComponentMeta -> String
showsPrec :: Int -> ComponentMeta -> ShowS
$cshowsPrec :: Int -> ComponentMeta -> ShowS
Show, ComponentMeta -> ()
(ComponentMeta -> ()) -> NFData ComponentMeta
forall a. (a -> ()) -> NFData a
rnf :: ComponentMeta -> ()
$crnf :: ComponentMeta -> ()
NFData)

type ComponentMap = OMap Unique (ComponentMeta, Component)

-- | State of the NetlistMonad
data NetlistState
  = NetlistState
  { NetlistState -> BindingMap
_bindings       :: BindingMap
  -- ^ Global binders
  , NetlistState -> ComponentMap
_components     :: ComponentMap
  -- ^ Cached components. Is an insertion ordered map to preserve a topologically
  -- sorted component list for the manifest file.
  , 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 -> (Identifier, SrcSpan)
_curCompNm      :: !(Identifier,SrcSpan)
  , 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 -> 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
  , NetlistState -> UsageMap
_usages :: UsageMap
  -- ^ The current way signals are assigned in netlist. This is used to
  -- determine how signals are rendered in HDL (i.e. wire/reg in Verilog, or
  -- signal/variable in VHDL).
  }

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

onSomeBackend :: (forall b. Backend b => b -> a) -> SomeBackend -> a
onSomeBackend :: (forall b. Backend b => b -> a) -> SomeBackend -> a
onSomeBackend forall b. Backend b => b -> a
f (SomeBackend backend
b) = backend -> a
forall b. Backend b => b -> a
f backend
b

fromSomeBackend :: (forall b. Backend b => b -> a) -> Lens.Getter SomeBackend a
fromSomeBackend :: (forall b. Backend b => b -> a) -> Getter SomeBackend a
fromSomeBackend forall b. Backend b => b -> a
f = (SomeBackend -> a) -> Optic' (->) f SomeBackend a
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to ((forall b. Backend b => b -> a) -> SomeBackend -> a
forall a. (forall b. Backend b => b -> a) -> SomeBackend -> a
onSomeBackend forall b. Backend b => b -> a
f)

type Comment = Text
type Directive = Text

data CommentOrDirective
  = Comment Comment
  | Directive Directive
  deriving Int -> CommentOrDirective -> ShowS
[CommentOrDirective] -> ShowS
CommentOrDirective -> String
(Int -> CommentOrDirective -> ShowS)
-> (CommentOrDirective -> String)
-> ([CommentOrDirective] -> ShowS)
-> Show CommentOrDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentOrDirective] -> ShowS
$cshowList :: [CommentOrDirective] -> ShowS
show :: CommentOrDirective -> String
$cshow :: CommentOrDirective -> String
showsPrec :: Int -> CommentOrDirective -> ShowS
$cshowsPrec :: Int -> CommentOrDirective -> ShowS
Show

-- | 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 -> [(Usage, (Identifier, HWType), Maybe Expr)]
outputs       :: [(Usage,(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, (forall x. Component -> Rep Component x)
-> (forall x. Rep Component x -> Component) -> Generic Component
forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Component x -> Component
$cfrom :: forall x. Component -> Rep Component x
Generic, Component -> ()
(Component -> ()) -> NFData Component
forall a. (a -> ()) -> NFData a
rnf :: Component -> ()
$crnf :: Component -> ()
NFData)

-- | Check if an input port is really an inout port.
--
isBiDirectional :: (Identifier, HWType) -> Bool
isBiDirectional :: (Identifier, HWType) -> Bool
isBiDirectional = HWType -> Bool
go (HWType -> Bool)
-> ((Identifier, HWType) -> HWType) -> (Identifier, HWType) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, HWType) -> HWType
forall a b. (a, b) -> b
snd
  where
    go :: HWType -> Bool
go BiDirectional{} = Bool
True
    go (Annotated [Attr Text]
_ HWType
hwty) = HWType -> Bool
go HWType
hwty
    go HWType
_ = Bool
False

-- | Find the name and domain name of each clock argument of a component.
--
-- This will not consider @ClockN@ to be a clock argument, which means only the
-- positive phase of a differential pair will be added to @sdcClock@.
findClocks :: Component -> [(Text, Text)]
findClocks :: Component -> [(Text, Text)]
findClocks (Component Identifier
_ [(Identifier, HWType)]
is [(Usage, (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 Text]
_ 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
  | MemBlob !Size !Size
  -- ^ MemBlob 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/
  | ClockN !DomainName
  -- ^ ClockN 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 Text] !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, Eq HWType
Eq HWType
-> (Int -> HWType -> Int) -> (HWType -> Int) -> Hashable HWType
Int -> HWType -> Int
HWType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HWType -> Int
$chash :: HWType -> Int
hashWithSalt :: Int -> HWType -> Int
$chashWithSalt :: Int -> HWType -> Int
$cp1Hashable :: Eq HWType
Hashable)

-- | Smart constructor for 'Annotated'. Wraps the given type in an 'Annotated'
-- if the attribute list is non-empty. If it is empty, it will return the given
-- 'HWType' unchanged.
annotated :: [Attr Text] -> HWType -> HWType
annotated :: [Attr Text] -> HWType -> HWType
annotated [] HWType
t = HWType
t
annotated [Attr Text]
attrs HWType
t = [Attr Text] -> HWType -> HWType
Annotated [Attr Text]
attrs HWType
t

hwTypeDomain :: HWType -> Maybe DomainName
hwTypeDomain :: HWType -> Maybe Text
hwTypeDomain = \case
  Clock Text
dom -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dom
  ClockN 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 Text]
hwTypeAttrs :: HWType -> [Attr Text]
hwTypeAttrs (Annotated [Attr Text]
attrs HWType
_type) = [Attr Text]
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 -- ^ Signal to assign
      !Usage      -- ^ How the signal is assigned
      !Expr       -- ^ Assigned expression

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

  -- | Instantiation of another component:
  | InstDecl
      EntityOrComponent                  -- ^ Whether it's an entity or a component
      (Maybe Text)                       -- ^ Library instance is defined in
      [Attr Text]                        -- ^ Attributes to add to the generated code
      !Identifier                        -- ^ The component's (or entity's) name
      !Identifier                        -- ^ Instance label
      [(Expr,HWType,Expr)]               -- ^ List of parameters for this component (param name, param type, param value)
      PortMap

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

  -- | @component@ declaration (VHDL).
  --
  -- See [this tutorial](https://www.ics.uci.edu/~jmoorkan/vhdlref/compdec.html);
  -- refer to §4.5 of IEEE 1076-1993
  | CompDecl
      !Text
      [(Text, PortDirection, HWType)]

  -- | Signal declaration
  | NetDecl'
      (Maybe Comment)                -- ^ Note; will be inserted as a comment in target hdl
      !Identifier                    -- ^ Name of signal
      HWType                         -- ^ Type of signal
      (Maybe Expr)                   -- ^ Initial value
      -- ^ Signal declaration

  -- | HDL tick corresponding to a Core tick
  | TickDecl CommentOrDirective

  -- | Sequential statement
  | Seq [Seq]

  -- | Compilation conditional on some preprocessor symbol, note that
  -- declarations here are ignored for VHDL. See here for a discussion
  -- https://github.com/clash-lang/clash-compiler/pull/1798#discussion_r648571862
  | ConditionalDecl
      !Text -- ^ condition text, for example @FORMAL@
      [Declaration]
  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 -- ^ Edge of the clock the statement should be executed
      Expr       -- ^ Clock expression
      [Seq]      -- ^ Statements to be executed on the active clock edge
  -- | Statements running at simulator start
  | Initial
      [Seq] -- ^ Statements to run at simulator start
  -- | Statements to run always
  | AlwaysComb
      [Seq] -- ^ Statements to run always
  -- | Declaration in sequential form
  | SeqDecl
      Declaration -- ^ The declaration
  -- | Branching statement
  | Branch
      !Expr                    -- ^ Scrutinized expresson
      !HWType                  -- ^ Type of the scrutinized expression
      [(Maybe Literal,[Seq])]  -- ^ 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

-- | Procedural assignment in HDL can be blocking or non-blocking. This
-- determines when the assignment takes place in simulation. The name refers to
-- whether evaluation of the remaining statements in a process is blocked
-- until the assignment is performed or not.
--
-- See Also:
--
-- IEEE 1364-2001, sections 9.2.1 and 9.2.2
-- IEEE 1076-1993, sections 8.4 and 8.5
--
data Blocking
  = NonBlocking
  -- ^ A non-blocking assignment means the new value is not observed until the
  -- next time step in simulation. Using the signal later in the process will
  -- continue to return the old value.
  | Blocking
  -- ^ A blocking assignment means the new value is observed immediately. Using
  -- the signal later in the process will return the new value.
  deriving (Get Blocking
[Blocking] -> Put
Blocking -> Put
(Blocking -> Put)
-> Get Blocking -> ([Blocking] -> Put) -> Binary Blocking
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Blocking] -> Put
$cputList :: [Blocking] -> Put
get :: Get Blocking
$cget :: Get Blocking
put :: Blocking -> Put
$cput :: Blocking -> Put
Binary, Blocking -> Blocking -> Bool
(Blocking -> Blocking -> Bool)
-> (Blocking -> Blocking -> Bool) -> Eq Blocking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blocking -> Blocking -> Bool
$c/= :: Blocking -> Blocking -> Bool
== :: Blocking -> Blocking -> Bool
$c== :: Blocking -> Blocking -> Bool
Eq, (forall x. Blocking -> Rep Blocking x)
-> (forall x. Rep Blocking x -> Blocking) -> Generic Blocking
forall x. Rep Blocking x -> Blocking
forall x. Blocking -> Rep Blocking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Blocking x -> Blocking
$cfrom :: forall x. Blocking -> Rep Blocking x
Generic, Eq Blocking
Eq Blocking
-> (Int -> Blocking -> Int)
-> (Blocking -> Int)
-> Hashable Blocking
Int -> Blocking -> Int
Blocking -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Blocking -> Int
$chash :: Blocking -> Int
hashWithSalt :: Int -> Blocking -> Int
$chashWithSalt :: Int -> Blocking -> Int
$cp1Hashable :: Eq Blocking
Hashable, Blocking -> ()
(Blocking -> ()) -> NFData Blocking
forall a. (a -> ()) -> NFData a
rnf :: Blocking -> ()
$crnf :: Blocking -> ()
NFData, Int -> Blocking -> ShowS
[Blocking] -> ShowS
Blocking -> String
(Int -> Blocking -> ShowS)
-> (Blocking -> String) -> ([Blocking] -> ShowS) -> Show Blocking
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Blocking] -> ShowS
$cshowList :: [Blocking] -> ShowS
show :: Blocking -> String
$cshow :: Blocking -> String
showsPrec :: Int -> Blocking -> ShowS
$cshowsPrec :: Int -> Blocking -> ShowS
Show)

-- NOTE [`Semigroup` instances for `Blocking` and `Usage`]
instance Semigroup Blocking where
  Blocking
NonBlocking <> :: Blocking -> Blocking -> Blocking
<> Blocking
y = Blocking
y
  Blocking
Blocking    <> Blocking
_ = Blocking
Blocking

-- | The usage of a signal refers to how the signal is written to in netlist.
-- This is used to determine if the signal should be a @wire@ or @reg@ in
-- (System)Verilog, or a @signal@ or @variable@ in VHDL.
--
data Usage
  = Cont
  -- ^ Continuous assignment, which occurs in a concurrent context.
  | Proc Blocking
  -- ^ Procedural assignment, which occurs in a sequential context.
  deriving (Get Usage
[Usage] -> Put
Usage -> Put
(Usage -> Put) -> Get Usage -> ([Usage] -> Put) -> Binary Usage
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Usage] -> Put
$cputList :: [Usage] -> Put
get :: Get Usage
$cget :: Get Usage
put :: Usage -> Put
$cput :: Usage -> Put
Binary, Usage -> Usage -> Bool
(Usage -> Usage -> Bool) -> (Usage -> Usage -> Bool) -> Eq Usage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c== :: Usage -> Usage -> Bool
Eq, (forall x. Usage -> Rep Usage x)
-> (forall x. Rep Usage x -> Usage) -> Generic Usage
forall x. Rep Usage x -> Usage
forall x. Usage -> Rep Usage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Usage x -> Usage
$cfrom :: forall x. Usage -> Rep Usage x
Generic, Eq Usage
Eq Usage
-> (Int -> Usage -> Int) -> (Usage -> Int) -> Hashable Usage
Int -> Usage -> Int
Usage -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Usage -> Int
$chash :: Usage -> Int
hashWithSalt :: Int -> Usage -> Int
$chashWithSalt :: Int -> Usage -> Int
$cp1Hashable :: Eq Usage
Hashable, Usage -> ()
(Usage -> ()) -> NFData Usage
forall a. (a -> ()) -> NFData a
rnf :: Usage -> ()
$crnf :: Usage -> ()
NFData, Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
(Int -> Usage -> ShowS)
-> (Usage -> String) -> ([Usage] -> ShowS) -> Show Usage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usage] -> ShowS
$cshowList :: [Usage] -> ShowS
show :: Usage -> String
$cshow :: Usage -> String
showsPrec :: Int -> Usage -> ShowS
$cshowsPrec :: Int -> Usage -> ShowS
Show)

-- NOTE [`Semigroup` instances for `Blocking` and `Usage`]
instance Semigroup Usage where
  Usage
Cont    <> :: Usage -> Usage -> Usage
<> Usage
y      = Usage
y
  Proc Blocking
x  <> Proc Blocking
y = Blocking -> Usage
Proc (Blocking
x Blocking -> Blocking -> Blocking
forall a. Semigroup a => a -> a -> a
<> Blocking
y)
  Proc Blocking
x  <> Usage
_      = Blocking -> Usage
Proc Blocking
x

{-
NOTE [`Semigroup` instances for `Blocking` and `Usage`]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Usages (and Blocking) are combined by taking the most restrictive usage, where
most restrictive means "has the most influence over the choice of declaration".
Clash produces three types of assignment:

  * continuous
  * prodecural non-blocking
  * prodecural blocking

Both VHDl and (System)Verilog have a type of declaration which only admits one
type of assignment. This is the most restrictive for that HDL. However, since
that would involve knowing the HDL type in these Semigroup instances, the
most restrictive here is based on ordering where the most restrictive for each
HDL is an extreme value (max for VHDL, min for Verilog). i.e.

          |-------------------------------------|
          | Continuous | NonBlocking | Blocking |
|---------|-------------------------------------|
|    VHDL |         signal           | variable |
|---------|-------------------------------------|
| Verilog |   wire     |          reg           |
|---------|-------------------------------------|
-}

instance FromJSON Usage where
  parseJSON :: Value -> Parser Usage
parseJSON = String -> (Text -> Parser Usage) -> Value -> Parser Usage
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Usage" ((Text -> Parser Usage) -> Value -> Parser Usage)
-> (Text -> Parser Usage) -> Value -> Parser Usage
forall a b. (a -> b) -> a -> b
$ \case
    Text
"Continuous"  -> Usage -> Parser Usage
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Usage
Cont
    Text
"NonBlocking" -> Usage -> Parser Usage
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Blocking -> Usage
Proc Blocking
NonBlocking)
    Text
"Blocking"    -> Usage -> Parser Usage
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Blocking -> Usage
Proc Blocking
Blocking)
    Text
str           -> String -> Parser Usage
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser Usage) -> String -> Parser Usage
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Could not parse usage: "
      , Text -> String
forall a. Show a => a -> String
show Text
str
      , String
"\nRecognized values are 'Continuous', 'NonBlocking' and 'Blocking'"
      ]

-- See NOTE [`Text` key for `UsageMap`]
type UsageMap = Map Text Usage

lookupUsage :: Identifier -> UsageMap -> Maybe Usage
lookupUsage :: Identifier -> UsageMap -> Maybe Usage
lookupUsage Identifier
i = Text -> UsageMap -> Maybe Usage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Identifier -> Text
Id.toText Identifier
i)

{-
NOTE [`Text` key for `UsageMap`]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We would like to use netlist identifiers as the key for the usage map, since
conceptually it is a map from an identifier to how it is used in assignments.
However, in practice we commonly end up with the same textual identifier
appearing in different ways in the netlist.

The most obvious example of this are identifiers that appear as both
`UniqueIdentifier` and `RawIdentifier`. If we track the usage on the raw
identifier, but the `NetDecl` uses the `UniqueIdentifier` then the wrong
declaration may be used in the rendered HDL.

Attempting to fix this by not generating the same textual identifier in
different ways proved difficult, so for now the key type is `Text` instead.
-}

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

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 d ty _
  where
    NetDecl Maybe Text
note Identifier
d HWType
ty = Maybe Text -> Identifier -> HWType -> Maybe Expr -> Declaration
NetDecl' Maybe Text
note Identifier
d 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,Eq PortDirection
Eq PortDirection
-> (Int -> PortDirection -> Int)
-> (PortDirection -> Int)
-> Hashable PortDirection
Int -> PortDirection -> Int
PortDirection -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PortDirection -> Int
$chash :: PortDirection -> Int
hashWithSalt :: Int -> PortDirection -> Int
$chashWithSalt :: Int -> PortDirection -> Int
$cp1Hashable :: Eq PortDirection
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). Note
  -- that the type of the expression is the type we are slicing from, not the type
  -- returned by the index operation.
  | 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                    -- ^ Primitive name
      [BlackBoxTemplate]       -- ^ VHDL only: add @library@ declarations
      [BlackBoxTemplate]       -- ^ VHDL only: add @use@ declarations:
      [((Text,Text),BlackBox)] -- ^ Intel/Quartus only: create a @.qsys@ file from given template.
      !BlackBox                -- ^ Template tokens
      !BlackBoxContext         -- ^ Context in which tokens should be rendered
      !Bool                    -- ^ Wrap in parentheses?

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

  -- | Convert BitVector to some type.
  | FromBv
      (Maybe Identifier) -- ^ Type prefix
      HWType             -- ^ Type to convert _to_
      Expr               -- ^ 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` ()

isConstExpr :: Expr -> Bool
isConstExpr :: Expr -> Bool
isConstExpr = \case
  Literal{} -> Bool
True
  DataCon HWType
_ Modifier
_ [Expr]
es -> (Expr -> Bool) -> [Expr] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Expr -> Bool
isConstExpr [Expr]
es
  Identifier{} -> Bool
False
  DataTag{} -> Bool
False
  BlackBoxE Text
nm [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
ctx Bool
_
    -- When using SimIO, `reg` creates (in Haskell) the mutable reference to
    -- some value. The blackbox for this however is simply `~ARG[0]`, so if
    -- the argument given is constant, the rendered HDL will also be constant.
    | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Explicit.SimIO.reg" ->
        ((Expr, HWType, Bool) -> Bool) -> [(Expr, HWType, Bool)] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\(Expr
e, HWType
_, Bool
_) -> Expr -> Bool
isConstExpr Expr
e) (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ctx)
    | Bool
otherwise -> Bool
False
  ToBv Maybe Identifier
_ HWType
_ Expr
e -> Expr -> Bool
isConstExpr Expr
e
  FromBv Maybe Identifier
_ HWType
_ Expr
e -> Expr -> Bool
isConstExpr Expr
e
  IfThenElse{} -> Bool
False
  Expr
Noop -> Bool
False

-- | 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]), Usage,
       [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
       BlackBoxContext)]
bbFunctions :: IntMap [(Either BlackBox (Identifier,[Declaration])
                          ,Usage
                          ,[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]
    -- ^ Used arguments
    -> (BlackBoxContext -> Bool)
    -- ^ Validation function. Should return 'False' if function can't render
    -- given a certain context.
    -> (forall s . Backend s => BlackBoxContext -> Lazy.State s Doc)
    -- ^ Render function
    -> TemplateFunction

instance Show BlackBox where
  showsPrec :: Int -> BlackBox -> ShowS
showsPrec Int
d (BBTemplate BlackBoxTemplate
t) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"BBTemplate " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BlackBoxTemplate -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 BlackBoxTemplate
t
  showsPrec Int
_ (BBFunction String
nm Int
hsh TemplateFunction
_) =
    (String
"<TemplateFunction(nm=" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", hash=" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
hsh ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (String
")>" String -> ShowS
forall a. [a] -> [a] -> [a]
++)

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 (NetlistId -> NetlistId -> Bool
(NetlistId -> NetlistId -> Bool)
-> (NetlistId -> NetlistId -> Bool) -> Eq NetlistId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetlistId -> NetlistId -> Bool
$c/= :: NetlistId -> NetlistId -> Bool
== :: NetlistId -> NetlistId -> Bool
$c== :: NetlistId -> NetlistId -> Bool
Eq, 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', 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. HasType a => a -> Type
coreTypeOf Id
i]
  MultiId [Id]
is -> (Id -> Type) -> [Id] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Type
forall a. HasType a => a -> Type
coreTypeOf [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. HasType a => a -> Type
coreTypeOf 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]), Usage,
       [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]), Usage,
    [BlackBoxTemplate], [BlackBoxTemplate], [((Text, Text), BlackBox)],
    BlackBoxContext)]
bbFunctions   = IntMap
  [(Either BlackBox (Identifier, [Declaration]), Usage,
    [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
  }

Lens.makeLenses ''NetlistEnv
Lens.makeLenses ''NetlistState

intWidth :: Lens.Getter NetlistEnv Int
intWidth :: (Int -> f Int) -> NetlistEnv -> f NetlistEnv
intWidth = (ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv
Lens' NetlistEnv ClashEnv
clashEnv ((ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv)
-> ((Int -> f Int) -> ClashEnv -> f ClashEnv)
-> (Int -> f Int)
-> NetlistEnv
-> f NetlistEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClashEnv -> Int) -> (Int -> f Int) -> ClashEnv -> f ClashEnv
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to (ClashOpts -> Int
opt_intWidth (ClashOpts -> Int) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClashEnv -> ClashOpts
envOpts)

customReprs :: Lens.Getter NetlistEnv CustomReprs
customReprs :: (CustomReprs -> f CustomReprs) -> NetlistEnv -> f NetlistEnv
customReprs = (ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv
Lens' NetlistEnv ClashEnv
clashEnv ((ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv)
-> ((CustomReprs -> f CustomReprs) -> ClashEnv -> f ClashEnv)
-> (CustomReprs -> f CustomReprs)
-> NetlistEnv
-> f NetlistEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClashEnv -> CustomReprs)
-> (CustomReprs -> f CustomReprs) -> ClashEnv -> f ClashEnv
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to ClashEnv -> CustomReprs
envCustomReprs

tcCache :: Lens.Getter NetlistEnv TyConMap
tcCache :: (TyConMap -> f TyConMap) -> NetlistEnv -> f NetlistEnv
tcCache = (ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv
Lens' NetlistEnv ClashEnv
clashEnv ((ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv)
-> ((TyConMap -> f TyConMap) -> ClashEnv -> f ClashEnv)
-> (TyConMap -> f TyConMap)
-> NetlistEnv
-> f NetlistEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClashEnv -> TyConMap)
-> (TyConMap -> f TyConMap) -> ClashEnv -> f ClashEnv
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to ClashEnv -> TyConMap
envTyConMap

primitives :: Lens.Getter NetlistEnv CompiledPrimMap
primitives :: (CompiledPrimMap -> f CompiledPrimMap)
-> NetlistEnv -> f NetlistEnv
primitives = (ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv
Lens' NetlistEnv ClashEnv
clashEnv ((ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv)
-> ((CompiledPrimMap -> f CompiledPrimMap)
    -> ClashEnv -> f ClashEnv)
-> (CompiledPrimMap -> f CompiledPrimMap)
-> NetlistEnv
-> f NetlistEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClashEnv -> CompiledPrimMap)
-> (CompiledPrimMap -> f CompiledPrimMap) -> ClashEnv -> f ClashEnv
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to ClashEnv -> CompiledPrimMap
envPrimitives

clashOpts :: Lens.Getter NetlistEnv ClashOpts
clashOpts :: (ClashOpts -> f ClashOpts) -> NetlistEnv -> f NetlistEnv
clashOpts = (ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv
Lens' NetlistEnv ClashEnv
clashEnv ((ClashEnv -> f ClashEnv) -> NetlistEnv -> f NetlistEnv)
-> ((ClashOpts -> f ClashOpts) -> ClashEnv -> f ClashEnv)
-> (ClashOpts -> f ClashOpts)
-> NetlistEnv
-> f NetlistEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClashEnv -> ClashOpts)
-> (ClashOpts -> f ClashOpts) -> ClashEnv -> f ClashEnv
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to ClashEnv -> ClashOpts
envOpts

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

instance HasUsageMap NetlistState where
  usageMap :: (UsageMap -> f UsageMap) -> NetlistState -> f NetlistState
usageMap = (UsageMap -> f UsageMap) -> NetlistState -> f NetlistState
Lens' NetlistState UsageMap
usages

instance HasIdentifierSet s => HasIdentifierSet (s, a) where
  identifierSet :: (IdentifierSet -> f IdentifierSet) -> (s, a) -> f (s, a)
identifierSet = (s -> f s) -> (s, a) -> f (s, a)
forall s t a b. Field1 s t a b => Lens s t a b
Lens._1 ((s -> f s) -> (s, a) -> f (s, a))
-> ((IdentifierSet -> f IdentifierSet) -> s -> f s)
-> (IdentifierSet -> f IdentifierSet)
-> (s, a)
-> f (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentifierSet -> f IdentifierSet) -> s -> f s
forall s. HasIdentifierSet s => Lens' s IdentifierSet
identifierSet

-- | 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 (Ap m) where
  identifierSetM :: (IdentifierSet -> IdentifierSet) -> Ap m IdentifierSet
identifierSetM = m IdentifierSet -> Ap m IdentifierSet
forall k (f :: k -> Type) (a :: k). f a -> Ap f a
Ap (m IdentifierSet -> Ap m IdentifierSet)
-> ((IdentifierSet -> IdentifierSet) -> m IdentifierSet)
-> (IdentifierSet -> IdentifierSet)
-> Ap 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