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

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Clash.GHC.NetlistTypes
  (ghcTypeToHWType)
where

import Data.Coerce                      (coerce)
import Data.Functor.Identity            (Identity (..))
import Data.Text                        (pack)
import Control.Monad.State.Strict       (State)
import Control.Monad.Trans.Except
  (Except, ExceptT (..), mapExceptT, runExceptT, throwE)
import Control.Monad.Trans.Maybe        (MaybeT (..))
import Language.Haskell.TH.Syntax       (showName)

import Clash.Core.DataCon               (DataCon (..))
import Clash.Core.Name                  (Name (..))
import Clash.Core.Pretty                (showPpr)
import Clash.Core.TyCon                 (TyConMap, tyConDataCons)
import Clash.Core.Type
  (LitTy (..), Type (..), TypeView (..), coreView, coreView1, tyView)
import Clash.Core.Util                  (tyNatSize, substArgTys)
import qualified Clash.Data.UniqMap as UniqMap
import Clash.Netlist.Util               (coreTypeToHWType, stripFiltered)
import Clash.Netlist.Types
  (HWType(..), HWMap, FilteredHWType(..), PortDirection (..))
import Clash.Signal.Internal
  (ResetPolarity(..), ActiveEdge(..), ResetKind(..)
  ,InitBehavior(..))
import Clash.Util                       (curLoc)

import Clash.Annotations.BitRepresentation.Internal
  (CustomReprs)

ghcTypeToHWType
  :: Int
  -- ^ Integer width. The width Clash assumes an Integer to be (instead of it
  -- begin an arbitrarily large, runtime sized construct).
  -> CustomReprs
  -- ^ Custom bit representations
  -> TyConMap
  -- ^ Type constructor map
  -> Type
  -- ^ Type to convert to HWType
  -> State HWMap (Maybe (Either String FilteredHWType))
ghcTypeToHWType :: Int
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
ghcTypeToHWType Int
iw = CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go
  where
    -- returnN :: HWType ->
    returnN :: HWType -> m FilteredHWType
returnN HWType
t = FilteredHWType -> m FilteredHWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
t [])

    go :: CustomReprs -> TyConMap -> Type -> State HWMap (Maybe (Either String FilteredHWType))
    go :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m (AnnType [Attr Text]
attrs Type
typ) = (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (StateT HWMap Identity (Either String FilteredHWType)
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> (ExceptT String (StateT HWMap Identity) FilteredHWType
    -> StateT HWMap Identity (Either String FilteredHWType))
-> ExceptT String (StateT HWMap Identity) FilteredHWType
-> State HWMap (Maybe (Either String FilteredHWType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String (StateT HWMap Identity) FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (StateT HWMap Identity) FilteredHWType
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> ExceptT String (StateT HWMap Identity) FilteredHWType
-> State HWMap (Maybe (Either String FilteredHWType))
forall a b. (a -> b) -> a -> b
$ do
      FilteredHWType HWType
typ' [[(IsVoid, FilteredHWType)]]
areVoids <- StateT HWMap Identity (Either String FilteredHWType)
-> ExceptT String (StateT HWMap Identity) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT HWMap Identity (Either String FilteredHWType)
 -> ExceptT String (StateT HWMap Identity) FilteredHWType)
-> StateT HWMap Identity (Either String FilteredHWType)
-> ExceptT String (StateT HWMap Identity) FilteredHWType
forall a b. (a -> b) -> a -> b
$ (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
typ
      FilteredHWType
-> ExceptT String (StateT HWMap Identity) FilteredHWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType ([Attr Text] -> HWType -> HWType
Annotated [Attr Text]
attrs HWType
typ') [[(IsVoid, FilteredHWType)]]
areVoids)

    go CustomReprs
reprs TyConMap
m ty :: Type
ty@(Type -> TypeView
tyView -> TyConApp TyConName
tc [Type]
args) = MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> (ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
    -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType))
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
-> State HWMap (Maybe (Either String FilteredHWType))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
-> State HWMap (Maybe (Either String FilteredHWType))
forall a b. (a -> b) -> a -> b
$
      case TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
tc of
        Text
"GHC.Int.Int8"                  -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
8)
        Text
"GHC.Int.Int16"                 -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
16)
        Text
"GHC.Int.Int32"                 -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
32)
        Text
"GHC.Int.Int64"                 ->
          if Int
iw Int -> Int -> IsVoid
forall a. Ord a => a -> a -> IsVoid
< Int
64
             then case TyCon -> [DataCon]
tyConDataCons (TyConName -> TyConMap -> TyCon
forall a b. Uniquable a => a -> UniqMap b -> b
UniqMap.find TyConName
tc TyConMap
m) of
                    [DataCon
dc] -> case DataCon -> [Type]
dcArgTys DataCon
dc of
                      [Type -> TypeView
tyView -> TyConApp TyConName
nm [Type]
_]
                        | TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
nm Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"GHC.Prim.Int#"   ->
                            String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Int64 not supported in forced 32-bit mode on a 64-bit machine."
                                             ,String
"Run Clash with `-fclash-intwidth=64`."
                                             ]
                        | TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
nm Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"GHC.Prim.Int64#" ->
                            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
64)
                      [Type]
_  -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Int64 DC has unexpected amount of arguments"
                    [DataCon]
_    -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Int64 TC has unexpected amount of DCs"
             else HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
64)
        Text
"GHC.Word.Word8"                -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
8)
        Text
"GHC.Word.Word16"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
16)
        Text
"GHC.Word.Word32"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
32)
        Text
"GHC.Word.Word64"               ->
          if Int
iw Int -> Int -> IsVoid
forall a. Ord a => a -> a -> IsVoid
< Int
64
             then case TyCon -> [DataCon]
tyConDataCons (TyConName -> TyConMap -> TyCon
forall a b. Uniquable a => a -> UniqMap b -> b
UniqMap.find TyConName
tc TyConMap
m) of
                    [DataCon
dc] -> case DataCon -> [Type]
dcArgTys DataCon
dc of
                      [Type -> TypeView
tyView -> TyConApp TyConName
nm [Type]
_]
                        | TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
nm Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"GHC.Prim.Word#"   ->
                            String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"Word64 not supported in forced 32-bit mode on a 64-bit machine."
                                             ,String
"Run Clash with `-fclash-intwidth=64`."
                                             ]
                        | TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
nm Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"GHC.Prim.Word64#" ->
                            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
64)
                      [Type]
_  -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Word64 DC has unexpected amount of arguments"
                    [DataCon]
_    -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Word64 TC has unexpected amount of DCs"
             else HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
64)
#if MIN_VERSION_ghc(9,0,0)
        "GHC.Num.Integer.Integer"       -> returnN (Signed iw)
        "GHC.Num.Natural.Natural"       -> returnN (Unsigned iw)
#else
        Text
"GHC.Integer.Type.Integer"      -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
iw)
        Text
"GHC.Natural.Natural"           -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
iw)
#endif
        Text
"GHC.Prim.Char#"                -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
21)
        Text
"GHC.Prim.Int#"                 -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
iw)
        Text
"GHC.Prim.Word#"                -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
iw)
        Text
"GHC.Prim.Int8#"                -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
8)
        Text
"GHC.Prim.Int16#"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
16)
        Text
"GHC.Prim.Int32#"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
32)
        Text
"GHC.Prim.Int64#"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed Int
64)
        Text
"GHC.Prim.Word8#"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
8)
        Text
"GHC.Prim.Word16#"              -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
16)
        Text
"GHC.Prim.Word32#"              -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
32)
        Text
"GHC.Prim.Word64#"              -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned Int
64)
        Text
"GHC.Prim.Float#"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
BitVector Int
32)
        Text
"GHC.Prim.Double#"              -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
BitVector Int
64)
        Text
"GHC.Prim.ByteArray#"           ->
          String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ String
"Can't translate type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty

        Text
"GHC.Types.Bool"                -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
Bool
        Text
"GHC.Types.Float"               -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
BitVector Int
32)
        Text
"GHC.Types.Double"              -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
BitVector Int
64)
        Text
"GHC.Prim.~#"                   -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing)

        Text
"Clash.Signal.Internal.Signal" ->
          MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (State HWMap (Maybe (Either String FilteredHWType))
 -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType))
-> State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m ([Type]
args [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! Int
1)

        Text
"Clash.Signal.BiSignal.BiSignalIn" -> do
          Type
szTy <- case [Type]
args of
            [Type
_, Type
_, Type
szTy] -> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
szTy
            [Type]
_ -> String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type)
-> String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BiSignalIn TC has unexpected amount of arguments"
          let fType :: HWType -> FilteredHWType
fType HWType
ty1 = HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
ty1 []
          (HWType -> FilteredHWType
fType (HWType -> FilteredHWType)
-> (Integer -> HWType) -> Integer -> FilteredHWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortDirection -> HWType -> HWType
BiDirectional PortDirection
In (HWType -> HWType) -> (Integer -> HWType) -> Integer -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HWType
BitVector (Int -> HWType) -> (Integer -> Int) -> Integer -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (Integer -> FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
szTy)

        Text
"Clash.Signal.BiSignal.BiSignalOut" -> do
          Type
szTy <- case [Type]
args of
            [Type
_, Type
_, Type
szTy] -> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
szTy
            [Type]
_ -> String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type)
-> String -> ExceptT String (MaybeT (StateT HWMap Identity)) Type
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BiSignalOut TC has unexpected amount of arguments"
          let fType :: HWType -> FilteredHWType
fType HWType
ty1 = HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
ty1 []
          (HWType -> FilteredHWType
fType (HWType -> FilteredHWType)
-> (Integer -> HWType) -> Integer -> FilteredHWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe HWType -> HWType
Void (Maybe HWType -> HWType)
-> (Integer -> Maybe HWType) -> Integer -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Maybe HWType
forall a. a -> Maybe a
Just (HWType -> Maybe HWType)
-> (Integer -> HWType) -> Integer -> Maybe HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortDirection -> HWType -> HWType
BiDirectional PortDirection
Out (HWType -> HWType) -> (Integer -> HWType) -> Integer -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HWType
BitVector (Int -> HWType) -> (Integer -> Int) -> Integer -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (Integer -> FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
szTy)

        -- XXX: this is a hack to get a KnownDomain from a KnownConfiguration
        Text
"GHC.Classes.(%,%)"
          | [arg0 :: Type
arg0@(Type -> TypeView
tyView -> TyConApp TyConName
kdNm [Type]
_), Type
arg1] <- [Type]
args
          , TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
kdNm Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"Clash.Signal.Internal.KnownDomain"
          -> case Type -> TypeView
tyView Type
arg1 of
                TyConApp TyConName
kdNm1 [Type]
_
                  | TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
kdNm1 Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
"Clash.Signal.Internal.KnownDomain"
                  -> do HWType
k1 <- (HWType -> HWType
stripVoid (HWType -> HWType)
-> (FilteredHWType -> HWType) -> FilteredHWType -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilteredHWType -> HWType
stripFiltered) (FilteredHWType -> HWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
arg0))
                        HWType
k2 <- (HWType -> HWType
stripVoid (HWType -> HWType)
-> (FilteredHWType -> HWType) -> FilteredHWType -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilteredHWType -> HWType
stripFiltered) (FilteredHWType -> HWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) HWType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
arg1))
                        HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Text -> Maybe [Text] -> [HWType] -> HWType
Product Text
"(%,%)" Maybe [Text]
forall a. Maybe a
Nothing [HWType
k1,HWType
k2])))
                  where
                    stripVoid :: HWType -> HWType
stripVoid (Void (Just HWType
t)) = HWType
t
                    stripVoid HWType
t = HWType
t
                TypeView
_ -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
arg0))


        Text
"Clash.Signal.Internal.KnownDomain"
          -> case TyCon -> [DataCon]
tyConDataCons (TyConName -> TyConMap -> TyCon
forall a b. Uniquable a => a -> UniqMap b -> b
UniqMap.find TyConName
tc TyConMap
m) of
               [DataCon
dc] -> case DataCon -> [Type] -> [Type]
substArgTys DataCon
dc [Type]
args of
                 [Type
_knownSymbol, Type
_knownNat, Type -> TypeView
tyView -> TyConApp TyConName
_ [Type
_,Type
dom]] ->
                  case Type -> TypeView
tyView (TyConMap -> Type -> Type
coreView TyConMap
m Type
dom) of
                   TyConApp TyConName
_ [Type
tag0, Type
period0, Type
edge0, Type
rstKind0, Type
init0, Type
polarity0] -> do
                     String
tag1      <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
tag0
                     Integer
period1   <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) Integer
domPeriod TyConMap
m Type
period0
                     ActiveEdge
edge1     <- TyConMap
-> Type
-> ExceptT String (MaybeT (StateT HWMap Identity)) ActiveEdge
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) ActiveEdge
domEdge TyConMap
m Type
edge0
                     ResetKind
rstKind1  <- TyConMap
-> Type
-> ExceptT String (MaybeT (StateT HWMap Identity)) ResetKind
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) ResetKind
domResetKind TyConMap
m Type
rstKind0
                     InitBehavior
init1     <- TyConMap
-> Type
-> ExceptT String (MaybeT (StateT HWMap Identity)) InitBehavior
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) InitBehavior
domInitBehavior TyConMap
m Type
init0
                     ResetPolarity
polarity1 <- TyConMap
-> Type
-> ExceptT String (MaybeT (StateT HWMap Identity)) ResetPolarity
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) ResetPolarity
domResetPolarity TyConMap
m Type
polarity0
                     let kd :: HWType
kd = Text
-> Integer
-> ActiveEdge
-> ResetKind
-> InitBehavior
-> ResetPolarity
-> HWType
KnownDomain (String -> Text
pack String
tag1) Integer
period1 ActiveEdge
edge1 ResetKind
rstKind1 InitBehavior
init1 ResetPolarity
polarity1
                     HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just HWType
kd))
                   TypeView
_ -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Either String FilteredHWType)
forall a. Maybe a
Nothing))
                 [Type]
_ -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Either String FilteredHWType)
forall a. Maybe a
Nothing))
               [DataCon]
_ -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Either String FilteredHWType)
forall a. Maybe a
Nothing))

        Text
"Clash.Signal.Internal.Clock"
          | [Type
tag0] <- [Type]
args
          -> do
            String
tag1 <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
tag0
            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Text -> HWType
Clock (String -> Text
pack String
tag1))

        Text
"Clash.Signal.Internal.ClockN"
          | [Type
tag0] <- [Type]
args
          -> do
            String
tag1 <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
tag0
            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Text -> HWType
ClockN (String -> Text
pack String
tag1))

        Text
"Clash.Signal.Internal.Reset"
          | [Type
tag0] <- [Type]
args
          -> do
            String
tag1 <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
tag0
            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Text -> HWType
Reset (String -> Text
pack String
tag1))

        Text
"Clash.Signal.Internal.Enable"
          | [Type
tag0] <- [Type]
args
          -> do
            String
tag1 <- TyConMap
-> Type -> ExceptT String (MaybeT (StateT HWMap Identity)) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
tag0
            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Text -> HWType
Enable (String -> Text
pack String
tag1))

        Text
"Clash.Sized.Internal.BitVector.Bit" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
Bit

        Text
"Clash.Sized.Internal.BitVector.BitVector" | Type
n0:[Type]
_ <- [Type]
args -> do
          Integer
n <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
n0)
          case Integer
n of
            Integer
0 -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType
BitVector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))))
            Integer
_ -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
BitVector (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))

        Text
"Clash.Sized.Internal.Index.Index" | Type
n0:[Type]
_ <- [Type]
args -> do
          Integer
n <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
n0)
          if Integer
n Integer -> Integer -> IsVoid
forall a. Ord a => a -> a -> IsVoid
< Integer
2
             then HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n))))
             else HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n))

        Text
"Clash.Sized.Internal.Signed.Signed" | Type
n0:[Type]
_ <- [Type]
args -> do
          Integer
n <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
n0)
          if Integer
n Integer -> Integer -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Integer
0
             then HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType
Signed (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))))
             else HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Signed (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))

        Text
"Clash.Sized.Internal.Unsigned.Unsigned" | Type
n0:[Type]
_ <- [Type]
args -> do
          Integer
n <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
n0)
          if Integer
n Integer -> Integer -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Integer
0
             then HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType
Unsigned (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))))
             else HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> HWType
Unsigned (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))

        Text
"Clash.Sized.Vector.Vec" -> case [Type]
args of
          [Type
szTy,Type
elTy] -> do
            Integer
sz0     <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
szTy)
            FilteredHWType
fElHWTy <- MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (State HWMap (Maybe (Either String FilteredHWType))
 -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType))
-> State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
elTy

            -- Treat Vec as a product type with a single constructor and N
            -- constructor fields.
            let sz1 :: Int
sz1    = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
sz0 :: Int
                elHWTy :: HWType
elHWTy = FilteredHWType -> HWType
stripFiltered FilteredHWType
fElHWTy

            let
              (IsVoid
isVoid, HWType
vecHWTy) =
                case HWType
elHWTy of
                  Void {}      -> (IsVoid
True, Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType -> HWType
Vector Int
sz1 HWType
elHWTy)))
                  HWType
_ | Int
sz1 Int -> Int -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Int
0 -> (IsVoid
True, Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType -> HWType
Vector Int
sz1 HWType
elHWTy)))
                  HWType
_            -> (IsVoid
False, Int -> HWType -> HWType
Vector Int
sz1 HWType
elHWTy)

            let filtered :: [[(IsVoid, FilteredHWType)]]
filtered = [Int -> (IsVoid, FilteredHWType) -> [(IsVoid, FilteredHWType)]
forall a. Int -> a -> [a]
replicate Int
sz1 (IsVoid
isVoid, FilteredHWType
fElHWTy)]
            FilteredHWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
vecHWTy [[(IsVoid, FilteredHWType)]]
filtered)
          [Type]
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Vec TC has unexpected amount of arguments"

        Text
"Clash.Explicit.BlockRam.Internal.MemBlob" -> case [Type]
args of
          [Type
nTy,Type
mTy] -> do
            Integer
n0 <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
nTy)
            Integer
m0 <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
mTy)
            HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Int -> Int -> HWType
MemBlob (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n0) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m0))
          [Type]
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"MemBlob TC has unexpected amount of arguments"

        Text
"Clash.Sized.RTree.RTree" -> case [Type]
args of
          [Type
szTy,Type
elTy] -> do
            Integer
sz0     <- Except String Integer
-> ExceptT String (MaybeT (StateT HWMap Identity)) Integer
forall (m :: Type -> Type) e a.
Applicative m =>
Except e a -> ExceptT e (MaybeT m) a
liftE (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
m Type
szTy)
            FilteredHWType
fElHWTy <- MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (State HWMap (Maybe (Either String FilteredHWType))
 -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType))
-> State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
elTy

            -- Treat RTree as a product type with a single constructor and 2^N
            -- constructor fields.
            let sz1 :: Int
sz1    = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
sz0 :: Int
                elHWTy :: HWType
elHWTy = FilteredHWType -> HWType
stripFiltered FilteredHWType
fElHWTy

            let
              (IsVoid
isVoid, HWType
vecHWTy) =
                case HWType
elHWTy of
                  Void {} -> (IsVoid
True, Maybe HWType -> HWType
Void (HWType -> Maybe HWType
forall a. a -> Maybe a
Just (Int -> HWType -> HWType
RTree Int
sz1 HWType
elHWTy)))
                  HWType
_       -> (IsVoid
False, Int -> HWType -> HWType
RTree Int
sz1 HWType
elHWTy)

            let filtered :: [[(IsVoid, FilteredHWType)]]
filtered = [Int -> (IsVoid, FilteredHWType) -> [(IsVoid, FilteredHWType)]
forall a. Int -> a -> [a]
replicate (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
sz1) (IsVoid
isVoid, FilteredHWType
fElHWTy)]
            FilteredHWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
vecHWTy [[(IsVoid, FilteredHWType)]]
filtered)
          [Type]
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RTree TC has unexpected amount of arguments"

        Text
"String" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
String
        Text
"GHC.Prim.Addr#" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
String
        Text
"GHC.Types.[]" | Type
a0:[Type]
_ <- [Type]
args -> case Type -> TypeView
tyView Type
a0 of
          (TyConApp (TyConName -> Text
forall a. Name a -> Text
nameOcc -> Text
"GHC.Types.Char") []) -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
String
          TypeView
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ String
"Can't translate type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty
        Text
"GHC.Types.List" | Type
a0:[Type]
_ <- [Type]
args -> case Type -> TypeView
tyView Type
a0 of
          (TyConApp (TyConName -> Text
forall a. Name a -> Text
nameOcc -> Text
"GHC.Types.Char") []) -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
String
          TypeView
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ String
"Can't translate type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty

        -- To ensure that Clash doesn't get stuck working away callstacks that
        -- never end up being used in the generated HDL.
        Text
"GHC.Stack.Types.CallStack" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing)

        Text
"Clash.Explicit.SimIO.SimIO" | Type
a0:[Type]
_ <- [Type]
args ->
          MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (State HWMap (Maybe (Either String FilteredHWType))
 -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType))
-> State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
a0

        Text
"Clash.Explicit.SimIO.File" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN HWType
FileType

        Text
"Clash.Explicit.SimIO.Reg" -> case [Type]
args of
          [Type
aTy] -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
aTy))
          [Type]
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Reg TC has unexpected amount of arguments"

        Text
"GHC.STRef.STRef" -> case [Type]
args of
          [Type
_,Type
aTy] -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Either String FilteredHWType
-> Maybe (Either String FilteredHWType)
forall a. a -> Maybe a
Just (Either String FilteredHWType
 -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (CustomReprs
 -> TyConMap
 -> Type
 -> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
go CustomReprs
reprs TyConMap
m Type
aTy))
          [Type]
_ -> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String
 -> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType)
-> String
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"STRef TC has unexpected amount of arguments"

        -- Anything that's wrapped in SimOnly should be elided when we generate HDL
        Text
"Clash.Magic.SimOnly" -> HWType
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall (m :: Type -> Type). Monad m => HWType -> m FilteredHWType
returnN (Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing)

        Text
_ -> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
-> ExceptT String (MaybeT (StateT HWMap Identity)) FilteredHWType
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (State HWMap (Maybe (Either String FilteredHWType))
-> MaybeT (StateT HWMap Identity) (Either String FilteredHWType)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Either String FilteredHWType)
forall a. Maybe a
Nothing))

    go CustomReprs
_ TyConMap
_ Type
_ = Maybe (Either String FilteredHWType)
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Either String FilteredHWType)
forall a. Maybe a
Nothing

liftE
  :: Applicative m
  => Except e a
  -> ExceptT e (MaybeT m) a
liftE :: Except e a -> ExceptT e (MaybeT m) a
liftE = (Identity (Either e a) -> MaybeT m (Either e a))
-> Except e a -> ExceptT e (MaybeT m) a
forall (m :: Type -> Type) e a (n :: Type -> Type) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (m (Maybe (Either e a)) -> MaybeT m (Either e a)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Either e a)) -> MaybeT m (Either e a))
-> (Identity (Either e a) -> m (Maybe (Either e a)))
-> Identity (Either e a)
-> MaybeT m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Either e a) -> m (Maybe (Either e a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Either e a) -> m (Maybe (Either e a)))
-> (Identity (Either e a) -> Maybe (Either e a))
-> Identity (Either e a)
-> m (Maybe (Either e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> Maybe (Either e a)
forall a. a -> Maybe a
Just (Either e a -> Maybe (Either e a))
-> (Identity (Either e a) -> Either e a)
-> Identity (Either e a)
-> Maybe (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Either e a) -> Either e a
coerce)

domTag :: Monad m => TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag :: TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m (TyConMap -> Type -> Maybe Type
coreView1 TyConMap
m -> Just Type
ty) = TyConMap -> Type -> ExceptT String (MaybeT m) String
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) String
domTag TyConMap
m Type
ty
domTag TyConMap
_ (LitTy (SymTy String
tag)) = String -> ExceptT String (MaybeT m) String
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure String
tag
domTag TyConMap
_ Type
ty = String -> ExceptT String (MaybeT m) String
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (MaybeT m) String)
-> String -> ExceptT String (MaybeT m) String
forall a b. (a -> b) -> a -> b
$ String
"Internal error. Cannot translate domain tag:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty

domPeriod :: Monad m => TyConMap -> Type -> ExceptT String (MaybeT m) Integer
domPeriod :: TyConMap -> Type -> ExceptT String (MaybeT m) Integer
domPeriod TyConMap
m (TyConMap -> Type -> Maybe Type
coreView1 TyConMap
m -> Just Type
ty) = TyConMap -> Type -> ExceptT String (MaybeT m) Integer
forall (m :: Type -> Type).
Monad m =>
TyConMap -> Type -> ExceptT String (MaybeT m) Integer
domPeriod TyConMap
m Type
ty
domPeriod TyConMap
_ (LitTy (NumTy Integer
period)) = Integer -> ExceptT String (MaybeT m) Integer
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Integer
period
domPeriod TyConMap
_ Type
ty = String -> ExceptT String (MaybeT m) Integer
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (MaybeT m) Integer)
-> String -> ExceptT String (MaybeT m) Integer
forall a b. (a -> b) -> a -> b
$ String
"Internal error. Cannot translate domain period:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty

fromType
  :: Monad m
  => String
  -- ^ Name of type (for error reporting)
  -> [(String, a)]
  -- ^ [(Fully qualified constructor name, constructor value)
  -> TyConMap
  -- ^ Constructor map (used to look through newtypes)
  -> Type
  -- ^ Type representing some constructor
  -> ExceptT String (MaybeT m) a
fromType :: String
-> [(String, a)] -> TyConMap -> Type -> ExceptT String (MaybeT m) a
fromType String
tyNm [(String, a)]
constrs TyConMap
m Type
ty =
  case Type -> TypeView
tyView (TyConMap -> Type -> Type
coreView TyConMap
m Type
ty) of
    TyConApp TyConName
tcNm [] ->
      [(String, a)] -> Text -> ExceptT String (MaybeT m) a
forall (m :: Type -> Type) a.
Monad m =>
[(String, a)] -> Text -> ExceptT String m a
go [(String, a)]
constrs (TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
tcNm)
    TypeView
_ ->
      String -> ExceptT String (MaybeT m) a
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (MaybeT m) a)
-> String -> ExceptT String (MaybeT m) a
forall a b. (a -> b) -> a -> b
$ String
"Can't translate " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tyNm String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty
 where
  go :: [(String, a)] -> Text -> ExceptT String m a
go ((String
cName,a
c):[(String, a)]
cs) Text
tcNm =
    if String -> Text
pack String
cName Text -> Text -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Text
tcNm then
      a -> ExceptT String m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
c
    else
      [(String, a)] -> Text -> ExceptT String m a
go [(String, a)]
cs Text
tcNm
  go [] Text
_ =
    String -> ExceptT String m a
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String m a) -> String -> ExceptT String m a
forall a b. (a -> b) -> a -> b
$ String
"Can't translate " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tyNm String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty

domEdge
  :: Monad m
  => TyConMap
  -> Type
  -> ExceptT String (MaybeT m) ActiveEdge
domEdge :: TyConMap -> Type -> ExceptT String (MaybeT m) ActiveEdge
domEdge =
  String
-> [(String, ActiveEdge)]
-> TyConMap
-> Type
-> ExceptT String (MaybeT m) ActiveEdge
forall (m :: Type -> Type) a.
Monad m =>
String
-> [(String, a)] -> TyConMap -> Type -> ExceptT String (MaybeT m) a
fromType
    (Name -> String
showName ''ActiveEdge)
    [ (Name -> String
showName 'Rising, ActiveEdge
Rising)
    , (Name -> String
showName 'Falling, ActiveEdge
Falling) ]

domResetKind
  :: Monad m
  => TyConMap
  -> Type
  -> ExceptT String (MaybeT m) ResetKind
domResetKind :: TyConMap -> Type -> ExceptT String (MaybeT m) ResetKind
domResetKind =
  String
-> [(String, ResetKind)]
-> TyConMap
-> Type
-> ExceptT String (MaybeT m) ResetKind
forall (m :: Type -> Type) a.
Monad m =>
String
-> [(String, a)] -> TyConMap -> Type -> ExceptT String (MaybeT m) a
fromType
    (Name -> String
showName ''ResetKind)
    [ (Name -> String
showName 'Synchronous, ResetKind
Synchronous)
    , (Name -> String
showName 'Asynchronous, ResetKind
Asynchronous) ]

domInitBehavior
  :: Monad m
  => TyConMap
  -> Type
  -> ExceptT String (MaybeT m) InitBehavior
domInitBehavior :: TyConMap -> Type -> ExceptT String (MaybeT m) InitBehavior
domInitBehavior =
  String
-> [(String, InitBehavior)]
-> TyConMap
-> Type
-> ExceptT String (MaybeT m) InitBehavior
forall (m :: Type -> Type) a.
Monad m =>
String
-> [(String, a)] -> TyConMap -> Type -> ExceptT String (MaybeT m) a
fromType
    (Name -> String
showName ''InitBehavior)
    [ (Name -> String
showName 'Defined, InitBehavior
Defined)
    , (Name -> String
showName 'Unknown, InitBehavior
Unknown) ]

domResetPolarity
  :: Monad m
  => TyConMap
  -> Type
  -> ExceptT String (MaybeT m) ResetPolarity
domResetPolarity :: TyConMap -> Type -> ExceptT String (MaybeT m) ResetPolarity
domResetPolarity =
  String
-> [(String, ResetPolarity)]
-> TyConMap
-> Type
-> ExceptT String (MaybeT m) ResetPolarity
forall (m :: Type -> Type) a.
Monad m =>
String
-> [(String, a)] -> TyConMap -> Type -> ExceptT String (MaybeT m) a
fromType
    (Name -> String
showName ''ResetPolarity)
    [ (Name -> String
showName 'ActiveHigh, ResetPolarity
ActiveHigh)
    , (Name -> String
showName 'ActiveLow, ResetPolarity
ActiveLow) ]