8752f955c2aa9044c734fa1d66866dca039d89c1
[matthijs/master-project/haskell-symposium-talk.git] / 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 34 "PolyAlu.lhs" #-}
7 import CLasH.HardwareTypes
8 {-# LINE 41 "PolyAlu.lhs" #-}
9 import CLasH.Translator.Annotations
10 {-# LINE 56 "PolyAlu.lhs" #-}
11 type Op s a         =   a -> Vector s a -> a
12 type Opcode         =   Bit
13 {-# LINE 64 "PolyAlu.lhs" #-}
14 type RegBank s a    =   Vector (s :+: D1) a
15 type RegState s a   =   State (RegBank s a)
16 {-# LINE 72 "PolyAlu.lhs" #-}
17 type Word           =   SizedInt D12
18 {-# LINE 89 "PolyAlu.lhs" #-}
19 primOp :: (a -> a -> a) -> Op s a
20 primOp f a b = a `f` a
21 {-# LINE 97 "PolyAlu.lhs" #-}
22 vectOp :: (a -> a -> a) -> Op s a
23 vectOp f a b = foldl f a b
24 {-# LINE 116 "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 139 "PolyAlu.lhs" #-}
32 registerBank :: 
33   ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) => (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 167 "PolyAlu.lhs" #-}
43 {-# ANN actual_cpu TopEntity#-}
44 actual_cpu :: 
45   (Opcode, Word, Vector D4 Word, RangedWord D9, 
46   RangedWord D9, Bit) ->  RegState D9 Word ->
47   (RegState D9 Word, Word)
48
49 actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram = (ram', alu_out)
50   where
51     alu_out = alu (primOp (+)) (vectOp (+)) opc ram_out b
52     (ram',ram_out)  = registerBank ram a rdaddr wraddr wren
53 {-# LINE 191 "PolyAlu.lhs" #-}
54 {-# ANN initstate InitState#-}
55 initstate :: RegState D9 Word
56 initstate = State (copy (0 :: Word))  
57   
58 {-# ANN program TestInput#-}
59 program :: [(Opcode, Word, Vector D4 Word, RangedWord D9, RangedWord D9, Bit)]
60 program =
61   [ (Low, 4, copy (0), 0, 0, High) --  Write 4 to Reg0, out = 0
62   , (Low, 3, copy (0), 0, 1, High) --  Write 3 to Reg1, out = 8
63   , (High,0, copy (3), 1, 0, Low)  --  No Write       , out = 15
64   ]
65
66 run func state [] = []
67 run func state (i:input) = o:out
68   where
69     (state', o) = func i state
70     out         = run func state' input
71     
72 main :: IO ()
73 main = do
74   let input = program
75   let istate = initstate
76   let output = run actual_cpu istate input
77   mapM_ (\x -> putStr $ ("(" P.++ (show x) P.++ ")\n")) output
78   return ()