HigherOrderCPU.hs

   1 {-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies, ScopedTypeVariables #-}
   2
   3 module HigherOrderCPU where
   4
   5 -- hide default prelude functions
   6 import qualified Prelude as P
   7
   8 -- import CλaSH specific types
   9 import CLasH.HardwareTypes hiding (min,foldl1,const)
  10 import CLasH.Translator.Annotations
  11
  12 type CpuState = State (Vector D4 (Signed D16))
  13
  14 fu op inputs (a1, a2) =
  15   op (inputs!a1) (inputs!a2)
  16
  17 fu1 = fu (+)
  18 fu2 = fu (-)
  19 fu3 = fu (*)
  20
  21 data Opcode = Shift | Xor | Equal
  22
  23 multiop Shift   = shift
  24 multiop Xor     = xor
  25 multiop Equal   = \a b -> if a == b then 1 else 0
  26
  27 fu0 c = fu (multiop c)
  28
  29 {-# ANN cpu TopEntity #-}
  30 {-# ANN cpu (InitState 'cpuState) #-}
  31 cpu :: CpuState
  32   -> (Signed D16, Opcode, Vector D4 (Index D6, Index D6))
  33   -> (CpuState, Signed D16)
  34 cpu (State s) (x,opc,addrs) = (State s', out)
  35   where
  36     inputs  = x +> (0 +> (1 +> s))
  37     s'      = (fu0 opc inputs (addrs!(0 :: Index D3))) +> (
  38               (fu1     inputs (addrs!(1 :: Index D3))) +> (
  39               (fu2     inputs (addrs!(2 :: Index D3))) +> (
  40               (fu3     inputs (addrs!(3 :: Index D3))) +> empty)))
  41     out     = last s
  42
  43 -- Some minor details
  44 cpuState :: Vector D4 (Signed D16)
  45 cpuState = copy 0
  46
  47 type Index  = RangedWord
  48 type Signed = SizedInt
  49
  50 const a b = a
  51 xor = const
  52 shift = const