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 Word   = SizedInt D16
  13 type Index  = RangedWord
  14
  15 const a b = a
  16
  17 fu op inputs (addr1, addr2) = regIn
  18   where
  19     in1   = inputs!addr1
  20     in2   = inputs!addr2
  21     regIn = op in1 in2
  22
  23 type CpuState = State (Vector D4 Word)
  24
  25 {-# ANN cpu TopEntity #-}
  26 {-# ANN cpu (InitState 'cpuState) #-}
  27 cpu :: CpuState -> Word -> Vector D4 (Index D6, Index D6) -> Opcode
  28   -> (CpuState, Word)
  29 cpu (State fuss) input addrs opc = (State fuss', out)
  30   where
  31     fuss'   = (fu (multiop opc) inputs (addrs!(0 :: Index D3))) +> (
  32               (fu (+)   inputs (addrs!(1 :: Index D3))) +> (
  33               (fu (-)   inputs (addrs!(2 :: Index D3))) +> (
  34               (fu (*)   inputs (addrs!(3 :: Index D3))) +> empty)))
  35     inputs  = 0 +> (1 +> (input +> fuss))
  36     out     = head fuss
  37
  38 cpuState :: Vector D4 Word
  39 cpuState = copy 0
  40
  41 data Opcode = Shift | Xor | Equal
  42
  43 multiop :: Opcode -> Word -> Word -> Word
  44 multiop opc a b = case opc of
  45   Shift             -> shift a b
  46   Xor               -> xor a b
  47   Equal | a == b    -> 1
  48         | otherwise -> 0
  49
  50 -- Placeholders, since we don't have these operations
  51 xor = const
  52 shift = const