Add translatable/compilable version of the higher-order CPU
[matthijs/master-project/dsd-paper.git] / HigherOrderCPU.hs
1 {-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies, 
2              ScopedTypeVariables, RecordWildCards, FlexibleContexts #-}
3
4 module HigherOrderCPU where
5
6 -- hide default prelude functions
7 import qualified Prelude as P
8
9 -- import C╬╗aSH specific types
10 import CLasH.HardwareTypes hiding (min,foldl1,const)
11 import CLasH.Translator.Annotations
12
13 type Word   = SizedInt D16
14 type Index  = RangedWord
15
16 const :: a -> a -> a
17 const a b = a
18
19 fu :: ( PositiveT p, NaturalT n, (p :>: n) ~ True) =>
20   (a -> a -> a)
21   -> Vector p a
22   -> (Index n, Index n)
23   -> a
24   -> (a, a)
25 fu op inputs (addr1, addr2) out =
26   (out', out)
27   where
28     in1  = inputs!addr1
29     in2  = inputs!addr2
30     out' = op in1 in2
31
32 type CpuState = State (Vector D4 Word)
33
34 {-# ANN cpu TopEntity #-}
35 {-# ANN cpu (InitState 'cpuState) #-}
36 cpu :: 
37   Word 
38   -> Vector D4 (Index D6, Index D6)
39   -> CpuState
40   -> (CpuState, Word)
41 cpu input addrs (State fuss) =
42   (State fuss', out)
43   where
44     fures = (fu const inputs (addrs!(0 :: Index D3)) (fuss!(0 :: Index D3))) +> (
45             (fu (+)   inputs (addrs!(1 :: Index D3)) (fuss!(1 :: Index D3))) +> (
46             (fu (-)   inputs (addrs!(2 :: Index D3)) (fuss!(2 :: Index D3))) +> ( singleton
47             (fu (*)   inputs (addrs!(3 :: Index D3)) (fuss!(3 :: Index D3))))))
48     (fuss', outputs) = unzip fures
49     inputs = 0 +> (1 +> (input +> outputs))
50     out = head outputs
51
52 cpuState :: Vector D4 Word
53 cpuState = copy 0