-{-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies,
- ScopedTypeVariables, RecordWildCards, FlexibleContexts #-}
+{-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies, ScopedTypeVariables #-}
module HigherOrderCPU where
import CLasH.HardwareTypes hiding (min,foldl1,const)
import CLasH.Translator.Annotations
-type Word = SizedInt D16
-type Index = RangedWord
+type CpuState = State (Vector D4 (Signed D16))
-const :: a -> a -> a
-const a b = a
+fu op inputs (a1, a2) =
+ op (inputs!a1) (inputs!a2)
-fu :: ( PositiveT p, NaturalT n, (p :>: n) ~ True) =>
- (a -> a -> a)
- -> Vector p a
- -> (Index n, Index n)
- -> a
- -> (a, a)
-fu op inputs (addr1, addr2) out =
- (out', out)
- where
- in1 = inputs!addr1
- in2 = inputs!addr2
- out' = op in1 in2
+fu1 = fu (+)
+fu2 = fu (-)
+fu3 = fu (*)
+
+data Opcode = Shift | Xor | Equal
+
+multiop Shift = shift
+multiop Xor = xor
+multiop Equal = \a b -> if a == b then 1 else 0
-type CpuState = State (Vector D4 Word)
+fu0 c = fu (multiop c)
{-# ANN cpu TopEntity #-}
{-# ANN cpu (InitState 'cpuState) #-}
-cpu ::
- Word
- -> Vector D4 (Index D6, Index D6)
- -> CpuState
- -> (CpuState, Word)
-cpu input addrs (State fuss) =
- (State fuss', out)
+cpu :: CpuState
+ -> (Signed D16, Opcode, Vector D4 (Index D6, Index D6))
+ -> (CpuState, Signed D16)
+cpu (State s) (x,opc,addrs) = (State s', out)
where
- fures = (fu const inputs (addrs!(0 :: Index D3)) (fuss!(0 :: Index D3))) +> (
- (fu (+) inputs (addrs!(1 :: Index D3)) (fuss!(1 :: Index D3))) +> (
- (fu (-) inputs (addrs!(2 :: Index D3)) (fuss!(2 :: Index D3))) +> ( singleton
- (fu (*) inputs (addrs!(3 :: Index D3)) (fuss!(3 :: Index D3))))))
- (fuss', outputs) = unzip fures
- inputs = 0 +> (1 +> (input +> outputs))
- out = head outputs
-
-cpuState :: Vector D4 Word
-cpuState = copy 0
\ No newline at end of file
+ inputs = x +> (0 +> (1 +> s))
+ s' = (fu0 opc inputs (addrs!(0 :: Index D3))) +> (
+ (fu1 inputs (addrs!(1 :: Index D3))) +> (
+ (fu2 inputs (addrs!(2 :: Index D3))) +> (
+ (fu3 inputs (addrs!(3 :: Index D3))) +> empty)))
+ out = last s
+
+-- Some minor details
+cpuState :: Vector D4 (Signed D16)
+cpuState = copy 0
+
+type Index = RangedWord
+type Signed = SizedInt
+
+const a b = a
+xor = const
+shift = const