reducer.hs

   1 {-# LANGUAGE TypeOperators, TemplateHaskell #-}
   2 module Reducer where
   3
   4 import System.Random
   5 import System.IO.Unsafe (unsafePerformIO,unsafeInterleaveIO)
   6
   7 import qualified Prelude as P
   8 import CLasH.HardwareTypes
   9 import CLasH.Translator.Annotations
  10
  11 type DataSize       = D8
  12 type IndexSize      = D8
  13 type DiscrSize      = D3
  14 type DiscrRange     = D7
  15 type AdderDepth     = D2
  16
  17 type DataInt        = SizedWord DataSize
  18 type ArrayIndex     = SizedWord IndexSize
  19 type Discr          = RangedWord DiscrRange
  20
  21 type RAM a          = Vector (DiscrRange :+: D1) a
  22
  23 type ReducerState   = State ( DiscrState
  24                       , InputState
  25                       , FpAdderState
  26                       , OutputState
  27                       )
  28 type ReducerSignal  = ( ( DataInt
  29                         , Discr
  30                         )
  31                       , Bit
  32                       )
  33
  34 type MemState a      = State (RAM a)
  35
  36 type OutputSignal   = ( (DataInt
  37                         , ArrayIndex
  38                         )
  39                       , Bit
  40                       )
  41
  42 type DiscrState     = State ( ArrayIndex
  43                       , SizedWord DiscrSize
  44                       )
  45
  46 type InputState     = State ( Vector (AdderDepth :+: D1) ReducerSignal
  47                       , RangedWord AdderDepth
  48                       )
  49
  50 type FpAdderState   = State (Vector AdderDepth ReducerSignal)
  51
  52 type OutputState    = State ( MemState DataInt
  53                             , MemState DataInt
  54                             , RAM ArrayIndex
  55                             , RAM Bit
  56                       )
  57 {-
  58 Discriminator adds a discriminator to each input value
  59
  60 State:
  61 prev_index: previous index
  62 cur_discr: current discriminator
  63
  64 Input:
  65 data_in: input value
  66 index: row index
  67
  68 Output:
  69 data_in: output value
  70 discr: discriminator belonging to output value
  71 new_discr: value of new discriminator, is -1 if cur_discr hasn't changed
  72 index: Index belonging to the new discriminator
  73 -}
  74 discriminator ::  DiscrState -> (DataInt, ArrayIndex) ->
  75                   ( DiscrState
  76                   , ((DataInt, Discr), (Bit, ArrayIndex))
  77                   )
  78 discriminator (State (prev_index,cur_discr)) (data_in, index) =
  79   (State (prev_index', cur_discr'), ((data_in, discr),(new_discr, index)))
  80   where
  81     -- Update discriminator if index changes
  82     cur_discr'  | prev_index == index = cur_discr
  83                 | otherwise           = cur_discr + 1
  84     -- Notify OutputBuffer if a new discriminator becomes in use
  85     new_discr   | prev_index == index = Low
  86                 | otherwise           = High
  87     prev_index'                       = index
  88     discr                             = fromSizedWord cur_discr'
  89
  90 {-
  91 Second attempt at Fifo
  92 Uses "write pointer"... ugly...
  93 Can potentially be mapped to hardware
  94
  95 State:
  96 mem: content of the FIFO
  97 wrptr: points to first free spot in the FIFO
  98
  99 Input:
 100 inp: (value,discriminator) pair
 101 enable: Flushes 2 values from FIFO if 2, 1 value from FIFO if 1, no values
 102         from FIFO if 0
 103
 104 Output
 105 out1: ((value, discriminator),valid) pair of head FIFO
 106 out2: ((value, discriminator),valid) pair of second register FIFO
 107
 108 valid indicates if the output contains a valid discriminator
 109 -}
 110 inputBuffer ::  InputState ->
 111                 ((DataInt, Discr), RangedWord D2) ->
 112                 (InputState, (ReducerSignal, ReducerSignal))
 113 inputBuffer (State (mem,wrptr)) (inp,enable) = (State (mem',wrptr'),(out1, out2))
 114   where
 115     out1                  = last mem -- output head of FIFO
 116     out2                  = last (init mem) -- output 2nd element
 117     -- Update free spot pointer according to value of 'enable'
 118     wrptr'  | enable == 0 = wrptr - 1
 119             | enable == 1 = wrptr
 120             | otherwise   = wrptr + 1
 121     -- Write value to free spot
 122     mem''                 = replace mem wrptr (inp,High)
 123     -- Flush values at head of fifo according to value of 'enable'
 124     mem'    | enable == 0 = mem''
 125             | enable == 1 = zero +> (init mem'')
 126             | otherwise   = zero +> (zero +> (init(init mem'')))
 127     zero                  = (((0::DataInt),(0::Discr)),(Low::Bit))
 128
 129
 130 {-
 131 floating point Adder
 132
 133 output discriminator becomes discriminator of the first operant
 134
 135 State:
 136 state: "pipeline" of the fp Adder
 137
 138 Input:
 139 input1: out1 of the FIFO
 140 input2: out2 of the FIFO
 141 grant: grant signal comming from the controller, determines which value enters
 142        the pipeline
 143 mem_out: Value of the output buffer for the read address
 144          Read address for the output buffer is the discriminator at the top of
 145         the adder pipeline
 146
 147 Output:
 148 output: ((Value, discriminator),valid) pair at the top of the adder pipeline
 149
 150 valid indicates if the output contains a valid discriminator
 151 -}
 152 fpAdder ::  FpAdderState ->
 153             ( ReducerSignal
 154             , ReducerSignal
 155             , (RangedWord D2, RangedWord D2)
 156             , ReducerSignal
 157             ) ->
 158             (FpAdderState, ReducerSignal)
 159 fpAdder (State state) (input1, input2, grant, mem_out) = (State state', output)
 160   where
 161     -- output is head of the pipeline
 162     output    = last state
 163     -- First value of 'grant' determines operant 1
 164     operant1  | (fst grant) == 0  = fst (fst (last state))
 165               | (fst grant) == 1  = fst (fst input2)
 166               | otherwise         = 0
 167     -- Second value of 'grant' determine operant 2
 168     operant2  | (snd grant) == 0  = fst (fst input1)
 169               | (snd grant) == 1  = fst (fst mem_out)
 170               | (otherwise)       = 0
 171     -- Determine discriminator for new value
 172     discr     | (snd grant) == 0  = snd (fst input1)
 173               | (snd grant) == 1  = snd (fst (last state))
 174               | otherwise         = 0
 175     -- Determine if discriminator should be marked as valid
 176     valid     | grant == (2,2)    = Low
 177               | otherwise         = High
 178     -- Shift addition of the two operants into the pipeline
 179     state'    = (((operant1 + operant2),discr),valid) +> (init state)
 180
 181
 182 {-
 183 first attempt at BlockRAM
 184
 185 State:
 186 mem: content of the RAM
 187
 188 Input:
 189 data_in: input value to be written to 'mem' at location 'wraddr'
 190 rdaddr: read address
 191 wraddr: write address
 192 wrenable: write enable flag
 193
 194 Output:
 195 data_out: value of 'mem' at location 'rdaddr'
 196 -}
 197 {-# NOINLINE blockRAM #-}
 198 blockRAM :: (MemState a) ->
 199             ( a
 200             , Discr
 201             , Discr
 202             , Bit
 203             ) ->
 204             ((MemState a), a )
 205 blockRAM (State mem) (data_in, rdaddr, wraddr, wrenable) =
 206   ((State mem'), data_out)
 207   where
 208     data_out  = mem!rdaddr
 209     -- Only write data_in to memory if write is enabled
 210     mem' = case wrenable of
 211       Low   ->  mem
 212       High  ->  replace mem wraddr data_in
 213
 214 {-
 215 Output logic - Determines when values are released from blockram to the output
 216
 217 State:
 218 mem: memory belonging to the blockRAM
 219 lut: Lookup table that maps discriminators to Index'
 220 valid: Lookup table for 'validity' of the content of the blockRAM
 221
 222 Input:
 223 discr: Value of the newest discriminator when it first enters the system.
 224        (-1) otherwise.
 225 index: Index belonging to the newest discriminator
 226 data_in: value to be written to RAM
 227 rdaddr: read address
 228 wraddr: write address
 229 wrenable: write enabled flag
 230
 231 Output:
 232 data_out: value of RAM at location 'rdaddr'
 233 output: Reduced row when ready, (-1) otherwise
 234 -}
 235 outputter ::  OutputState ->
 236               ( Discr
 237               , ArrayIndex
 238               , Bit
 239               , DataInt
 240               , Discr
 241               , Discr
 242               , Bit
 243               ) ->
 244               (OutputState, (ReducerSignal, OutputSignal))
 245 outputter (State (mem1, mem2, lut, valid))
 246   (discr, index, new_discr, data_in, rdaddr, wraddr, wrenable) =
 247   ((State (mem1', mem2', lut', valid')), (data_out, output))
 248   where
 249     -- Lut is updated when new discriminator/index combination enters system
 250     lut'    | new_discr /= Low  = replace lut discr index
 251             | otherwise         = lut
 252     -- Location becomes invalid when Reduced row leaves system
 253     valid'' | (new_discr /= Low) && ((valid!discr) /= Low) =
 254                                   replace valid discr Low
 255             | otherwise         = valid
 256     -- Location becomes invalid when it is fed back into the pipeline
 257     valid'  | wrenable == Low   = replace valid'' rdaddr Low
 258             | otherwise         = replace valid'' wraddr High
 259     (mem1', mem_out1)           = blockRAM mem1 ( data_in
 260                                                 , rdaddr
 261                                                 , wraddr
 262                                                 , wrenable
 263                                                 )
 264     (mem2', mem_out2)           = blockRAM mem2 ( data_in
 265                                             , discr
 266                                             , wraddr
 267                                             , wrenable
 268                                             )
 269     data_out                    = ( ( (mem_out1)
 270                                     , rdaddr
 271                                     )
 272                                   , (valid!rdaddr)
 273                                   )
 274     -- Reduced row is released when new discriminator enters system
 275     -- And the position at the discriminator holds a valid value
 276     output                      = ( ( (mem_out2)
 277                                     , (lut!discr)
 278                                     )
 279                                   , (new_discr `hwand` (valid!discr))
 280                                   )
 281
 282 {-
 283 Arbiter determines which rules are valid
 284
 285 Input:
 286 fp_out: output of the adder pipeline
 287 mem_out: data_out of the output logic
 288 inp1: Head of the input FIFO
 289 inp2: Second element of input FIFO
 290
 291 Output:
 292 r4 - r0: vector of rules, rule is invalid if it's 0, valid otherwise
 293 -}
 294 arbiter :: (ReducerSignal, ReducerSignal, ReducerSignal, ReducerSignal) ->
 295             Vector D5 Bit
 296 arbiter (fp_out, mem_out, inp1, inp2) = (r4 +> (r3 +> (r2 +> (r1 +> (singleton r0)))))
 297   where -- unpack parameters
 298     fp_valid    = snd fp_out
 299     next_valid  = snd mem_out
 300     inp1_valid  = snd inp1
 301     inp2_valid  = snd inp2
 302     fp_discr    = snd (fst fp_out)
 303     next_discr  = snd (fst mem_out)
 304     inp1_discr  = snd (fst inp1)
 305     inp2_discr  = snd (fst inp2)
 306     -- Apply rules
 307     r0  | (fp_valid /= Low) && (next_valid /= Low) && (fp_discr == next_discr)
 308                                       = High
 309         | otherwise                   = Low
 310     r1  | (fp_valid /= Low) && (inp1_valid /= Low) && (fp_discr == inp1_discr)
 311                                       = High
 312         | otherwise                   = Low
 313     r2  | (inp1_valid /= Low) && (inp2_valid /= Low) &&
 314           (inp1_discr == inp2_discr)  = High
 315         | otherwise                   = Low
 316     r3  | inp1_valid /= Low           = High
 317         | otherwise                   = Low
 318     r4                                = High
 319
 320 {-
 321 Controller determines which values are fed into the pipeline
 322 and if the write enable flag for the Output RAM should be set
 323 to true. Also determines how many values should be flushed from
 324 the input FIFO.
 325
 326 Input:
 327 fp_out: output of the adder pipeline
 328 mem_out: data_out of the output logic
 329 inp1: Head of input FIFO
 330 inp2: Second element of input FIFO
 331
 332 Output:
 333 grant: Signal that determines operants for the adder
 334 enable: Number of values to be flushed from input buffer
 335 wr_enable: Determine if value of the adder should be written to RAM
 336 -}
 337 controller :: (ReducerSignal, ReducerSignal, ReducerSignal, ReducerSignal) ->
 338                 ((RangedWord D2, RangedWord D2), RangedWord D2, Bit)
 339 controller (fp_out,mem_out,inp1,inp2) = (grant,enable,wr_enable)
 340   where
 341     -- Arbiter determines which rules are valid
 342     valid       = arbiter (fp_out,mem_out,inp1,inp2)
 343     -- Determine which values should be fed to the adder
 344     grant       = if (valid!(4 :: RangedWord D4) == High)
 345                   then (0,1)
 346                   else if ((drop d3 valid) == $(vectorTH [High,Low]))
 347                   then (0,0)
 348                   else if ((drop d2 valid) == $(vectorTH [High,Low,Low]))
 349                   then (1,0)
 350                   else if ((drop d1 valid) == $(vectorTH [High,Low,Low,Low]))
 351                   then (2,0)
 352                   else (2,2)
 353     -- Determine if some values should be flushed from input FIFO
 354     enable      = if (grant == (1,0))
 355                   then 2
 356                   else if ((grant == (0,0)) || (grant == (2,0)))
 357                   then 1
 358                   else 0
 359     -- Determine if the output value of the adder should be written to RAM
 360     wr_enable'  = if (valid!(4 :: RangedWord D4) == High)
 361                   then Low
 362                   else if ((drop d3 valid) == $(vectorTH [High,Low]))
 363                   then Low
 364                   else if ((drop d2 valid) == $(vectorTH [High,Low,Low]))
 365                   then High
 366                   else if ((drop d1 valid) == $(vectorTH [High,Low,Low,Low]))
 367                   then High
 368                   else High
 369     wr_enable   = if ((snd fp_out) /= Low) then wr_enable' else Low
 370
 371 {-
 372 Reducer
 373
 374 Combines all the earlier defined functions. Uses the second implementation
 375 of the input FIFO.
 376
 377 Parameter:
 378 'n': specifies the max discriminator value.
 379
 380 State: all the states of the used functions
 381
 382 Input: (value,index) combination
 383
 384 Output: reduced row
 385 -}
 386 {-# ANN reducer TopEntity #-}
 387 reducer ::  ReducerState ->
 388             (DataInt, ArrayIndex) ->
 389             (ReducerState, OutputSignal)
 390 reducer (State (discrstate,inputstate,fpadderstate,outputstate)) input =
 391   (State (discrstate',inputstate',fpadderstate',outputstate'),output)
 392   where
 393     (discrstate', discr_out)              = discriminator discrstate input
 394     (inputstate',(fifo_out1, fifo_out2))  = inputBuffer inputstate (
 395                                             (fst discr_out), enable)
 396     (fpadderstate', fp_out)               = fpAdder fpadderstate (fifo_out1,
 397                                                 fifo_out2, grant, mem_out)
 398     discr                                 = snd (fst discr_out)
 399     new_discr                             = fst (snd discr_out)
 400     index                                 = snd (snd discr_out)
 401     rdaddr                                = snd (fst fp_out)
 402     wraddr                                = rdaddr
 403     data_in                               = fst (fst fp_out)
 404     (outputstate', (mem_out, output))     = outputter outputstate (discr,
 405                                             index, new_discr, data_in, rdaddr,
 406                                             wraddr, wr_enable)
 407     (grant,enable,wr_enable)              = controller (fp_out, mem_out,
 408                                             fifo_out1, fifo_out2)
 409
 410
 411 -- -------------------------------------------------------
 412 -- -- Test Functions
 413 -- -------------------------------------------------------
 414 --
 415 -- "Default" Run function
 416 run func state [] = []
 417 run func state (i:input) = o:out
 418   where
 419     (state', o) = func state i
 420     out         = run func state' input
 421 --
 422 -- -- "Special" Run function, also outputs new state
 423 -- run' func state [] = ([],[])
 424 -- run' func state (i:input) = ((o:out), (state':ss))
 425 --   where
 426 --     (state',o)  = func state i
 427 --     (out,ss)         = run' func state' input
 428 --
 429 -- Run reducer
 430 runReducer =  ( reduceroutput
 431               , validoutput
 432               , equal
 433               )
 434   where
 435     input = siminput
 436     istate = initstate
 437     output = run reducer istate input
 438     reduceroutput = P.map fst (filter (\x -> (snd x) /= Low) output)
 439     validoutput   = [P.foldl (+) 0
 440                       (P.map (\z -> toInteger (fst z))
 441                         (filter (\x -> (snd x) == i) input)) | i <- [0..10]]
 442     equal = [validoutput!!i == toInteger (fst (reduceroutput!!i)) |
 443               i <- [0..10]]
 444 --
 445 -- -- Generate infinite list of numbers between 1 and 'x'
 446 -- randX :: Integer -> [Integer]
 447 -- randX x = randomRs (1,x) (unsafePerformIO newStdGen)
 448 --
 449 -- -- Generate random lists of indexes
 450 -- randindex 15 i = randindex 1 i
 451 -- randindex m i = (P.take n (repeat i)) P.++ (randindex (m+1) (i+1))
 452 --   where
 453 --     [n] = P.take 1 rnd
 454 --     rnd = randomRs (1,m) (unsafePerformIO newStdGen)
 455 --
 456 -- -- Combine indexes and values to generate random input for the reducer
 457 -- randominput n x = P.zip data_in index_in
 458 --   where
 459 --     data_in   = P.map (fromInteger :: Integer -> DataInt) (P.take n (randX x))
 460 --     index_in  = P.map (fromInteger :: Integer -> ArrayIndex)
 461 --                         (P.take n (randindex 7 0))
 462 -- main =
 463 --   do
 464 --     putStrLn (show runReducer)
 465
 466 -- simulate f input s = do
 467 --   putStr "Input: "
 468 --   putStr $ show input
 469 --   putStr "\nInitial State: "
 470 --   putStr $ show s
 471 --   putStr "\n\n"
 472 --   foldl1 (>>) (map (printOutput) output)
 473 --   where
 474 --     output = run f input s
 475
 476 initstate :: ReducerState
 477 initstate = State
 478   ( State ( (255 :: ArrayIndex)
 479     , (7 :: SizedWord DiscrSize)
 480     )
 481   , State ( copy ((0::DataInt,0::Discr),Low)
 482     , (2 :: RangedWord AdderDepth)
 483     )
 484   , State (copy ((0::DataInt,0::Discr),Low))
 485   , State ( State (copy (0::DataInt))
 486           , State (copy (0::DataInt))
 487           , (copy (0::ArrayIndex))
 488           , (copy Low)
 489           )
 490   )
 491
 492 siminput :: [(DataInt, ArrayIndex)]
 493 siminput =  [(13,0),(7,0),(14,0),(14,0),(12,0),(10,0),(19,1),(20,1),(13,1)
 494             ,(5,1),(9,1),(16,1),(15,1),(10,2),(13,2),(3,2),(9,2),(19,2),(5,3)
 495             ,(5,3),(10,3),(17,3),(14,3),(5,3),(15,3),(11,3),(5,3),(1,3),(8,4)
 496             ,(20,4),(8,4),(1,4),(11,4),(10,4),(13,5),(18,5),(5,5),(6,5),(6,5)
 497             ,(4,6),(4,6),(11,6),(11,6),(11,6),(1,6),(11,6),(3,6),(12,6),(12,6)
 498             ,(2,6),(14,6),(11,7),(13,7),(17,7),(9,7),(19,8),(4,9),(18,10)
 499             ,(6,10),(18,11),(1,12),(3,12),(14,12),(18,12),(14,12),(6,13)
 500             ,(9,13),(11,14),(4,14),(1,14),(14,14),(14,14),(6,14),(11,15)
 501             ,(13,15),(7,15),(2,16),(16,16),(17,16),(5,16),(20,16),(17,16)
 502             ,(14,16),(18,17),(13,17),(1,17),(19,18),(1,18),(20,18),(4,18)
 503             ,(5,19),(4,19),(6,19),(19,19),(4,19),(3,19),(7,19),(13,19),(19,19)
 504             ,(8,19)
 505             ]