HigherOrderCPU.hs

   1 {-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies,
   2              ScopedTypeVariables, RecordWildCards, FlexibleContexts #-}
   3
   4 module HigherOrderCPU where
   5
   6 -- hide default prelude functions
   7 import qualified Prelude as P
   8
   9 -- import CλaSH specific types
  10 import CLasH.HardwareTypes hiding (min,foldl1,const)
  11 import CLasH.Translator.Annotations
  12
  13 type Word   = SizedInt D16
  14 type Index  = RangedWord
  15
  16 const :: a -> a -> a
  17 const a b = a
  18
  19 fu :: ( PositiveT p, NaturalT n, (p :>: n) ~ True) =>
  20   (a -> a -> a)
  21   -> Vector p a
  22   -> (Index n, Index n)
  23   -> a
  24   -> (a, a)
  25 fu op inputs (addr1, addr2) out =
  26   (out', out)
  27   where
  28     in1  = inputs!addr1
  29     in2  = inputs!addr2
  30     out' = op in1 in2
  31
  32 type CpuState = State (Vector D4 Word)
  33
  34 {-# ANN cpu TopEntity #-}
  35 {-# ANN cpu (InitState 'cpuState) #-}
  36 cpu ::
  37   Word
  38   -> Vector D4 (Index D6, Index D6)
  39   -> CpuState
  40   -> (CpuState, Word)
  41 cpu input addrs (State fuss) =
  42   (State fuss', out)
  43   where
  44     fures = (fu const inputs (addrs!(0 :: Index D3)) (fuss!(0 :: Index D3))) +> (
  45             (fu (+)   inputs (addrs!(1 :: Index D3)) (fuss!(1 :: Index D3))) +> (
  46             (fu (-)   inputs (addrs!(2 :: Index D3)) (fuss!(2 :: Index D3))) +> ( singleton
  47             (fu (*)   inputs (addrs!(3 :: Index D3)) (fuss!(3 :: Index D3))))))
  48     (fuss', outputs) = unzip fures
  49     inputs = 0 +> (1 +> (input +> outputs))
  50     out = head outputs
  51
  52 cpuState :: Vector D4 Word
  53 cpuState = copy 0