{-|
  Copyright   :  (C) 2018,      Google Inc.,
                     2021-2023, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

  API for synthesis attributes (sometimes referred to as "synthesis directives",
  "pragmas", or "logic synthesis directives"). This is an experimental feature,
  please report any unexpected or broken behavior to Clash's GitHub page
  (<https://github.com/clash-lang/clash-compiler/issues>).
-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Clash.Annotations.SynthesisAttributes
  ( Attr(..)
  , Annotate
  , annotate
  , markDebug
  ) where

import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.Hashable (Hashable)
import Data.Kind (Type)
import Data.String.Interpolate (__i)
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)

import Clash.Annotations.Primitive (Primitive(InlineYamlPrimitive), hasBlackBox)
import Clash.Signal.Internal (Signal)
import Clash.Sized.Vector (Vec(..))

type Annotate (a :: Type) (attrs :: k) = a

-- | Synthesis attributes are directives passed to synthesis tools, such as
-- Quartus. An example of such an attribute in VHDL:
--
-- > attribute chip_pin : string;
-- > attribute chip_pin of sel : signal is "C4";
-- > attribute chip_pin of data : signal is "D1, D2, D3, D4";
--
-- This would instruct the synthesis tool to map the wire /sel/ to pin /C4/, and
-- wire /data/ to pins /D1/, /D2/, /D3/, and /D4/. To achieve this in Clash, /Attr/s
-- are used. An example of the same annotation:
--
-- @
-- import Clash.Annotations.SynthesisAttributes (Attr (..), Annotate )
--
-- myFunc
--     :: (Signal System Bool \`Annotate\` 'StringAttr "chip_pin" \"C4\")
--     -> (Signal System Int4 \`Annotate\` 'StringAttr "chip_pin" "D1, D2, D3, D4")
--     -> ...
-- myFunc sel data = ...
-- {\-\# NOINLINE myFunc \#-\}
-- @
--
-- To ensure this function will be rendered as its own module, do not forget a
-- NOINLINE pragma.
--
-- Multiple attributes for the /same/ argument can be specified by using a list.
-- For example:
--
-- @
-- Signal System Bool \`Annotate\`
--   [ 'StringAttr "chip_pin" \"C4\"
--   , 'BoolAttr "direct_enable" 'True
--   , 'IntegerAttr "max_depth" 512
--   , 'Attr "keep"
--   ]
-- @
--
-- For Verilog see:
--     <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vlog/vlog_file_dir.htm>
--
-- For VHDL, see:
--     <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vhdl/vhdl_file_dir.htm>
--
-- = Warnings
--
-- When using annotations, it is important that annotated arguments are not
-- eta-reduced, as this may result in the annotation being stripped by GHC. For
-- example
--
-- @
-- f :: Signal System Bool \`Annotate\` 'StringAttr \"chip_pin\" \"C4\"
--   -> Signal System Bool
-- f x = id x -- Using a lambda, i.e. f = \\x -> id x also works
-- @
--
-- will reliably show the annotation in the generated HDL, but
--
-- @
-- g :: Signal System Bool \`Annotate\` 'StringAttr \"chip_pin\" \"C4\"
--   -> Signal System Bool
-- g = id
-- @
--
-- will not work.
--
-- This is an experimental feature, please report any unexpected or broken
-- behavior to Clash's GitHub page (<https://github.com/clash-lang/clash-compiler/issues>).
--
-- Use 'annotate' if you wish to annotate an intermediate signal. Its use is
-- preferred over type level annotations.
data Attr a
  = BoolAttr a Bool
  -- ^ Attribute which argument is rendered as a bool. Example:
  -- <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vlog/vlog_file_dir_direct_enable.htm>
  | IntegerAttr a Integer
  -- ^ Attribute which argument is rendered as a integer. Example:
  -- <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vlog/vlog_file_dir_max_depth.htm>
  | StringAttr a a
  -- ^ Attribute which argument is rendered as a string. Example:
  -- <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vlog/vlog_file_dir_chip.htm>
  | Attr a
  -- ^ Attribute rendered as constant. Example:
  -- <https://www.intel.com/content/www/us/en/programmable/quartushelp/current/index.htm#hdl/vlog/vlog_file_dir_keep.htm>
  deriving (Int -> Attr a -> ShowS
[Attr a] -> ShowS
Attr a -> String
(Int -> Attr a -> ShowS)
-> (Attr a -> String) -> ([Attr a] -> ShowS) -> Show (Attr a)
forall a. Show a => Int -> Attr a -> ShowS
forall a. Show a => [Attr a] -> ShowS
forall a. Show a => Attr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Attr a -> ShowS
showsPrec :: Int -> Attr a -> ShowS
$cshow :: forall a. Show a => Attr a -> String
show :: Attr a -> String
$cshowList :: forall a. Show a => [Attr a] -> ShowS
showList :: [Attr a] -> ShowS
Show, (forall x. Attr a -> Rep (Attr a) x)
-> (forall x. Rep (Attr a) x -> Attr a) -> Generic (Attr a)
forall x. Rep (Attr a) x -> Attr a
forall x. Attr a -> Rep (Attr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Attr a) x -> Attr a
forall a x. Attr a -> Rep (Attr a) x
$cfrom :: forall a x. Attr a -> Rep (Attr a) x
from :: forall x. Attr a -> Rep (Attr a) x
$cto :: forall a x. Rep (Attr a) x -> Attr a
to :: forall x. Rep (Attr a) x -> Attr a
Generic, Attr a -> ()
(Attr a -> ()) -> NFData (Attr a)
forall a. NFData a => Attr a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Attr a -> ()
rnf :: Attr a -> ()
NFData, Get (Attr a)
[Attr a] -> Put
Attr a -> Put
(Attr a -> Put)
-> Get (Attr a) -> ([Attr a] -> Put) -> Binary (Attr a)
forall a. Binary a => Get (Attr a)
forall a. Binary a => [Attr a] -> Put
forall a. Binary a => Attr a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: forall a. Binary a => Attr a -> Put
put :: Attr a -> Put
$cget :: forall a. Binary a => Get (Attr a)
get :: Get (Attr a)
$cputList :: forall a. Binary a => [Attr a] -> Put
putList :: [Attr a] -> Put
Binary, (forall (m :: Type -> Type). Quote m => Attr a -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    Attr a -> Code m (Attr a))
-> Lift (Attr a)
forall a (m :: Type -> Type). (Lift a, Quote m) => Attr a -> m Exp
forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Attr a -> Code m (Attr a)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => Attr a -> m Exp
forall (m :: Type -> Type). Quote m => Attr a -> Code m (Attr a)
$clift :: forall a (m :: Type -> Type). (Lift a, Quote m) => Attr a -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Attr a -> m Exp
$cliftTyped :: forall a (m :: Type -> Type).
(Lift a, Quote m) =>
Attr a -> Code m (Attr a)
liftTyped :: forall (m :: Type -> Type). Quote m => Attr a -> Code m (Attr a)
Lift, Attr a -> Attr a -> Bool
(Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Bool) -> Eq (Attr a)
forall a. Eq a => Attr a -> Attr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Attr a -> Attr a -> Bool
== :: Attr a -> Attr a -> Bool
$c/= :: forall a. Eq a => Attr a -> Attr a -> Bool
/= :: Attr a -> Attr a -> Bool
Eq, Eq (Attr a)
Eq (Attr a) =>
(Attr a -> Attr a -> Ordering)
-> (Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Attr a)
-> (Attr a -> Attr a -> Attr a)
-> Ord (Attr a)
Attr a -> Attr a -> Bool
Attr a -> Attr a -> Ordering
Attr a -> Attr a -> Attr 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 (Attr a)
forall a. Ord a => Attr a -> Attr a -> Bool
forall a. Ord a => Attr a -> Attr a -> Ordering
forall a. Ord a => Attr a -> Attr a -> Attr a
$ccompare :: forall a. Ord a => Attr a -> Attr a -> Ordering
compare :: Attr a -> Attr a -> Ordering
$c< :: forall a. Ord a => Attr a -> Attr a -> Bool
< :: Attr a -> Attr a -> Bool
$c<= :: forall a. Ord a => Attr a -> Attr a -> Bool
<= :: Attr a -> Attr a -> Bool
$c> :: forall a. Ord a => Attr a -> Attr a -> Bool
> :: Attr a -> Attr a -> Bool
$c>= :: forall a. Ord a => Attr a -> Attr a -> Bool
>= :: Attr a -> Attr a -> Bool
$cmax :: forall a. Ord a => Attr a -> Attr a -> Attr a
max :: Attr a -> Attr a -> Attr a
$cmin :: forall a. Ord a => Attr a -> Attr a -> Attr a
min :: Attr a -> Attr a -> Attr a
Ord, Eq (Attr a)
Eq (Attr a) =>
(Int -> Attr a -> Int) -> (Attr a -> Int) -> Hashable (Attr a)
Int -> Attr a -> Int
Attr a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Attr a)
forall a. Hashable a => Int -> Attr a -> Int
forall a. Hashable a => Attr a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Attr a -> Int
hashWithSalt :: Int -> Attr a -> Int
$chash :: forall a. Hashable a => Attr a -> Int
hash :: Attr a -> Int
Hashable, (forall a b. (a -> b) -> Attr a -> Attr b)
-> (forall a b. a -> Attr b -> Attr a) -> Functor Attr
forall a b. a -> Attr b -> Attr a
forall a b. (a -> b) -> Attr a -> Attr b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Attr a -> Attr b
fmap :: forall a b. (a -> b) -> Attr a -> Attr b
$c<$ :: forall a b. a -> Attr b -> Attr a
<$ :: forall a b. a -> Attr b -> Attr a
Functor)

-- | Create a new identifier in HDL and inserts given synthesis attributes. The
-- name of the intermediate signal can be influenced using naming functions in
-- "Clash.Magic".
annotate :: forall n dom a . Vec n (Attr String) -> Signal dom a -> Signal dom a
annotate :: forall (n :: Nat) (dom :: Symbol) a.
Vec n (Attr String) -> Signal dom a -> Signal dom a
annotate !Vec n (Attr String)
_attrs !Signal dom a
a = Signal dom a
a
{-# CLASH_OPAQUE annotate #-}
{-# ANN annotate hasBlackBox #-}
{-# ANN annotate
  let primName = show 'annotate
  in InlineYamlPrimitive [minBound..] [__i|
    BlackBoxHaskell:
        name: #{primName}
        templateFunction: "Clash.Primitives.Annotations.SynthesisAttributes.annotateBBF"
        workInfo: Always
  |] #-}

-- | Insert attributes such that signals are preserved in major synthesis tools.
-- Also inserts "mark_debug", a way of signalling Vivado a signal should show up
-- in a list of signals desired for ILA/VIO insertion.
--
-- Attributes inserted: @keep@, @mark_debug@, @noprune@, and @preserve@.
markDebug :: Signal dom a -> Signal dom a
markDebug :: forall (dom :: Symbol) a. Signal dom a -> Signal dom a
markDebug = Vec (((1 + 1) + 1) + 1) (Attr String)
-> Signal dom a -> Signal dom a
forall (n :: Nat) (dom :: Symbol) a.
Vec n (Attr String) -> Signal dom a -> Signal dom a
annotate (Vec (((1 + 1) + 1) + 1) (Attr String)
 -> Signal dom a -> Signal dom a)
-> Vec (((1 + 1) + 1) + 1) (Attr String)
-> Signal dom a
-> Signal dom a
forall a b. (a -> b) -> a -> b
$
     String -> Bool -> Attr String
forall a. a -> Bool -> Attr a
BoolAttr String
"keep" Bool
True

  -- Vivado:
  Attr String
-> Vec ((1 + 1) + 1) (Attr String)
-> Vec (((1 + 1) + 1) + 1) (Attr String)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> String -> Bool -> Attr String
forall a. a -> Bool -> Attr a
BoolAttr String
"mark_debug" Bool
True

  -- Quartus:
  Attr String
-> Vec (1 + 1) (Attr String) -> Vec ((1 + 1) + 1) (Attr String)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> String -> Attr String
forall a. a -> Attr a
Attr String
"noprune"
  Attr String -> Vec 1 (Attr String) -> Vec (1 + 1) (Attr String)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> String -> Attr String
forall a. a -> Attr a
Attr String
"preserve"
  Attr String -> Vec 0 (Attr String) -> Vec (0 + 1) (Attr String)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 (Attr String)
forall b. Vec 0 b
Nil