Use adapted CAES theme
[matthijs/master-project/haskell-symposium-talk.git] / PolyAlu.lhs
1 %include talk.fmt
2 %if style == newcode
3 \begin{code}
4 {-# LANGUAGE  TypeOperators, TypeFamilies, FlexibleContexts #-}
5 module PolyCPU where
6
7 import qualified Prelude as P
8 \end{code}
9 %endif
10
11 \section{Polymorphic, Higher-Order CPU}
12 \subsection{Introduction}
13 \frame
14 {
15 \frametitle{Small Use Case}
16 \begin{itemize}
17   \item Small Polymorphic, Higher-Order CPU
18   \item Each function is turned into a hardware component
19   \item Use of state will be simple
20 \end{itemize}
21 }
22
23 \frame
24 {
25 \frametitle{Imports}
26 Import all the built-in types, such as vectors and integers:
27 \begin{code}
28 import CLasH.HardwareTypes
29 \end{code}\pause
30 Import annotations, helps \clash{} to find top-level component:
31 \begin{code}
32 import CLasH.Translator.Annotations
33 \end{code}
34 }
35
36 \subsection{Type Definitions}
37 \frame
38 {
39 First we define some ALU types:
40 \begin{code}
41 type Op s a         =   a -> Vector s a -> a
42 type Opcode         =   Bit
43 \end{code}\pause
44 And some Register types:
45 \begin{code}
46 type RegBank s a    =   Vector (s :+: D1) a
47 type RegState s a   =   State (RegBank s a)
48 \end{code}\pause
49 And a simple Word type:
50 \begin{code}
51 type Word           =   SizedInt D12
52 \end{code}
53 }
54 \subsection{Frameworks for Operations}
55 \frame
56 {
57 We make a primitive operation:
58 \begin{code}
59 primOp :: {-"{\color<2>[rgb]{1,0,0}"-}(a -> a -> a){-"}"-} -> Op s a
60 primOp f a b = a `f` a
61 \end{code}\pause
62 We make a vector operation:
63 \begin{code}
64 vectOp :: {-"{\color<2>[rgb]{1,0,0}"-}(a -> a -> a){-"}"-} -> Op s a
65 vectOp f a b = {-"{\color<2>[rgb]{1,0,0}"-}foldl{-"}"-} f a b
66 \end{code}
67 }
68 \subsection{Polymorphic, Higher-Order ALU}
69 \frame
70 {
71 We define a polymorphic ALU:
72 \begin{code}
73 alu :: 
74   Op s a -> 
75   Op s a -> 
76   Opcode -> a -> Vector s a -> a
77 alu op1 op2 {-"{\color<2>[rgb]{1,0,0}"-}Low{-"}"-}    a b = op1 a b
78 alu op1 op2 {-"{\color<2>[rgb]{1,0,0}"-}High{-"}"-}   a b = op2 a b
79 \end{code}
80 }
81 \subsection{Register bank}
82 \frame
83 {
84 Make a simple register bank:
85 \begin{code}
86 registerBank :: 
87   CXT((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) =>
88   (RegState s a) -> a -> {-"{\color<2>[rgb]{1,0,0}"-}RangedWord s{-"}"-} ->
89   {-"{\color<2>[rgb]{1,0,0}"-}RangedWord s{-"}"-} -> Bit -> ((RegState s a), a )
90   
91 registerBank (State mem) data_in rdaddr wraddr wrenable = 
92   ((State mem'), data_out)
93   where
94     data_out  =   mem!rdaddr
95     mem'  {-"{\color<3>[rgb]{1,0,0}"-}| wrenable == Low{-"}"-}    = mem
96           {-"{\color<3>[rgb]{1,0,0}"-}| otherwise{-"}"-}          = replace mem wraddr data_in
97 \end{code}
98 }
99 \subsection{Simple CPU: ALU \& Register Bank}
100 \frame
101 {
102 Combining ALU and register bank:
103 \begin{code}
104 {-"{\color<2>[rgb]{1,0,0}"-}ANN(actual_cpu TopEntity){-"}"-}
105 actual_cpu :: 
106   (Opcode, Word, Vector D4 Word, RangedWord D9, 
107   RangedWord D9, Bit) ->  RegState D9 Word ->
108   (RegState D9 Word, Word)
109
110 actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram = 
111   (ram', alu_out)
112   where
113     alu_out = alu simpleOp vectorOp opc ram_out b
114     (ram',ram_out)  = registerBank ram a rdaddr wraddr wren
115     simpleOp =  primOp  (+)
116     vectorOp =  vectOp  (+)
117 \end{code}
118 }