PolyAlu.hs

   1 {-# LINE 4 "PolyAlu.lhs" #-}
   2 {-#  LANGUAGE  TypeOperators, TypeFamilies, FlexibleContexts  #-}
   3 module Main where
   4
   5 import qualified Prelude as P
   6 {-# LINE 29 "PolyAlu.lhs" #-}
   7 import CLasH.HardwareTypes
   8 {-# LINE 36 "PolyAlu.lhs" #-}
   9 import CLasH.Translator.Annotations
  10 {-# LINE 48 "PolyAlu.lhs" #-}
  11 type Op s a         =   a -> Vector s a -> a
  12 type Opcode         =   Bit
  13 {-# LINE 56 "PolyAlu.lhs" #-}
  14 type RegBank s a    =   Vector (s :+: D1) a
  15 type RegState s a   =   State (RegBank s a)
  16 {-# LINE 64 "PolyAlu.lhs" #-}
  17 type Word           =   SizedInt D12
  18 {-# LINE 76 "PolyAlu.lhs" #-}
  19 primOp :: (a -> a -> a) -> Op s a
  20 primOp f a b = a `f` a
  21 {-# LINE 84 "PolyAlu.lhs" #-}
  22 vectOp :: (a -> a -> a) -> Op s a
  23 vectOp f a b = foldl f a b
  24 {-# LINE 96 "PolyAlu.lhs" #-}
  25 alu ::
  26   Op s a ->
  27   Op s a ->
  28   Opcode -> a -> Vector s a -> a
  29 alu op1 op2 Low    a b = op1 a b
  30 alu op1 op2 High   a b = op2 a b
  31 {-# LINE 112 "PolyAlu.lhs" #-}
  32 registerBank ::
  33   ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) =>
  34   (RegState s a) -> a -> RangedWord s ->
  35   RangedWord s -> Bit -> ((RegState s a), a )
  36
  37 registerBank (State mem) data_in rdaddr wraddr wrenable =
  38   ((State mem'), data_out)
  39   where
  40     data_out  =   mem!rdaddr
  41     mem'  | wrenable == Low    = mem
  42           | otherwise          = replace mem wraddr data_in
  43 {-# LINE 133 "PolyAlu.lhs" #-}
  44 {-# ANN actual_cpu TopEntity#-}
  45 actual_cpu ::
  46   (Opcode, Word, Vector D4 Word, RangedWord D9,
  47   RangedWord D9, Bit) ->  RegState D9 Word ->
  48   (RegState D9 Word, Word)
  49
  50 actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram = (ram', alu_out)
  51   where
  52     alu_out = alu (primOp (+)) (vectOp (+)) opc ram_out b
  53     (ram',ram_out)  = registerBank ram a rdaddr wraddr wren
  54 {-# LINE 149 "PolyAlu.lhs" #-}
  55 {-# ANN initstate InitState#-}
  56 initstate :: RegState D9 Word
  57 initstate = State (copy (0 :: Word))
  58
  59 {-# ANN program TestInput#-}
  60 program :: [(Opcode, Word, Vector D4 Word, RangedWord D9, RangedWord D9, Bit)]
  61 program =
  62   [ (Low, 4, copy (0::Word), 0, 0, High) --  Write 4 to Reg0, out = 0
  63   , (Low, 3, copy (0::Word), 0, 1, High) --  Write 3 to Reg1, out = Reg0 + Reg0 = 8
  64   , (High,0, copy (3::Word), 1, 0, Low)  --  No Write       , out = 15
  65   ]
  66
  67 run func state [] = []
  68 run func state (i:input) = o:out
  69   where
  70     (state', o) = func i state
  71     out         = run func state' input
  72
  73 main :: IO ()
  74 main = do
  75   let input = program
  76   let istate = initstate
  77   let output = run actual_cpu istate input
  78   mapM_ (\x -> putStr $ ("# (" P.++ (show x) P.++ ")\n")) output
  79   return ()