content: {-|
    Copyright  :  (C) 2020, QBayLogic B.V.
                      2022, Google Inc.
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
  
    Transform/format a Netlist Identifier so that it is acceptable as a HDL identifier
  -}
  
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Clash.Netlist.Id
    ( -- * Utilities to use IdentifierSet
      IdentifierSet
    , IdentifierSetMonad(..)
    , HasIdentifierSet(..)
    , emptyIdentifierSet
    , makeSet
    , clearSet
  
      -- * Unsafe creation and extracting identifiers
    , Identifier
    , IdentifierType (..)
    , unsafeMake
    , unsafeFromCoreId
    , toText
    , toLazyText
    , toList
    , union
  
      -- * Creating and extending identifiers
    , make
    , makeBasic
    , makeBasicOr
    , makeAs
    , add
    , addMultiple
    , addRaw
    , deepen
    , deepenN
    , next
    , nextN
    , prefix
    , suffix
    , fromCoreId
  
    -- * Misc. and internals
    , VHDL.stripDollarPrefixes
    , toBasicId#
    , isBasic#
    , isExtended#
    )
  where
  
  import           Clash.Annotations.Primitive (HDL (..))
  import           Clash.Core.Name (nameOcc)
  import           Clash.Core.Var (Id, varName)
  import           Clash.Debug (debugIsOn)
  import           Clash.Netlist.Types
    (PreserveCase(..), HasIdentifierSet(..), IdentifierSet(..), Identifier(..),
     IdentifierType(..), IdentifierSetMonad(identifierSetM))
  import qualified Data.HashSet as HashSet
  import qualified Data.HashMap.Strict as HashMap
  import qualified Data.IntMap.Strict as IntMap
  import qualified Data.List as List
  import           Data.Text (Text)
  import qualified Data.Text.Lazy as LT
  import           GHC.Stack
  
  import qualified Clash.Netlist.Id.VHDL as VHDL
  import           Clash.Netlist.Id.Internal
  
  -- | Identifier set without identifiers
  emptyIdentifierSet
    :: Bool
    -- ^ Allow escaped identifiers?
    -> PreserveCase
    -- ^ Should all basic identifiers be lower case?
    -> HDL
    -- ^ HDL to generate names for
    -> IdentifierSet
  emptyIdentifierSet esc lw hdl = makeSet esc lw hdl mempty
  
  -- | Union of two identifier sets. Errors if given sets have been made with
  -- different options enabled.
  union :: HasCallStack => IdentifierSet -> IdentifierSet -> IdentifierSet
  union (IdentifierSet escL lwL hdlL freshL idsL) (IdentifierSet escR lwR hdlR freshR idsR)
    | escL /= escR = error $ "Internal error: escL /= escR, " <> show (escL, escR)
    | hdlL /= hdlR = error $ "Internal error: hdlL /= hdlR, " <> show (hdlL, hdlR)
    | lwL /= lwR = error $ "Internal error: lwL /= lwR , " <> show (lwL, lwR)
    | otherwise = IdentifierSet escR lwR hdlR fresh ids
   where
    fresh = HashMap.unionWith (IntMap.unionWith max) freshL freshR
    ids = HashSet.union idsL idsR
  
  -- | Make a identifier set filled with given identifiers
  makeSet
    :: Bool
    -- ^ Allow escaped identifiers?
    -> PreserveCase
    -- ^ Should all basic identifiers be lower case?
    -> HDL
    -- ^ HDL to generate names for
    -> HashSet.HashSet Identifier
    -- ^ Identifiers to add to set
    -> IdentifierSet
  makeSet esc lw hdl ids = IdentifierSet esc lw hdl fresh ids
   where
    fresh = List.foldl' updateFreshCache# mempty ids
  
  -- | Remove all identifiers from a set
  clearSet :: IdentifierSet -> IdentifierSet
  clearSet (IdentifierSet escL lwL hdlL _ _) =
    IdentifierSet escL lwL hdlL mempty mempty
  
  toList :: IdentifierSet -> [Identifier]
  toList (IdentifierSet _ _ _ _ idStore) = HashSet.toList idStore
  
  -- | Convert an identifier to string
  toText :: Identifier -> Text
  toText = toText#
  
  -- | Convert an identifier to string
  toLazyText :: Identifier -> LT.Text
  toLazyText = LT.fromStrict . toText
  
  -- | Helper function to define pure Id functions in terms of a IdentifierSetMonad
  withIdentifierSetM'
    :: IdentifierSetMonad m
    => (IdentifierSet -> a -> IdentifierSet)
    -> a
    -> m ()
  withIdentifierSetM' f a = do
    is0 <- identifierSetM id
    identifierSetM (const (f is0 a)) >> pure ()
  
  -- | Helper function to define pure Id functions in terms of a IdentifierSetMonad
  withIdentifierSetM
    :: IdentifierSetMonad m
    => (IdentifierSet -> a -> (IdentifierSet, b))
    -> a
    -> m b
  withIdentifierSetM f a = do
    is0 <- identifierSetM id
    let (is1, b) = f is0 a
    _ <- identifierSetM (const is1)
    pure b
  
  -- | Like 'addRaw', 'unsafeMake' creates an identifier that will be spliced
  -- at verbatim in the HDL. As opposed to 'addRaw', the resulting Identifier
  -- might be generated at a later point as it is NOT added to an IdentifierSet.
  unsafeMake :: HasCallStack => Text -> Identifier
  unsafeMake t =
    RawIdentifier t Nothing (if debugIsOn then callStack else emptyCallStack)
  
  -- | Add an identifier to an IdentifierSet
  add :: HasCallStack => IdentifierSetMonad m => Identifier -> m ()
  add = withIdentifierSetM' add#
  
  -- | Add identifiers to an IdentifierSet
  addMultiple :: (HasCallStack, IdentifierSetMonad m, Foldable t) => t Identifier -> m ()
  addMultiple = withIdentifierSetM' addMultiple#
  
  -- | Add a string as is to an IdentifierSet. Should only be used for identifiers
  -- that should be spliced at verbatim in HDL, such as port names. It's sanitized
  -- version will still be added to the identifier set, to prevent freshly
  -- generated variables clashing with the raw one.
  addRaw :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier
  addRaw = withIdentifierSetM addRaw#
  
  -- | Make unique identifier based on given string
  make :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier
  make = withIdentifierSetM make#
  
  -- | Make unique basic identifier based on given string
  makeBasic :: (HasCallStack, IdentifierSetMonad m) => Text -> m Identifier
  makeBasic = withIdentifierSetM makeBasic#
  
  -- | Make unique basic identifier based on given string. If given string can't
  -- be converted to a basic identifier (i.e., it would yield an empty string) the
  -- alternative name is used.
  makeBasicOr
    :: (HasCallStack, IdentifierSetMonad m)
    => Text
    -- ^ Name hint
    -> Text
    -- ^ If name hint can't be converted to a sensible basic id, use this instead
    -> m Identifier
  makeBasicOr hint altHint =
    withIdentifierSetM
      (\is0 -> uncurry (makeBasicOr# is0))
      (hint, altHint)
  
  -- | Make unique identifier. Uses 'makeBasic' if first argument is 'Basic'
  makeAs :: (HasCallStack, IdentifierSetMonad m) => IdentifierType -> Text -> m Identifier
  makeAs Basic = makeBasic
  makeAs Extended = make
  
  -- | Given identifier "foo_1_2" return "foo_1_3". If "foo_1_3" is already a
  -- member of the given set, return "foo_1_4" instead, etc. Identifier returned
  -- is guaranteed to be unique.
  next :: (HasCallStack, IdentifierSetMonad m) => Identifier -> m Identifier
  next = withIdentifierSetM next#
  
  -- | Same as 'nextM', but returns N fresh identifiers
  nextN :: (HasCallStack, IdentifierSetMonad m) => Int -> Identifier -> m [Identifier]
  nextN n = withIdentifierSetM (nextN# n)
  
  -- | Given identifier "foo_1_2" return "foo_1_2_0". If "foo_1_2_0" is already a
  -- member of the given set, return "foo_1_2_1" instead, etc. Identifier returned
  -- is guaranteed to be unique.
  deepen :: (HasCallStack, IdentifierSetMonad m) => Identifier -> m Identifier
  deepen = withIdentifierSetM deepen#
  
  -- | Same as 'deepenM', but returns N fresh identifiers. For example, given
  -- "foo_23" is would return "foo_23_0", "foo_23_1", ...
  deepenN :: (HasCallStack, IdentifierSetMonad m) => Int -> Identifier -> m [Identifier]
  deepenN n = withIdentifierSetM (deepenN# n)
  
  -- | Given identifier "foo_1_2" and a suffix "bar", return an identifier called
  -- "foo_bar". Identifier returned is guaranteed to be unique according to the
  -- rules of 'nextIdentifier'.
  suffix :: (HasCallStack, IdentifierSetMonad m) => Identifier -> Text -> m Identifier
  suffix id0 suffix_ = withIdentifierSetM (\is id1 -> suffix# is id1 suffix_) id0
  
  -- | Given identifier "foo_1_2" and a prefix "bar", return an identifier called
  -- "bar_foo". Identifier returned is guaranteed to be unique according to the
  -- rules of 'nextIdentifier'.
  prefix :: (HasCallStack, IdentifierSetMonad m) => Identifier -> Text -> m Identifier
  prefix id0 prefix_ = withIdentifierSetM (\is id1 -> prefix# is id1 prefix_) id0
  
  -- | Convert a Clash Core Id to an identifier. Makes sure returned identifier
  -- is unique.
  fromCoreId :: (HasCallStack, IdentifierSetMonad m) => Id -> m Identifier
  fromCoreId = withIdentifierSetM fromCoreId#
  
  -- | Like 'fromCoreId, 'unsafeFromCoreId' creates an identifier that will be
  -- spliced at verbatim in the HDL. As opposed to 'fromCoreId', the resulting
  -- Identifier might be generated at a later point as it is NOT added to an
  -- IdentifierSet.
  unsafeFromCoreId :: HasCallStack => Id -> Identifier
  unsafeFromCoreId = unsafeMake . nameOcc . varName
  