4 {-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts #-}
7 import qualified Prelude as P
11 \section{Polymorphic, Higher-Order CPU}
12 \subsection{Introduction}
15 \frametitle{Small Use Case}
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
26 Import all the built-in types, such as vectors and integers:
28 import CLasH.HardwareTypes
30 Import annotations, helps \clash{} to find top-level component:
32 import CLasH.Translator.Annotations
36 \subsection{Type Definitions}
39 First we define some ALU types:
41 type Op s a = a -> Vector s a -> a
44 And some Register types:
46 type RegBank s a = Vector (s :+: D1) a
47 type RegState s a = State (RegBank s a)
49 And a simple Word type:
51 type Word = SizedInt D12
54 \subsection{Frameworks for Operations}
57 We make a primitive operation:
59 primOp :: {-"{\color<2>[rgb]{1,0,0}"-}(a -> a -> a){-"}"-} -> Op s a
60 primOp f a b = a `f` a
62 We make a vector operation:
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
68 \subsection{Polymorphic, Higher-Order ALU}
71 We define a polymorphic ALU:
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
81 \subsection{Register bank}
84 Make a simple register bank:
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 )
91 registerBank (State mem) data_in rdaddr wraddr wrenable =
92 ((State mem'), data_out)
95 mem' {-"{\color<3>[rgb]{1,0,0}"-}| wrenable == Low{-"}"-} = mem
96 {-"{\color<3>[rgb]{1,0,0}"-}| otherwise{-"}"-} = replace mem wraddr data_in
99 \subsection{Simple CPU: ALU \& Register Bank}
102 Combining ALU and register bank:
104 {-"{\color<2>[rgb]{1,0,0}"-}ANN(actual_cpu TopEntity){-"}"-}
106 (Opcode, Word, Vector D4 Word, RangedWord D9,
107 RangedWord D9, Bit) -> RegState D9 Word ->
108 (RegState D9 Word, Word)
110 actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram =
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 (+)