-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, FlexibleContexts, TypeFamilies, TypeOperators #-}
module CLasH.HardwareTypes
( module Types
, hwor
, hwxor
, hwnot
+ , RAM
+ , MemState
+ , blockRAM
) where
import qualified Prelude as P
_ `hwxor` _ = Low
hwnot High = Low
-hwnot Low = High
\ No newline at end of file
+hwnot Low = High
+
+type RAM s a = Vector (s :+: D1) a
+
+type MemState s a = State (RAM s a)
+
+blockRAM ::
+ (NaturalT s
+ ,PositiveT (s :+: D1)
+ ,((s :+: D1) :>: s) ~ True ) =>
+ (MemState s a) ->
+ a ->
+ RangedWord s ->
+ RangedWord s ->
+ Bit ->
+ ((MemState s a), a )
+blockRAM (State mem) data_in rdaddr wraddr wrenable =
+ ((State mem'), data_out)
+ where
+ data_out = mem!rdaddr
+ -- Only write data_in to memory if write is enabled
+ mem' = case wrenable of
+ Low -> mem
+ High -> replace mem wraddr data_in
tfvecId :: String
tfvecId = "TFVec"
+blockRAMId :: String
+blockRAMId = "blockRAM"
+
-- | output file identifier (from std.textio)
showIdString :: String
showIdString = "show"
-- Return the conditional generate part
return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
+genBlockRAM :: BuiltinBuilder
+genBlockRAM = genNoInsts $ genExprArgs genBlockRAM'
+
+genBlockRAM' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
+genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
+ -- Get the ram type
+ let (tup,data_out) = Type.splitAppTy (Var.varType res)
+ let (tup',ramvec) = Type.splitAppTy tup
+ let Just realram = Type.coreView ramvec
+ let Just (tycon, types) = Type.splitTyConApp_maybe realram
+ Just ram_vhdl_ty <- MonadState.lift tsType $ vhdl_ty "wtf" (head types)
+ -- Make the intermediate vector
+ let ram_dec = AST.BDISD $ AST.SigDec ram_id ram_vhdl_ty Nothing
+ -- Get the data_out name
+ reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
+ let resname' = varToVHDLName res
+ let resname = mkSelectedName resname' (reslabels!!0)
+ let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr
+ let assign = mkUncondAssign (Right resname) argexpr
+ let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res))
+ let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm]
+ return [AST.CSBSm block]
+ where
+ ram_id = mkVHDLBasicId "ram"
+ mkUpdateProcSm :: AST.ConcSm
+ mkUpdateProcSm = AST.CSPSm $ AST.ProcSm proclabel [clockId] [statement]
+ where
+ proclabel = mkVHDLBasicId "updateRAM"
+ rising_edge = mkVHDLBasicId "rising_edge"
+ ramloc = mkIndexedName (AST.NSimple ram_id) wraddr
+ wform = AST.Wform [AST.WformElem data_in Nothing]
+ ramassign = AST.SigAssign ramloc wform
+ rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
+ statement = AST.IfSm (AST.And rising_edge_clk (wrenable AST.:=: AST.PrimLit "'1'")) [ramassign] [] Nothing
-----------------------------------------------------------------------------
-- Function to generate VHDL for applications
, (smallIntegerId , (1, genFromInteger ) )
, (fstId , (1, genFst ) )
, (sndId , (1, genSnd ) )
+ , (blockRAMId , (5, genBlockRAM ) )
--, (tfvecId , (1, genTFVec ) )
, (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
]
-{-# LANGUAGE TypeOperators, TemplateHaskell #-}
+{-# LANGUAGE TypeOperators, TemplateHaskell, FlexibleContexts, TypeFamilies #-}
module Reducer where
import System.Random
type ArrayIndex = SizedWord IndexSize
type Discr = RangedWord DiscrRange
-type RAM a = Vector (DiscrRange :+: D1) a
-
type ReducerState = State ( DiscrState
, InputState
, FpAdderState
)
, Bit
)
-
-type MemState a = State (RAM a)
type OutputSignal = ( (DataInt
, ArrayIndex
type FpAdderState = State (Vector AdderDepth ReducerSignal)
-type OutputState = State ( MemState DataInt
- , MemState DataInt
- , RAM ArrayIndex
- , RAM Bit
+type OutputState = State ( MemState DiscrRange DataInt
+ , MemState DiscrRange DataInt
+ , RAM DiscrRange ArrayIndex
+ , RAM DiscrRange Bit
)
{-
Discriminator adds a discriminator to each input value
| otherwise = High
-- Shift addition of the two operants into the pipeline
state' = (((operant1 + operant2),discr),valid) +> (init state)
-
-
-{-
-first attempt at BlockRAM
-
-State:
-mem: content of the RAM
-
-Input:
-data_in: input value to be written to 'mem' at location 'wraddr'
-rdaddr: read address
-wraddr: write address
-wrenable: write enable flag
-
-Output:
-data_out: value of 'mem' at location 'rdaddr'
--}
-{-# NOINLINE blockRAM #-}
-blockRAM :: (MemState a) ->
- ( a
- , Discr
- , Discr
- , Bit
- ) ->
- ((MemState a), a )
-blockRAM (State mem) (data_in, rdaddr, wraddr, wrenable) =
- ((State mem'), data_out)
- where
- data_out = mem!rdaddr
- -- Only write data_in to memory if write is enabled
- mem' = case wrenable of
- Low -> mem
- High -> replace mem wraddr data_in
{-
Output logic - Determines when values are released from blockram to the output
-- Location becomes invalid when it is fed back into the pipeline
valid' | wrenable == Low = replace valid'' rdaddr Low
| otherwise = replace valid'' wraddr High
- (mem1', mem_out1) = blockRAM mem1 ( data_in
- , rdaddr
- , wraddr
- , wrenable
- )
- (mem2', mem_out2) = blockRAM mem2 ( data_in
- , discr
- , wraddr
- , wrenable
- )
+ (mem1', mem_out1) = blockRAM mem1 data_in rdaddr wraddr wrenable
+ (mem2', mem_out2) = blockRAM mem2 data_in discr wraddr wrenable
data_out = ( ( (mem_out1)
, rdaddr
)
projects / matthijs / master-project / cλash.git / commitdiff