PolyAlu.hs

   1 {-# LINE 4 "PolyAlu.lhs" #-}
   2 {-#  LANGUAGE  TypeOperators, TypeFamilies, FlexibleContexts  #-}
   3 module PolyCPU where
   4
   5 import qualified Prelude as P
   6 {-# LINE 27 "PolyAlu.lhs" #-}
   7 import CLasH.HardwareTypes
   8 import CLasH.Translator.Annotations
   9 {-# LINE 37 "PolyAlu.lhs" #-}
  10 type Op s a         =   a -> Vector s a -> a
  11 type Opcode         =   Bit
  12 {-# LINE 42 "PolyAlu.lhs" #-}
  13 type RegBank s a    =   Vector (s :+: D1) a
  14 type RegState s a   =   State (RegBank s a)
  15 {-# LINE 47 "PolyAlu.lhs" #-}
  16 type Word           =   SizedInt D12
  17 {-# LINE 55 "PolyAlu.lhs" #-}
  18 primOp :: (a -> a -> a) -> Op s a
  19 primOp f a b = a `f` a
  20 {-# LINE 60 "PolyAlu.lhs" #-}
  21 vectOp :: (a -> a -> a) -> Op s a
  22 vectOp f a b = foldl f a b
  23 {-# LINE 69 "PolyAlu.lhs" #-}
  24 alu ::
  25   Op s a ->
  26   Op s a ->
  27   Opcode -> a -> Vector s a -> a
  28 alu op1 op2 Low    a b = op1 a b
  29 alu op1 op2 High   a b = op2 a b
  30 {-# LINE 82 "PolyAlu.lhs" #-}
  31 registerBank ::
  32   ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) =>
  33   (RegState s a) -> a -> RangedWord s ->
  34   RangedWord s -> Bit -> ((RegState s a), a )
  35
  36 registerBank (State mem) data_in rdaddr wraddr wrenable =
  37   ((State mem'), data_out)
  38   where
  39     data_out  =   mem!rdaddr
  40     mem'          | wrenable == Low  = mem
  41                   | otherwise        = replace mem wraddr data_in
  42 {-# LINE 100 "PolyAlu.lhs" #-}
  43 {-# ANN actual_cpu TopEntity#-}
  44 actual_cpu ::
  45   (Opcode, Word, Vector D4 Word,
  46   RangedWord D9,
  47   RangedWord D9, Bit) ->
  48   RegState D9 Word ->
  49   (RegState D9 Word, Word)
  50
  51 actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram = (ram', alu_out)
  52   where
  53     alu_out = alu simpleOp vectorOp opc ram_out b
  54     (ram',ram_out)  = registerBank ram a rdaddr wraddr wren
  55     simpleOp =  primOp  (+)
  56     vectorOp =  vectOp  (+)