{-|
  Copyright   :  (C) 2019-2023, Myrtle Software Ltd
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

Control naming and deduplication in the generated HDL code. Explicitly nameable
things include:

* Component (VHDL) / module ((System)Verilog) instances

* Registers

* Terms

Refer to "Clash.Annotations.TopEntity" for controlling naming of entities
(VHDL) / modules ((System)Verilog) and their ports.
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Clash.Magic
  (
  -- ** Functions to control names of identifiers in HDL
    prefixName
  , suffixName
  , suffixNameP
  , suffixNameFromNat
  , suffixNameFromNatP
  , setName
  , nameHint

  -- ** Functions to control Clash's (de)duplication mechanisms
  , deDup
  , noDeDup

  -- ** Utilities to differentiate between simulation and generating HDL
  , clashSimulation
  , SimOnly (..)

  -- * Static assertions
  , clashCompileError
  ) where

import Data.String.Interpolate     (__i)
import GHC.Magic                   (noinline)
import GHC.Stack                   (HasCallStack, withFrozenCallStack)
import Clash.NamedTypes            ((:::))
import GHC.TypeLits                (Nat,Symbol)
import Clash.Promoted.Symbol       (SSymbol)
import Clash.Annotations.Primitive (Primitive(..), hasBlackBox)

-- | Prefix instance and register names with the given 'Symbol'
prefixName
  :: forall (name :: Symbol) a . a -> name ::: a
prefixName :: a -> a
prefixName = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE prefixName #-}

-- | Suffix instance and register names with the given 'Symbol'
suffixName
  :: forall (name :: Symbol) a . a -> name ::: a
suffixName :: a -> a
suffixName = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE suffixName #-}

-- | Suffix instance and register names with the given 'Nat'
suffixNameFromNat
  :: forall (name :: Nat) a . a -> name ::: a
suffixNameFromNat :: a -> a
suffixNameFromNat = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE suffixNameFromNat #-}

-- | Suffix instance and register names with the given 'Symbol', but add it
-- in front of other suffixes.
--
-- When you write
--
-- @
-- suffixName \@\"A\" (suffixName \@\"B\" f))
-- @
--
-- you get register and instance names inside /f/ with the suffix: "_B_A"
--
-- However, if you want them in the other order you can write:
--
-- @
-- suffixNameP \@\"A\" (suffixName \@\"B\" f))
-- @
--
-- so that names inside /f/ will have the suffix "_A_B"
suffixNameP
  :: forall (name :: Symbol) a . a -> name ::: a
suffixNameP :: a -> a
suffixNameP = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE suffixNameP #-}

-- | Suffix instance and register names with the given 'Nat', but add it in
-- front of other suffixes.
--
-- When you write
--
-- @
-- suffixNameNat \@1 (suffixName \@\"B\" f))
-- @
--
-- you get register and instance names inside /f/ with the suffix: "_B_1"
--
-- However, if you want them in the other order you can write:
--
-- @
-- suffixNameNatP \@1 (suffixName \@\"B\" f))
-- @
--
-- so that names inside /f/ will have the suffix "_1_B"
suffixNameFromNatP
  :: forall (name :: Nat) a . a -> name ::: a
suffixNameFromNatP :: a -> a
suffixNameFromNatP = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE suffixNameFromNatP #-}

-- | Name the instance or register with the given 'Symbol', instead of using
-- an auto-generated name. Pre- and suffixes annotated with 'prefixName' and
-- 'suffixName' will be added to both instances and registers named with
-- 'setName' and instances and registers that are auto-named.
setName
  :: forall (name :: Symbol) a . a -> name ::: a
setName :: a -> a
setName = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE setName #-}

-- | Name a given term, such as one of type 'Clash.Signal.Signal', using the
-- given 'SSymbol'. Results in a declaration with the name used as the
-- identifier in the generated HDL code.
--
-- Example usage:
--
-- @
-- nameHint (SSymbol @"identifier") term
-- @
--
-- __NB__: The given name should be considered a hint as it may be expanded,
-- e.g. if it collides with existing identifiers.
nameHint
  :: SSymbol sym
  -- ^ A hint for a name
  -> a -> a
nameHint :: SSymbol sym -> a -> a
nameHint = SSymbol sym -> a -> a
seq
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE nameHint #-}
{-# ANN nameHint hasBlackBox #-}

-- | Force deduplication, i.e. share a function or operator between multiple
-- branches.
--
-- By default Clash converts
--
-- @
-- case x of
--   A -> 3 * y
--   B -> x * x
-- @
--
-- to
--
-- @
-- let f_arg0 = case x of {A -> 3; _ -> x}
--     f_arg1 = case x of {A -> y; _ -> x}
--     f_out  = f_arg0 * f_arg1
-- in  case x of
--       A -> f_out
--       B -> f_out
-- @
--
-- However, it won't do this for:
--
-- @
-- case x of
--   A -> 3 + y
--   B -> x + x
-- @
--
-- Because according to the internal heuristics the multiplexer introduced for
-- the deduplication are more expensive than the addition. This might not be
-- the case for your particular platform.
--
-- In these cases you can force Clash to deduplicate by:
--
-- @
-- case x of
--   A -> 'deDup' (3 + y)
--   B -> 'deDup' (x + x)
-- @
deDup
  :: forall a . a -> a
deDup :: a -> a
deDup = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE deDup #-}

-- | Do not deduplicate, i.e. /keep/, an applied function inside a
-- case-alternative; do not try to share the function between multiple
-- branches.
--
-- By default Clash converts
--
-- @
-- case x of
--   A -> f 3 y
--   B -> f x x
--   C -> h x
-- @
--
-- to
--
-- @
-- let f_arg0 = case x of {A -> 3; _ -> x}
--     f_arg1 = case x of {A -> y; _ -> x}
--     f_out  = f f_arg0 f_arg1
-- in  case x of
--       A -> f_out
--       B -> f_out
--       C -> h x
-- @
--
-- i.e. it deduplicates functions (and operators such as multiplication) between
-- case-alternatives to save on area. This comes at the cost of multiplexing the
-- arguments for the deduplicated function.
--
-- There are two reasons you would want to stop Clash from doing this:
--
-- 1. The deduplicated function is in the critical path, and the addition of the
--    multiplexers further increased the propagation delay.
--
-- 2. Clash's heuristics were off, and the addition of the multiplexers actually
--    made the final circuit larger instead of smaller.
--
-- In these cases you want to tell Clash not to deduplicate:
--
-- @
-- case x of
--   A -> 'noDeDup' f 3 y
--   B -> f x x
--   C -> h x
-- @
--
-- Where the application of /f/ in the /A/-alternative is now explicitly not
-- deduplicated, and given that the /f/ in the B-alternative is the only
-- remaining application of /f/ in the case-expression it is also not
-- deduplicated.
--
-- Note that if the /C/-alternative also had an application of /f/, then the
-- applications of /f/ in the /B/- and /C/-alternatives would have been
-- deduplicated; i.e. the final circuit would have had two application of /f/.
noDeDup
  :: forall a . a -> a
noDeDup :: a -> a
noDeDup = a -> a
forall a. a -> a
id
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE noDeDup #-}

-- | 'True' in Haskell/Clash simulation. Replaced by 'False' when generating HDL.
clashSimulation :: Bool
clashSimulation :: Bool
clashSimulation = Bool -> Bool
forall a. a -> a
noinline Bool
True
-- The 'noinline' is here to prevent SpecConstr from poking through the OPAQUE, see #2736
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE clashSimulation #-}

-- | A container for data you only want to have around during simulation and
-- is ignored during synthesis. Useful for carrying around things such as:
--
--   * A map of simulation/vcd traces
--   * Co-simulation state or meta-data
--   * etc.
data SimOnly a = SimOnly a
  deriving (SimOnly a -> SimOnly a -> Bool
(SimOnly a -> SimOnly a -> Bool)
-> (SimOnly a -> SimOnly a -> Bool) -> Eq (SimOnly a)
forall a. Eq a => SimOnly a -> SimOnly a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimOnly a -> SimOnly a -> Bool
$c/= :: forall a. Eq a => SimOnly a -> SimOnly a -> Bool
== :: SimOnly a -> SimOnly a -> Bool
$c== :: forall a. Eq a => SimOnly a -> SimOnly a -> Bool
Eq, Eq (SimOnly a)
Eq (SimOnly a)
-> (SimOnly a -> SimOnly a -> Ordering)
-> (SimOnly a -> SimOnly a -> Bool)
-> (SimOnly a -> SimOnly a -> Bool)
-> (SimOnly a -> SimOnly a -> Bool)
-> (SimOnly a -> SimOnly a -> Bool)
-> (SimOnly a -> SimOnly a -> SimOnly a)
-> (SimOnly a -> SimOnly a -> SimOnly a)
-> Ord (SimOnly a)
SimOnly a -> SimOnly a -> Bool
SimOnly a -> SimOnly a -> Ordering
SimOnly a -> SimOnly a -> SimOnly a
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
forall a. Ord a => Eq (SimOnly a)
forall a. Ord a => SimOnly a -> SimOnly a -> Bool
forall a. Ord a => SimOnly a -> SimOnly a -> Ordering
forall a. Ord a => SimOnly a -> SimOnly a -> SimOnly a
min :: SimOnly a -> SimOnly a -> SimOnly a
$cmin :: forall a. Ord a => SimOnly a -> SimOnly a -> SimOnly a
max :: SimOnly a -> SimOnly a -> SimOnly a
$cmax :: forall a. Ord a => SimOnly a -> SimOnly a -> SimOnly a
>= :: SimOnly a -> SimOnly a -> Bool
$c>= :: forall a. Ord a => SimOnly a -> SimOnly a -> Bool
> :: SimOnly a -> SimOnly a -> Bool
$c> :: forall a. Ord a => SimOnly a -> SimOnly a -> Bool
<= :: SimOnly a -> SimOnly a -> Bool
$c<= :: forall a. Ord a => SimOnly a -> SimOnly a -> Bool
< :: SimOnly a -> SimOnly a -> Bool
$c< :: forall a. Ord a => SimOnly a -> SimOnly a -> Bool
compare :: SimOnly a -> SimOnly a -> Ordering
$ccompare :: forall a. Ord a => SimOnly a -> SimOnly a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SimOnly a)
Ord, SimOnly a -> Bool
(a -> m) -> SimOnly a -> m
(a -> b -> b) -> b -> SimOnly a -> b
(forall m. Monoid m => SimOnly m -> m)
-> (forall m a. Monoid m => (a -> m) -> SimOnly a -> m)
-> (forall m a. Monoid m => (a -> m) -> SimOnly a -> m)
-> (forall a b. (a -> b -> b) -> b -> SimOnly a -> b)
-> (forall a b. (a -> b -> b) -> b -> SimOnly a -> b)
-> (forall b a. (b -> a -> b) -> b -> SimOnly a -> b)
-> (forall b a. (b -> a -> b) -> b -> SimOnly a -> b)
-> (forall a. (a -> a -> a) -> SimOnly a -> a)
-> (forall a. (a -> a -> a) -> SimOnly a -> a)
-> (forall a. SimOnly a -> [a])
-> (forall a. SimOnly a -> Bool)
-> (forall a. SimOnly a -> Int)
-> (forall a. Eq a => a -> SimOnly a -> Bool)
-> (forall a. Ord a => SimOnly a -> a)
-> (forall a. Ord a => SimOnly a -> a)
-> (forall a. Num a => SimOnly a -> a)
-> (forall a. Num a => SimOnly a -> a)
-> Foldable SimOnly
forall a. Eq a => a -> SimOnly a -> Bool
forall a. Num a => SimOnly a -> a
forall a. Ord a => SimOnly a -> a
forall m. Monoid m => SimOnly m -> m
forall a. SimOnly a -> Bool
forall a. SimOnly a -> Int
forall a. SimOnly a -> [a]
forall a. (a -> a -> a) -> SimOnly a -> a
forall m a. Monoid m => (a -> m) -> SimOnly a -> m
forall b a. (b -> a -> b) -> b -> SimOnly a -> b
forall a b. (a -> b -> b) -> b -> SimOnly 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 :: SimOnly a -> a
$cproduct :: forall a. Num a => SimOnly a -> a
sum :: SimOnly a -> a
$csum :: forall a. Num a => SimOnly a -> a
minimum :: SimOnly a -> a
$cminimum :: forall a. Ord a => SimOnly a -> a
maximum :: SimOnly a -> a
$cmaximum :: forall a. Ord a => SimOnly a -> a
elem :: a -> SimOnly a -> Bool
$celem :: forall a. Eq a => a -> SimOnly a -> Bool
length :: SimOnly a -> Int
$clength :: forall a. SimOnly a -> Int
null :: SimOnly a -> Bool
$cnull :: forall a. SimOnly a -> Bool
toList :: SimOnly a -> [a]
$ctoList :: forall a. SimOnly a -> [a]
foldl1 :: (a -> a -> a) -> SimOnly a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SimOnly a -> a
foldr1 :: (a -> a -> a) -> SimOnly a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SimOnly a -> a
foldl' :: (b -> a -> b) -> b -> SimOnly a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SimOnly a -> b
foldl :: (b -> a -> b) -> b -> SimOnly a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SimOnly a -> b
foldr' :: (a -> b -> b) -> b -> SimOnly a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SimOnly a -> b
foldr :: (a -> b -> b) -> b -> SimOnly a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SimOnly a -> b
foldMap' :: (a -> m) -> SimOnly a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SimOnly a -> m
foldMap :: (a -> m) -> SimOnly a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SimOnly a -> m
fold :: SimOnly m -> m
$cfold :: forall m. Monoid m => SimOnly m -> m
Foldable, Functor SimOnly
Foldable SimOnly
Functor SimOnly
-> Foldable SimOnly
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> SimOnly a -> f (SimOnly b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    SimOnly (f a) -> f (SimOnly a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> SimOnly a -> m (SimOnly b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    SimOnly (m a) -> m (SimOnly a))
-> Traversable SimOnly
(a -> f b) -> SimOnly a -> f (SimOnly 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 =>
SimOnly (m a) -> m (SimOnly a)
forall (f :: Type -> Type) a.
Applicative f =>
SimOnly (f a) -> f (SimOnly a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> SimOnly a -> m (SimOnly b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> SimOnly a -> f (SimOnly b)
sequence :: SimOnly (m a) -> m (SimOnly a)
$csequence :: forall (m :: Type -> Type) a.
Monad m =>
SimOnly (m a) -> m (SimOnly a)
mapM :: (a -> m b) -> SimOnly a -> m (SimOnly b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> SimOnly a -> m (SimOnly b)
sequenceA :: SimOnly (f a) -> f (SimOnly a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
SimOnly (f a) -> f (SimOnly a)
traverse :: (a -> f b) -> SimOnly a -> f (SimOnly b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> SimOnly a -> f (SimOnly b)
$cp2Traversable :: Foldable SimOnly
$cp1Traversable :: Functor SimOnly
Traversable)
{-# ANN SimOnly hasBlackBox #-}

instance Functor SimOnly where
  fmap :: (a -> b) -> SimOnly a -> SimOnly b
fmap a -> b
f (SimOnly a
a) = b -> SimOnly b
forall a. a -> SimOnly a
SimOnly (a -> b
f a
a)

instance Applicative SimOnly where
  pure :: a -> SimOnly a
pure = a -> SimOnly a
forall a. a -> SimOnly a
SimOnly
  (SimOnly a -> b
f) <*> :: SimOnly (a -> b) -> SimOnly a -> SimOnly b
<*> (SimOnly a
a) = b -> SimOnly b
forall a. a -> SimOnly a
SimOnly (a -> b
f a
a)

instance Monad SimOnly where
  (SimOnly a
a) >>= :: SimOnly a -> (a -> SimOnly b) -> SimOnly b
>>= a -> SimOnly b
f = a -> SimOnly b
f a
a

instance Semigroup a => Semigroup (SimOnly a) where
  (SimOnly a
a) <> :: SimOnly a -> SimOnly a -> SimOnly a
<> (SimOnly a
b) = a -> SimOnly a
forall a. a -> SimOnly a
SimOnly (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)

instance Monoid a => Monoid (SimOnly a) where
  mempty :: SimOnly a
mempty = a -> SimOnly a
forall a. a -> SimOnly a
SimOnly a
forall a. Monoid a => a
mempty

-- | Same as 'error' but will make HDL generation fail if included in the
-- final circuit.
--
-- This is useful for the error case of static assertions.
--
-- Note that the error message needs to be a literal, and during HDL generation
-- the error message does not include a stack trace, so it had better be
-- descriptive.
clashCompileError :: forall a . HasCallStack => String -> a
clashCompileError :: String -> a
clashCompileError String
msg = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error String
msg
-- See: https://github.com/clash-lang/clash-compiler/pull/2511
{-# CLASH_OPAQUE clashCompileError #-}
{-# ANN clashCompileError (
  let primName = 'clashCompileError
  in InlineYamlPrimitive [minBound..] [__i|
    BlackBoxHaskell:
      name: #{primName}
      templateFunction: Clash.Primitives.Magic.clashCompileErrorBBF
    |]) #-}