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