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

      Utility functions to generate Primitives
    -}

    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}

    module Clash.Primitives.Util
      ( generatePrimMap
      , hashCompiledPrimMap
      , constantArgs
      , decodeOrErrJson
      , decodeOrErrYaml
      , getFunctionPlurality
      ) where

    import           Control.DeepSeq        (force)
    import           Control.Monad          (forM)
    import           Data.Aeson.Extra       (decodeOrErrJson, decodeOrErrYaml)
    import qualified Data.ByteString.Lazy   as LZ
    import qualified Data.HashMap.Lazy      as HashMap
    import qualified Data.HashMap.Strict    as HashMapStrict
    import qualified Data.Set               as Set
    import           Data.Hashable          (hash)
    import           Data.List              (isSuffixOf, sort, find)
    import           Data.Maybe             (fromMaybe)
    import qualified Data.Text              as TS
    import           Data.Text.Lazy         (Text)
    import qualified Data.Text.Lazy.IO      as T
    import           GHC.Stack              (HasCallStack)
    import qualified System.Directory       as Directory
    import qualified System.FilePath        as FilePath
    import           System.IO.Error        (tryIOError)

    import           Clash.Annotations.Primitive
      ( PrimitiveGuard(HasBlackBox, DontTranslate)
      , PrimitiveWarning(WarnNonSynthesizable)
      , extractPrim, extractWarnings)
    import           Clash.Core.Term        (Term)
    import           Clash.Core.Type        (Type)
    import           Clash.Primitives.Types
      ( Primitive(BlackBox), CompiledPrimitive, ResolvedPrimitive, ResolvedPrimMap
      , includes, template, TemplateSource(TFile, TInline), Primitive(..)
      , UnresolvedPrimitive, CompiledPrimMap, GuardedResolvedPrimitive)
    import           Clash.Netlist.Types    (BlackBox(..), NetlistMonad)
    import           Clash.Netlist.Util     (preserveState)
    import           Clash.Netlist.BlackBox.Util
      (walkElement)
    import           Clash.Netlist.BlackBox.Types
      (Element(Const, Lit), BlackBoxMeta(..))

    hashCompiledPrimitive :: CompiledPrimitive -> Int
    hashCompiledPrimitive :: CompiledPrimitive -> Int
    hashCompiledPrimitive (Primitive {Text
    name :: Text
    name :: forall a b c d. Primitive a b c d -> Text
    name, Text
    primSort :: Text
    primSort :: forall a b c d. Primitive a b c d -> Text
    primSort}) = (Text, Text) -> Int
    forall a. Hashable a => a -> Int
    hash (Text
    name, Text
    primSort)
    hashCompiledPrimitive (BlackBoxHaskell {(Int, BlackBoxFunction)
    function :: (Int, BlackBoxFunction)
    function :: forall a b c d. Primitive a b c d -> d
    function}) = (Int, BlackBoxFunction) -> Int
    forall a b. (a, b) -> a
    fst (Int, BlackBoxFunction)
    function
    hashCompiledPrimitive (BlackBox {Text
    name :: forall a b c d. Primitive a b c d -> Text
    name :: Text
    name, TemplateKind
    kind :: TemplateKind
    kind :: forall a b c d. Primitive a b c d -> TemplateKind
    kind, Usage
    outputUsage :: Usage
    outputUsage :: forall a b c d. Primitive a b c d -> Usage
    outputUsage, [BlackBoxTemplate]
    libraries :: [BlackBoxTemplate]
    libraries :: forall a b c d. Primitive a b c d -> [a]
    libraries, [BlackBoxTemplate]
    imports :: [BlackBoxTemplate]
    imports :: forall a b c d. Primitive a b c d -> [a]
    imports, [((Text, Text), BlackBox)]
    includes :: forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes :: [((Text, Text), BlackBox)]
    includes, BlackBox
    template :: forall a b c d. Primitive a b c d -> b
    template :: BlackBox
    template}) =
      (Text, TemplateKind, Usage, [BlackBoxTemplate], [BlackBoxTemplate],
     [((Text, Text), Int)], Int)
    -> Int
    forall a. Hashable a => a -> Int
    hash (Text
    name, TemplateKind
    kind, Usage
    outputUsage, [BlackBoxTemplate]
    libraries, [BlackBoxTemplate]
    imports, [((Text, Text), Int)]
    includes', BlackBox -> Int
    hashBlackbox BlackBox
    template)
        where
          includes' :: [((Text, Text), Int)]
    includes' = (((Text, Text), BlackBox) -> ((Text, Text), Int))
    -> [((Text, Text), BlackBox)] -> [((Text, Text), Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\((Text, Text)
    nms, BlackBox
    bb) -> ((Text, Text)
    nms, BlackBox -> Int
    hashBlackbox BlackBox
    bb)) [((Text, Text), BlackBox)]
    includes
          hashBlackbox :: BlackBox -> Int
    hashBlackbox (BBTemplate BlackBoxTemplate
    bbTemplate) = BlackBoxTemplate -> Int
    forall a. Hashable a => a -> Int
    hash BlackBoxTemplate
    bbTemplate
          hashBlackbox (BBFunction BBName
    bbName Int
    bbHash TemplateFunction
    _bbFunc) = (BBName, Int) -> Int
    forall a. Hashable a => a -> Int
    hash (BBName
    bbName, Int
    bbHash)

    -- | Hash a compiled primitive map. It needs a separate function (as opposed to
    -- just 'hash') as it might contain (obviously unhashable) Haskell functions. This
    -- function takes the hash value stored with the function instead.
    hashCompiledPrimMap :: CompiledPrimMap -> Int
    hashCompiledPrimMap :: CompiledPrimMap -> Int
    hashCompiledPrimMap CompiledPrimMap
    cpm = [PrimitiveGuard Int] -> Int
    forall a. Hashable a => a -> Int
    hash ((PrimitiveGuard CompiledPrimitive -> PrimitiveGuard Int)
    -> [PrimitiveGuard CompiledPrimitive] -> [PrimitiveGuard Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CompiledPrimitive -> Int)
    -> PrimitiveGuard CompiledPrimitive -> PrimitiveGuard Int
    forall a b. (a -> b) -> PrimitiveGuard a -> PrimitiveGuard b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap CompiledPrimitive -> Int
    hashCompiledPrimitive) [PrimitiveGuard CompiledPrimitive]
    orderedValues)
      where
        -- TODO: switch to 'normal' map instead of hashmap?
        orderedKeys :: [Text]
    orderedKeys   = [Text] -> [Text]
    forall a. Ord a => [a] -> [a]
    sort (CompiledPrimMap -> [Text]
    forall k v. HashMap k v -> [k]
    HashMap.keys CompiledPrimMap
    cpm)
        orderedValues :: [PrimitiveGuard CompiledPrimitive]
    orderedValues = (Text -> PrimitiveGuard CompiledPrimitive)
    -> [Text] -> [PrimitiveGuard CompiledPrimitive]
    forall a b. (a -> b) -> [a] -> [b]
    map (CompiledPrimMap
    cpm CompiledPrimMap -> Text -> PrimitiveGuard CompiledPrimitive
    forall k v.
    (Eq k, Hashable k, HasCallStack) =>
    HashMap k v -> k -> v
    HashMapStrict.!) [Text]
    orderedKeys

    resolveTemplateSource
      :: HasCallStack
      => FilePath
      -> TemplateSource
      -> IO Text
    resolveTemplateSource :: HasCallStack => BBName -> TemplateSource -> IO Text
    resolveTemplateSource BBName
    _metaPath (TInline Text
    text) =
      Text -> IO Text
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Text
    text
    resolveTemplateSource BBName
    metaPath (TFile BBName
    path) =
      let path' :: BBName
    path' = BBName -> BBName -> BBName
    FilePath.replaceFileName BBName
    metaPath BBName
    path in
      (IOError -> Text) -> (Text -> Text) -> Either IOError Text -> Text
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (BBName -> Text
    forall a. HasCallStack => BBName -> a
    error (BBName -> Text) -> (IOError -> BBName) -> IOError -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOError -> BBName
    forall a. Show a => a -> BBName
    show) Text -> Text
    forall a. a -> a
    id (Either IOError Text -> Text)
    -> IO (Either IOError Text) -> IO Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO Text -> IO (Either IOError Text)
    forall a. IO a -> IO (Either IOError a)
    tryIOError (IO Text -> IO (Either IOError Text))
    -> IO Text -> IO (Either IOError Text)
    forall a b. (a -> b) -> a -> b
    $ BBName -> IO Text
    T.readFile BBName
    path')

    -- | Replace file pointers with file contents
    resolvePrimitive'
      :: HasCallStack
      => FilePath
      -> UnresolvedPrimitive
      -> IO (TS.Text, GuardedResolvedPrimitive)
    resolvePrimitive' :: HasCallStack =>
    BBName
    -> UnresolvedPrimitive -> IO (Text, GuardedResolvedPrimitive)
    resolvePrimitive' BBName
    _metaPath (Primitive Text
    name WorkInfo
    wf Text
    primType) =
      (Text, GuardedResolvedPrimitive)
    -> IO (Text, GuardedResolvedPrimitive)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Text
    name, [PrimitiveWarning] -> ResolvedPrimitive -> GuardedResolvedPrimitive
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox [] (Text -> WorkInfo -> Text -> ResolvedPrimitive
    forall a b c d. Text -> WorkInfo -> Text -> Primitive a b c d
    Primitive Text
    name WorkInfo
    wf Text
    primType))
    resolvePrimitive' BBName
    metaPath BlackBox{template :: forall a b c d. Primitive a b c d -> b
    template=((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    t, includes :: forall a b c d. Primitive a b c d -> [((Text, Text), b)]
    includes=[((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
    i, resultNames :: forall a b c d. Primitive a b c d -> [b]
    resultNames=[((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    r, resultInits :: forall a b c d. Primitive a b c d -> [b]
    resultInits=[((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    ri, Bool
    [(Int, Int)]
    [Text]
    Maybe Text
    Text
    WorkInfo
    Usage
    TemplateKind
    RenderVoid
    name :: forall a b c d. Primitive a b c d -> Text
    kind :: forall a b c d. Primitive a b c d -> TemplateKind
    outputUsage :: forall a b c d. Primitive a b c d -> Usage
    libraries :: forall a b c d. Primitive a b c d -> [a]
    imports :: forall a b c d. Primitive a b c d -> [a]
    name :: Text
    workInfo :: WorkInfo
    renderVoid :: RenderVoid
    multiResult :: Bool
    kind :: TemplateKind
    warning :: Maybe Text
    outputUsage :: Usage
    libraries :: [Text]
    imports :: [Text]
    functionPlurality :: [(Int, Int)]
    functionPlurality :: forall a b c d. Primitive a b c d -> [(Int, Int)]
    warning :: forall a b c d. Primitive a b c d -> c
    multiResult :: forall a b c d. Primitive a b c d -> Bool
    renderVoid :: forall a b c d. Primitive a b c d -> RenderVoid
    workInfo :: forall a b c d. Primitive a b c d -> WorkInfo
    ..} = do
      let resolveSourceM :: ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    resolveSourceM = (Maybe TemplateSource -> IO (Maybe Text))
    -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b)
    -> ((TemplateFormat, BlackBoxFunctionName), a)
    -> f ((TemplateFormat, BlackBoxFunctionName), b)
    traverse ((TemplateSource -> IO Text)
    -> Maybe TemplateSource -> IO (Maybe Text)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse (HasCallStack => BBName -> TemplateSource -> IO Text
    BBName -> TemplateSource -> IO Text
    resolveTemplateSource BBName
    metaPath))
      bb <- Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> ()
    -> Usage
    -> [Text]
    -> [Text]
    -> [(Int, Int)]
    -> [((Text, Text),
         ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    -> ResolvedPrimitive
    forall a b c d.
    Text
    -> WorkInfo
    -> RenderVoid
    -> Bool
    -> TemplateKind
    -> c
    -> Usage
    -> [a]
    -> [a]
    -> [(Int, Int)]
    -> [((Text, Text), b)]
    -> [b]
    -> [b]
    -> b
    -> Primitive a b c d
    BlackBox Text
    name WorkInfo
    workInfo RenderVoid
    renderVoid Bool
    multiResult TemplateKind
    kind () Usage
    outputUsage [Text]
    libraries [Text]
    imports [(Int, Int)]
    functionPlurality
              ([((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
     -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
     -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
     -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
     -> ResolvedPrimitive)
    -> IO
         [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    -> IO
         ([((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
          -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
          -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
          -> ResolvedPrimitive)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
     -> IO
          ((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe Text)))
    -> [((Text, Text),
         ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
    -> IO
         [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe Text))]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM ((((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
     -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
    -> ((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
    -> IO
         ((Text, Text),
          ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> ((Text, Text), a) -> f ((Text, Text), b)
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    resolveSourceM) [((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
    i
              IO
      ([((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
       -> [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
       -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
       -> ResolvedPrimitive)
    -> IO [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> IO
         ([((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
          -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
          -> ResolvedPrimitive)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
     -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    -> IO [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    resolveSourceM [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    r
              IO
      ([((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
       -> ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
       -> ResolvedPrimitive)
    -> IO [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    -> IO
         (((TemplateFormat, BlackBoxFunctionName), Maybe Text)
          -> ResolvedPrimitive)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
     -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text))
    -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    -> IO [((TemplateFormat, BlackBoxFunctionName), Maybe Text)]
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    resolveSourceM [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
    ri
              IO
      (((TemplateFormat, BlackBoxFunctionName), Maybe Text)
       -> ResolvedPrimitive)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    -> IO ResolvedPrimitive
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> IO ((TemplateFormat, BlackBoxFunctionName), Maybe Text)
    resolveSourceM ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    t
      case warning of
        Just Text
    w  -> (Text, GuardedResolvedPrimitive)
    -> IO (Text, GuardedResolvedPrimitive)
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Text
    name, [PrimitiveWarning] -> ResolvedPrimitive -> GuardedResolvedPrimitive
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox [BBName -> PrimitiveWarning
    WarnNonSynthesizable (Text -> BBName
    TS.unpack Text
    w)] ResolvedPrimitive
    bb)
        Maybe Text
    Nothing -> (Text, GuardedResolvedPrimitive)
    -> IO (Text, GuardedResolvedPrimitive)
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Text
    name, [PrimitiveWarning] -> ResolvedPrimitive -> GuardedResolvedPrimitive
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox [] ResolvedPrimitive
    bb)
    resolvePrimitive' BBName
    metaPath (BlackBoxHaskell Text
    bbName WorkInfo
    wf UsedArguments
    usedArgs Bool
    multiRes BlackBoxFunctionName
    funcName Maybe TemplateSource
    t) =
      (Text
    bbName,) (GuardedResolvedPrimitive -> (Text, GuardedResolvedPrimitive))
    -> (Maybe Text -> GuardedResolvedPrimitive)
    -> Maybe Text
    -> (Text, GuardedResolvedPrimitive)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [PrimitiveWarning] -> ResolvedPrimitive -> GuardedResolvedPrimitive
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox [] (ResolvedPrimitive -> GuardedResolvedPrimitive)
    -> (Maybe Text -> ResolvedPrimitive)
    -> Maybe Text
    -> GuardedResolvedPrimitive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text
    -> WorkInfo
    -> UsedArguments
    -> Bool
    -> BlackBoxFunctionName
    -> Maybe Text
    -> ResolvedPrimitive
    forall a b c d.
    Text
    -> WorkInfo
    -> UsedArguments
    -> Bool
    -> BlackBoxFunctionName
    -> d
    -> Primitive a b c d
    BlackBoxHaskell Text
    bbName WorkInfo
    wf UsedArguments
    usedArgs Bool
    multiRes BlackBoxFunctionName
    funcName (Maybe Text -> (Text, GuardedResolvedPrimitive))
    -> IO (Maybe Text) -> IO (Text, GuardedResolvedPrimitive)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        ((TemplateSource -> IO Text)
    -> Maybe TemplateSource -> IO (Maybe Text)
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM (HasCallStack => BBName -> TemplateSource -> IO Text
    BBName -> TemplateSource -> IO Text
    resolveTemplateSource BBName
    metaPath) Maybe TemplateSource
    t)

    -- | Interprets contents of json file as list of @Primitive@s. Throws
    -- exception if it fails.
    resolvePrimitive
      :: HasCallStack
      => FilePath
      -> IO [(TS.Text, GuardedResolvedPrimitive)]
    resolvePrimitive :: HasCallStack => BBName -> IO [(Text, GuardedResolvedPrimitive)]
    resolvePrimitive BBName
    fileName = do
      prims <- BBName -> ByteString -> [UnresolvedPrimitive]
    decoder BBName
    fileName (ByteString -> [UnresolvedPrimitive])
    -> IO ByteString -> IO [UnresolvedPrimitive]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> BBName -> IO ByteString
    LZ.readFile BBName
    fileName
      mapM (resolvePrimitive' fileName) prims
     where
      decoder :: BBName -> ByteString -> [UnresolvedPrimitive]
    decoder
       | BBName
    ".primitives.yaml" BBName -> BBName -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` BBName
    fileName = BBName -> ByteString -> [UnresolvedPrimitive]
    forall a. (HasCallStack, FromJSON a) => BBName -> ByteString -> a
    decodeOrErrYaml
       | BBName
    ".primitives" BBName -> BBName -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` BBName
    fileName = BBName -> ByteString -> [UnresolvedPrimitive]
    forall a. (HasCallStack, FromJSON a) => BBName -> ByteString -> a
    decodeOrErrJson
       | Bool
    otherwise = BBName -> BBName -> ByteString -> [UnresolvedPrimitive]
    forall a. HasCallStack => BBName -> a
    error (BBName
    "Unexpected filename extension in: " BBName -> BBName -> BBName
    forall a. Semigroup a => a -> a -> a
    <> BBName
    fileName)

    addGuards
      :: ResolvedPrimMap
      -> [(TS.Text, PrimitiveGuard ())]
      -> ResolvedPrimMap
    addGuards :: ResolvedPrimMap -> [(Text, PrimitiveGuard ())] -> ResolvedPrimMap
    addGuards = (ResolvedPrimMap -> (Text, PrimitiveGuard ()) -> ResolvedPrimMap)
    -> ResolvedPrimMap
    -> [(Text, PrimitiveGuard ())]
    -> ResolvedPrimMap
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ResolvedPrimMap -> (Text, PrimitiveGuard ()) -> ResolvedPrimMap
    go
     where
      lookupPrim
        :: TS.Text
        -> ResolvedPrimMap
        -> Maybe ([PrimitiveWarning], ResolvedPrimitive)
      lookupPrim :: Text
    -> ResolvedPrimMap -> Maybe ([PrimitiveWarning], ResolvedPrimitive)
    lookupPrim Text
    nm ResolvedPrimMap
    primMap = do
        guardedPrim <- Text -> ResolvedPrimMap -> Maybe GuardedResolvedPrimitive
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HashMapStrict.lookup Text
    nm ResolvedPrimMap
    primMap
        prim <- extractPrim guardedPrim
        return (extractWarnings guardedPrim, prim)

      go :: ResolvedPrimMap -> (Text, PrimitiveGuard ()) -> ResolvedPrimMap
    go ResolvedPrimMap
    primMap (Text
    nm, PrimitiveGuard ()
    guard) =
        Text
    -> GuardedResolvedPrimitive -> ResolvedPrimMap -> ResolvedPrimMap
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    HashMapStrict.insert
          Text
    nm
          (case (Text
    -> ResolvedPrimMap -> Maybe ([PrimitiveWarning], ResolvedPrimitive)
    lookupPrim Text
    nm ResolvedPrimMap
    primMap, PrimitiveGuard ()
    guard) of
            (Maybe ([PrimitiveWarning], ResolvedPrimitive)
    Nothing, PrimitiveGuard ()
    DontTranslate) -> GuardedResolvedPrimitive
    forall a. PrimitiveGuard a
    DontTranslate
            (Maybe ([PrimitiveWarning], ResolvedPrimitive)
    Nothing, HasBlackBox [PrimitiveWarning]
    _ ()) ->
              BBName -> GuardedResolvedPrimitive
    forall a. HasCallStack => BBName -> a
    error (BBName -> GuardedResolvedPrimitive)
    -> BBName -> GuardedResolvedPrimitive
    forall a b. (a -> b) -> a -> b
    $ BBName
    "No BlackBox definition for '" BBName -> BBName -> BBName
    forall a. [a] -> [a] -> [a]
    ++ Text -> BBName
    TS.unpack Text
    nm BBName -> BBName -> BBName
    forall a. [a] -> [a] -> [a]
    ++ BBName
    "' even"
                   BBName -> BBName -> BBName
    forall a. [a] -> [a] -> [a]
    ++ BBName
    " though this value was annotated with 'HasBlackBox'."
            (Just ([PrimitiveWarning], ResolvedPrimitive)
    _, PrimitiveGuard ()
    DontTranslate) ->
              BBName -> GuardedResolvedPrimitive
    forall a. HasCallStack => BBName -> a
    error (Text -> BBName
    TS.unpack Text
    nm BBName -> BBName -> BBName
    forall a. [a] -> [a] -> [a]
    ++ BBName
    " was annotated with DontTranslate, but a "
                                  BBName -> BBName -> BBName
    forall a. [a] -> [a] -> [a]
    ++ BBName
    "BlackBox definition was found anyway.")
            (Just ([PrimitiveWarning]
    ws1, ResolvedPrimitive
    p), HasBlackBox [PrimitiveWarning]
    ws2 ()) ->
              [PrimitiveWarning] -> ResolvedPrimitive -> GuardedResolvedPrimitive
    forall a. [PrimitiveWarning] -> a -> PrimitiveGuard a
    HasBlackBox ([PrimitiveWarning]
    ws1 [PrimitiveWarning] -> [PrimitiveWarning] -> [PrimitiveWarning]
    forall a. [a] -> [a] -> [a]
    ++ [PrimitiveWarning]
    ws2) ResolvedPrimitive
    p
          )
          ResolvedPrimMap
    primMap

    -- | Generate a set of primitives that are found in the primitive definition
    -- files in the given directories.
    generatePrimMap
      :: HasCallStack
      => [UnresolvedPrimitive]
      -- ^ unresolved primitives found in annotations (in LoadModules and
      -- LoadInterfaceFiles)
      -> [(TS.Text, PrimitiveGuard ())]
      -- ^ Primitive guards found in annotations
      -> [FilePath]
      -- ^ Directories to search for primitive definitions
      -> IO ResolvedPrimMap
    generatePrimMap :: HasCallStack =>
    [UnresolvedPrimitive]
    -> [(Text, PrimitiveGuard ())] -> [BBName] -> IO ResolvedPrimMap
    generatePrimMap [UnresolvedPrimitive]
    unresolvedPrims [(Text, PrimitiveGuard ())]
    primGuards [BBName]
    filePaths = do
      primitiveFiles <- ([[BBName]] -> [BBName]) -> IO [[BBName]] -> IO [BBName]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[BBName]] -> [BBName]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat (IO [[BBName]] -> IO [BBName]) -> IO [[BBName]] -> IO [BBName]
    forall a b. (a -> b) -> a -> b
    $ [BBName] -> (BBName -> IO [BBName]) -> IO [[BBName]]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [BBName]
    filePaths ((BBName -> IO [BBName]) -> IO [[BBName]])
    -> (BBName -> IO [BBName]) -> IO [[BBName]]
    forall a b. (a -> b) -> a -> b
    $ \BBName
    filePath -> do
        fpExists <- BBName -> IO Bool
    Directory.doesDirectoryExist BBName
    filePath
        if fpExists then do
          contents <- Directory.getDirectoryContents filePath
          let
            jsonPrims = (BBName -> Bool) -> [BBName] -> [BBName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BBName
    ".primitives" BBName -> BBName -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf`) [BBName]
    contents
            yamlPrims = (BBName -> Bool) -> [BBName] -> [BBName]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BBName
    ".primitives.yaml" BBName -> BBName -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf`) [BBName]
    contents
            relPrims = [BBName]
    jsonPrims [BBName] -> [BBName] -> [BBName]
    forall a. Semigroup a => a -> a -> a
    <> [BBName]
    yamlPrims
            absPrims = (BBName -> BBName) -> [BBName] -> [BBName]
    forall a b. (a -> b) -> [a] -> [b]
    map (BBName -> BBName -> BBName
    FilePath.combine BBName
    filePath) [BBName]
    relPrims
          return absPrims
        else
          return []

      primitives0 <- concat <$> mapM resolvePrimitive primitiveFiles
      let metapaths = (UnresolvedPrimitive -> BBName)
    -> [UnresolvedPrimitive] -> [BBName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> BBName
    TS.unpack (Text -> BBName)
    -> (UnresolvedPrimitive -> Text) -> UnresolvedPrimitive -> BBName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnresolvedPrimitive -> Text
    forall a b c d. Primitive a b c d -> Text
    name) [UnresolvedPrimitive]
    unresolvedPrims
      primitives1 <- sequence $ zipWith resolvePrimitive' metapaths unresolvedPrims
      let primMap = [(Text, GuardedResolvedPrimitive)] -> ResolvedPrimMap
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([(Text, GuardedResolvedPrimitive)]
    primitives0 [(Text, GuardedResolvedPrimitive)]
    -> [(Text, GuardedResolvedPrimitive)]
    -> [(Text, GuardedResolvedPrimitive)]
    forall a. [a] -> [a] -> [a]
    ++ [(Text, GuardedResolvedPrimitive)]
    primitives1)
      return (force (addGuards primMap primGuards))
    {-# SCC generatePrimMap #-}

    -- | Determine what argument should be constant / literal
    constantArgs :: TS.Text -> CompiledPrimitive -> Set.Set Int
    constantArgs :: Text -> CompiledPrimitive -> Set Int
    constantArgs Text
    nm BlackBox {template :: forall a b c d. Primitive a b c d -> b
    template = templ :: BlackBox
    templ@(BBTemplate BlackBoxTemplate
    _), resultInits :: forall a b c d. Primitive a b c d -> [b]
    resultInits = [BlackBox]
    tRIM} =
      [Int] -> Set Int
    forall a. Ord a => [a] -> Set a
    Set.fromList ([[Int]] -> [Int]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ [Int]
    fromIntForce
                           , (BlackBox -> [Int]) -> [BlackBox] -> [Int]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap BlackBox -> [Int]
    walkTemplate [BlackBox]
    tRIM
                           , BlackBox -> [Int]
    walkTemplate BlackBox
    templ
                           ])
     where
      walkTemplate :: BlackBox -> [Int]
    walkTemplate (BBTemplate BlackBoxTemplate
    t) = (Element -> [Int]) -> BlackBoxTemplate -> [Int]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap ((Element -> Maybe Int) -> Element -> [Int]
    forall a. (Element -> Maybe a) -> Element -> [a]
    walkElement Element -> Maybe Int
    getConstant) BlackBoxTemplate
    t
      walkTemplate BlackBox
    _ = []

      getConstant :: Element -> Maybe Int
    getConstant (Lit Int
    i)      = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    i
      getConstant (Const Int
    i)    = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    i
      getConstant Element
    _            = Maybe Int
    forall a. Maybe a
    Nothing

      -- Ensure that if the 'Integer' arguments are constants, that they are reduced
      -- to literals, so that the builtin rules can properly fire.
      --
      -- Only in the the case that 'Integer' arguments are truly variables should
      -- the blackbox rules fire.
      fromIntForce :: [Int]
    fromIntForce
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Internal.BitVector.fromInteger#"  = [Int
    2]
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Internal.BitVector.fromInteger##" = [Int
    0,Int
    1]
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Internal.Index.fromInteger#"      = [Int
    1]
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Internal.Signed.fromInteger#"     = [Int
    1]
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Internal.Unsigned.fromInteger#"   = [Int
    1]

        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Vector.replace_int"               = [Int
    1,Int
    2]
        | Bool
    otherwise = []
    constantArgs Text
    nm (BlackBoxHaskell{}) = [Int] -> Set Int
    forall a. Ord a => [a] -> Set a
    Set.fromList [Int]
    fromIntForce
     where
        -- There is a special code-path for `index_int` in the Verilog backend in
        -- case the index is a constant. But this code path only works when the
        -- vector is (a projection of) a variable. By forcing the arguments of
        -- index_int we can be sure that arguments are either:
        --
        -- Constant Variable
        -- Variable Constant
        -- Variable Variable
        --
        -- As all other cases would be reduced by the evaluator, and even expensive
        -- primitives under index_int are fully unrolled.
      fromIntForce :: [Int]
    fromIntForce
        | Text
    nm Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Clash.Sized.Vector.index_int"                 = [Int
    2]
        | Bool
    otherwise = []
    constantArgs Text
    _ CompiledPrimitive
    _ = Set Int
    forall a. Set a
    Set.empty

    -- | Helper function of 'getFunctionPlurality'
    getFunctionPlurality' :: [(Int, Int)] -> Int -> Int
    getFunctionPlurality' :: [(Int, Int)] -> Int -> Int
    getFunctionPlurality' [(Int, Int)]
    functionPlurality Int
    n =
      Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    1 ((Int, Int) -> Int
    forall a b. (a, b) -> b
    snd ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (((Int, Int) -> Bool) -> [(Int, Int)] -> Maybe (Int, Int)
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Maybe a
    find ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, Int)]
    functionPlurality))

    -- | Looks up the plurality of a function's function argument. See
    -- 'functionPlurality' for more information. If not set, the returned plurality
    -- will default to /1/.
    getFunctionPlurality
      :: HasCallStack
      => CompiledPrimitive
      -> [Either Term Type]
      -- ^ Arguments passed to blackbox
      -> [Type]
      -- ^ Result types
      -> Int
      -- ^ Argument number holding the function of interest
      -> NetlistMonad Int
      -- ^ Plurality of function. Defaults to 1. Does not err if argument isn't
      -- a function in the first place. State of monad will not be modified.
    getFunctionPlurality :: HasCallStack =>
    CompiledPrimitive
    -> [Either Term Type] -> [Type] -> Int -> NetlistMonad Int
    getFunctionPlurality (Primitive {}) [Either Term Type]
    _args [Type]
    _resTys Int
    _n = Int -> NetlistMonad Int
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Int
    1
    getFunctionPlurality (BlackBoxHaskell {Text
    name :: forall a b c d. Primitive a b c d -> Text
    name :: Text
    name, (Int, BlackBoxFunction)
    function :: forall a b c d. Primitive a b c d -> d
    function :: (Int, BlackBoxFunction)
    function, BlackBoxFunctionName
    functionName :: BlackBoxFunctionName
    functionName :: forall a b c d. Primitive a b c d -> BlackBoxFunctionName
    functionName}) [Either Term Type]
    args [Type]
    resTys Int
    n = do
      errOrMeta <- NetlistMonad (Either BBName (BlackBoxMeta, BlackBox))
    -> NetlistMonad (Either BBName (BlackBoxMeta, BlackBox))
    forall a. NetlistMonad a -> NetlistMonad a
    preserveState (((Int, BlackBoxFunction) -> BlackBoxFunction
    forall a b. (a, b) -> b
    snd (Int, BlackBoxFunction)
    function) Bool
    False Text
    name [Either Term Type]
    args [Type]
    resTys)
      case errOrMeta of
        Left BBName
    err ->
          BBName -> NetlistMonad Int
    forall a. HasCallStack => BBName -> a
    error (BBName -> NetlistMonad Int) -> BBName -> NetlistMonad Int
    forall a b. (a -> b) -> a -> b
    $ [BBName] -> BBName
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ BBName
    "Tried to determine function plurality for "
                         , Text -> BBName
    TS.unpack Text
    name, BBName
    " by quering ", BlackBoxFunctionName -> BBName
    forall a. Show a => a -> BBName
    show BlackBoxFunctionName
    functionName
                         , BBName
    ". Function returned an error message instead:\n\n"
                         , BBName
    err ]
        Right (BlackBoxMeta {[(Int, Int)]
    bbFunctionPlurality :: [(Int, Int)]
    bbFunctionPlurality :: BlackBoxMeta -> [(Int, Int)]
    bbFunctionPlurality}, BlackBox
    _bb) ->
          Int -> NetlistMonad Int
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([(Int, Int)] -> Int -> Int
    getFunctionPlurality' [(Int, Int)]
    bbFunctionPlurality Int
    n)
    getFunctionPlurality (BlackBox {[(Int, Int)]
    functionPlurality :: forall a b c d. Primitive a b c d -> [(Int, Int)]
    functionPlurality :: [(Int, Int)]
    functionPlurality}) [Either Term Type]
    _args [Type]
    _resTy Int
    n =
      Int -> NetlistMonad Int
    forall a. a -> NetlistMonad a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([(Int, Int)] -> Int -> Int
    getFunctionPlurality' [(Int, Int)]
    functionPlurality Int
    n)