1 {-# LINE 4 "PolyAlu.lhs" #-}
2 {-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts #-}
5 import CLasH.HardwareTypes
6 import CLasH.Translator.Annotations
7 import qualified Prelude as P
8 {-# LINE 51 "PolyAlu.lhs" #-}
9 type Op a = a -> a -> a
10 {-# LINE 58 "PolyAlu.lhs" #-}
15 {-# LINE 66 "PolyAlu.lhs" #-}
16 type Word = SizedInt D12
17 {-# LINE 85 "PolyAlu.lhs" #-}
22 alu op1 op2 Low a b = op1 a b
23 alu op1 op2 High a b = op2 a b
24 {-# LINE 108 "PolyAlu.lhs" #-}
26 ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) => a -> RangedWord s ->
27 RangedWord s -> (RegState s a) -> (RegState s a, a )
28 {-# LINE 116 "PolyAlu.lhs" #-}
29 registers data_in rdaddr wraddr (State mem) =
30 ((State mem'), data_out)
33 mem' = replace mem wraddr data_in
34 {-# LINE 138 "PolyAlu.lhs" #-}
35 type Instruction = (Opcode, Word, RangedWord D9, RangedWord D9)
36 {-# LINE 142 "PolyAlu.lhs" #-}
37 {-# ANN cpu TopEntity#-}
39 Instruction -> RegState D9 Word -> (RegState D9 Word, Word)
41 cpu (opc, d, rdaddr, wraddr) ram = (ram', alu_out)
43 alu_out = alu (+) (-) opc d ram_out
44 (ram',ram_out) = registers alu_out rdaddr wraddr ram
45 {-# LINE 165 "PolyAlu.lhs" #-}
46 {-# ANN initstate InitState#-}
47 initstate :: RegState D9 Word
48 initstate = State (copy (0 :: Word))
50 {-# ANN program TestInput#-}
51 program :: [Instruction]
53 [ (Low, 4, 0, 0) -- Write 4 to Reg0
54 , (Low, 3, 0, 1) -- Write 3+4 to Reg1
55 , (High,8, 1, 2) -- Write 8-7 to Reg2
58 run func state [] = []
59 run func state (i:input) = o:out
61 (state', o) = func i state
62 out = run func state' input
67 let istate = initstate
68 let output = run cpu istate input
69 mapM_ (\x -> putStr $ ("(" P.++ (show x) P.++ ")\n")) output