{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
#if !MIN_VERSION_ghc(8,8,0)
{-# LANGUAGE MonadFailDesugaring #-}
#endif
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Clash.Netlist.Util where
import Control.Error (hush)
import Control.Exception (throw)
import Control.Lens ((.=),(%=))
import qualified Control.Lens as Lens
import Control.Monad (unless, when, zipWithM, join)
import Control.Monad.Reader (ask, local)
import Control.Monad.State.Strict
(State, evalState, get, modify, runState)
import Control.Monad.Trans.Except
(ExceptT (..), runExcept, runExceptT, throwE)
import Data.Either (partitionEithers)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.String (fromString)
import Data.List (intersperse, unzip4, sort, intercalate)
import qualified Data.List as List
import Data.Maybe (catMaybes,fromMaybe,isNothing)
import Data.Monoid (First (..))
import Text.Printf (printf)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc (Doc)
import Outputable (ppr, showSDocUnsafe)
import Clash.Annotations.BitRepresentation.ClashLib
(coreToType')
import Clash.Annotations.BitRepresentation.Internal
(CustomReprs, ConstrRepr'(..), DataRepr'(..), getDataRepr, getConstrRepr)
import Clash.Annotations.TopEntity (PortName (..), TopEntity (..))
import Clash.Driver.Types (Manifest (..), ClashOpts (..))
import Clash.Core.DataCon (DataCon (..))
import Clash.Core.FreeVars (freeLocalIds, typeFreeVars)
import qualified Clash.Core.Literal as C
import Clash.Core.Name
(Name (..), appendToName, nameOcc)
import Clash.Core.Pretty (showPpr)
import Clash.Core.Subst
(Subst (..), extendIdSubst, extendIdSubstList, extendInScopeId,
extendInScopeIdList, mkSubst, substTm)
import Clash.Core.Term
(Alt, LetBinding, Pat (..), Term (..), TickInfo (..), NameMod (..))
import Clash.Core.TyCon
(TyConName, TyConMap, tyConDataCons)
import Clash.Core.Type (Type (..), TypeView (..),
coreView1, splitTyConAppM, tyView, TyVar)
import Clash.Core.Util
(collectBndrs, stripTicks, substArgTys, termType, tySym)
import Clash.Core.Var
(Id, Var (..), mkLocalId, modifyVarName, Attr')
import Clash.Core.VarEnv
(InScopeSet, extendInScopeSetList, uniqAway)
import Clash.Netlist.Id (IdType (..), stripDollarPrefixes)
import Clash.Netlist.Types as HW
import Clash.Unique
import Clash.Util
stripFiltered :: FilteredHWType -> HWType
stripFiltered :: FilteredHWType -> HWType
stripFiltered (FilteredHWType hwty :: HWType
hwty _filtered :: [[(IsVoid, FilteredHWType)]]
_filtered) = HWType
hwty
flattenFiltered :: FilteredHWType -> [[Bool]]
flattenFiltered :: FilteredHWType -> [[IsVoid]]
flattenFiltered (FilteredHWType _hwty :: HWType
_hwty filtered :: [[(IsVoid, FilteredHWType)]]
filtered) = ([(IsVoid, FilteredHWType)] -> [IsVoid])
-> [[(IsVoid, FilteredHWType)]] -> [[IsVoid]]
forall a b. (a -> b) -> [a] -> [b]
map (((IsVoid, FilteredHWType) -> IsVoid)
-> [(IsVoid, FilteredHWType)] -> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map (IsVoid, FilteredHWType) -> IsVoid
forall a b. (a, b) -> a
fst) [[(IsVoid, FilteredHWType)]]
filtered
isVoid :: HWType -> Bool
isVoid :: HWType -> IsVoid
isVoid Void {} = IsVoid
True
isVoid _ = IsVoid
False
isFilteredVoid :: FilteredHWType -> Bool
isFilteredVoid :: FilteredHWType -> IsVoid
isFilteredVoid = HWType -> IsVoid
isVoid (HWType -> IsVoid)
-> (FilteredHWType -> HWType) -> FilteredHWType -> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilteredHWType -> HWType
stripFiltered
isBiSignalOut :: HWType -> Bool
isBiSignalOut :: HWType -> IsVoid
isBiSignalOut (Void (Just (BiDirectional Out _))) = IsVoid
True
isBiSignalOut (Vector n :: Size
n ty :: HWType
ty) | Size
n Size -> Size -> IsVoid
forall a. Eq a => a -> a -> IsVoid
/= 0 = HWType -> IsVoid
isBiSignalOut HWType
ty
isBiSignalOut (RTree _ ty :: HWType
ty) = HWType -> IsVoid
isBiSignalOut HWType
ty
isBiSignalOut _ = IsVoid
False
mkIdentifier :: IdType -> Identifier -> NetlistMonad Identifier
mkIdentifier :: IdType -> Identifier -> NetlistMonad Identifier
mkIdentifier typ :: IdType
typ nm :: Identifier
nm = Getting
(IdType -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier)
-> NetlistMonad (IdType -> Identifier -> Identifier)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(IdType -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier)
Lens' NetlistState (IdType -> Identifier -> Identifier)
mkIdentifierFn NetlistMonad (IdType -> Identifier -> Identifier)
-> NetlistMonad IdType -> NetlistMonad (Identifier -> Identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IdType -> NetlistMonad IdType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdType
typ NetlistMonad (Identifier -> Identifier)
-> NetlistMonad Identifier -> NetlistMonad Identifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Identifier -> NetlistMonad Identifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
nm
extendIdentifier
:: IdType
-> Identifier
-> Identifier
-> NetlistMonad Identifier
extendIdentifier :: IdType -> Identifier -> Identifier -> NetlistMonad Identifier
extendIdentifier typ :: IdType
typ nm :: Identifier
nm ext :: Identifier
ext =
Getting
(IdType -> Identifier -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier -> Identifier)
-> NetlistMonad (IdType -> Identifier -> Identifier -> Identifier)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(IdType -> Identifier -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier -> Identifier)
Lens'
NetlistState (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifierFn NetlistMonad (IdType -> Identifier -> Identifier -> Identifier)
-> NetlistMonad IdType
-> NetlistMonad (Identifier -> Identifier -> Identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IdType -> NetlistMonad IdType
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdType
typ NetlistMonad (Identifier -> Identifier -> Identifier)
-> NetlistMonad Identifier
-> NetlistMonad (Identifier -> Identifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Identifier -> NetlistMonad Identifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
nm NetlistMonad (Identifier -> Identifier)
-> NetlistMonad Identifier -> NetlistMonad Identifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Identifier -> NetlistMonad Identifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
ext
splitNormalized
:: TyConMap
-> Term
-> (Either String ([Id],[LetBinding],Id))
splitNormalized :: TyConMap -> Term -> Either String ([Id], [LetBinding], Id)
splitNormalized tcm :: TyConMap
tcm expr :: Term
expr = case Term -> ([Either Id TyVar], Term)
collectBndrs Term
expr of
(args :: [Either Id TyVar]
args,Letrec xes :: [LetBinding]
xes e :: Term
e)
| (tmArgs :: [Id]
tmArgs,[]) <- [Either Id TyVar] -> ([Id], [TyVar])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Id TyVar]
args -> case Term -> Term
stripTicks Term
e of
Var v :: Id
v -> ([Id], [LetBinding], Id) -> Either String ([Id], [LetBinding], Id)
forall a b. b -> Either a b
Right ([Id]
tmArgs,[LetBinding]
xes,Id
v)
_ -> String -> Either String ([Id], [LetBinding], Id)
forall a b. a -> Either a b
Left ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Not in normal form: res not simple var")
| IsVoid
otherwise -> String -> Either String ([Id], [LetBinding], Id)
forall a b. a -> Either a b
Left ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Not in normal form: tyArgs")
_ ->
String -> Either String ([Id], [LetBinding], Id)
forall a b. a -> Either a b
Left ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Not in normal form: no Letrec:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Term -> String
forall p. PrettyPrec p => p -> String
showPpr Term
expr String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n\nWhich has type:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty)
where
ty :: Type
ty = TyConMap -> Term -> Type
termType TyConMap
tcm Term
expr
unsafeCoreTypeToHWType'
:: SrcSpan
-> String
-> (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap HWType
unsafeCoreTypeToHWType' :: SrcSpan
-> String
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap HWType
unsafeCoreTypeToHWType' sp :: SrcSpan
sp loc :: String
loc builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs m :: TyConMap
m ty :: Type
ty =
FilteredHWType -> HWType
stripFiltered (FilteredHWType -> HWType)
-> StateT HWMap Identity FilteredHWType -> State HWMap HWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SrcSpan
-> String
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity FilteredHWType
unsafeCoreTypeToHWType SrcSpan
sp String
loc CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation CustomReprs
reprs TyConMap
m Type
ty)
unsafeCoreTypeToHWType
:: SrcSpan
-> String
-> (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap FilteredHWType
unsafeCoreTypeToHWType :: SrcSpan
-> String
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity FilteredHWType
unsafeCoreTypeToHWType sp :: SrcSpan
sp loc :: String
loc builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs m :: TyConMap
m ty :: Type
ty =
(String -> FilteredHWType)
-> (FilteredHWType -> FilteredHWType)
-> Either String FilteredHWType
-> FilteredHWType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\msg :: String
msg -> ClashException -> FilteredHWType
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
sp (String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg) Maybe String
forall a. Maybe a
Nothing)) FilteredHWType -> FilteredHWType
forall a. a -> a
id (Either String FilteredHWType -> FilteredHWType)
-> StateT HWMap Identity (Either String FilteredHWType)
-> StateT HWMap Identity FilteredHWType
forall (f :: * -> *) 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))
builtInTranslation CustomReprs
reprs TyConMap
m Type
ty
unsafeCoreTypeToHWTypeM'
:: String
-> Type
-> NetlistMonad HWType
unsafeCoreTypeToHWTypeM' :: String -> Type -> NetlistMonad HWType
unsafeCoreTypeToHWTypeM' loc :: String
loc ty :: Type
ty =
FilteredHWType -> HWType
stripFiltered (FilteredHWType -> HWType)
-> NetlistMonad FilteredHWType -> NetlistMonad HWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Type -> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM String
loc Type
ty
unsafeCoreTypeToHWTypeM
:: String
-> Type
-> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM :: String -> Type -> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM loc :: String
loc ty :: Type
ty = do
(_,cmpNm :: SrcSpan
cmpNm) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
-> NetlistMonad (Identifier, SrcSpan)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
Lens' NetlistState (Identifier, SrcSpan)
curCompNm
CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
tt <- Getting
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> NetlistMonad
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
Lens'
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
typeTranslator
CustomReprs
reprs <- Getting CustomReprs NetlistState CustomReprs
-> NetlistMonad CustomReprs
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting CustomReprs NetlistState CustomReprs
Lens' NetlistState CustomReprs
customReprs
TyConMap
tcm <- Getting TyConMap NetlistState TyConMap -> NetlistMonad TyConMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting TyConMap NetlistState TyConMap
Lens' NetlistState TyConMap
tcCache
HWMap
htm0 <- Getting HWMap NetlistState HWMap -> NetlistMonad HWMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting HWMap NetlistState HWMap
Lens' NetlistState HWMap
htyCache
let (hty :: FilteredHWType
hty,htm1 :: HWMap
htm1) = StateT HWMap Identity FilteredHWType
-> HWMap -> (FilteredHWType, HWMap)
forall s a. State s a -> s -> (a, s)
runState (SrcSpan
-> String
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity FilteredHWType
unsafeCoreTypeToHWType SrcSpan
cmpNm String
loc CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
tt CustomReprs
reprs TyConMap
tcm Type
ty) HWMap
htm0
(HWMap -> Identity HWMap) -> NetlistState -> Identity NetlistState
Lens' NetlistState HWMap
htyCache ((HWMap -> Identity HWMap)
-> NetlistState -> Identity NetlistState)
-> HWMap -> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
Lens..= HWMap
htm1
FilteredHWType -> NetlistMonad FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return FilteredHWType
hty
coreTypeToHWTypeM'
:: Type
-> NetlistMonad (Maybe HWType)
coreTypeToHWTypeM' :: Type -> NetlistMonad (Maybe HWType)
coreTypeToHWTypeM' ty :: Type
ty =
(FilteredHWType -> HWType) -> Maybe FilteredHWType -> Maybe HWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilteredHWType -> HWType
stripFiltered (Maybe FilteredHWType -> Maybe HWType)
-> NetlistMonad (Maybe FilteredHWType)
-> NetlistMonad (Maybe HWType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> NetlistMonad (Maybe FilteredHWType)
coreTypeToHWTypeM Type
ty
coreTypeToHWTypeM
:: Type
-> NetlistMonad (Maybe FilteredHWType)
coreTypeToHWTypeM :: Type -> NetlistMonad (Maybe FilteredHWType)
coreTypeToHWTypeM ty :: Type
ty = do
CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
tt <- Getting
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> NetlistMonad
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
Lens'
NetlistState
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
typeTranslator
CustomReprs
reprs <- Getting CustomReprs NetlistState CustomReprs
-> NetlistMonad CustomReprs
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting CustomReprs NetlistState CustomReprs
Lens' NetlistState CustomReprs
customReprs
TyConMap
tcm <- Getting TyConMap NetlistState TyConMap -> NetlistMonad TyConMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting TyConMap NetlistState TyConMap
Lens' NetlistState TyConMap
tcCache
HWMap
htm0 <- Getting HWMap NetlistState HWMap -> NetlistMonad HWMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting HWMap NetlistState HWMap
Lens' NetlistState HWMap
htyCache
let (hty :: Either String FilteredHWType
hty,htm1 :: HWMap
htm1) = StateT HWMap Identity (Either String FilteredHWType)
-> HWMap -> (Either String FilteredHWType, HWMap)
forall s a. State s a -> s -> (a, s)
runState ((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))
tt CustomReprs
reprs TyConMap
tcm Type
ty) HWMap
htm0
(HWMap -> Identity HWMap) -> NetlistState -> Identity NetlistState
Lens' NetlistState HWMap
htyCache ((HWMap -> Identity HWMap)
-> NetlistState -> Identity NetlistState)
-> HWMap -> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
Lens..= HWMap
htm1
Maybe FilteredHWType -> NetlistMonad (Maybe FilteredHWType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String FilteredHWType -> Maybe FilteredHWType
forall a b. Either a b -> Maybe b
hush Either String FilteredHWType
hty)
packSP
:: CustomReprs
-> (Text, c)
-> (ConstrRepr', Text, c)
packSP :: CustomReprs -> (Identifier, c) -> (ConstrRepr', Identifier, c)
packSP reprs :: CustomReprs
reprs (name :: Identifier
name, tys :: c
tys) =
case Identifier -> CustomReprs -> Maybe ConstrRepr'
getConstrRepr Identifier
name CustomReprs
reprs of
Just repr :: ConstrRepr'
repr -> (ConstrRepr'
repr, Identifier
name, c
tys)
Nothing -> String -> (ConstrRepr', Identifier, c)
forall a. HasCallStack => String -> a
error (String -> (ConstrRepr', Identifier, c))
-> String -> (ConstrRepr', Identifier, c)
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
[ "Could not find custom representation for", Identifier -> String
Text.unpack Identifier
name ]
packSum
:: CustomReprs
-> Text
-> (ConstrRepr', Text)
packSum :: CustomReprs -> Identifier -> (ConstrRepr', Identifier)
packSum reprs :: CustomReprs
reprs name :: Identifier
name =
case Identifier -> CustomReprs -> Maybe ConstrRepr'
getConstrRepr Identifier
name CustomReprs
reprs of
Just repr :: ConstrRepr'
repr -> (ConstrRepr'
repr, Identifier
name)
Nothing -> String -> (ConstrRepr', Identifier)
forall a. HasCallStack => String -> a
error (String -> (ConstrRepr', Identifier))
-> String -> (ConstrRepr', Identifier)
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords
[ "Could not find custom representation for", Identifier -> String
Text.unpack Identifier
name ]
fixCustomRepr
:: CustomReprs
-> Type
-> HWType
-> HWType
fixCustomRepr :: CustomReprs -> Type -> HWType -> HWType
fixCustomRepr reprs :: CustomReprs
reprs (Type -> Either String Type'
coreToType' -> Right tyName :: Type'
tyName) sum_ :: HWType
sum_@(Sum name :: Identifier
name subtys :: [Identifier]
subtys) =
case Type' -> CustomReprs -> Maybe DataRepr'
getDataRepr Type'
tyName CustomReprs
reprs of
Just dRepr :: DataRepr'
dRepr@(DataRepr' name' :: Type'
name' size :: Size
size constrs :: [ConstrRepr']
constrs) ->
if [ConstrRepr'] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [ConstrRepr']
constrs Size -> Size -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== [Identifier] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [Identifier]
subtys then
Identifier
-> DataRepr' -> Size -> [(ConstrRepr', Identifier)] -> HWType
CustomSum
Identifier
name
DataRepr'
dRepr
(Size -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size)
[CustomReprs -> Identifier -> (ConstrRepr', Identifier)
packSum CustomReprs
reprs Identifier
ty | Identifier
ty <- [Identifier]
subtys]
else
String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Identifier -> String
Text.unpack (Identifier -> String) -> Identifier -> String
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
Text.unwords
[ "Type "
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Type' -> String
forall a. Show a => a -> String
show Type'
name'
, "has"
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Size -> String
forall a. Show a => a -> String
show (Size -> String) -> Size -> String
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [Identifier]
subtys
, "constructors: \n\n"
, Identifier -> [Identifier] -> Identifier
Text.intercalate "\n" ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort [Identifier -> Identifier -> Identifier
Text.append " * " Identifier
id_ | Identifier
id_ <- [Identifier]
subtys]
, "\n\nBut the custom bit representation only specified"
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Size -> String
forall a. Show a => a -> String
show (Size -> String) -> Size -> String
forall a b. (a -> b) -> a -> b
$ [ConstrRepr'] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [ConstrRepr']
constrs
, "constructors:\n\n"
, Identifier -> [Identifier] -> Identifier
Text.intercalate "\n" ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort [Identifier -> Identifier -> Identifier
Text.append " * " Identifier
id_ | (ConstrRepr' id_ :: Identifier
id_ _ _ _ _) <- [ConstrRepr']
constrs]
])
Nothing ->
HWType
sum_
fixCustomRepr reprs :: CustomReprs
reprs (Type -> Either String Type'
coreToType' -> Right tyName :: Type'
tyName) sp :: HWType
sp@(SP name :: Identifier
name subtys :: [(Identifier, [HWType])]
subtys) =
case Type' -> CustomReprs -> Maybe DataRepr'
getDataRepr Type'
tyName CustomReprs
reprs of
Just dRepr :: DataRepr'
dRepr@(DataRepr' name' :: Type'
name' size :: Size
size constrs :: [ConstrRepr']
constrs) ->
if [ConstrRepr'] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [ConstrRepr']
constrs Size -> Size -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== [(Identifier, [HWType])] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [(Identifier, [HWType])]
subtys then
Identifier
-> DataRepr'
-> Size
-> [(ConstrRepr', Identifier, [HWType])]
-> HWType
CustomSP
Identifier
name
DataRepr'
dRepr
(Size -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size)
[CustomReprs
-> (Identifier, [HWType]) -> (ConstrRepr', Identifier, [HWType])
forall c.
CustomReprs -> (Identifier, c) -> (ConstrRepr', Identifier, c)
packSP CustomReprs
reprs (Identifier, [HWType])
ty | (Identifier, [HWType])
ty <- [(Identifier, [HWType])]
subtys]
else
String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Identifier -> String
Text.unpack (Identifier -> String) -> Identifier -> String
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
Text.unwords
[ "Type "
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Type' -> String
forall a. Show a => a -> String
show (Type' -> String) -> Type' -> String
forall a b. (a -> b) -> a -> b
$ Type'
name'
, "has"
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Size -> String
forall a. Show a => a -> String
show (Size -> String) -> Size -> String
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [(Identifier, [HWType])]
subtys
, "constructors: \n\n"
, Identifier -> [Identifier] -> Identifier
Text.intercalate "\n" ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort [Identifier -> Identifier -> Identifier
Text.append " * " Identifier
id_ | (id_ :: Identifier
id_, _) <- [(Identifier, [HWType])]
subtys]
, "\n\nBut the custom bit representation only specified"
, String -> Identifier
Text.pack (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ Size -> String
forall a. Show a => a -> String
show (Size -> String) -> Size -> String
forall a b. (a -> b) -> a -> b
$ [ConstrRepr'] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [ConstrRepr']
constrs, "constructors:\n\n"
, Identifier -> [Identifier] -> Identifier
Text.intercalate "\n" ([Identifier] -> Identifier) -> [Identifier] -> Identifier
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Identifier]
forall a. Ord a => [a] -> [a]
sort [Identifier -> Identifier -> Identifier
Text.append " * " Identifier
id_ | (ConstrRepr' id_ :: Identifier
id_ _ _ _ _) <- [ConstrRepr']
constrs]
])
Nothing ->
HWType
sp
fixCustomRepr _ _ typ :: HWType
typ = HWType
typ
coreTypeToHWType'
:: (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Either String HWType)
coreTypeToHWType' :: (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Either String HWType)
coreTypeToHWType' builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs m :: TyConMap
m ty :: Type
ty =
(FilteredHWType -> HWType)
-> Either String FilteredHWType -> Either String HWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilteredHWType -> HWType
stripFiltered (Either String FilteredHWType -> Either String HWType)
-> StateT HWMap Identity (Either String FilteredHWType)
-> State HWMap (Either String HWType)
forall (f :: * -> *) 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))
builtInTranslation CustomReprs
reprs TyConMap
m Type
ty
coreTypeToHWType
:: (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Either String FilteredHWType)
coreTypeToHWType :: (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> StateT HWMap Identity (Either String FilteredHWType)
coreTypeToHWType builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs m :: TyConMap
m ty :: Type
ty = do
Maybe (Either String FilteredHWType)
htyM <- Type -> HWMap -> Maybe (Either String FilteredHWType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Type
ty (HWMap -> Maybe (Either String FilteredHWType))
-> StateT HWMap Identity HWMap
-> State HWMap (Maybe (Either String FilteredHWType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT HWMap Identity HWMap
forall s (m :: * -> *). MonadState s m => m s
get
case Maybe (Either String FilteredHWType)
htyM of
Just hty :: Either String FilteredHWType
hty -> Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String FilteredHWType
hty
_ -> do
Maybe (Either String FilteredHWType)
hty0M <- CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation CustomReprs
reprs TyConMap
m Type
ty
Either String FilteredHWType
hty1 <- Maybe (Either String FilteredHWType)
-> Type -> StateT HWMap Identity (Either String FilteredHWType)
go Maybe (Either String FilteredHWType)
hty0M Type
ty
(HWMap -> HWMap) -> StateT HWMap Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Type -> Either String FilteredHWType -> HWMap -> HWMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Type
ty Either String FilteredHWType
hty1)
Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String FilteredHWType
hty1
where
go :: Maybe (Either String FilteredHWType)
-> Type
-> State (HashMap Type (Either String FilteredHWType))
(Either String FilteredHWType)
go :: Maybe (Either String FilteredHWType)
-> Type -> StateT HWMap Identity (Either String FilteredHWType)
go (Just hwtyE :: Either String FilteredHWType
hwtyE) _ = Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType))
-> Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$
(\(FilteredHWType hwty :: HWType
hwty filtered :: [[(IsVoid, FilteredHWType)]]
filtered) ->
(HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (CustomReprs -> Type -> HWType -> HWType
fixCustomRepr CustomReprs
reprs Type
ty HWType
hwty) [[(IsVoid, FilteredHWType)]]
filtered)) (FilteredHWType -> FilteredHWType)
-> Either String FilteredHWType -> Either String FilteredHWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String FilteredHWType
hwtyE
go _ (TyConMap -> Type -> Maybe Type
coreView1 TyConMap
m -> Just ty' :: Type
ty') =
(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))
builtInTranslation CustomReprs
reprs TyConMap
m Type
ty'
go _ (Type -> TypeView
tyView -> TyConApp tc :: TyConName
tc args :: [Type]
args) = ExceptT String (State HWMap) FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (State HWMap) FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType))
-> ExceptT String (State HWMap) FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ do
FilteredHWType hwty :: HWType
hwty filtered :: [[(IsVoid, FilteredHWType)]]
filtered <- (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> String
-> TyConName
-> [Type]
-> ExceptT String (State HWMap) FilteredHWType
mkADT CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation CustomReprs
reprs TyConMap
m (Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty) TyConName
tc [Type]
args
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (CustomReprs -> Type -> HWType -> HWType
fixCustomRepr CustomReprs
reprs Type
ty HWType
hwty) [[(IsVoid, FilteredHWType)]]
filtered)
go _ _ = Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType))
-> Either String FilteredHWType
-> StateT HWMap Identity (Either String FilteredHWType)
forall a b. (a -> b) -> a -> b
$ String -> Either String FilteredHWType
forall a b. a -> Either a b
Left (String -> Either String FilteredHWType)
-> String -> Either String FilteredHWType
forall a b. (a -> b) -> a -> b
$ "Can't translate non-tycon type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall p. PrettyPrec p => p -> String
showPpr Type
ty
originalIndices
:: [Bool]
-> [Int]
originalIndices :: [IsVoid] -> [Size]
originalIndices wereVoids :: [IsVoid]
wereVoids =
[Size
i | (i :: Size
i, void :: IsVoid
void) <- [Size] -> [IsVoid] -> [(Size, IsVoid)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [IsVoid]
wereVoids, IsVoid -> IsVoid
not IsVoid
void]
mkADT
:: (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> String
-> TyConName
-> [Type]
-> ExceptT String (State HWMap) FilteredHWType
mkADT :: (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> String
-> TyConName
-> [Type]
-> ExceptT String (State HWMap) FilteredHWType
mkADT _ _ m :: TyConMap
m tyString :: String
tyString tc :: TyConName
tc _
| TyConMap -> TyConName -> IsVoid
isRecursiveTy TyConMap
m TyConName
tc
= String -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String (State HWMap) FilteredHWType)
-> String -> ExceptT String (State HWMap) FilteredHWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Can't translate recursive type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tyString
mkADT builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs m :: TyConMap
m _tyString :: String
_tyString tc :: TyConName
tc args :: [Type]
args = case TyCon -> [DataCon]
tyConDataCons (TyConMap
m TyConMap -> TyConName -> TyCon
forall a b. (HasCallStack, Uniquable a) => UniqMap b -> a -> b
`lookupUniqMap'` TyConName
tc) of
[] -> FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing) [])
dcs :: [DataCon]
dcs -> do
let tcName :: Identifier
tcName = TyConName -> Identifier
forall a. Name a -> Identifier
nameOcc TyConName
tc
substArgTyss :: [[Type]]
substArgTyss = (DataCon -> [Type]) -> [DataCon] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
map (DataCon -> [Type] -> [Type]
`substArgTys` [Type]
args) [DataCon]
dcs
[[FilteredHWType]]
argHTyss0 <- ([Type] -> ExceptT String (State HWMap) [FilteredHWType])
-> [[Type]] -> ExceptT String (State HWMap) [[FilteredHWType]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Type -> ExceptT String (State HWMap) FilteredHWType)
-> [Type] -> ExceptT String (State HWMap) [FilteredHWType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT HWMap Identity (Either String FilteredHWType)
-> ExceptT String (State HWMap) FilteredHWType
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT HWMap Identity (Either String FilteredHWType)
-> ExceptT String (State HWMap) FilteredHWType)
-> (Type -> StateT HWMap Identity (Either String FilteredHWType))
-> Type
-> ExceptT String (State HWMap) FilteredHWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
builtInTranslation CustomReprs
reprs TyConMap
m)) [[Type]]
substArgTyss
let argHTyss1 :: [[(IsVoid, FilteredHWType)]]
argHTyss1 = ([FilteredHWType] -> [(IsVoid, FilteredHWType)])
-> [[FilteredHWType]] -> [[(IsVoid, FilteredHWType)]]
forall a b. (a -> b) -> [a] -> [b]
map (\tys :: [FilteredHWType]
tys -> [IsVoid] -> [FilteredHWType] -> [(IsVoid, FilteredHWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FilteredHWType -> IsVoid) -> [FilteredHWType] -> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map FilteredHWType -> IsVoid
isFilteredVoid [FilteredHWType]
tys) [FilteredHWType]
tys) [[FilteredHWType]]
argHTyss0
let areVoids :: [[IsVoid]]
areVoids = ([(IsVoid, FilteredHWType)] -> [IsVoid])
-> [[(IsVoid, FilteredHWType)]] -> [[IsVoid]]
forall a b. (a -> b) -> [a] -> [b]
map (((IsVoid, FilteredHWType) -> IsVoid)
-> [(IsVoid, FilteredHWType)] -> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map (IsVoid, FilteredHWType) -> IsVoid
forall a b. (a, b) -> a
fst) [[(IsVoid, FilteredHWType)]]
argHTyss1
let filteredArgHTyss :: [[FilteredHWType]]
filteredArgHTyss = ([(IsVoid, FilteredHWType)] -> [FilteredHWType])
-> [[(IsVoid, FilteredHWType)]] -> [[FilteredHWType]]
forall a b. (a -> b) -> [a] -> [b]
map (((IsVoid, FilteredHWType) -> FilteredHWType)
-> [(IsVoid, FilteredHWType)] -> [FilteredHWType]
forall a b. (a -> b) -> [a] -> [b]
map (IsVoid, FilteredHWType) -> FilteredHWType
forall a b. (a, b) -> b
snd ([(IsVoid, FilteredHWType)] -> [FilteredHWType])
-> ([(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)])
-> [(IsVoid, FilteredHWType)]
-> [FilteredHWType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IsVoid, FilteredHWType) -> IsVoid)
-> [(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)]
forall a. (a -> IsVoid) -> [a] -> [a]
filter (IsVoid -> IsVoid
not (IsVoid -> IsVoid)
-> ((IsVoid, FilteredHWType) -> IsVoid)
-> (IsVoid, FilteredHWType)
-> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsVoid, FilteredHWType) -> IsVoid
forall a b. (a, b) -> a
fst)) [[(IsVoid, FilteredHWType)]]
argHTyss1
case ([DataCon]
dcs, [[FilteredHWType]]
filteredArgHTyss) of
(_:[],[[elemTy :: FilteredHWType
elemTy]]) ->
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (FilteredHWType -> HWType
stripFiltered FilteredHWType
elemTy) [[(IsVoid, FilteredHWType)]]
argHTyss1)
([DataCon -> [Identifier]
dcFieldLabels -> [Identifier]
labels0],[elemTys :: [FilteredHWType]
elemTys@(_:_)]) -> do
Maybe [Identifier]
labelsM <-
if [Identifier] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Identifier]
labels0 then
Maybe [Identifier]
-> ExceptT String (State HWMap) (Maybe [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Identifier]
forall a. Maybe a
Nothing
else
let areNotVoids :: [IsVoid]
areNotVoids = (IsVoid -> IsVoid) -> [IsVoid] -> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map IsVoid -> IsVoid
not ([[IsVoid]] -> [IsVoid]
forall a. [a] -> a
head [[IsVoid]]
areVoids) in
let labels1 :: [(IsVoid, Identifier)]
labels1 = ((IsVoid, Identifier) -> IsVoid)
-> [(IsVoid, Identifier)] -> [(IsVoid, Identifier)]
forall a. (a -> IsVoid) -> [a] -> [a]
filter (IsVoid, Identifier) -> IsVoid
forall a b. (a, b) -> a
fst ([IsVoid] -> [Identifier] -> [(IsVoid, Identifier)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IsVoid]
areNotVoids [Identifier]
labels0) in
let labels2 :: [Identifier]
labels2 = ((IsVoid, Identifier) -> Identifier)
-> [(IsVoid, Identifier)] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (IsVoid, Identifier) -> Identifier
forall a b. (a, b) -> b
snd [(IsVoid, Identifier)]
labels1 in
Maybe [Identifier]
-> ExceptT String (State HWMap) (Maybe [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Identifier] -> Maybe [Identifier]
forall a. a -> Maybe a
Just [Identifier]
labels2)
let hwty :: HWType
hwty = Identifier -> Maybe [Identifier] -> [HWType] -> HWType
Product Identifier
tcName Maybe [Identifier]
labelsM ((FilteredHWType -> HWType) -> [FilteredHWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map FilteredHWType -> HWType
stripFiltered [FilteredHWType]
elemTys)
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType HWType
hwty [[(IsVoid, FilteredHWType)]]
argHTyss1)
(_, [[FilteredHWType]] -> [FilteredHWType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat -> [])
| [DataCon] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [DataCon]
dcs Size -> Size -> IsVoid
forall a. Ord a => a -> a -> IsVoid
<= 1 ->
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (Maybe HWType -> HWType
Void Maybe HWType
forall a. Maybe a
Nothing) [[(IsVoid, FilteredHWType)]]
argHTyss1)
| IsVoid
otherwise ->
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (Identifier -> [Identifier] -> HWType
Sum Identifier
tcName ([Identifier] -> HWType) -> [Identifier] -> HWType
forall a b. (a -> b) -> a -> b
$ (DataCon -> Identifier) -> [DataCon] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (Name DataCon -> Identifier
forall a. Name a -> Identifier
nameOcc (Name DataCon -> Identifier)
-> (DataCon -> Name DataCon) -> DataCon -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> Name DataCon
dcName) [DataCon]
dcs) [[(IsVoid, FilteredHWType)]]
argHTyss1)
(_,elemHTys :: [[FilteredHWType]]
elemHTys) ->
FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilteredHWType -> ExceptT String (State HWMap) FilteredHWType)
-> FilteredHWType -> ExceptT String (State HWMap) FilteredHWType
forall a b. (a -> b) -> a -> b
$ HWType -> [[(IsVoid, FilteredHWType)]] -> FilteredHWType
FilteredHWType (Identifier -> [(Identifier, [HWType])] -> HWType
SP Identifier
tcName ([(Identifier, [HWType])] -> HWType)
-> [(Identifier, [HWType])] -> HWType
forall a b. (a -> b) -> a -> b
$ (DataCon -> [HWType] -> (Identifier, [HWType]))
-> [DataCon] -> [[HWType]] -> [(Identifier, [HWType])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\dc :: DataCon
dc tys :: [HWType]
tys -> ( Name DataCon -> Identifier
forall a. Name a -> Identifier
nameOcc (DataCon -> Name DataCon
dcName DataCon
dc), [HWType]
tys))
[DataCon]
dcs ((FilteredHWType -> HWType) -> [FilteredHWType] -> [HWType]
forall a b. (a -> b) -> [a] -> [b]
map FilteredHWType -> HWType
stripFiltered ([FilteredHWType] -> [HWType]) -> [[FilteredHWType]] -> [[HWType]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[FilteredHWType]]
elemHTys)) [[(IsVoid, FilteredHWType)]]
argHTyss1
isRecursiveTy :: TyConMap -> TyConName -> Bool
isRecursiveTy :: TyConMap -> TyConName -> IsVoid
isRecursiveTy m :: TyConMap
m tc :: TyConName
tc = case TyCon -> [DataCon]
tyConDataCons (TyConMap
m TyConMap -> TyConName -> TyCon
forall a b. (HasCallStack, Uniquable a) => UniqMap b -> a -> b
`lookupUniqMap'` TyConName
tc) of
[] -> IsVoid
False
dcs :: [DataCon]
dcs -> let argTyss :: [[Type]]
argTyss = (DataCon -> [Type]) -> [DataCon] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> [Type]
dcArgTys [DataCon]
dcs
argTycons :: [TyConName]
argTycons = (((TyConName, [Type]) -> TyConName)
-> [(TyConName, [Type])] -> [TyConName]
forall a b. (a -> b) -> [a] -> [b]
map (TyConName, [Type]) -> TyConName
forall a b. (a, b) -> a
fst ([(TyConName, [Type])] -> [TyConName])
-> ([Maybe (TyConName, [Type])] -> [(TyConName, [Type])])
-> [Maybe (TyConName, [Type])]
-> [TyConName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (TyConName, [Type])] -> [(TyConName, [Type])]
forall a. [Maybe a] -> [a]
catMaybes) ([Maybe (TyConName, [Type])] -> [TyConName])
-> [Maybe (TyConName, [Type])] -> [TyConName]
forall a b. (a -> b) -> a -> b
$ (([Type] -> [Maybe (TyConName, [Type])])
-> [[Type]] -> [Maybe (TyConName, [Type])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Type] -> [Maybe (TyConName, [Type])])
-> [[Type]] -> [Maybe (TyConName, [Type])])
-> ((Type -> Maybe (TyConName, [Type]))
-> [Type] -> [Maybe (TyConName, [Type])])
-> (Type -> Maybe (TyConName, [Type]))
-> [[Type]]
-> [Maybe (TyConName, [Type])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Maybe (TyConName, [Type]))
-> [Type] -> [Maybe (TyConName, [Type])]
forall a b. (a -> b) -> [a] -> [b]
map) Type -> Maybe (TyConName, [Type])
splitTyConAppM [[Type]]
argTyss
in TyConName
tc TyConName -> [TyConName] -> IsVoid
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsVoid
`elem` [TyConName]
argTycons
representableType
:: (CustomReprs -> TyConMap -> Type ->
State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> Bool
-> TyConMap
-> Type
-> Bool
representableType :: (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs -> IsVoid -> TyConMap -> Type -> IsVoid
representableType builtInTranslation :: CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation reprs :: CustomReprs
reprs stringRepresentable :: IsVoid
stringRepresentable m :: TyConMap
m =
(String -> IsVoid)
-> (HWType -> IsVoid) -> Either String HWType -> IsVoid
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IsVoid -> String -> IsVoid
forall a b. a -> b -> a
const IsVoid
False) HWType -> IsVoid
isRepresentable (Either String HWType -> IsVoid)
-> (Type -> Either String HWType) -> Type -> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(State HWMap (Either String HWType)
-> HWMap -> Either String HWType)
-> HWMap
-> State HWMap (Either String HWType)
-> Either String HWType
forall a b c. (a -> b -> c) -> b -> a -> c
flip State HWMap (Either String HWType) -> HWMap -> Either String HWType
forall s a. State s a -> s -> a
evalState HWMap
forall k v. HashMap k v
HashMap.empty (State HWMap (Either String HWType) -> Either String HWType)
-> (Type -> State HWMap (Either String HWType))
-> Type
-> Either String HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType)))
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Either String HWType)
coreTypeToHWType' CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either String FilteredHWType))
builtInTranslation CustomReprs
reprs TyConMap
m
where
isRepresentable :: HWType -> IsVoid
isRepresentable hty :: HWType
hty = case HWType
hty of
String -> IsVoid
stringRepresentable
Vector _ elTy :: HWType
elTy -> HWType -> IsVoid
isRepresentable HWType
elTy
RTree _ elTy :: HWType
elTy -> HWType -> IsVoid
isRepresentable HWType
elTy
Product _ _ elTys :: [HWType]
elTys -> (HWType -> IsVoid) -> [HWType] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
all HWType -> IsVoid
isRepresentable [HWType]
elTys
SP _ elTyss :: [(Identifier, [HWType])]
elTyss -> ((Identifier, [HWType]) -> IsVoid)
-> [(Identifier, [HWType])] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
all ((HWType -> IsVoid) -> [HWType] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
all HWType -> IsVoid
isRepresentable ([HWType] -> IsVoid)
-> ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType])
-> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd) [(Identifier, [HWType])]
elTyss
BiDirectional _ t :: HWType
t -> HWType -> IsVoid
isRepresentable HWType
t
Annotated _ ty :: HWType
ty -> HWType -> IsVoid
isRepresentable HWType
ty
_ -> IsVoid
True
typeSize :: HWType
-> Int
typeSize :: HWType -> Size
typeSize (Void {}) = 0
typeSize String = 0
typeSize Integer = 0
typeSize (KnownDomain {}) = 0
typeSize Bool = 1
typeSize Bit = 1
typeSize (Clock _) = 1
typeSize (Reset {}) = 1
typeSize (BitVector i :: Size
i) = Size
i
typeSize (Index 0) = 0
typeSize (Index 1) = 1
typeSize (Index u :: Integer
u) = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe 0 (Integer -> Integer -> Maybe Size
clogBase 2 Integer
u)
typeSize (Signed i :: Size
i) = Size
i
typeSize (Unsigned i :: Size
i) = Size
i
typeSize (Vector n :: Size
n el :: HWType
el) = Size
n Size -> Size -> Size
forall a. Num a => a -> a -> a
* HWType -> Size
typeSize HWType
el
typeSize (RTree d :: Size
d el :: HWType
el) = (2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
d) Size -> Size -> Size
forall a. Num a => a -> a -> a
* HWType -> Size
typeSize HWType
el
typeSize t :: HWType
t@(SP _ cons :: [(Identifier, [HWType])]
cons) = HWType -> Size
conSize HWType
t Size -> Size -> Size
forall a. Num a => a -> a -> a
+
[Size] -> Size
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Identifier, [HWType]) -> Size)
-> [(Identifier, [HWType])] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map ([Size] -> Size
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Size] -> Size)
-> ((Identifier, [HWType]) -> [Size])
-> (Identifier, [HWType])
-> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWType -> Size) -> [HWType] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Size
typeSize ([HWType] -> [Size])
-> ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType])
-> [Size]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd) [(Identifier, [HWType])]
cons)
typeSize (Sum _ dcs :: [Identifier]
dcs) = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Size -> Size) -> (Size -> Maybe Size) -> Size -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Maybe Size
clogBase 2 (Integer -> Maybe Size) -> (Size -> Integer) -> Size -> Maybe Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Integer
forall a. Integral a => a -> Integer
toInteger (Size -> Size) -> Size -> Size
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [Identifier]
dcs
typeSize (Product _ _ tys :: [HWType]
tys) = [Size] -> Size
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Size] -> Size) -> [Size] -> Size
forall a b. (a -> b) -> a -> b
$ (HWType -> Size) -> [HWType] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Size
typeSize [HWType]
tys
typeSize (BiDirectional In h :: HWType
h) = HWType -> Size
typeSize HWType
h
typeSize (BiDirectional Out _) = 0
typeSize (CustomSP _ _ size :: Size
size _) = Size -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size
typeSize (CustomSum _ _ size :: Size
size _) = Size -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size
typeSize (Annotated _ ty :: HWType
ty) = HWType -> Size
typeSize HWType
ty
conSize :: HWType
-> Int
conSize :: HWType -> Size
conSize (SP _ cons :: [(Identifier, [HWType])]
cons) = Size -> Maybe Size -> Size
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Size -> Size) -> (Size -> Maybe Size) -> Size -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Maybe Size
clogBase 2 (Integer -> Maybe Size) -> (Size -> Integer) -> Size -> Maybe Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Integer
forall a. Integral a => a -> Integer
toInteger (Size -> Size) -> Size -> Size
forall a b. (a -> b) -> a -> b
$ [(Identifier, [HWType])] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [(Identifier, [HWType])]
cons
conSize t :: HWType
t = HWType -> Size
typeSize HWType
t
typeLength :: HWType
-> Int
typeLength :: HWType -> Size
typeLength (Vector n :: Size
n _) = Size
n
typeLength _ = 0
termHWType :: String
-> Term
-> NetlistMonad HWType
termHWType :: String -> Term -> NetlistMonad HWType
termHWType loc :: String
loc e :: Term
e = do
TyConMap
m <- Getting TyConMap NetlistState TyConMap -> NetlistMonad TyConMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting TyConMap NetlistState TyConMap
Lens' NetlistState TyConMap
tcCache
let ty :: Type
ty = TyConMap -> Term -> Type
termType TyConMap
m Term
e
FilteredHWType -> HWType
stripFiltered (FilteredHWType -> HWType)
-> NetlistMonad FilteredHWType -> NetlistMonad HWType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Type -> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM String
loc Type
ty
termHWTypeM
:: Term
-> NetlistMonad (Maybe FilteredHWType)
termHWTypeM :: Term -> NetlistMonad (Maybe FilteredHWType)
termHWTypeM e :: Term
e = do
TyConMap
m <- Getting TyConMap NetlistState TyConMap -> NetlistMonad TyConMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting TyConMap NetlistState TyConMap
Lens' NetlistState TyConMap
tcCache
let ty :: Type
ty = TyConMap -> Term -> Type
termType TyConMap
m Term
e
Type -> NetlistMonad (Maybe FilteredHWType)
coreTypeToHWTypeM Type
ty
isBiSignalIn :: HWType -> Bool
isBiSignalIn :: HWType -> IsVoid
isBiSignalIn (BiDirectional In _) = IsVoid
True
isBiSignalIn _ = IsVoid
False
containsBiSignalIn
:: HWType
-> Bool
containsBiSignalIn :: HWType -> IsVoid
containsBiSignalIn (BiDirectional In _) = IsVoid
True
containsBiSignalIn (Product _ _ tys :: [HWType]
tys) = (HWType -> IsVoid) -> [HWType] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
any HWType -> IsVoid
containsBiSignalIn [HWType]
tys
containsBiSignalIn (SP _ tyss :: [(Identifier, [HWType])]
tyss) = ((Identifier, [HWType]) -> IsVoid)
-> [(Identifier, [HWType])] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
any ((HWType -> IsVoid) -> [HWType] -> IsVoid
forall (t :: * -> *) a.
Foldable t =>
(a -> IsVoid) -> t a -> IsVoid
any HWType -> IsVoid
containsBiSignalIn ([HWType] -> IsVoid)
-> ((Identifier, [HWType]) -> [HWType])
-> (Identifier, [HWType])
-> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd) [(Identifier, [HWType])]
tyss
containsBiSignalIn (Vector _ ty :: HWType
ty) = HWType -> IsVoid
containsBiSignalIn HWType
ty
containsBiSignalIn (RTree _ ty :: HWType
ty) = HWType -> IsVoid
containsBiSignalIn HWType
ty
containsBiSignalIn _ = IsVoid
False
collectPortNames'
:: [String]
-> PortName
-> [Identifier]
collectPortNames' :: [String] -> PortName -> [Identifier]
collectPortNames' prefixes :: [String]
prefixes (PortName nm :: String
nm) =
let prefixes' :: [String]
prefixes' = [String] -> [String]
forall a. [a] -> [a]
reverse (String
nm String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prefixes) in
[String -> Identifier
forall a. IsString a => String -> a
fromString (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "_" [String]
prefixes')]
collectPortNames' prefixes :: [String]
prefixes (PortProduct "" nms :: [PortName]
nms) =
(PortName -> [Identifier]) -> [PortName] -> [Identifier]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> PortName -> [Identifier]
collectPortNames' [String]
prefixes) [PortName]
nms
collectPortNames' prefixes :: [String]
prefixes (PortProduct prefix :: String
prefix nms :: [PortName]
nms) =
(PortName -> [Identifier]) -> [PortName] -> [Identifier]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> PortName -> [Identifier]
collectPortNames' (String
prefix String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prefixes)) [PortName]
nms
collectPortNames
:: TopEntity
-> [Identifier]
collectPortNames :: TopEntity -> [Identifier]
collectPortNames TestBench {} = []
collectPortNames Synthesize { [PortName]
t_inputs :: TopEntity -> [PortName]
t_inputs :: [PortName]
t_inputs, PortName
t_output :: TopEntity -> PortName
t_output :: PortName
t_output } =
(PortName -> [Identifier]) -> [PortName] -> [Identifier]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> PortName -> [Identifier]
collectPortNames' []) [PortName]
t_inputs [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ ([String] -> PortName -> [Identifier]
collectPortNames' []) PortName
t_output
filterVoidPorts
:: FilteredHWType
-> PortName
-> PortName
filterVoidPorts :: FilteredHWType -> PortName -> PortName
filterVoidPorts _hwty :: FilteredHWType
_hwty (PortName s :: String
s) =
String -> PortName
PortName String
s
filterVoidPorts (FilteredHWType _hwty :: HWType
_hwty [filtered :: [(IsVoid, FilteredHWType)]
filtered]) (PortProduct s :: String
s ps :: [PortName]
ps) =
String -> [PortName] -> PortName
PortProduct String
s [FilteredHWType -> PortName -> PortName
filterVoidPorts FilteredHWType
f PortName
p | (p :: PortName
p, (void :: IsVoid
void, f :: FilteredHWType
f)) <- [PortName]
-> [(IsVoid, FilteredHWType)]
-> [(PortName, (IsVoid, FilteredHWType))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PortName]
ps [(IsVoid, FilteredHWType)]
filtered, IsVoid -> IsVoid
not IsVoid
void]
filterVoidPorts (FilteredHWType _hwty :: HWType
_hwty fs :: [[(IsVoid, FilteredHWType)]]
fs) (PortProduct s :: String
s ps :: [PortName]
ps)
| [(IsVoid, FilteredHWType)] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length (((IsVoid, FilteredHWType) -> IsVoid)
-> [(IsVoid, FilteredHWType)] -> [(IsVoid, FilteredHWType)]
forall a. (a -> IsVoid) -> [a] -> [a]
filter (IsVoid -> IsVoid
not(IsVoid -> IsVoid)
-> ((IsVoid, FilteredHWType) -> IsVoid)
-> (IsVoid, FilteredHWType)
-> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IsVoid, FilteredHWType) -> IsVoid
forall a b. (a, b) -> a
fst) ([[(IsVoid, FilteredHWType)]] -> [(IsVoid, FilteredHWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(IsVoid, FilteredHWType)]]
fs)) Size -> Size -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== 1
, [PortName] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [PortName]
ps Size -> Size -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== 2
= String -> [PortName] -> PortName
PortProduct String
s [PortName]
ps
filterVoidPorts filtered :: FilteredHWType
filtered pp :: PortName
pp@(PortProduct _s :: String
_s _ps :: [PortName]
_ps) =
String -> PortName
forall a. HasCallStack => String -> a
error (String -> PortName) -> String -> PortName
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Ports were annotated as product, but type wasn't one: \n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " Filtered was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FilteredHWType -> String
forall a. Show a => a -> String
show FilteredHWType
filtered String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " Ports was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PortName -> String
forall a. Show a => a -> String
show PortName
pp
mkUniqueNormalized
:: InScopeSet
-> Maybe (Maybe TopEntity)
-> ( [Id]
, [LetBinding]
, Id
)
-> NetlistMonad
([Bool]
,[(Identifier,HWType)]
,[Declaration]
,[(Identifier,HWType)]
,[Declaration]
,[LetBinding]
,Maybe Id)
mkUniqueNormalized :: InScopeSet
-> Maybe (Maybe TopEntity)
-> ([Id], [LetBinding], Id)
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration],
[(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
mkUniqueNormalized is0 :: InScopeSet
is0 topMM :: Maybe (Maybe TopEntity)
topMM (args :: [Id]
args,binds :: [LetBinding]
binds,res :: Id
res) = do
let
portNames :: [Identifier]
portNames =
case Maybe (Maybe TopEntity) -> Maybe TopEntity
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe TopEntity)
topMM of
Nothing -> []
Just top :: TopEntity
top -> TopEntity -> [Identifier]
collectPortNames TopEntity
top
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((Word -> Word -> Word)
-> HashMap Identifier Word
-> HashMap Identifier Word
-> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith Word -> Word -> Word
forall a. Ord a => a -> a -> a
max ([(Identifier, Word)] -> HashMap Identifier Word
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((Identifier -> (Identifier, Word))
-> [Identifier] -> [(Identifier, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (,0) [Identifier]
portNames)))
let (bndrs :: [Id]
bndrs,exprs :: [Term]
exprs) = [LetBinding] -> ([Id], [Term])
forall a b. [(a, b)] -> ([a], [b])
unzip [LetBinding]
binds
let is1 :: InScopeSet
is1 = InScopeSet
is0 InScopeSet -> [Id] -> InScopeSet
forall a. InScopeSet -> [Var a] -> InScopeSet
`extendInScopeSetList` ([Id]
args [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ [Id]
bndrs)
(wereVoids :: [IsVoid]
wereVoids, iports :: [(Identifier, HWType)]
iports,iwrappers :: [Declaration]
iwrappers,substArgs :: Subst
substArgs) <- Subst
-> Maybe (Maybe TopEntity)
-> [Id]
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
mkUniqueArguments (InScopeSet -> Subst
mkSubst InScopeSet
is1) Maybe (Maybe TopEntity)
topMM [Id]
args
Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
resM <- Subst
-> Maybe (Maybe TopEntity)
-> Id
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
mkUniqueResult Subst
substArgs Maybe (Maybe TopEntity)
topMM Id
res
case Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
resM of
Just (oports :: [(Identifier, HWType)]
oports,owrappers :: [Declaration]
owrappers,res1 :: Id
res1,substRes :: Subst
substRes) -> do
let usesOutput :: [Id]
usesOutput = (Term -> [Id]) -> [Term] -> [Id]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Id -> IsVoid) -> [Id] -> [Id]
forall a. (a -> IsVoid) -> [a] -> [a]
filter ( Id -> Id -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Id
res)
([Id] -> [Id]) -> (Term -> [Id]) -> Term -> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Id]) Term Id -> Term -> [Id]
forall a s. Getting (Endo [a]) s a -> s -> [a]
Lens.toListOf Getting (Endo [Id]) Term Id
Fold Term Id
freeLocalIds
) [Term]
exprs
(res2 :: Name Term
res2,subst'' :: Subst
subst'',extraBndr :: [LetBinding]
extraBndr) <- case [Id]
usesOutput of
[] -> (Name Term, Subst, [LetBinding])
-> NetlistMonad (Name Term, Subst, [LetBinding])
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Name Term
forall a. Var a -> Name a
varName Id
res1
,Subst
substRes
,[] :: [(Id, Term)])
_ -> do
([res3 :: Id
res3],substRes' :: Subst
substRes') <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
substRes [(Name Term -> Name Term) -> Id -> Id
forall a. (Name a -> Name a) -> Var a -> Var a
modifyVarName (Name Term -> Identifier -> Name Term
forall a. Name a -> Identifier -> Name a
`appendToName` "_rec") Id
res]
(Name Term, Subst, [LetBinding])
-> NetlistMonad (Name Term, Subst, [LetBinding])
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Name Term
forall a. Var a -> Name a
varName Id
res3,Subst
substRes'
,[(Id
res1, Id -> Term
Var Id
res3)])
let resN :: Name Term
resN = Id -> Name Term
forall a. Var a -> Name a
varName Id
res
bndrs' :: [Id]
bndrs' = (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (\i :: Id
i -> if Id -> Name Term
forall a. Var a -> Name a
varName Id
i Name Term -> Name Term -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Name Term
resN then (Name Term -> Name Term) -> Id -> Id
forall a. (Name a -> Name a) -> Var a -> Var a
modifyVarName (Name Term -> Name Term -> Name Term
forall a b. a -> b -> a
const Name Term
res2) Id
i else Id
i) [Id]
bndrs
(bndrsL :: [Id]
bndrsL,r :: Id
r:bndrsR :: [Id]
bndrsR) = (Id -> IsVoid) -> [Id] -> ([Id], [Id])
forall a. (a -> IsVoid) -> [a] -> ([a], [a])
break ((Name Term -> Name Term -> IsVoid
forall a. Eq a => a -> a -> IsVoid
== Name Term
res2)(Name Term -> IsVoid) -> (Id -> Name Term) -> Id -> IsVoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Id -> Name Term
forall a. Var a -> Name a
varName) [Id]
bndrs'
(bndrsL' :: [Id]
bndrsL',substL :: Subst
substL) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
subst'' [Id]
bndrsL
(bndrsR' :: [Id]
bndrsR',substR :: Subst
substR) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
substL [Id]
bndrsR
let exprs' :: [Term]
exprs' = (Term -> Term) -> [Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Doc () -> Subst -> Term -> Term
Doc () -> Subst -> Term -> Term
substTm ("mkUniqueNormalized1" :: Doc ()) Subst
substR) [Term]
exprs
([IsVoid], [(Identifier, HWType)], [Declaration],
[(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration],
[(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([IsVoid]
wereVoids,[(Identifier, HWType)]
iports,[Declaration]
iwrappers,[(Identifier, HWType)]
oports,[Declaration]
owrappers,[Id] -> [Term] -> [LetBinding]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Id]
bndrsL' [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ Id
rId -> [Id] -> [Id]
forall a. a -> [a] -> [a]
:[Id]
bndrsR') [Term]
exprs' [LetBinding] -> [LetBinding] -> [LetBinding]
forall a. [a] -> [a] -> [a]
++ [LetBinding]
extraBndr,Id -> Maybe Id
forall a. a -> Maybe a
Just Id
res1)
Nothing -> do
(bndrs' :: [Id]
bndrs', substArgs' :: Subst
substArgs') <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
substArgs [Id]
bndrs
([IsVoid], [(Identifier, HWType)], [Declaration],
[(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration],
[(Identifier, HWType)], [Declaration], [LetBinding], Maybe Id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([IsVoid]
wereVoids,[(Identifier, HWType)]
iports,[Declaration]
iwrappers,[],[],[Id] -> [Term] -> [LetBinding]
forall a b. [a] -> [b] -> [(a, b)]
zip [Id]
bndrs' ((Term -> Term) -> [Term] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Doc () -> Subst -> Term -> Term
Doc () -> Subst -> Term -> Term
substTm ("mkUniqueNormalized2" :: Doc ()) Subst
substArgs') [Term]
exprs),Maybe Id
forall a. Maybe a
Nothing)
mkUniqueArguments
:: Subst
-> Maybe (Maybe TopEntity)
-> [Id]
-> NetlistMonad
( [Bool]
, [(Identifier,HWType)]
, [Declaration]
, Subst
)
mkUniqueArguments :: Subst
-> Maybe (Maybe TopEntity)
-> [Id]
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
mkUniqueArguments subst0 :: Subst
subst0 Nothing args :: [Id]
args = do
(args' :: [Id]
args',subst1 :: Subst
subst1) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
subst0 [Id]
args
[Maybe (Identifier, HWType)]
ports <- (Id -> NetlistMonad (Maybe (Identifier, HWType)))
-> [Id] -> NetlistMonad [Maybe (Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Id -> NetlistMonad (Maybe (Identifier, HWType))
idToInPort [Id]
args'
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (Identifier, HWType) -> IsVoid)
-> [Maybe (Identifier, HWType)] -> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Identifier, HWType) -> IsVoid
forall a. Maybe a -> IsVoid
isNothing [Maybe (Identifier, HWType)]
ports, [Maybe (Identifier, HWType)] -> [(Identifier, HWType)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Identifier, HWType)]
ports, [], Subst
subst1)
mkUniqueArguments subst0 :: Subst
subst0 (Just teM :: Maybe TopEntity
teM) args :: [Id]
args = do
let iPortSupply :: [Maybe PortName]
iPortSupply = [Maybe PortName]
-> (TopEntity -> [Maybe PortName])
-> Maybe TopEntity
-> [Maybe PortName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PortName -> [Maybe PortName]
forall a. a -> [a]
repeat Maybe PortName
forall a. Maybe a
Nothing) ([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName])
-> (TopEntity -> [PortName]) -> TopEntity -> [Maybe PortName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopEntity -> [PortName]
t_inputs) Maybe TopEntity
teM
[Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
ports0 <- (Maybe PortName
-> Id
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))))
-> [Maybe PortName]
-> [Id]
-> NetlistMonad
[Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> Id
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
go [Maybe PortName]
iPortSupply [Id]
args
let (ports1 :: [[(Identifier, HWType)]]
ports1, decls :: [[Declaration]]
decls, subst :: [(Id, LetBinding)]
subst) = [([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
-> ([[(Identifier, HWType)]], [[Declaration]], [(Id, LetBinding)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
-> [([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
ports0)
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
-> NetlistMonad
([IsVoid], [(Identifier, HWType)], [Declaration], Subst)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
-> IsVoid)
-> [Maybe
([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
-> [IsVoid]
forall a b. (a -> b) -> [a] -> [b]
map Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
-> IsVoid
forall a. Maybe a -> IsVoid
isNothing [Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))]
ports0
, [[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports1
, [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls
, Subst -> [Id] -> Subst
extendInScopeIdList (Subst -> [LetBinding] -> Subst
extendIdSubstList Subst
subst0 (((Id, LetBinding) -> LetBinding)
-> [(Id, LetBinding)] -> [LetBinding]
forall a b. (a -> b) -> [a] -> [b]
map (Id, LetBinding) -> LetBinding
forall a b. (a, b) -> b
snd [(Id, LetBinding)]
subst))
(((Id, LetBinding) -> Id) -> [(Id, LetBinding)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, LetBinding) -> Id
forall a b. (a, b) -> a
fst [(Id, LetBinding)]
subst))
where
go :: Maybe PortName
-> Id
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
go pM :: Maybe PortName
pM var :: Id
var = do
let i :: Name Term
i = Id -> Name Term
forall a. Var a -> Name a
varName Id
var
i' :: Identifier
i' = Name Term -> Identifier
forall a. Name a -> Identifier
nameOcc Name Term
i
ty :: Type
ty = Id -> Type
forall a. Var a -> Type
varType Id
var
FilteredHWType
fHwty <- String -> Type -> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM $(curLoc) Type
ty
let FilteredHWType hwty :: HWType
hwty _ = FilteredHWType
fHwty
(ports :: [(Identifier, HWType)]
ports,decls :: [Declaration]
decls,_,pN :: Identifier
pN) <- Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput (FilteredHWType -> PortName -> PortName
filterVoidPorts FilteredHWType
fHwty (PortName -> PortName) -> Maybe PortName -> Maybe PortName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortName
pM) (Identifier
i',HWType
hwty)
let pId :: Id
pId = Type -> Name Term -> Id
mkLocalId Type
ty (Identifier -> Name Term -> Name Term
forall a. Identifier -> Name a -> Name a
repName Identifier
pN Name Term
i)
if HWType -> IsVoid
isVoid HWType
hwty
then Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
forall a. Maybe a
Nothing
else Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding)))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Identifier, HWType)], [Declaration], (Id, LetBinding))
-> Maybe ([(Identifier, HWType)], [Declaration], (Id, LetBinding))
forall a. a -> Maybe a
Just ([(Identifier, HWType)]
ports,[Declaration]
decls,(Id
pId,(Id
var,Id -> Term
Var Id
pId))))
mkUniqueResult
:: Subst
-> Maybe (Maybe TopEntity)
-> Id
-> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Id,Subst))
mkUniqueResult :: Subst
-> Maybe (Maybe TopEntity)
-> Id
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
mkUniqueResult subst0 :: Subst
subst0 Nothing res :: Id
res = do
([res' :: Id
res'],subst1 :: Subst
subst1) <- Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique Subst
subst0 [Id
res]
Maybe (Identifier, HWType)
portM <- Id -> NetlistMonad (Maybe (Identifier, HWType))
idToOutPort Id
res'
case Maybe (Identifier, HWType)
portM of
Just port :: (Identifier, HWType)
port -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Identifier, HWType)], [Declaration], Id, Subst)
-> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
forall a. a -> Maybe a
Just ([(Identifier, HWType)
port],[],Id
res',Subst
subst1))
_ -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
forall a. Maybe a
Nothing
mkUniqueResult subst0 :: Subst
subst0 (Just teM :: Maybe TopEntity
teM) res :: Id
res = do
(_,sp :: SrcSpan
sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
-> NetlistMonad (Identifier, SrcSpan)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
Lens' NetlistState (Identifier, SrcSpan)
curCompNm
let o :: Name Term
o = Id -> Name Term
forall a. Var a -> Name a
varName Id
res
o' :: Identifier
o' = Name Term -> Identifier
forall a. Name a -> Identifier
nameOcc Name Term
o
ty :: Type
ty = Id -> Type
forall a. Var a -> Type
varType Id
res
FilteredHWType
fHwty <- String -> Type -> NetlistMonad FilteredHWType
unsafeCoreTypeToHWTypeM $(curLoc) Type
ty
let FilteredHWType hwty :: HWType
hwty _ = FilteredHWType
fHwty
oPortSupply :: Maybe PortName
oPortSupply = (TopEntity -> PortName) -> Maybe TopEntity -> Maybe PortName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TopEntity -> PortName
t_output Maybe TopEntity
teM
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
when (HWType -> IsVoid
containsBiSignalIn HWType
hwty)
(ClashException -> NetlistMonad ()
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
sp ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Maybe String
forall a. Maybe a
Nothing))
Maybe ([(Identifier, HWType)], [Declaration], Identifier)
output <- Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Identifier))
mkOutput (FilteredHWType -> PortName -> PortName
filterVoidPorts FilteredHWType
fHwty (PortName -> PortName) -> Maybe PortName -> Maybe PortName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortName
oPortSupply) (Identifier
o',HWType
hwty)
case Maybe ([(Identifier, HWType)], [Declaration], Identifier)
output of
Just (ports :: [(Identifier, HWType)]
ports, decls :: [Declaration]
decls, pN :: Identifier
pN) -> do
let pO :: Name Term
pO = Identifier -> Name Term -> Name Term
forall a. Identifier -> Name a -> Name a
repName Identifier
pN Name Term
o
pOId :: Id
pOId = Type -> Name Term -> Id
mkLocalId Type
ty Name Term
pO
subst1 :: Subst
subst1 = Subst -> Id -> Subst
extendInScopeId (Subst -> Id -> Term -> Subst
extendIdSubst Subst
subst0 Id
res (Id -> Term
Var Id
pOId)) Id
pOId
Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Identifier, HWType)], [Declaration], Id, Subst)
-> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
forall a. a -> Maybe a
Just ([(Identifier, HWType)]
ports,[Declaration]
decls,Id
pOId,Subst
subst1))
_ -> Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Id, Subst))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Identifier, HWType)], [Declaration], Id, Subst)
forall a. Maybe a
Nothing
idToInPort :: Id -> NetlistMonad (Maybe (Identifier,HWType))
idToInPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
idToInPort var :: Id
var = do
(_, sp :: SrcSpan
sp) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
-> NetlistMonad (Identifier, SrcSpan)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
Lens' NetlistState (Identifier, SrcSpan)
curCompNm
Maybe (Identifier, HWType)
portM <- Id -> NetlistMonad (Maybe (Identifier, HWType))
idToPort Id
var
case Maybe (Identifier, HWType)
portM of
Just (_,hty :: HWType
hty) -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
when (HWType -> IsVoid
containsBiSignalIn HWType
hty IsVoid -> IsVoid -> IsVoid
&& IsVoid -> IsVoid
not (HWType -> IsVoid
isBiSignalIn HWType
hty))
(ClashException -> NetlistMonad ()
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
sp ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "BiSignalIn currently cannot be part of a composite type when it's a function's argument") Maybe String
forall a. Maybe a
Nothing))
Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Identifier, HWType)
portM
_ -> Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Identifier, HWType)
forall a. Maybe a
Nothing
idToOutPort :: Id -> NetlistMonad (Maybe (Identifier,HWType))
idToOutPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
idToOutPort var :: Id
var = do
(_, srcspan :: SrcSpan
srcspan) <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
-> NetlistMonad (Identifier, SrcSpan)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
Lens' NetlistState (Identifier, SrcSpan)
curCompNm
Maybe (Identifier, HWType)
portM <- Id -> NetlistMonad (Maybe (Identifier, HWType))
idToPort Id
var
case Maybe (Identifier, HWType)
portM of
Just (_,hty :: HWType
hty) -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
when (HWType -> IsVoid
containsBiSignalIn HWType
hty)
(ClashException -> NetlistMonad ()
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
srcspan ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "BiSignalIn cannot be part of a function's result. Use 'readFromBiSignal'.") Maybe String
forall a. Maybe a
Nothing))
Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Identifier, HWType)
portM
_ -> Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Identifier, HWType)
forall a. Maybe a
Nothing
idToPort :: Id -> NetlistMonad (Maybe (Identifier,HWType))
idToPort :: Id -> NetlistMonad (Maybe (Identifier, HWType))
idToPort var :: Id
var = do
let i :: Name Term
i = Id -> Name Term
forall a. Var a -> Name a
varName Id
var
ty :: Type
ty = Id -> Type
forall a. Var a -> Type
varType Id
var
HWType
hwTy <- String -> Type -> NetlistMonad HWType
unsafeCoreTypeToHWTypeM' $(curLoc) Type
ty
if HWType -> IsVoid
isVoid HWType
hwTy
then Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Identifier, HWType)
forall a. Maybe a
Nothing
else Maybe (Identifier, HWType)
-> NetlistMonad (Maybe (Identifier, HWType))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Identifier, HWType) -> Maybe (Identifier, HWType)
forall a. a -> Maybe a
Just (Name Term -> Identifier
forall a. Name a -> Identifier
nameOcc Name Term
i, HWType
hwTy))
id2type :: Id -> Type
id2type :: Id -> Type
id2type = Id -> Type
forall a. Var a -> Type
varType
id2identifier :: Id -> Identifier
id2identifier :: Id -> Identifier
id2identifier = Name Term -> Identifier
forall a. Name a -> Identifier
nameOcc (Name Term -> Identifier) -> (Id -> Name Term) -> Id -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name Term
forall a. Var a -> Name a
varName
repName :: Text -> Name a -> Name a
repName :: Identifier -> Name a -> Name a
repName s :: Identifier
s (Name sort' :: NameSort
sort' _ i :: Size
i loc :: SrcSpan
loc) = NameSort -> Identifier -> Size -> SrcSpan -> Name a
forall a. NameSort -> Identifier -> Size -> SrcSpan -> Name a
Name NameSort
sort' Identifier
s Size
i SrcSpan
loc
mkUnique
:: Subst
-> [Id]
-> NetlistMonad ([Id],Subst)
mkUnique :: Subst -> [Id] -> NetlistMonad ([Id], Subst)
mkUnique = [Id] -> Subst -> [Id] -> NetlistMonad ([Id], Subst)
go []
where
go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id],Subst)
go :: [Id] -> Subst -> [Id] -> NetlistMonad ([Id], Subst)
go processed :: [Id]
processed subst :: Subst
subst [] = ([Id], Subst) -> NetlistMonad ([Id], Subst)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Id] -> [Id]
forall a. [a] -> [a]
reverse [Id]
processed,Subst
subst)
go processed :: [Id]
processed subst :: Subst
subst@(Subst isN :: InScopeSet
isN _ _ _) (i :: Id
i:is :: [Id]
is) = do
Identifier
iN <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended (Id -> Identifier
id2identifier Id
i)
let i' :: Id
i' = InScopeSet -> Id -> Id
forall a. InScopeSet -> Var a -> Var a
uniqAway InScopeSet
isN ((Name Term -> Name Term) -> Id -> Id
forall a. (Name a -> Name a) -> Var a -> Var a
modifyVarName (Identifier -> Name Term -> Name Term
forall a. Identifier -> Name a -> Name a
repName Identifier
iN) Id
i)
subst' :: Subst
subst' = Subst -> Id -> Subst
extendInScopeId (Subst -> Id -> Term -> Subst
extendIdSubst Subst
subst Id
i (Id -> Term
Var Id
i')) Id
i'
[Id] -> Subst -> [Id] -> NetlistMonad ([Id], Subst)
go (Id
i'Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
:[Id]
processed)
Subst
subst'
[Id]
is
mkUniqueIdentifier
:: IdType
-> Identifier
-> NetlistMonad Identifier
mkUniqueIdentifier :: IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier typ :: IdType
typ nm :: Identifier
nm = do
HashMap Identifier Word
seen <- Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
-> NetlistMonad (HashMap Identifier Word)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
Lens' NetlistState (HashMap Identifier Word)
seenIds
HashMap Identifier Word
seenC <- Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
-> NetlistMonad (HashMap Identifier Word)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
Lens' NetlistState (HashMap Identifier Word)
seenComps
Identifier
i <- IdType -> Identifier -> NetlistMonad Identifier
mkIdentifier IdType
typ Identifier
nm
let getCopyIter :: Identifier -> Maybe Word
getCopyIter k :: Identifier
k = First Word -> Maybe Word
forall a. First a -> Maybe a
getFirst (Maybe Word -> First Word
forall a. Maybe a -> First a
First (Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
k HashMap Identifier Word
seen) First Word -> First Word -> First Word
forall a. Semigroup a => a -> a -> a
<> Maybe Word -> First Word
forall a. Maybe a -> First a
First (Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
k HashMap Identifier Word
seenC))
case Identifier -> Maybe Word
getCopyIter Identifier
i of
Just n :: Word
n -> Word
-> (Identifier -> Maybe Word)
-> Identifier
-> NetlistMonad Identifier
go Word
n Identifier -> Maybe Word
getCopyIter Identifier
i
Nothing -> do
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
i 0
Identifier -> NetlistMonad Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier
i
where
go :: Word -> (Identifier -> Maybe Word) -> Identifier -> NetlistMonad Identifier
go :: Word
-> (Identifier -> Maybe Word)
-> Identifier
-> NetlistMonad Identifier
go n :: Word
n g :: Identifier -> Maybe Word
g i :: Identifier
i = do
Identifier
i' <- IdType -> Identifier -> Identifier -> NetlistMonad Identifier
extendIdentifier IdType
typ Identifier
i (String -> Identifier
Text.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:Word -> String
forall a. Show a => a -> String
show Word
n))
case Identifier -> Maybe Word
g Identifier
i' of
Just _ -> Word
-> (Identifier -> Maybe Word)
-> Identifier
-> NetlistMonad Identifier
go (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1) Identifier -> Maybe Word
g Identifier
i
Nothing -> do
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
i (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1)
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
i' 0
Identifier -> NetlistMonad Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier
i'
preserveVarEnv :: NetlistMonad a
-> NetlistMonad a
preserveVarEnv :: NetlistMonad a -> NetlistMonad a
preserveVarEnv action :: NetlistMonad a
action = do
Size
vCnt <- Getting Size NetlistState Size -> NetlistMonad Size
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting Size NetlistState Size
Lens' NetlistState Size
varCount
(Identifier, SrcSpan)
vComp <- Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
-> NetlistMonad (Identifier, SrcSpan)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting (Identifier, SrcSpan) NetlistState (Identifier, SrcSpan)
Lens' NetlistState (Identifier, SrcSpan)
curCompNm
HashMap Identifier Word
vSeen <- Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
-> NetlistMonad (HashMap Identifier Word)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(HashMap Identifier Word) NetlistState (HashMap Identifier Word)
Lens' NetlistState (HashMap Identifier Word)
seenIds
a
val <- NetlistMonad a
action
(Size -> Identity Size) -> NetlistState -> Identity NetlistState
Lens' NetlistState Size
varCount ((Size -> Identity Size) -> NetlistState -> Identity NetlistState)
-> Size -> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Size
vCnt
((Identifier, SrcSpan) -> Identity (Identifier, SrcSpan))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (Identifier, SrcSpan)
curCompNm (((Identifier, SrcSpan) -> Identity (Identifier, SrcSpan))
-> NetlistState -> Identity NetlistState)
-> (Identifier, SrcSpan) -> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Identifier, SrcSpan)
vComp
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> HashMap Identifier Word -> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= HashMap Identifier Word
vSeen
a -> NetlistMonad a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
dcToLiteral :: HWType -> Int -> Literal
dcToLiteral :: HWType -> Size -> Literal
dcToLiteral Bool 1 = IsVoid -> Literal
BoolLit IsVoid
False
dcToLiteral Bool 2 = IsVoid -> Literal
BoolLit IsVoid
True
dcToLiteral _ i :: Size
i = Integer -> Literal
NumLit (Size -> Integer
forall a. Integral a => a -> Integer
toInteger Size
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)
extendPorts :: [PortName] -> [Maybe PortName]
extendPorts :: [PortName] -> [Maybe PortName]
extendPorts ps :: [PortName]
ps = (PortName -> Maybe PortName) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> [a] -> [b]
map PortName -> Maybe PortName
forall a. a -> Maybe a
Just [PortName]
ps [Maybe PortName] -> [Maybe PortName] -> [Maybe PortName]
forall a. [a] -> [a] -> [a]
++ Maybe PortName -> [Maybe PortName]
forall a. a -> [a]
repeat Maybe PortName
forall a. Maybe a
Nothing
portName
:: String
-> Identifier
-> Identifier
portName :: String -> Identifier -> Identifier
portName [] i :: Identifier
i = Identifier
i
portName x :: String
x _ = String -> Identifier
Text.pack String
x
prefixParent :: String -> PortName -> PortName
prefixParent :: String -> PortName -> PortName
prefixParent "" p :: PortName
p = PortName
p
prefixParent parent :: String
parent (PortName p :: String
p) = String -> PortName
PortName (String
parent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p)
prefixParent parent :: String
parent (PortProduct "" ps :: [PortName]
ps) = String -> [PortName] -> PortName
PortProduct String
parent [PortName]
ps
prefixParent parent :: String
parent (PortProduct p :: String
p ps :: [PortName]
ps) = String -> [PortName] -> PortName
PortProduct (String
parent String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
p) [PortName]
ps
appendIdentifier
:: (Identifier,HWType)
-> Int
-> NetlistMonad (Identifier,HWType)
appendIdentifier :: (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (nm :: Identifier
nm,hwty :: HWType
hwty) i :: Size
i =
(,HWType
hwty) (Identifier -> (Identifier, HWType))
-> NetlistMonad Identifier -> NetlistMonad (Identifier, HWType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdType -> Identifier -> Identifier -> NetlistMonad Identifier
extendIdentifier IdType
Extended Identifier
nm (String -> Identifier
Text.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:Size -> String
forall a. Show a => a -> String
show Size
i))
uniquePortName
:: String
-> Identifier
-> NetlistMonad Identifier
uniquePortName :: String -> Identifier -> NetlistMonad Identifier
uniquePortName [] i :: Identifier
i = IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended Identifier
i
uniquePortName x :: String
x _ = do
let xT :: Identifier
xT = String -> Identifier
Text.pack String
x
Identifier
xTB <- IdType -> Identifier -> NetlistMonad Identifier
mkIdentifier IdType
Basic Identifier
xT
(HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState
Lens' NetlistState (HashMap Identifier Word)
seenIds ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> NetlistState -> Identity NetlistState)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> NetlistMonad ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (\s :: HashMap Identifier Word
s -> (HashMap Identifier Word -> Identifier -> HashMap Identifier Word)
-> HashMap Identifier Word
-> [Identifier]
-> HashMap Identifier Word
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\m :: HashMap Identifier Word
m k :: Identifier
k -> Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
k 0 HashMap Identifier Word
m) HashMap Identifier Word
s [Identifier
xT,Identifier
xTB])
Identifier -> NetlistMonad Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier
xT
mkInput
:: Maybe PortName
-> (Identifier,HWType)
-> NetlistMonad ([(Identifier,HWType)],[Declaration],Expr,Identifier)
mkInput :: Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput pM :: Maybe PortName
pM = case Maybe PortName
pM of
Nothing -> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
go
Just p :: PortName
p -> PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
go' PortName
p
where
go :: (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
go (i :: Identifier
i,hwty :: HWType
hwty) = do
Identifier
i' <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended Identifier
i
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
i',HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
arguments
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
i' (Size -> HWType -> HWType
Vector Size
sz HWType
hwty'')
vecExpr :: Expr
vecExpr = Size -> HWType -> [Expr] -> Expr
mkVectorChain Size
sz HWType
hwty'' [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
i' Expr
vecExpr
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
vecExpr,Identifier
i')
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector"
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
i',HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
arguments
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
i' (Size -> HWType -> HWType
RTree Size
d HWType
hwty'')
trExpr :: Expr
trExpr = Size -> HWType -> [Expr] -> Expr
mkRTreeChain Size
d HWType
hwty'' [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
i' Expr
trExpr
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
trExpr,Identifier
i')
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "RTree"
Product _ _ hwtys :: [HWType]
hwtys -> do
[(Identifier, HWType)]
arguments <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
i',) [HWType]
hwtys) [0..]
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
arguments
case [Expr]
exprs of
[expr :: Expr
expr] ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
i' HWType
hwty
dcExpr :: Expr
dcExpr = Expr
expr
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
i' Expr
expr
in ([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
dcExpr,Identifier
i')
_ ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
i' HWType
hwty
dcExpr :: Expr
dcExpr = HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
hwty ((HWType, Size) -> Modifier
DC (HWType
hwty,0)) [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
i' Expr
dcExpr
in if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
dcExpr,Identifier
i')
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Product"
_ -> ([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
i',HWType
hwty)],[],Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i' Maybe Modifier
forall a. Maybe a
Nothing,Identifier
i')
go' :: PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
go' (PortName p :: String
p) (i :: Identifier
i,hwty :: HWType
hwty) = do
Identifier
pN <- String -> Identifier -> NetlistMonad Identifier
uniquePortName String
p Identifier
i
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
pN,HWType
hwty)],[],Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN Maybe Modifier
forall a. Maybe a
Nothing,Identifier
pN)
go' (PortProduct p :: String
p ps :: [PortName]
ps) (i :: Identifier
i,hwty :: HWType
hwty) = do
Identifier
pN <- String -> Identifier -> NetlistMonad Identifier
uniquePortName String
p Identifier
i
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN,HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput ([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps) [(Identifier, HWType)]
arguments
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN (Size -> HWType -> HWType
Vector Size
sz HWType
hwty'')
vecExpr :: Expr
vecExpr = Size -> HWType -> [Expr] -> Expr
mkVectorChain Size
sz HWType
hwty'' [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
pN Expr
vecExpr
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
vecExpr,Identifier
pN)
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector"
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN,HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput ([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps) [(Identifier, HWType)]
arguments
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN (Size -> HWType -> HWType
RTree Size
d HWType
hwty'')
trExpr :: Expr
trExpr = Size -> HWType -> [Expr] -> Expr
mkRTreeChain Size
d HWType
hwty'' [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
pN Expr
trExpr
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
trExpr,Identifier
pN)
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "RTree"
Product _ _ hwtys :: [HWType]
hwtys -> do
[(Identifier, HWType)]
arguments <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
pN,) [HWType]
hwtys) [0..]
let ps' :: [Maybe PortName]
ps' = [PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)])
-> ([Maybe PortName], [(Identifier, HWType)])
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput) ([Maybe PortName]
ps', [(Identifier, HWType)]
arguments)
case [Expr]
exprs of
[expr :: Expr
expr] ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
dcExpr :: Expr
dcExpr = Expr
expr
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
pN Expr
expr
in ([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
dcExpr,Identifier
pN)
_ -> let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
dcExpr :: Expr
dcExpr = HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
hwty' ((HWType, Size) -> Modifier
DC (HWType
hwty',0)) [Expr]
exprs
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
pN Expr
dcExpr
in if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
dcExpr,Identifier
pN)
else
String
-> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Product"
SP _ (([[HWType]] -> [HWType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[HWType]] -> [HWType])
-> ([(Identifier, [HWType])] -> [[HWType]])
-> [(Identifier, [HWType])]
-> [HWType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [[HWType]]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd) -> [elTy :: HWType
elTy]) -> do
let hwtys :: [HWType]
hwtys = [Size -> HWType
BitVector (HWType -> Size
conSize HWType
hwty'),HWType
elTy]
[(Identifier, HWType)]
arguments <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
pN,) [HWType]
hwtys) [0..]
let ps' :: [Maybe PortName]
ps' = [PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps
(ports :: [[(Identifier, HWType)]]
ports,_,exprs :: [Expr]
exprs,_) <- [([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Expr],
[Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Expr], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)])
-> ([Maybe PortName], [(Identifier, HWType)])
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Expr, Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
mkInput) ([Maybe PortName]
ps', [(Identifier, HWType)]
arguments)
case [Expr]
exprs of
[conExpr :: Expr
conExpr,elExpr :: Expr
elExpr] -> do
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
dcExpr :: Expr
dcExpr = HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
hwty' ((HWType, Size) -> Modifier
DC (Size -> HWType
BitVector (HWType -> Size
typeSize HWType
hwty'),0))
[Expr
conExpr,Maybe Identifier -> HWType -> IsVoid -> Expr -> Expr
ConvBV Maybe Identifier
forall a. Maybe a
Nothing HWType
elTy IsVoid
True Expr
elExpr]
netassgn :: Declaration
netassgn = Identifier -> Expr -> Declaration
Assignment Identifier
pN Expr
dcExpr
([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,[Declaration
netdecl,Declaration
netassgn],Expr
dcExpr,Identifier
pN)
_ -> String
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall a. HasCallStack => String -> a
error "Unexpected error for PortProduct"
_ -> ([(Identifier, HWType)], [Declaration], Expr, Identifier)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Expr, Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
pN,HWType
hwty)],[],Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN Maybe Modifier
forall a. Maybe a
Nothing,Identifier
pN)
mkVectorChain :: Int
-> HWType
-> [Expr]
-> Expr
mkVectorChain :: Size -> HWType -> [Expr] -> Expr
mkVectorChain _ elTy :: HWType
elTy [] = HWType -> Modifier -> [Expr] -> Expr
DataCon (Size -> HWType -> HWType
Vector 0 HWType
elTy) Modifier
VecAppend []
mkVectorChain _ elTy :: HWType
elTy [e :: Expr
e] = HWType -> Modifier -> [Expr] -> Expr
DataCon (Size -> HWType -> HWType
Vector 1 HWType
elTy) Modifier
VecAppend
[Expr
e]
mkVectorChain sz :: Size
sz elTy :: HWType
elTy (e :: Expr
e:es :: [Expr]
es) = HWType -> Modifier -> [Expr] -> Expr
DataCon (Size -> HWType -> HWType
Vector Size
sz HWType
elTy) Modifier
VecAppend
[ Expr
e
, Size -> HWType -> [Expr] -> Expr
mkVectorChain (Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1) HWType
elTy [Expr]
es
]
mkRTreeChain :: Int
-> HWType
-> [Expr]
-> Expr
mkRTreeChain :: Size -> HWType -> [Expr] -> Expr
mkRTreeChain _ elTy :: HWType
elTy [e :: Expr
e] = HWType -> Modifier -> [Expr] -> Expr
DataCon (Size -> HWType -> HWType
RTree 0 HWType
elTy) Modifier
RTreeAppend
[Expr
e]
mkRTreeChain d :: Size
d elTy :: HWType
elTy es :: [Expr]
es =
let (esL :: [Expr]
esL,esR :: [Expr]
esR) = Size -> [Expr] -> ([Expr], [Expr])
forall a. Size -> [a] -> ([a], [a])
splitAt ([Expr] -> Size
forall (t :: * -> *) a. Foldable t => t a -> Size
length [Expr]
es Size -> Size -> Size
forall a. Integral a => a -> a -> a
`div` 2) [Expr]
es
in HWType -> Modifier -> [Expr] -> Expr
DataCon (Size -> HWType -> HWType
RTree Size
d HWType
elTy) Modifier
RTreeAppend
[ Size -> HWType -> [Expr] -> Expr
mkRTreeChain (Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1) HWType
elTy [Expr]
esL
, Size -> HWType -> [Expr] -> Expr
mkRTreeChain (Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1) HWType
elTy [Expr]
esR
]
genComponentName
:: Bool
-> HashMap Identifier Word
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier,Maybe Identifier)
-> Id
-> Identifier
genComponentName :: IsVoid
-> HashMap Identifier Word
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier, Maybe Identifier)
-> Id
-> Identifier
genComponentName newInlineStrat :: IsVoid
newInlineStrat seen :: HashMap Identifier Word
seen mkIdFn :: IdType -> Identifier -> Identifier
mkIdFn prefixM :: (Maybe Identifier, Maybe Identifier)
prefixM nm :: Id
nm =
let nm' :: [Identifier]
nm' = Identifier -> Identifier -> [Identifier]
Text.splitOn (String -> Identifier
Text.pack ".") (Name Term -> Identifier
forall a. Name a -> Identifier
nameOcc (Id -> Name Term
forall a. Var a -> Name a
varName Id
nm))
fn :: Identifier
fn = IdType -> Identifier -> Identifier
mkIdFn IdType
Basic (Identifier -> Identifier
stripDollarPrefixes ([Identifier] -> Identifier
forall a. [a] -> a
last [Identifier]
nm'))
fn' :: Identifier
fn' = if Identifier -> IsVoid
Text.null Identifier
fn then String -> Identifier
Text.pack "Component" else Identifier
fn
prefix :: [Identifier]
prefix = ([Identifier] -> [Identifier])
-> (Identifier -> [Identifier] -> [Identifier])
-> Maybe Identifier
-> [Identifier]
-> [Identifier]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Identifier] -> [Identifier]
forall a. a -> a
id (:) ((Maybe Identifier, Maybe Identifier) -> Maybe Identifier
forall a b. (a, b) -> b
snd (Maybe Identifier, Maybe Identifier)
prefixM) (if IsVoid
newInlineStrat then [] else [Identifier] -> [Identifier]
forall a. [a] -> [a]
init [Identifier]
nm')
nm2 :: Identifier
nm2 = [Identifier] -> Identifier
Text.concat (Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
intersperse (String -> Identifier
Text.pack "_") ([Identifier]
prefix [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier
fn']))
nm3 :: Identifier
nm3 = IdType -> Identifier -> Identifier
mkIdFn IdType
Basic Identifier
nm2
in case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
nm3 HashMap Identifier Word
seen of
Just n :: Word
n -> Word -> Identifier -> Identifier
go Word
n Identifier
nm3
Nothing -> Identifier
nm3
where
go :: Word -> Identifier -> Identifier
go :: Word -> Identifier -> Identifier
go n :: Word
n i :: Identifier
i =
let i' :: Identifier
i' = IdType -> Identifier -> Identifier
mkIdFn IdType
Basic (Identifier
i Identifier -> Identifier -> Identifier
`Text.append` String -> Identifier
Text.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:Word -> String
forall a. Show a => a -> String
show Word
n))
in case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
i' HashMap Identifier Word
seen of
Just _ -> Word -> Identifier -> Identifier
go (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1) Identifier
i
Nothing -> Identifier
i'
genTopComponentName
:: Bool
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier,Maybe Identifier)
-> Maybe TopEntity
-> Id
-> Identifier
genTopComponentName :: IsVoid
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier, Maybe Identifier)
-> Maybe TopEntity
-> Id
-> Identifier
genTopComponentName _oldInlineStrat :: IsVoid
_oldInlineStrat _mkIdFn :: IdType -> Identifier -> Identifier
_mkIdFn prefixM :: (Maybe Identifier, Maybe Identifier)
prefixM (Just ann :: TopEntity
ann) _nm :: Id
_nm =
case (Maybe Identifier, Maybe Identifier)
prefixM of
(Just p :: Identifier
p,_) -> Identifier
p Identifier -> Identifier -> Identifier
`Text.append` String -> Identifier
Text.pack ('_'Char -> String -> String
forall a. a -> [a] -> [a]
:TopEntity -> String
t_name TopEntity
ann)
_ -> String -> Identifier
Text.pack (TopEntity -> String
t_name TopEntity
ann)
genTopComponentName oldInlineStrat :: IsVoid
oldInlineStrat mkIdFn :: IdType -> Identifier -> Identifier
mkIdFn prefixM :: (Maybe Identifier, Maybe Identifier)
prefixM Nothing nm :: Id
nm =
IsVoid
-> HashMap Identifier Word
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier, Maybe Identifier)
-> Id
-> Identifier
genComponentName IsVoid
oldInlineStrat HashMap Identifier Word
forall k v. HashMap k v
HashMap.empty IdType -> Identifier -> Identifier
mkIdFn (Maybe Identifier, Maybe Identifier)
prefixM Id
nm
stripAttributes
:: HWType
-> ([Attr'], HWType)
stripAttributes :: HWType -> ([Attr'], HWType)
stripAttributes (Annotated attrs :: [Attr']
attrs typ :: HWType
typ) =
let (attrs' :: [Attr']
attrs', typ' :: HWType
typ') = HWType -> ([Attr'], HWType)
stripAttributes HWType
typ
in ([Attr']
attrs [Attr'] -> [Attr'] -> [Attr']
forall a. [a] -> [a] -> [a]
++ [Attr']
attrs', HWType
typ')
stripAttributes typ :: HWType
typ = ([], HWType
typ)
mkOutput
:: Maybe PortName
-> (Identifier,HWType)
-> NetlistMonad (Maybe ([(Identifier,HWType)],[Declaration],Identifier))
mkOutput :: Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Identifier))
mkOutput _pM :: Maybe PortName
_pM (_o :: Identifier
_o, (BiDirectional Out _)) = Maybe ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Identifier))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Identifier, HWType)], [Declaration], Identifier)
forall a. Maybe a
Nothing
mkOutput _pM :: Maybe PortName
_pM (_o :: Identifier
_o, (Void _)) = Maybe ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Identifier))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([(Identifier, HWType)], [Declaration], Identifier)
forall a. Maybe a
Nothing
mkOutput pM :: Maybe PortName
pM (o :: Identifier
o, hwty :: HWType
hwty) = ([(Identifier, HWType)], [Declaration], Identifier)
-> Maybe ([(Identifier, HWType)], [Declaration], Identifier)
forall a. a -> Maybe a
Just (([(Identifier, HWType)], [Declaration], Identifier)
-> Maybe ([(Identifier, HWType)], [Declaration], Identifier))
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad
(Maybe ([(Identifier, HWType)], [Declaration], Identifier))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' Maybe PortName
pM (Identifier
o, HWType
hwty)
mkOutput'
:: Maybe PortName
-> (Identifier,HWType)
-> NetlistMonad ([(Identifier,HWType)],[Declaration],Identifier)
mkOutput' :: Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' pM :: Maybe PortName
pM = case Maybe PortName
pM of
Nothing -> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
go
Just p :: PortName
p -> PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
go' PortName
p
where
go :: (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
go (o :: Identifier
o,hwty :: HWType
hwty) = do
Identifier
o' <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended Identifier
o
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
unless ([Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs)
(String -> String -> NetlistMonad ()
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector")
[(Identifier, HWType)]
results <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
o',HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
results
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
o' HWType
hwty'
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
o' HWType
hwty' 10) [Identifier]
ids [0..]
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
o')
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
unless ([Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs)
(String -> String -> NetlistMonad ()
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "RTree")
[(Identifier, HWType)]
results <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
o',HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
results
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
o' HWType
hwty'
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
o' HWType
hwty' 10) [Identifier]
ids [0..]
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
o')
Product _ _ hwtys :: [HWType]
hwtys -> do
[(Identifier, HWType)]
results <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
o,) [HWType]
hwtys) [0..]
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' Maybe PortName
forall a. Maybe a
Nothing) [(Identifier, HWType)]
results
case [Identifier]
ids of
[i :: Identifier
i] ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
o' HWType
hwty
assign :: Declaration
assign = Identifier -> Expr -> Declaration
Assignment Identifier
i (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
o' Maybe Modifier
forall a. Maybe a
Nothing)
in ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:Declaration
assignDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
o')
_ ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
o' HWType
hwty
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
o' HWType
hwty 0) [Identifier]
ids [0..]
in if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
o')
else
String
-> String
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Product"
_ -> ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
o',HWType
hwty)],[],Identifier
o')
go' :: PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
go' (PortName p :: String
p) (o :: Identifier
o,hwty :: HWType
hwty) = do
Identifier
pN <- String -> Identifier -> NetlistMonad Identifier
uniquePortName String
p Identifier
o
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
pN,HWType
hwty)],[],Identifier
pN)
go' (PortProduct p :: String
p ps :: [PortName]
ps) (o :: Identifier
o,hwty :: HWType
hwty) = do
Identifier
pN <- String -> Identifier -> NetlistMonad Identifier
uniquePortName String
p Identifier
o
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
unless ([Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs)
(String -> String -> NetlistMonad ()
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector")
[(Identifier, HWType)]
results <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN,HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' ([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps) [(Identifier, HWType)]
results
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
pN HWType
hwty' 10) [Identifier]
ids [0..]
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
pN)
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
IsVoid -> NetlistMonad () -> NetlistMonad ()
forall (f :: * -> *). Applicative f => IsVoid -> f () -> f ()
unless ([Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs)
(String -> String -> NetlistMonad ()
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "RTree")
[(Identifier, HWType)]
results <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN,HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput' ([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps) [(Identifier, HWType)]
results
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
pN HWType
hwty' 10) [Identifier]
ids [0..]
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
pN)
Product _ _ hwtys :: [HWType]
hwtys -> do
[(Identifier, HWType)]
results <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
pN,) [HWType]
hwtys) [0..]
let ps' :: [Maybe PortName]
ps' = [PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)])
-> ([Maybe PortName], [(Identifier, HWType)])
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput') ([Maybe PortName]
ps', [(Identifier, HWType)]
results)
case [Identifier]
ids of
[i :: Identifier
i] -> let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
assign :: Declaration
assign = Identifier -> Expr -> Declaration
Assignment Identifier
i (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN Maybe Modifier
forall a. Maybe a
Nothing)
in ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:Declaration
assignDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
pN)
_ -> let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
assigns :: [Declaration]
assigns = (Identifier -> Size -> Declaration)
-> [Identifier] -> [Size] -> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId Identifier
pN HWType
hwty' 0) [Identifier]
ids [0..]
in if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
pN)
else
String
-> String
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Product"
SP _ (([[HWType]] -> [HWType]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[HWType]] -> [HWType])
-> ([(Identifier, [HWType])] -> [[HWType]])
-> [(Identifier, [HWType])]
-> [HWType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Identifier, [HWType]) -> [HWType])
-> [(Identifier, [HWType])] -> [[HWType]]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, [HWType]) -> [HWType]
forall a b. (a, b) -> b
snd) -> [elTy :: HWType
elTy]) -> do
let hwtys :: [HWType]
hwtys = [Size -> HWType
BitVector (HWType -> Size
conSize HWType
hwty'),HWType
elTy]
[(Identifier, HWType)]
results <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
pN,) [HWType]
hwtys) [0..]
let ps' :: [Maybe PortName]
ps' = [PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName]) -> [PortName] -> [Maybe PortName]
forall a b. (a -> b) -> a -> b
$ (PortName -> PortName) -> [PortName] -> [PortName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PortName -> PortName
prefixParent String
p) [PortName]
ps
(ports :: [[(Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Identifier]
ids) <- [([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([([(Identifier, HWType)], [Declaration], Identifier)]
-> ([[(Identifier, HWType)]], [[Declaration]], [Identifier]))
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
-> NetlistMonad
([[(Identifier, HWType)]], [[Declaration]], [Identifier])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)])
-> ([Maybe PortName], [(Identifier, HWType)])
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, HWType)], [Declaration], Identifier))
-> [Maybe PortName]
-> [(Identifier, HWType)]
-> NetlistMonad
[([(Identifier, HWType)], [Declaration], Identifier)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
mkOutput') ([Maybe PortName]
ps', [(Identifier, HWType)]
results)
case [Identifier]
ids of
[conId :: Identifier
conId,elId :: Identifier
elId] ->
let netdecl :: Declaration
netdecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN HWType
hwty'
conIx :: Modifier
conIx = (HWType, Size, Size) -> Modifier
Sliced (Size -> HWType
BitVector (HWType -> Size
typeSize HWType
hwty')
,HWType -> Size
typeSize HWType
hwty' Size -> Size -> Size
forall a. Num a => a -> a -> a
- 1
,HWType -> Size
typeSize HWType
elTy
)
elIx :: Modifier
elIx = (HWType, Size, Size) -> Modifier
Sliced (Size -> HWType
BitVector (HWType -> Size
typeSize HWType
hwty')
,HWType -> Size
typeSize HWType
elTy Size -> Size -> Size
forall a. Num a => a -> a -> a
- 1
,0
)
assigns :: [Declaration]
assigns = [Identifier -> Expr -> Declaration
Assignment Identifier
conId (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
conIx))
,Identifier -> Expr -> Declaration
Assignment Identifier
elId (Maybe Identifier -> HWType -> IsVoid -> Expr -> Expr
ConvBV Maybe Identifier
forall a. Maybe a
Nothing HWType
elTy IsVoid
False
(Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just Modifier
elIx)))
]
in ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Identifier, HWType)]] -> [(Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, HWType)]]
ports,Declaration
netdeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier
pN)
_ -> String
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall a. HasCallStack => String -> a
error "Unexpected error for PortProduct"
_ -> ([(Identifier, HWType)], [Declaration], Identifier)
-> NetlistMonad ([(Identifier, HWType)], [Declaration], Identifier)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier
pN,HWType
hwty)],[],Identifier
pN)
assignId :: Identifier -> HWType -> Size -> Identifier -> Size -> Declaration
assignId p :: Identifier
p hwty :: HWType
hwty con :: Size
con i :: Identifier
i n :: Size
n =
Identifier -> Expr -> Declaration
Assignment Identifier
i (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
p (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Size, Size) -> Modifier
Indexed (HWType
hwty,Size
con,Size
n))))
mkTopUnWrapper
:: Id
-> Maybe TopEntity
-> Manifest
-> (Identifier,HWType)
-> [(Expr,HWType)]
-> [Declaration]
-> NetlistMonad [Declaration]
mkTopUnWrapper :: Id
-> Maybe TopEntity
-> Manifest
-> (Identifier, HWType)
-> [(Expr, HWType)]
-> [Declaration]
-> NetlistMonad [Declaration]
mkTopUnWrapper topEntity :: Id
topEntity annM :: Maybe TopEntity
annM man :: Manifest
man dstId :: (Identifier, HWType)
dstId args :: [(Expr, HWType)]
args tickDecls :: [Declaration]
tickDecls = do
let inTys :: [Identifier]
inTys = Manifest -> [Identifier]
portInTypes Manifest
man
outTys :: [Identifier]
outTys = Manifest -> [Identifier]
portOutTypes Manifest
man
inNames :: [Identifier]
inNames = Manifest -> [Identifier]
portInNames Manifest
man
outNames :: [Identifier]
outNames = Manifest -> [Identifier]
portOutNames Manifest
man
IsVoid
newInlineStrat <- ClashOpts -> IsVoid
opt_newInlineStrat (ClashOpts -> IsVoid)
-> NetlistMonad ClashOpts -> NetlistMonad IsVoid
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting ClashOpts NetlistState ClashOpts -> NetlistMonad ClashOpts
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting ClashOpts NetlistState ClashOpts
Lens' NetlistState ClashOpts
clashOpts
IdType -> Identifier -> Identifier
mkIdFn <- Getting
(IdType -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier)
-> NetlistMonad (IdType -> Identifier -> Identifier)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(IdType -> Identifier -> Identifier)
NetlistState
(IdType -> Identifier -> Identifier)
Lens' NetlistState (IdType -> Identifier -> Identifier)
mkIdentifierFn
(Maybe Identifier, Maybe Identifier)
prefixM <- Getting
(Maybe Identifier, Maybe Identifier)
NetlistState
(Maybe Identifier, Maybe Identifier)
-> NetlistMonad (Maybe Identifier, Maybe Identifier)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
Lens.use Getting
(Maybe Identifier, Maybe Identifier)
NetlistState
(Maybe Identifier, Maybe Identifier)
Lens' NetlistState (Maybe Identifier, Maybe Identifier)
componentPrefix
let topName :: Identifier
topName = IsVoid
-> (IdType -> Identifier -> Identifier)
-> (Maybe Identifier, Maybe Identifier)
-> Maybe TopEntity
-> Id
-> Identifier
genTopComponentName IsVoid
newInlineStrat IdType -> Identifier -> Identifier
mkIdFn (Maybe Identifier, Maybe Identifier)
prefixM Maybe TopEntity
annM Id
topEntity
topM :: Maybe Identifier
topM = (TopEntity -> Identifier) -> Maybe TopEntity -> Maybe Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identifier -> TopEntity -> Identifier
forall a b. a -> b -> a
const Identifier
topName) Maybe TopEntity
annM
let iPortSupply :: [Maybe PortName]
iPortSupply = [Maybe PortName]
-> (TopEntity -> [Maybe PortName])
-> Maybe TopEntity
-> [Maybe PortName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PortName -> [Maybe PortName]
forall a. a -> [a]
repeat Maybe PortName
forall a. Maybe a
Nothing)
([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName])
-> (TopEntity -> [PortName]) -> TopEntity -> [Maybe PortName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopEntity -> [PortName]
t_inputs)
Maybe TopEntity
annM
[(Identifier, HWType)]
arguments <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (((Expr, HWType) -> (Identifier, HWType))
-> [(Expr, HWType)] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (\a :: (Expr, HWType)
a -> ("input",(Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd (Expr, HWType)
a)) [(Expr, HWType)]
args) [0..]
(_,arguments1 :: [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <- ([(Identifier, Identifier)]
-> (Maybe PortName, (Identifier, HWType))
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(Identifier, Identifier)]
-> [(Maybe PortName, (Identifier, HWType))]
-> NetlistMonad
([(Identifier, Identifier)],
[([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (\acc :: [(Identifier, Identifier)]
acc (p :: Maybe PortName
p,i :: (Identifier, HWType)
i) -> Maybe Identifier
-> [(Identifier, Identifier)]
-> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
mkTopInput Maybe Identifier
topM [(Identifier, Identifier)]
acc Maybe PortName
p (Identifier, HWType)
i)
([Identifier] -> [Identifier] -> [(Identifier, Identifier)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
inNames [Identifier]
inTys)
([Maybe PortName]
-> [(Identifier, HWType)]
-> [(Maybe PortName, (Identifier, HWType))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe PortName]
iPortSupply [(Identifier, HWType)]
arguments)
let (iports :: [[(Identifier, Identifier, HWType)]]
iports,wrappers :: [[Declaration]]
wrappers,idsI :: [Either Identifier (Identifier, HWType)]
idsI) = [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
-> ([[(Identifier, Identifier, HWType)]], [[Declaration]],
[Either Identifier (Identifier, HWType)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1
inpAssigns :: [Declaration]
inpAssigns = (Either Identifier (Identifier, HWType) -> Expr -> Declaration)
-> [Either Identifier (Identifier, HWType)]
-> [Expr]
-> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV Maybe Identifier
topM) [Either Identifier (Identifier, HWType)]
idsI (((Expr, HWType) -> Expr) -> [(Expr, HWType)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst [(Expr, HWType)]
args)
let oPortSupply :: [Maybe PortName]
oPortSupply = [Maybe PortName]
-> (TopEntity -> [Maybe PortName])
-> Maybe TopEntity
-> [Maybe PortName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe PortName -> [Maybe PortName]
forall a. a -> [a]
repeat Maybe PortName
forall a. Maybe a
Nothing)
([PortName] -> [Maybe PortName]
extendPorts ([PortName] -> [Maybe PortName])
-> (TopEntity -> [PortName]) -> TopEntity -> [Maybe PortName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PortName -> [PortName] -> [PortName]
forall a. a -> [a] -> [a]
:[]) (PortName -> [PortName])
-> (TopEntity -> PortName) -> TopEntity -> [PortName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopEntity -> PortName
t_output)
Maybe TopEntity
annM
let iResult :: [Declaration]
iResult = [Declaration]
inpAssigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
wrappers
result :: (Identifier, HWType)
result = ("result",(Identifier, HWType) -> HWType
forall a b. (a, b) -> b
snd (Identifier, HWType)
dstId)
Maybe
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
topOutputM <- Maybe Identifier
-> [(Identifier, Identifier)]
-> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
(Maybe
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
mkTopOutput
Maybe Identifier
topM
([Identifier] -> [Identifier] -> [(Identifier, Identifier)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
outNames [Identifier]
outTys)
([Maybe PortName] -> Maybe PortName
forall a. [a] -> a
head [Maybe PortName]
oPortSupply)
(Identifier, HWType)
result
([Declaration]
iResult [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++) ([Declaration] -> [Declaration])
-> NetlistMonad [Declaration] -> NetlistMonad [Declaration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
topOutputM of
Nothing -> [Declaration] -> NetlistMonad [Declaration]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (_, (oports :: [(Identifier, Identifier, HWType)]
oports, unwrappers :: [Declaration]
unwrappers, idsO :: Either Identifier (Identifier, HWType)
idsO)) -> do
Identifier
instLabel0 <- IdType -> Identifier -> Identifier -> NetlistMonad Identifier
extendIdentifier IdType
Basic Identifier
topName ("_" Identifier -> Identifier -> Identifier
`Text.append` (Identifier, HWType) -> Identifier
forall a b. (a, b) -> a
fst (Identifier, HWType)
dstId)
Identifier
instLabel1 <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Basic Identifier
instLabel0
let outpAssign :: Declaration
outpAssign = Identifier -> Expr -> Declaration
Assignment ((Identifier, HWType) -> Identifier
forall a b. (a, b) -> a
fst (Identifier, HWType)
dstId) (Maybe Identifier -> Either Identifier (Identifier, HWType) -> Expr
resBV Maybe Identifier
topM Either Identifier (Identifier, HWType)
idsO)
let topCompDecl :: Declaration
topCompDecl = EntityOrComponent
-> Maybe Identifier
-> Identifier
-> Identifier
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl
EntityOrComponent
Entity
(Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
topName)
Identifier
topName
Identifier
instLabel1
[]
( ((Identifier, Identifier, HWType)
-> (Expr, PortDirection, HWType, Expr))
-> [(Identifier, Identifier, HWType)]
-> [(Expr, PortDirection, HWType, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Identifier
p,i :: Identifier
i,t :: HWType
t) -> (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
p Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In, HWType
t,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i Maybe Modifier
forall a. Maybe a
Nothing)) ([[(Identifier, Identifier, HWType)]]
-> [(Identifier, Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, Identifier, HWType)]]
iports) [(Expr, PortDirection, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
forall a. [a] -> [a] -> [a]
++
((Identifier, Identifier, HWType)
-> (Expr, PortDirection, HWType, Expr))
-> [(Identifier, Identifier, HWType)]
-> [(Expr, PortDirection, HWType, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Identifier
p,o :: Identifier
o,t :: HWType
t) -> (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
p Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
t,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
o Maybe Modifier
forall a. Maybe a
Nothing)) [(Identifier, Identifier, HWType)]
oports)
[Declaration] -> NetlistMonad [Declaration]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Declaration] -> NetlistMonad [Declaration])
-> [Declaration] -> NetlistMonad [Declaration]
forall a b. (a -> b) -> a -> b
$ [Declaration]
tickDecls [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ (Declaration
topCompDeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
unwrappers) [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [Declaration
outpAssign]
argBV
:: Maybe Identifier
-> Either Identifier (Identifier, HWType)
-> Expr
-> Declaration
argBV :: Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV _ (Left i :: Identifier
i) e :: Expr
e = Identifier -> Expr -> Declaration
Assignment Identifier
i Expr
e
argBV topM :: Maybe Identifier
topM (Right (i :: Identifier
i,t :: HWType
t)) e :: Expr
e = Identifier -> Expr -> Declaration
Assignment Identifier
i
(Expr -> Declaration) -> (Expr -> Expr) -> Expr -> Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Maybe (Maybe Identifier) -> IsVoid -> Expr -> Expr
doConv HWType
t ((Identifier -> Maybe Identifier)
-> Maybe Identifier -> Maybe (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Maybe Identifier
topM) IsVoid
False
(Expr -> Declaration) -> Expr -> Declaration
forall a b. (a -> b) -> a -> b
$ HWType -> Maybe (Maybe Identifier) -> IsVoid -> Expr -> Expr
doConv HWType
t ((Identifier -> Maybe Identifier)
-> Maybe Identifier -> Maybe (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Identifier -> Identifier -> Maybe Identifier
forall a b. a -> b -> a
const Maybe Identifier
forall a. Maybe a
Nothing) Maybe Identifier
topM) IsVoid
True Expr
e
resBV
:: Maybe Identifier
-> Either Identifier (Identifier, HWType)
-> Expr
resBV :: Maybe Identifier -> Either Identifier (Identifier, HWType) -> Expr
resBV _ (Left i :: Identifier
i) = Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i Maybe Modifier
forall a. Maybe a
Nothing
resBV topM :: Maybe Identifier
topM (Right (i :: Identifier
i,t :: HWType
t)) = HWType -> Maybe (Maybe Identifier) -> IsVoid -> Expr -> Expr
doConv HWType
t ((Identifier -> Maybe Identifier)
-> Maybe Identifier -> Maybe (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Identifier -> Identifier -> Maybe Identifier
forall a b. a -> b -> a
const Maybe Identifier
forall a. Maybe a
Nothing) Maybe Identifier
topM) IsVoid
False
(Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Maybe (Maybe Identifier) -> IsVoid -> Expr -> Expr
doConv HWType
t ((Identifier -> Maybe Identifier)
-> Maybe Identifier -> Maybe (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Maybe Identifier
topM) IsVoid
True
(Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i Maybe Modifier
forall a. Maybe a
Nothing
doConv
:: HWType
-> Maybe (Maybe Identifier)
-> Bool
-> Expr
-> Expr
doConv :: HWType -> Maybe (Maybe Identifier) -> IsVoid -> Expr -> Expr
doConv _ Nothing _ e :: Expr
e = Expr
e
doConv hwty :: HWType
hwty (Just topM :: Maybe Identifier
topM) b :: IsVoid
b e :: Expr
e = case HWType
hwty of
Vector {} -> Maybe Identifier -> HWType -> IsVoid -> Expr -> Expr
ConvBV Maybe Identifier
topM HWType
hwty IsVoid
b Expr
e
RTree {} -> Maybe Identifier -> HWType -> IsVoid -> Expr -> Expr
ConvBV Maybe Identifier
topM HWType
hwty IsVoid
b Expr
e
Product {} -> Maybe Identifier -> HWType -> IsVoid -> Expr -> Expr
ConvBV Maybe Identifier
topM HWType
hwty IsVoid
b Expr
e
_ -> Expr
e
mkTopInput
:: Maybe Identifier
-> [(Identifier,Identifier)]
-> Maybe PortName
-> (Identifier,HWType)
-> NetlistMonad ([(Identifier,Identifier)]
,([(Identifier,Identifier,HWType)]
,[Declaration]
,Either Identifier (Identifier,HWType)))
mkTopInput :: Maybe Identifier
-> [(Identifier, Identifier)]
-> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
mkTopInput topM :: Maybe Identifier
topM inps :: [(Identifier, Identifier)]
inps pM :: Maybe PortName
pM = case Maybe PortName
pM of
Nothing -> [(Identifier, Identifier)]
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a b.
[(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go [(Identifier, Identifier)]
inps
Just p :: PortName
p -> PortName
-> [(Identifier, Identifier)]
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go' PortName
p [(Identifier, Identifier)]
inps
where
go :: [(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go inps' :: [(a, b)]
inps'@((iN :: a
iN,_):rest :: [(a, b)]
rest) (i :: Identifier
i,hwty :: HWType
hwty) = do
Identifier
i' <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Basic Identifier
i
let iDecl :: Declaration
iDecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
i' HWType
hwty
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
i',HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(inps'' :: [(a, b)]
inps'',arguments1 :: [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <- ([(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(a, b)]
-> [(Identifier, HWType)]
-> NetlistMonad
([(a, b)],
[([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM [(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go [(a, b)]
inps' [(Identifier, HWType)]
arguments
let (ports :: [[(a, Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Either Identifier (Identifier, HWType)]
ids) = [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
-> ([[(a, Identifier, HWType)]], [[Declaration]],
[Either Identifier (Identifier, HWType)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1
assigns :: [Declaration]
assigns = (Either Identifier (Identifier, HWType) -> Expr -> Declaration)
-> [Either Identifier (Identifier, HWType)]
-> [Expr]
-> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV Maybe Identifier
topM) [Either Identifier (Identifier, HWType)]
ids
[ Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i' (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Size, Size) -> Modifier
Indexed (HWType
hwty,10,Size
n)))
| Size
n <- [0..]]
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, b)]
inps'',([[(a, Identifier, HWType)]] -> [(a, Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, Identifier, HWType)]]
ports,Declaration
iDeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns[Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++[[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier -> Either Identifier (Identifier, HWType)
forall a b. a -> Either a b
Left Identifier
i'))
else
String
-> String
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector"
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
i',HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(inps'' :: [(a, b)]
inps'',arguments1 :: [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <- ([(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(a, b)]
-> [(Identifier, HWType)]
-> NetlistMonad
([(a, b)],
[([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM [(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go [(a, b)]
inps' [(Identifier, HWType)]
arguments
let (ports :: [[(a, Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Either Identifier (Identifier, HWType)]
ids) = [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
-> ([[(a, Identifier, HWType)]], [[Declaration]],
[Either Identifier (Identifier, HWType)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1
assigns :: [Declaration]
assigns = (Either Identifier (Identifier, HWType) -> Expr -> Declaration)
-> [Either Identifier (Identifier, HWType)]
-> [Expr]
-> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV Maybe Identifier
topM) [Either Identifier (Identifier, HWType)]
ids
[ Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i' (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Size, Size) -> Modifier
Indexed (HWType
hwty,10,Size
n)))
| Size
n <- [0..]]
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, b)]
inps'',([[(a, Identifier, HWType)]] -> [(a, Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, Identifier, HWType)]]
ports,Declaration
iDeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns[Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++[[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier -> Either Identifier (Identifier, HWType)
forall a b. a -> Either a b
Left Identifier
i'))
else
String
-> String
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "RTree"
Product _ _ hwtys :: [HWType]
hwtys -> do
[(Identifier, HWType)]
arguments <- ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType))
-> [(Identifier, HWType)]
-> [Size]
-> NetlistMonad [(Identifier, HWType)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier ((HWType -> (Identifier, HWType))
-> [HWType] -> [(Identifier, HWType)]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier
i,) [HWType]
hwtys) [0..]
(inps'' :: [(a, b)]
inps'',arguments1 :: [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <- ([(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(a, b)]
-> [(Identifier, HWType)]
-> NetlistMonad
([(a, b)],
[([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM [(a, b)]
-> (Identifier, HWType)
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go [(a, b)]
inps' [(Identifier, HWType)]
arguments
let (ports :: [[(a, Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Either Identifier (Identifier, HWType)]
ids) = [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
-> ([[(a, Identifier, HWType)]], [[Declaration]],
[Either Identifier (Identifier, HWType)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1
assigns :: [Declaration]
assigns = (Either Identifier (Identifier, HWType) -> Expr -> Declaration)
-> [Either Identifier (Identifier, HWType)]
-> [Expr]
-> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV Maybe Identifier
topM) [Either Identifier (Identifier, HWType)]
ids
[ Identifier -> Maybe Modifier -> Expr
Identifier Identifier
i' (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Size, Size) -> Modifier
Indexed (HWType
hwty,0,Size
n)))
| Size
n <- [0..]]
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, b)]
inps'',([[(a, Identifier, HWType)]] -> [(a, Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(a, Identifier, HWType)]]
ports,Declaration
iDeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns[Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++[[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier -> Either Identifier (Identifier, HWType)
forall a b. a -> Either a b
Left Identifier
i'))
else
String
-> String
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Product"
_ -> ([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, b)]
rest,([(a
iN,Identifier
i',HWType
hwty)],[Declaration
iDecl],Identifier -> Either Identifier (Identifier, HWType)
forall a b. a -> Either a b
Left Identifier
i'))
go [] _ = String
-> NetlistMonad
([(a, b)],
([(a, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. HasCallStack => String -> a
error "This shouldn't happen"
go' :: PortName
-> [(Identifier, Identifier)]
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
go' (PortName _) ((iN :: Identifier
iN,iTy :: Identifier
iTy):inps' :: [(Identifier, Identifier)]
inps') (_,hwty :: HWType
hwty) = do
Identifier
iN' <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended Identifier
iN
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier, Identifier)]
inps',([(Identifier
iN,Identifier
iN',HWType
hwty)]
,[Maybe Identifier
-> WireOrReg
-> Identifier
-> Either Identifier HWType
-> Declaration
NetDecl' Maybe Identifier
forall a. Maybe a
Nothing WireOrReg
Wire Identifier
iN' (Identifier -> Either Identifier HWType
forall a b. a -> Either a b
Left Identifier
iTy)]
,(Identifier, HWType) -> Either Identifier (Identifier, HWType)
forall a b. b -> Either a b
Right (Identifier
iN',HWType
hwty)))
go' (PortName _) [] _ = String
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. HasCallStack => String -> a
error "This shouldnt happen"
go' (PortProduct p :: String
p ps :: [PortName]
ps) inps' :: [(Identifier, Identifier)]
inps' (i :: Identifier
i,hwty :: HWType
hwty) = do
let pN :: Identifier
pN = String -> Identifier -> Identifier
portName String
p Identifier
i
Identifier
pN' <- IdType -> Identifier -> NetlistMonad Identifier
mkUniqueIdentifier IdType
Extended Identifier
pN
let pDecl :: Declaration
pDecl = Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pN' HWType
hwty
let (attrs :: [Attr']
attrs, hwty' :: HWType
hwty') = HWType -> ([Attr'], HWType)
stripAttributes HWType
hwty
case HWType
hwty' of
Vector sz :: Size
sz hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN',HWType
hwty'')) [0..Size
szSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(inps'' :: [(Identifier, Identifier)]
inps'',arguments1 :: [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <-
([(Identifier, Identifier)]
-> (Maybe PortName, (Identifier, HWType))
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(Identifier, Identifier)]
-> [(Maybe PortName, (Identifier, HWType))]
-> NetlistMonad
([(Identifier, Identifier)],
[([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (\acc :: [(Identifier, Identifier)]
acc (p' :: Maybe PortName
p',o' :: (Identifier, HWType)
o') -> Maybe Identifier
-> [(Identifier, Identifier)]
-> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
mkTopInput Maybe Identifier
topM [(Identifier, Identifier)]
acc Maybe PortName
p' (Identifier, HWType)
o') [(Identifier, Identifier)]
inps'
([Maybe PortName]
-> [(Identifier, HWType)]
-> [(Maybe PortName, (Identifier, HWType))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([PortName] -> [Maybe PortName]
extendPorts [PortName]
ps) [(Identifier, HWType)]
arguments)
let (ports :: [[(Identifier, Identifier, HWType)]]
ports,decls :: [[Declaration]]
decls,ids :: [Either Identifier (Identifier, HWType)]
ids) = [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
-> ([[(Identifier, Identifier, HWType)]], [[Declaration]],
[Either Identifier (Identifier, HWType)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1
assigns :: [Declaration]
assigns = (Either Identifier (Identifier, HWType) -> Expr -> Declaration)
-> [Either Identifier (Identifier, HWType)]
-> [Expr]
-> [Declaration]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe Identifier
-> Either Identifier (Identifier, HWType) -> Expr -> Declaration
argBV Maybe Identifier
topM) [Either Identifier (Identifier, HWType)]
ids
[ Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pN' (Modifier -> Maybe Modifier
forall a. a -> Maybe a
Just ((HWType, Size, Size) -> Modifier
Indexed (HWType
hwty,10,Size
n)))
| Size
n <- [0..]]
if [Attr'] -> IsVoid
forall (t :: * -> *) a. Foldable t => t a -> IsVoid
null [Attr']
attrs then
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier, Identifier)]
inps'',([[(Identifier, Identifier, HWType)]]
-> [(Identifier, Identifier, HWType)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Identifier, Identifier, HWType)]]
ports,Declaration
pDeclDeclaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
:[Declaration]
assigns [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [[Declaration]] -> [Declaration]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
decls,Identifier -> Either Identifier (Identifier, HWType)
forall a b. a -> Either a b
Left Identifier
pN'))
else
String
-> String
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
forall a. String -> String -> NetlistMonad a
throwAnnotatedSplitError $(curLoc) "Vector"
RTree d :: Size
d hwty'' :: HWType
hwty'' -> do
[(Identifier, HWType)]
arguments <- (Size -> NetlistMonad (Identifier, HWType))
-> [Size] -> NetlistMonad [(Identifier, HWType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Identifier, HWType) -> Size -> NetlistMonad (Identifier, HWType)
appendIdentifier (Identifier
pN',HWType
hwty'')) [0..2Size -> Size -> Size
forall a b. (Num a, Integral b) => a -> b -> a
^Size
dSize -> Size -> Size
forall a. Num a => a -> a -> a
-1]
(inps'' :: [(Identifier, Identifier)]
inps'',arguments1 :: [([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))]
arguments1) <-
([(Identifier, Identifier)]
-> (Maybe PortName, (Identifier, HWType))
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))))
-> [(Identifier, Identifier)]
-> [(Maybe PortName, (Identifier, HWType))]
-> NetlistMonad
([(Identifier, Identifier)],
[([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType))])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (\acc :: [(Identifier, Identifier)]
acc (p' :: Maybe PortName
p',o' :: (Identifier, HWType)
o') -> Maybe Identifier
-> [(Identifier, Identifier)]
-> Maybe PortName
-> (Identifier, HWType)
-> NetlistMonad
([(Identifier, Identifier)],
([(Identifier, Identifier, HWType)], [Declaration],
Either Identifier (Identifier, HWType)))
mkTopInput Maybe Identifier
topM [(Identifier, Identifier)]
acc Maybe PortName
p' (Identifier, HWType)
o') [(Identifier, Identifier)]
inps'
([Maybe PortName]
-> [(Identifier, HWType)]
-> [(Maybe PortName, (Identifier, HWType))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([PortName] -> [Maybe PortName]
extendPorts [PortName]
ps) [(Identifier, HWType)]
arguments