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 -> a -> a
  16 const a b = a
  17
  18 fu :: ( PositiveT p, NaturalT n, (p :>: n) ~ True) =>
  19   (a -> a -> a)
  20   -> Vector p a
  21   -> (Index n, Index n)
  22   -> a
  23   -> (a, a)
  24 fu op inputs (addr1, addr2) out =
  25   (out', out)
  26   where
  27     in1  = inputs!addr1
  28     in2  = inputs!addr2
  29     out' = op in1 in2
  30
  31 type CpuState = State (Vector D4 Word)
  32
  33 {-# ANN cpu TopEntity #-}
  34 {-# ANN cpu (InitState 'cpuState) #-}
  35 cpu ::
  36   Word
  37   -> Vector D4 (Index D6, Index D6)
  38   -> CpuState
  39   -> (CpuState, Word)
  40 cpu input addrs (State fuss) =
  41   (State fuss', out)
  42   where
  43     fures = (fu const inputs (addrs!(0 :: Index D3)) (fuss!(0 :: Index D3))) +> (
  44             (fu (+)   inputs (addrs!(1 :: Index D3)) (fuss!(1 :: Index D3))) +> (
  45             (fu (-)   inputs (addrs!(2 :: Index D3)) (fuss!(2 :: Index D3))) +> ( singleton
  46             (fu (*)   inputs (addrs!(3 :: Index D3)) (fuss!(3 :: Index D3))))))
  47     (fuss', outputs) = unzip fures
  48     inputs = 0 +> (1 +> (input +> outputs))
  49     out = head outputs
  50
  51 cpuState :: Vector D4 Word
  52 cpuState = copy 0