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

  Type definitions used by the Driver module
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Clash.Driver.Types where

-- For Int/Word size
#include "MachDeps.h"

import           Control.DeepSeq                (NFData(rnf), deepseq)
import           Data.Binary                    (Binary)
import           Data.Fixed
import           Data.Hashable
import           Data.HashMap.Strict            (HashMap)
import           Data.IntMap.Strict             (IntMap)
import           Data.Maybe                     (isJust)
import           Data.Set                       (Set)
import qualified Data.Set                       as Set
import           Data.Text                      (Text)
import qualified Data.Text as Text              (dropAround)

#if MIN_VERSION_prettyprinter(1,7,0)
import           Prettyprinter
#else
import           Data.Text.Prettyprint.Doc
#endif

import           GHC.Generics                   (Generic)

#if MIN_VERSION_ghc(9,4,0)
import           GHC.Types.Basic                (InlineSpec)
import           GHC.Types.SrcLoc               (SrcSpan)
#elif MIN_VERSION_ghc(9,0,0)
import           GHC.Types.Basic                (InlineSpec)
import           GHC.Types.SrcLoc               (SrcSpan)
#else
import           BasicTypes                     (InlineSpec)
import           SrcLoc                         (SrcSpan)
#endif

import           Clash.Annotations.BitRepresentation.Internal (CustomReprs)
import           Clash.Signal.Internal

import           Clash.Backend.Verilog.Time     (Period(..), Unit(Fs))
import           Clash.Core.Pretty              (unsafeLookupEnvBool)
import           Clash.Core.Term                (Term)
import           Clash.Core.TyCon               (TyConMap, TyConName)
import           Clash.Core.Var                 (Id)
import           Clash.Core.VarEnv              (VarEnv)
import           Clash.Driver.Bool              (OverridingBool(..))
import           Clash.Netlist.BlackBox.Types   (HdlSyn (..))
import {-# SOURCE #-} Clash.Netlist.Types       (PreserveCase(..), TopEntityT)
import           Clash.Primitives.Types         (CompiledPrimMap)

data ClashEnv = ClashEnv
  { ClashEnv -> ClashOpts
envOpts        :: ClashOpts
  , ClashEnv -> TyConMap
envTyConMap    :: TyConMap
  , ClashEnv -> IntMap TyConName
envTupleTyCons :: IntMap TyConName
  , ClashEnv -> CompiledPrimMap
envPrimitives  :: CompiledPrimMap
  , ClashEnv -> CustomReprs
envCustomReprs :: CustomReprs
  , ClashEnv -> DomainMap
envDomains     :: DomainMap
  } deriving ((forall x. ClashEnv -> Rep ClashEnv x)
-> (forall x. Rep ClashEnv x -> ClashEnv) -> Generic ClashEnv
forall x. Rep ClashEnv x -> ClashEnv
forall x. ClashEnv -> Rep ClashEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClashEnv x -> ClashEnv
$cfrom :: forall x. ClashEnv -> Rep ClashEnv x
Generic, ClashEnv -> ()
(ClashEnv -> ()) -> NFData ClashEnv
forall a. (a -> ()) -> NFData a
rnf :: ClashEnv -> ()
$crnf :: ClashEnv -> ()
NFData)

data ClashDesign = ClashDesign
  { ClashDesign -> [TopEntityT]
designEntities :: [TopEntityT]
  , ClashDesign -> BindingMap
designBindings :: BindingMap
  }

instance NFData ClashDesign where
  rnf :: ClashDesign -> ()
rnf ClashDesign
design =
    ClashDesign -> [TopEntityT]
designEntities ClashDesign
design [TopEntityT] -> () -> ()
`seq`
    ClashDesign -> BindingMap
designBindings ClashDesign
design BindingMap -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
    ()

data IsPrim
  = IsPrim
    -- ^ The binding is the unfolding for a primitive.
  | IsFun
    -- ^ The binding is an ordinary function.
  deriving (Get IsPrim
[IsPrim] -> Put
IsPrim -> Put
(IsPrim -> Put) -> Get IsPrim -> ([IsPrim] -> Put) -> Binary IsPrim
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [IsPrim] -> Put
$cputList :: [IsPrim] -> Put
get :: Get IsPrim
$cget :: Get IsPrim
put :: IsPrim -> Put
$cput :: IsPrim -> Put
Binary, IsPrim -> IsPrim -> Bool
(IsPrim -> IsPrim -> Bool)
-> (IsPrim -> IsPrim -> Bool) -> Eq IsPrim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsPrim -> IsPrim -> Bool
$c/= :: IsPrim -> IsPrim -> Bool
== :: IsPrim -> IsPrim -> Bool
$c== :: IsPrim -> IsPrim -> Bool
Eq, (forall x. IsPrim -> Rep IsPrim x)
-> (forall x. Rep IsPrim x -> IsPrim) -> Generic IsPrim
forall x. Rep IsPrim x -> IsPrim
forall x. IsPrim -> Rep IsPrim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsPrim x -> IsPrim
$cfrom :: forall x. IsPrim -> Rep IsPrim x
Generic, IsPrim -> ()
(IsPrim -> ()) -> NFData IsPrim
forall a. (a -> ()) -> NFData a
rnf :: IsPrim -> ()
$crnf :: IsPrim -> ()
NFData, Int -> IsPrim -> ShowS
[IsPrim] -> ShowS
IsPrim -> String
(Int -> IsPrim -> ShowS)
-> (IsPrim -> String) -> ([IsPrim] -> ShowS) -> Show IsPrim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsPrim] -> ShowS
$cshowList :: [IsPrim] -> ShowS
show :: IsPrim -> String
$cshow :: IsPrim -> String
showsPrec :: Int -> IsPrim -> ShowS
$cshowsPrec :: Int -> IsPrim -> ShowS
Show)

-- A function binder in the global environment.
--
data Binding a = Binding
  { Binding a -> Id
bindingId :: Id
    -- ^ The core identifier for this binding.
  , Binding a -> SrcSpan
bindingLoc :: SrcSpan
    -- ^ The source location of this binding in the original source code.
  , Binding a -> InlineSpec
bindingSpec :: InlineSpec
    -- ^ the inline specification for this binding, in the original source code.
  , Binding a -> IsPrim
bindingIsPrim :: IsPrim
    -- ^ Is the binding a core term corresponding to a primitive with a known
    -- implementation? If so, it can potentially be inlined despite being
    -- marked as NOINLINE in source.
  , Binding a -> a
bindingTerm :: a
    -- ^ The term representation for this binding. This is polymorphic so
    -- alternate representations can be used if more appropriate (i.e. in the
    -- evaluator this can be Value for evaluated bindings).
  , Binding a -> Bool
bindingRecursive :: Bool
    -- ^ Whether the binding is recursive.
    --
    -- TODO Ideally the BindingMap would store recursive and non-recursive
    -- bindings in a way similar to Let / Letrec. GHC also does this.
  } deriving (Get (Binding a)
[Binding a] -> Put
Binding a -> Put
(Binding a -> Put)
-> Get (Binding a) -> ([Binding a] -> Put) -> Binary (Binding a)
forall a. Binary a => Get (Binding a)
forall a. Binary a => [Binding a] -> Put
forall a. Binary a => Binding a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Binding a] -> Put
$cputList :: forall a. Binary a => [Binding a] -> Put
get :: Get (Binding a)
$cget :: forall a. Binary a => Get (Binding a)
put :: Binding a -> Put
$cput :: forall a. Binary a => Binding a -> Put
Binary, a -> Binding b -> Binding a
(a -> b) -> Binding a -> Binding b
(forall a b. (a -> b) -> Binding a -> Binding b)
-> (forall a b. a -> Binding b -> Binding a) -> Functor Binding
forall a b. a -> Binding b -> Binding a
forall a b. (a -> b) -> Binding a -> Binding b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Binding b -> Binding a
$c<$ :: forall a b. a -> Binding b -> Binding a
fmap :: (a -> b) -> Binding a -> Binding b
$cfmap :: forall a b. (a -> b) -> Binding a -> Binding b
Functor, (forall x. Binding a -> Rep (Binding a) x)
-> (forall x. Rep (Binding a) x -> Binding a)
-> Generic (Binding a)
forall x. Rep (Binding a) x -> Binding a
forall x. Binding a -> Rep (Binding a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Binding a) x -> Binding a
forall a x. Binding a -> Rep (Binding a) x
$cto :: forall a x. Rep (Binding a) x -> Binding a
$cfrom :: forall a x. Binding a -> Rep (Binding a) x
Generic, Binding a -> ()
(Binding a -> ()) -> NFData (Binding a)
forall a. NFData a => Binding a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Binding a -> ()
$crnf :: forall a. NFData a => Binding a -> ()
NFData, Int -> Binding a -> ShowS
[Binding a] -> ShowS
Binding a -> String
(Int -> Binding a -> ShowS)
-> (Binding a -> String)
-> ([Binding a] -> ShowS)
-> Show (Binding a)
forall a. Show a => Int -> Binding a -> ShowS
forall a. Show a => [Binding a] -> ShowS
forall a. Show a => Binding a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding a] -> ShowS
$cshowList :: forall a. Show a => [Binding a] -> ShowS
show :: Binding a -> String
$cshow :: forall a. Show a => Binding a -> String
showsPrec :: Int -> Binding a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Binding a -> ShowS
Show)

-- | Global function binders
--
-- Global functions cannot be mutually recursive, only self-recursive.
type BindingMap = VarEnv (Binding Term)
type DomainMap = HashMap Text VDomainConfiguration

-- | Information to show about transformations during compilation.
--
-- __NB__: The @Ord@ instance compares by amount of information.
data TransformationInfo
  = None
  -- ^ Show no information about transformations.
  | FinalTerm
  -- ^ Show the final term after all applied transformations.
  | AppliedName
  -- ^ Show the name of every transformation that is applied.
  | AppliedTerm
  -- ^ Show the name and result of every transformation that is applied.
  | TryName
  -- ^ Show the name of every transformation that is attempted, and the result
  -- of every transformation that is applied.
  | TryTerm
  -- ^ Show the name and input to every transformation that is applied, and
  -- the result of every transformation that is applied.
  deriving (TransformationInfo -> TransformationInfo -> Bool
(TransformationInfo -> TransformationInfo -> Bool)
-> (TransformationInfo -> TransformationInfo -> Bool)
-> Eq TransformationInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformationInfo -> TransformationInfo -> Bool
$c/= :: TransformationInfo -> TransformationInfo -> Bool
== :: TransformationInfo -> TransformationInfo -> Bool
$c== :: TransformationInfo -> TransformationInfo -> Bool
Eq, (forall x. TransformationInfo -> Rep TransformationInfo x)
-> (forall x. Rep TransformationInfo x -> TransformationInfo)
-> Generic TransformationInfo
forall x. Rep TransformationInfo x -> TransformationInfo
forall x. TransformationInfo -> Rep TransformationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransformationInfo x -> TransformationInfo
$cfrom :: forall x. TransformationInfo -> Rep TransformationInfo x
Generic, Eq TransformationInfo
Eq TransformationInfo
-> (Int -> TransformationInfo -> Int)
-> (TransformationInfo -> Int)
-> Hashable TransformationInfo
Int -> TransformationInfo -> Int
TransformationInfo -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TransformationInfo -> Int
$chash :: TransformationInfo -> Int
hashWithSalt :: Int -> TransformationInfo -> Int
$chashWithSalt :: Int -> TransformationInfo -> Int
$cp1Hashable :: Eq TransformationInfo
Hashable, Eq TransformationInfo
Eq TransformationInfo
-> (TransformationInfo -> TransformationInfo -> Ordering)
-> (TransformationInfo -> TransformationInfo -> Bool)
-> (TransformationInfo -> TransformationInfo -> Bool)
-> (TransformationInfo -> TransformationInfo -> Bool)
-> (TransformationInfo -> TransformationInfo -> Bool)
-> (TransformationInfo -> TransformationInfo -> TransformationInfo)
-> (TransformationInfo -> TransformationInfo -> TransformationInfo)
-> Ord TransformationInfo
TransformationInfo -> TransformationInfo -> Bool
TransformationInfo -> TransformationInfo -> Ordering
TransformationInfo -> TransformationInfo -> TransformationInfo
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
min :: TransformationInfo -> TransformationInfo -> TransformationInfo
$cmin :: TransformationInfo -> TransformationInfo -> TransformationInfo
max :: TransformationInfo -> TransformationInfo -> TransformationInfo
$cmax :: TransformationInfo -> TransformationInfo -> TransformationInfo
>= :: TransformationInfo -> TransformationInfo -> Bool
$c>= :: TransformationInfo -> TransformationInfo -> Bool
> :: TransformationInfo -> TransformationInfo -> Bool
$c> :: TransformationInfo -> TransformationInfo -> Bool
<= :: TransformationInfo -> TransformationInfo -> Bool
$c<= :: TransformationInfo -> TransformationInfo -> Bool
< :: TransformationInfo -> TransformationInfo -> Bool
$c< :: TransformationInfo -> TransformationInfo -> Bool
compare :: TransformationInfo -> TransformationInfo -> Ordering
$ccompare :: TransformationInfo -> TransformationInfo -> Ordering
$cp1Ord :: Eq TransformationInfo
Ord, ReadPrec [TransformationInfo]
ReadPrec TransformationInfo
Int -> ReadS TransformationInfo
ReadS [TransformationInfo]
(Int -> ReadS TransformationInfo)
-> ReadS [TransformationInfo]
-> ReadPrec TransformationInfo
-> ReadPrec [TransformationInfo]
-> Read TransformationInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransformationInfo]
$creadListPrec :: ReadPrec [TransformationInfo]
readPrec :: ReadPrec TransformationInfo
$creadPrec :: ReadPrec TransformationInfo
readList :: ReadS [TransformationInfo]
$creadList :: ReadS [TransformationInfo]
readsPrec :: Int -> ReadS TransformationInfo
$creadsPrec :: Int -> ReadS TransformationInfo
Read, Int -> TransformationInfo -> ShowS
[TransformationInfo] -> ShowS
TransformationInfo -> String
(Int -> TransformationInfo -> ShowS)
-> (TransformationInfo -> String)
-> ([TransformationInfo] -> ShowS)
-> Show TransformationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransformationInfo] -> ShowS
$cshowList :: [TransformationInfo] -> ShowS
show :: TransformationInfo -> String
$cshow :: TransformationInfo -> String
showsPrec :: Int -> TransformationInfo -> ShowS
$cshowsPrec :: Int -> TransformationInfo -> ShowS
Show, TransformationInfo -> ()
(TransformationInfo -> ()) -> NFData TransformationInfo
forall a. (a -> ()) -> NFData a
rnf :: TransformationInfo -> ()
$crnf :: TransformationInfo -> ()
NFData)

-- | Options related to debugging. See 'ClashOpts'
data DebugOpts = DebugOpts
  { DebugOpts -> Bool
dbg_invariants :: Bool
  -- ^ Check that the results of applied transformations do not violate the
  -- invariants for rewriting (e.g. no accidental shadowing, or type changes).
  --
  -- Command line flag: -fclash-debug-invariants
  , DebugOpts -> TransformationInfo
dbg_transformationInfo :: TransformationInfo
  -- ^ The information to show when debugging a transformation. See the
  -- 'TransformationInfo' type for different configurations.
  --
  -- Command line flag: -fclash-debug-info (None|FinalTerm|AppliedName|AppliedTerm|TryName|TryTerm)
  , DebugOpts -> Set String
dbg_transformations :: Set String
  -- ^ List the transformations that are being debugged. When the set is empty,
  -- all transformations are debugged.
  --
  -- Command line flag: -fclash-debug-transformations t1[,t2...]
  , DebugOpts -> Bool
dbg_countTransformations :: Bool
  -- ^ Count how many times transformations are applied and provide a summary
  -- at the end of normalization. This includes all transformations, not just
  -- those in 'dbg_transformations'.
  --
  -- Command line flag: -fclash-debug-count-transformations
  , DebugOpts -> Maybe Word
dbg_transformationsFrom :: Maybe Word
  -- ^ Debug transformations applied after the nth transformation applied. This
  -- includes all transformations, not just those in 'dbg_transformations'.
  --
  -- Command line flag: -fclash-debug-transformations-from=N
  , DebugOpts -> Maybe Word
dbg_transformationsLimit :: Maybe Word
  -- ^ Debug up to the nth applied transformation. If this limit is exceeded
  -- then Clash will error. This includes all transformations, not just those
  -- in 'dbg_transformations'.
  --
  -- Command line flag: -fclash-debug-transformations-limit=N
  , DebugOpts -> Maybe String
dbg_historyFile :: Maybe FilePath
  -- ^ Save information about all applied transformations to a history file
  -- for use with @clash-term@.
  --
  -- Command line flag: -fclash-debug-history[=FILE]
  } deriving ((forall x. DebugOpts -> Rep DebugOpts x)
-> (forall x. Rep DebugOpts x -> DebugOpts) -> Generic DebugOpts
forall x. Rep DebugOpts x -> DebugOpts
forall x. DebugOpts -> Rep DebugOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DebugOpts x -> DebugOpts
$cfrom :: forall x. DebugOpts -> Rep DebugOpts x
Generic, DebugOpts -> ()
(DebugOpts -> ()) -> NFData DebugOpts
forall a. (a -> ()) -> NFData a
rnf :: DebugOpts -> ()
$crnf :: DebugOpts -> ()
NFData, Int -> DebugOpts -> ShowS
[DebugOpts] -> ShowS
DebugOpts -> String
(Int -> DebugOpts -> ShowS)
-> (DebugOpts -> String)
-> ([DebugOpts] -> ShowS)
-> Show DebugOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugOpts] -> ShowS
$cshowList :: [DebugOpts] -> ShowS
show :: DebugOpts -> String
$cshow :: DebugOpts -> String
showsPrec :: Int -> DebugOpts -> ShowS
$cshowsPrec :: Int -> DebugOpts -> ShowS
Show, DebugOpts -> DebugOpts -> Bool
(DebugOpts -> DebugOpts -> Bool)
-> (DebugOpts -> DebugOpts -> Bool) -> Eq DebugOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugOpts -> DebugOpts -> Bool
$c/= :: DebugOpts -> DebugOpts -> Bool
== :: DebugOpts -> DebugOpts -> Bool
$c== :: DebugOpts -> DebugOpts -> Bool
Eq)

instance Hashable DebugOpts where
  hashWithSalt :: Int -> DebugOpts -> Int
hashWithSalt Int
s DebugOpts{Bool
Maybe String
Maybe Word
Set String
TransformationInfo
dbg_historyFile :: Maybe String
dbg_transformationsLimit :: Maybe Word
dbg_transformationsFrom :: Maybe Word
dbg_countTransformations :: Bool
dbg_transformations :: Set String
dbg_transformationInfo :: TransformationInfo
dbg_invariants :: Bool
dbg_historyFile :: DebugOpts -> Maybe String
dbg_transformationsLimit :: DebugOpts -> Maybe Word
dbg_transformationsFrom :: DebugOpts -> Maybe Word
dbg_countTransformations :: DebugOpts -> Bool
dbg_transformations :: DebugOpts -> Set String
dbg_transformationInfo :: DebugOpts -> TransformationInfo
dbg_invariants :: DebugOpts -> Bool
..} =
    Int
s Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    Bool
dbg_invariants Int -> TransformationInfo -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    TransformationInfo
dbg_transformationInfo Int -> Set String -> Int
`hashSet`
    Set String
dbg_transformations Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    Bool
dbg_countTransformations Int -> Maybe Word -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    Maybe Word
dbg_transformationsFrom Int -> Maybe Word -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    Maybe Word
dbg_transformationsLimit Int -> Maybe String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
    Maybe String
dbg_historyFile
   where
    hashSet :: Int -> Set String -> Int
hashSet = (Int -> String -> Int) -> Int -> Set String -> Int
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
    infixl 0 `hashSet`

-- | Check whether the debugging options mean the compiler is debugging. This
-- is true only if at least one debugging feature is enabled, namely one of
--
--   * checking for invariants
--   * showing info for transformations
--   * counting applied transformations
--   * limiting the number of transformations
--
-- Other flags, such as writing to a history file or offsetting which applied
-- transformation to show information from do not affect the result, as it is
-- possible to enable these but still not perform any debugging checks in
-- functions like 'applyDebug'. If this is no longer the case, this function
-- will need to be changed.
isDebugging :: DebugOpts -> Bool
isDebugging :: DebugOpts -> Bool
isDebugging DebugOpts
opts = [Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
or
  [ DebugOpts -> Bool
dbg_invariants DebugOpts
opts
  , DebugOpts -> TransformationInfo
dbg_transformationInfo DebugOpts
opts TransformationInfo -> TransformationInfo -> Bool
forall a. Ord a => a -> a -> Bool
> TransformationInfo
None
  , DebugOpts -> Bool
dbg_countTransformations DebugOpts
opts
  , Maybe Word -> Bool
forall a. Maybe a -> Bool
isJust (DebugOpts -> Maybe Word
dbg_transformationsLimit DebugOpts
opts)
  ]

-- | Check whether the requested information is available to the specified
-- transformation according to the options. e.g.
--
-- @
-- traceIf (hasDebugInfo AppliedName name opts) ("Trace something using: " <> show name)
-- @
--
-- This accounts for the set of transformations which are being debugged. For a
-- check which is agnostic to the a transformation, see 'hasTransformationInfo'.
hasDebugInfo :: TransformationInfo -> String -> DebugOpts -> Bool
hasDebugInfo :: TransformationInfo -> String -> DebugOpts -> Bool
hasDebugInfo TransformationInfo
info String
name DebugOpts
opts =
  String -> Bool
isDebugged String
name Bool -> Bool -> Bool
&& TransformationInfo -> DebugOpts -> Bool
hasTransformationInfo TransformationInfo
info DebugOpts
opts
 where
  isDebugged :: String -> Bool
isDebugged String
n =
    let set :: Set String
set = DebugOpts -> Set String
dbg_transformations DebugOpts
opts
     in Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
set Bool -> Bool -> Bool
|| String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
n Set String
set

-- | Check that the transformation info shown supports the requested info.
-- If the call-site is in the context of a particular transformation,
-- 'hasDebugInfo' should be used instead.
hasTransformationInfo :: TransformationInfo -> DebugOpts -> Bool
hasTransformationInfo :: TransformationInfo -> DebugOpts -> Bool
hasTransformationInfo TransformationInfo
info DebugOpts
opts =
  TransformationInfo
info TransformationInfo -> TransformationInfo -> Bool
forall a. Ord a => a -> a -> Bool
<= DebugOpts -> TransformationInfo
dbg_transformationInfo DebugOpts
opts

-- NOTE [debugging options]
--
-- The preset debugging options here provide backwards compatibility with the
-- old style DebugLevel enum. However it is also possible to have finer-grained
-- control over debugging by using individual flags which did not previously
-- exist, e.g. -fclash-debug-invariants.

-- | -fclash-debug DebugNone
debugNone :: DebugOpts
debugNone :: DebugOpts
debugNone = DebugOpts :: Bool
-> TransformationInfo
-> Set String
-> Bool
-> Maybe Word
-> Maybe Word
-> Maybe String
-> DebugOpts
DebugOpts
  { dbg_invariants :: Bool
dbg_invariants = Bool
False
  , dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
None
  , dbg_transformations :: Set String
dbg_transformations = Set String
forall a. Set a
Set.empty
  , dbg_countTransformations :: Bool
dbg_countTransformations = Bool
False
  , dbg_transformationsFrom :: Maybe Word
dbg_transformationsFrom = Maybe Word
forall a. Maybe a
Nothing
  , dbg_transformationsLimit :: Maybe Word
dbg_transformationsLimit = Maybe Word
forall a. Maybe a
Nothing
  , dbg_historyFile :: Maybe String
dbg_historyFile = Maybe String
forall a. Maybe a
Nothing
  }

-- | -fclash-debug DebugSilent
debugSilent :: DebugOpts
debugSilent :: DebugOpts
debugSilent = DebugOpts
debugNone { dbg_invariants :: Bool
dbg_invariants = Bool
True }

-- | -fclash-debug DebugFinal
debugFinal :: DebugOpts
debugFinal :: DebugOpts
debugFinal = DebugOpts
debugSilent { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
FinalTerm }

-- | -fclash-debug DebugCount
debugCount :: DebugOpts
debugCount :: DebugOpts
debugCount = DebugOpts
debugFinal { dbg_countTransformations :: Bool
dbg_countTransformations = Bool
True }

-- | -fclash-debug DebugName
debugName :: DebugOpts
debugName :: DebugOpts
debugName = DebugOpts
debugCount { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
AppliedName }

-- | -fclash-debug DebugTry
debugTry :: DebugOpts
debugTry :: DebugOpts
debugTry = DebugOpts
debugName { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
TryName }

-- | -fclash-debug DebugApplied
debugApplied :: DebugOpts
debugApplied :: DebugOpts
debugApplied = DebugOpts
debugTry { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
AppliedTerm }

-- | -fclash-debug DebugAll
debugAll :: DebugOpts
debugAll :: DebugOpts
debugAll = DebugOpts
debugApplied { dbg_transformationInfo :: TransformationInfo
dbg_transformationInfo = TransformationInfo
TryTerm }

-- | Options passed to Clash compiler
data ClashOpts = ClashOpts
  { ClashOpts -> Bool
opt_werror :: Bool
  -- ^ Are warnings treated as errors.
  --
  -- Command line flag: -Werror
  , ClashOpts -> Int
opt_inlineLimit :: Int
  -- ^ Change the number of times a function f can undergo inlining inside
  -- some other function g. This prevents the size of g growing dramatically.
  --
  -- Command line flag: -fclash-inline-limit
  , ClashOpts -> Int
opt_specLimit :: Int
  -- ^ Change the number of times a function can undergo specialization.
  --
  -- Command line flag: -fclash-spec-limit
  , ClashOpts -> Word
opt_inlineFunctionLimit :: Word
  -- ^ Set the threshold for function size. Below this threshold functions are
  -- always inlined (if it is not recursive).
  --
  -- Command line flag: -fclash-inline-function-limit
  , ClashOpts -> Word
opt_inlineConstantLimit :: Word
  -- ^ Set the threshold for constant size. Below this threshold constants are
  -- always inlined. A value of 0 inlines all constants.
  --
  -- Command line flag: -fclash-inline-constant-limit
  , ClashOpts -> Word
opt_evaluatorFuelLimit :: Word
  -- ^ Set the threshold for maximum unfolding depth in the evaluator. A value
  -- of zero means no potentially non-terminating binding is unfolded.
  --
  -- Command line flag: -fclash-evaluator-fuel-limit
  , ClashOpts -> DebugOpts
opt_debug :: DebugOpts
  -- ^ Options which control debugging. See 'DebugOpts'.
  , ClashOpts -> Bool
opt_cachehdl :: Bool
  -- ^ Reuse previously generated output from Clash. Only caches topentities.
  --
  -- Command line flag: -fclash-no-cache
  , ClashOpts -> Bool
opt_clear :: Bool
  -- ^ Remove HDL directories before writing to them. By default, Clash will
  -- only write to non-empty directories if it can prove all files in it are
  -- generated by a previous run. This option applies to directories of the
  -- various top entities, i.e., the subdirectories made in the directory passed
  -- in with @-fclash-hdldir@. Note that Clash will still use a cache if it can.
  --
  -- Command line flag: @-fclash-clear@
  , ClashOpts -> Bool
opt_primWarn :: Bool
  -- ^ Disable warnings for primitives
  --
  -- Command line flag: -fclash-no-prim-warn
  , ClashOpts -> OverridingBool
opt_color :: OverridingBool
  -- ^ Show colors in debug output
  --
  -- Command line flag: -fdiagnostics-color
  , ClashOpts -> Int
opt_intWidth :: Int
  -- ^ Set the bit width for the Int\/Word\/Integer types. The only allowed values
  -- are 32 or 64.
  , ClashOpts -> Maybe String
opt_hdlDir :: Maybe String
  -- ^ Directory to save HDL files to
  , ClashOpts -> HdlSyn
opt_hdlSyn :: HdlSyn
  -- ^ Synthesis target. See "HdlSyn" for available options.
  , ClashOpts -> Bool
opt_errorExtra :: Bool
  -- ^ Show additional information in error messages
  , ClashOpts -> [String]
opt_importPaths :: [FilePath]
  -- ^ Paths where Clash should look for modules
  , ClashOpts -> Maybe Text
opt_componentPrefix :: Maybe Text
  -- ^ Prefix components with given string
  , ClashOpts -> Bool
opt_newInlineStrat :: Bool
  -- ^ Use new inline strategy. Functions marked NOINLINE will get their own
  -- HDL module.
  , ClashOpts -> Bool
opt_escapedIds :: Bool
  -- ^ Use escaped identifiers in HDL. See:
  --
  --  * https://peterfab.com/ref/vhdl/vhdl_renerta/source/vhd00037.htm
  --  * https://peterfab.com/ref/verilog/verilog_renerta/source/vrg00018.htm
  , ClashOpts -> PreserveCase
opt_lowerCaseBasicIds :: PreserveCase
  -- ^ Force all generated basic identifiers to lowercase. Among others, this
  -- affects module and file names.
  , ClashOpts -> Bool
opt_ultra :: Bool
  -- ^ Perform a high-effort compile, trading improved performance for
  -- potentially much longer compile times.
  --
  -- Name inspired by Design Compiler's /compile_ultra/ flag.
  , ClashOpts -> Maybe (Maybe Int)
opt_forceUndefined :: Maybe (Maybe Int)
  -- ^
  -- * /Nothing/: generate undefined's in the HDL
  --
  -- * /Just Nothing/: replace undefined's by a constant in the HDL; the
  -- compiler decides what's best
  --
  -- * /Just (Just x)/: replace undefined's by /x/ in the HDL
  , ClashOpts -> Bool
opt_checkIDir :: Bool
  -- ^ Check whether paths specified in 'opt_importPaths' exists on the
  -- filesystem.
  , ClashOpts -> Bool
opt_aggressiveXOpt :: Bool
  -- ^ Enable aggressive X optimization, which may remove undefineds from
  -- generated HDL by replaced with defined alternatives.
  , ClashOpts -> Bool
opt_aggressiveXOptBB :: Bool
  -- ^ Enable aggressive X optimization, which may remove undefineds from
  -- HDL generated by blackboxes. This enables the ~ISUNDEFINED template tag.
  , ClashOpts -> Word
opt_inlineWFCacheLimit :: Word
  -- ^ At what size do we cache normalized work-free top-level binders.
  , ClashOpts -> Bool
opt_edalize :: Bool
  -- ^ Generate an EDAM file for use with Edalize.
  , ClashOpts -> Bool
opt_renderEnums :: Bool
  -- ^ Render sum types with all zero-width fields as enums where supported, as
  -- opposed to rendering them as bitvectors.
  , ClashOpts -> Period
opt_timescalePrecision :: Period
  -- ^ Timescale precision set in Verilog files. E.g., setting this would sets
  -- the second part of @`timescale 100fs/100fs@.
  , ClashOpts -> Bool
opt_ignoreBrokenGhcs :: Bool
  -- ^ Don't error if we see a (potentially) broken GHC / platform combination.
  -- See the project's @README.md@ for more information.
  }
  deriving (Int -> ClashOpts -> ShowS
[ClashOpts] -> ShowS
ClashOpts -> String
(Int -> ClashOpts -> ShowS)
-> (ClashOpts -> String)
-> ([ClashOpts] -> ShowS)
-> Show ClashOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClashOpts] -> ShowS
$cshowList :: [ClashOpts] -> ShowS
show :: ClashOpts -> String
$cshow :: ClashOpts -> String
showsPrec :: Int -> ClashOpts -> ShowS
$cshowsPrec :: Int -> ClashOpts -> ShowS
Show, ClashOpts -> ClashOpts -> Bool
(ClashOpts -> ClashOpts -> Bool)
-> (ClashOpts -> ClashOpts -> Bool) -> Eq ClashOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClashOpts -> ClashOpts -> Bool
$c/= :: ClashOpts -> ClashOpts -> Bool
== :: ClashOpts -> ClashOpts -> Bool
$c== :: ClashOpts -> ClashOpts -> Bool
Eq, ClashOpts -> ()
(ClashOpts -> ()) -> NFData ClashOpts
forall a. (a -> ()) -> NFData a
rnf :: ClashOpts -> ()
$crnf :: ClashOpts -> ()
NFData, (forall x. ClashOpts -> Rep ClashOpts x)
-> (forall x. Rep ClashOpts x -> ClashOpts) -> Generic ClashOpts
forall x. Rep ClashOpts x -> ClashOpts
forall x. ClashOpts -> Rep ClashOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClashOpts x -> ClashOpts
$cfrom :: forall x. ClashOpts -> Rep ClashOpts x
Generic, Eq ClashOpts
Eq ClashOpts
-> (Int -> ClashOpts -> Int)
-> (ClashOpts -> Int)
-> Hashable ClashOpts
Int -> ClashOpts -> Int
ClashOpts -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ClashOpts -> Int
$chash :: ClashOpts -> Int
hashWithSalt :: Int -> ClashOpts -> Int
$chashWithSalt :: Int -> ClashOpts -> Int
$cp1Hashable :: Eq ClashOpts
Hashable)

defClashOpts :: ClashOpts
defClashOpts :: ClashOpts
defClashOpts
  = ClashOpts :: Bool
-> Int
-> Int
-> Word
-> Word
-> Word
-> DebugOpts
-> Bool
-> Bool
-> Bool
-> OverridingBool
-> Int
-> Maybe String
-> HdlSyn
-> Bool
-> [String]
-> Maybe Text
-> Bool
-> Bool
-> PreserveCase
-> Bool
-> Maybe (Maybe Int)
-> Bool
-> Bool
-> Bool
-> Word
-> Bool
-> Bool
-> Period
-> Bool
-> ClashOpts
ClashOpts
  { opt_werror :: Bool
opt_werror              = Bool
False
  , opt_inlineLimit :: Int
opt_inlineLimit         = Int
20
  , opt_specLimit :: Int
opt_specLimit           = Int
20
  , opt_inlineFunctionLimit :: Word
opt_inlineFunctionLimit = Word
15
  , opt_inlineConstantLimit :: Word
opt_inlineConstantLimit = Word
0
  , opt_evaluatorFuelLimit :: Word
opt_evaluatorFuelLimit  = Word
20
  , opt_debug :: DebugOpts
opt_debug               = DebugOpts
debugNone
  , opt_cachehdl :: Bool
opt_cachehdl            = Bool
True
  , opt_clear :: Bool
opt_clear               = Bool
False
  , opt_primWarn :: Bool
opt_primWarn            = Bool
True
  , opt_color :: OverridingBool
opt_color               = OverridingBool
Auto
  , opt_intWidth :: Int
opt_intWidth            = WORD_SIZE_IN_BITS
  , opt_hdlDir :: Maybe String
opt_hdlDir              = Maybe String
forall a. Maybe a
Nothing
  , opt_hdlSyn :: HdlSyn
opt_hdlSyn              = HdlSyn
Other
  , opt_errorExtra :: Bool
opt_errorExtra          = Bool
False
  , opt_importPaths :: [String]
opt_importPaths         = []
  , opt_componentPrefix :: Maybe Text
opt_componentPrefix     = Maybe Text
forall a. Maybe a
Nothing
  , opt_newInlineStrat :: Bool
opt_newInlineStrat      = Bool
True
  , opt_escapedIds :: Bool
opt_escapedIds          = Bool
True
  , opt_lowerCaseBasicIds :: PreserveCase
opt_lowerCaseBasicIds   = PreserveCase
PreserveCase
  , opt_ultra :: Bool
opt_ultra               = Bool
False
  , opt_forceUndefined :: Maybe (Maybe Int)
opt_forceUndefined      = Maybe (Maybe Int)
forall a. Maybe a
Nothing
  , opt_checkIDir :: Bool
opt_checkIDir           = Bool
True
  , opt_aggressiveXOpt :: Bool
opt_aggressiveXOpt      = Bool
False
  , opt_aggressiveXOptBB :: Bool
opt_aggressiveXOptBB    = Bool
False
  , opt_inlineWFCacheLimit :: Word
opt_inlineWFCacheLimit  = Word
10 -- TODO: find "optimal" value
  , opt_edalize :: Bool
opt_edalize             = Bool
False
  , opt_renderEnums :: Bool
opt_renderEnums         = Bool
True
  , opt_timescalePrecision :: Period
opt_timescalePrecision  = Word64 -> Unit -> Period
Period Word64
100 Unit
Fs
  -- XXX: We probe environment variables until we've found a proper solution to
  --      https://github.com/clash-lang/clash-compiler/issues/2762.
  , opt_ignoreBrokenGhcs :: Bool
opt_ignoreBrokenGhcs    = HasCallStack => String -> Bool -> Bool
String -> Bool -> Bool
unsafeLookupEnvBool String
"CLASH_IGNORE_BROKEN_GHCS" Bool
False
  }

-- | Synopsys Design Constraint (SDC) information for a component.
-- Currently this limited to the names and periods of clocks for create_clock.
--
newtype SdcInfo = SdcInfo
  { SdcInfo -> [(Text, VDomainConfiguration)]
sdcClock :: [(Text, VDomainConfiguration)]
  }

-- | Render an SDC file from an SdcInfo.
-- The clock periods, waveforms, and targets are all hardcoded.
--
pprSDC :: SdcInfo -> Doc ()
pprSDC :: SdcInfo -> Doc ()
pprSDC = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ()] -> Doc ()) -> (SdcInfo -> [Doc ()]) -> SdcInfo -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, VDomainConfiguration) -> Doc ())
-> [(Text, VDomainConfiguration)] -> [Doc ()]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, VDomainConfiguration) -> Doc ()
forall ann. (Text, VDomainConfiguration) -> Doc ann
go ([(Text, VDomainConfiguration)] -> [Doc ()])
-> (SdcInfo -> [(Text, VDomainConfiguration)])
-> SdcInfo
-> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SdcInfo -> [(Text, VDomainConfiguration)]
sdcClock
 where
  go :: (Text, VDomainConfiguration) -> Doc ann
go (Text
i, VDomainConfiguration
dom) =
        -- VDomainConfiguration stores period in ps, SDC expects it in ns.
    let p :: Fixed E3
p        = Integer -> Fixed E3
forall k (a :: k). Integer -> Fixed a
MkFixed (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ VDomainConfiguration -> Natural
vPeriod VDomainConfiguration
dom) :: Fixed E3
        name :: Doc ann
name     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((Char -> Bool) -> Text -> Text
Text.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
i))
        period :: Doc ann
period   = Fixed E3 -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Fixed E3
p
        waveform :: Doc ann
waveform = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann
"0.000" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Fixed E3 -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (Fixed E3
p Fixed E3 -> Fixed E3 -> Fixed E3
forall a. Fractional a => a -> a -> a
/ Fixed E3
2))
        targets :: Doc ann
targets  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann
"get_ports" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
name)
     in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
          [ Doc ann
"create_clock"
          , Doc ann
"-name" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
name
          , Doc ann
"-period" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
period
          , Doc ann
"-waveform" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
waveform
          , Doc ann
forall ann. Doc ann
targets
          ]