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}\pause
18 \item Polymorphic, Higher-Order CPU\pause
19 \item Use of state will be simple
22 \item Small "toy"-example of what can be done in \clash{}
23 \item Show what can be translated to Hardware
24 \item Put your hardware glasses on: each function will be a component
25 \item Use of state will be kept simple
28 \subsection{Type Definitions}
31 \frametitle{Type definitions}\pause
32 TODO: Plaatje van de ALU
33 First we define some ALU types:
34 \begin{beamercolorbox}[sep=-2.5ex,rounded=true,shadow=true,vmode]{codebox}
36 type Op a = a -> a -> a
38 \end{beamercolorbox}\pause
40 And some Register types:
41 \begin{beamercolorbox}[sep=-2.5ex,rounded=true,shadow=true,vmode]{codebox}
43 type RegBank s a = Vector (s :+: D1) a
44 type RegState s a = State (RegBank s a)
46 \end{beamercolorbox}\pause
48 \item The first type is already polymorphic in input / output type
49 \item State has to be of the State type to be recognized as such
52 \subsection{Polymorphic, Higher-Order ALU}
55 \frametitle{Simple ALU}
56 Abstract ALU definition:
57 \begin{beamercolorbox}[sep=-2.5ex,rounded=true,shadow=true,vmode]{codebox}
63 alu op1 op2 {-"{\color<2>[rgb]{1,0,0}"-}Low{-"}"-} a b = op1 a b
64 alu op1 op2 {-"{\color<2>[rgb]{1,0,0}"-}High{-"}"-} a b = op2 a b
68 \uncover<2->{\item We support Pattern Matching}
71 \item Alu is both higher-order, and polymorphic
72 \item Two parameters are "compile time", others are "runtime"
73 \item We support pattern matching
76 \subsection{Register bank}
79 \frametitle{Register Bank}
80 Make a simple register bank:
81 \begin{beamercolorbox}[sep=-2.5ex,rounded=true,shadow=true,vmode]{codebox}
85 CXT((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) => a -> RangedWord s ->
86 RangedWord s -> Bool -> (RegState s a) -> ((RegState s a), a )
88 registerBank data_in rdaddr wraddr (State mem) =
89 ((State mem'), data_out)
92 mem' = replace mem wraddr data_in
96 \uncover<2->{\item We support Guards}
99 \item RangedWord runs from 0 to the upper bound
100 \item mem is statefull
101 \item We support guards
102 \item replace is a builtin function
105 \subsection{Simple CPU: ALU \& Register Bank}
108 \frametitle{Simple CPU}
109 Combining ALU and register bank:
110 \begin{beamercolorbox}[sep=-2.5ex,rounded=true,shadow=true,vmode]{codebox}
111 TODO: Hide Instruction type?
113 type Instruction = (Opcode, Word, RangedWord D9, RangedWord D9) -> RegState D9 Word ->
114 {-"{\color<2>[rgb]{1,0,0}"-}ANN(actual_cpu TopEntity){-"}"-}
116 Instruction -> RegState D9 Word -> (RegState D9 Word, Word)
118 actual_cpu (opc, d, rdaddr, wraddr) ram = (ram', alu_out)
120 alu_out = alu ({-"{\color<3>[rgb]{1,0,0}"-}(+){-"}"-}) ({-"{\color<3>[rgb]{1,0,0}"-}(-){-"}"-}) opc d ram_out
121 (ram',ram_out) = registerBank alu_out rdaddr wraddr ram
125 \uncover<2->{\item Annotation is used to indicate top-level component}
128 \item We use the new Annotion functionality to indicate this is the top level. TopEntity is defined by us.
129 \item the primOp and vectOp frameworks are now supplied with real functionality, the plus (+) operations
130 \item No polymorphism or higher-order stuff is allowed at this level.
131 \item Functions must be specialized, and have primitives for input and output
136 ANN(initstate InitState)
137 initstate :: RegState D9 Word
138 initstate = State (copy (0 :: Word))
140 ANN(program TestInput)
141 program :: [(Opcode, Word, Vector D4 Word, RangedWord D9, RangedWord D9, Bit)]
143 [ (Low, 4, copy (0), 0, 0, High) -- Write 4 to Reg0, out = 0
144 , (Low, 3, copy (0), 0, 1, High) -- Write 3 to Reg1, out = 8
145 , (High,0, copy (3), 1, 0, Low) -- No Write , out = 15
148 run func state [] = []
149 run func state (i:input) = o:out
151 (state', o) = func i state
152 out = run func state' input
157 let istate = initstate
158 let output = run actual_cpu istate input
159 mapM_ (\x -> putStr $ ("(" P.++ (show x) P.++ ")\n")) output