X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fhaskell-symposium-talk.git;a=blobdiff_plain;f=PolyAlu.hs;fp=PolyAlu.hs;h=a464ffbaea172d76f2c361e6f5f77978dc1ec74c;hp=8752f955c2aa9044c734fa1d66866dca039d89c1;hb=d514bd151f4bd5bbb5ae6828902a778222de9738;hpb=bb178ef5c75d6adf38295303902670365634319c

diff --git a/PolyAlu.hs b/PolyAlu.hs
index 8752f95..a464ffb 100644
--- a/PolyAlu.hs
+++ b/PolyAlu.hs
@@ -2,65 +2,57 @@
 {-#  LANGUAGE  TypeOperators, TypeFamilies, FlexibleContexts  #-}
 module Main where
 
-import qualified Prelude as P
-{-# LINE 34 "PolyAlu.lhs" #-}
 import CLasH.HardwareTypes
-{-# LINE 41 "PolyAlu.lhs" #-}
 import CLasH.Translator.Annotations
-{-# LINE 56 "PolyAlu.lhs" #-}
-type Op s a         =   a -> Vector s a -> a
+import qualified Prelude as P
+{-# LINE 51 "PolyAlu.lhs" #-}
+type Op a         =   a -> a -> a
+{-# LINE 58 "PolyAlu.lhs" #-}
+type RegBank s a    =   
+  Vector (s :+: D1) a
+type RegState s a   =   
+  State (RegBank s a)
+{-# LINE 66 "PolyAlu.lhs" #-}
+type Word = SizedInt D12
+{-# LINE 85 "PolyAlu.lhs" #-}
 type Opcode         =   Bit
-{-# LINE 64 "PolyAlu.lhs" #-}
-type RegBank s a    =   Vector (s :+: D1) a
-type RegState s a   =   State (RegBank s a)
-{-# LINE 72 "PolyAlu.lhs" #-}
-type Word           =   SizedInt D12
-{-# LINE 89 "PolyAlu.lhs" #-}
-primOp :: (a -> a -> a) -> Op s a
-primOp f a b = a `f` a
-{-# LINE 97 "PolyAlu.lhs" #-}
-vectOp :: (a -> a -> a) -> Op s a
-vectOp f a b = foldl f a b
-{-# LINE 116 "PolyAlu.lhs" #-}
 alu :: 
-  Op s a -> 
-  Op s a -> 
-  Opcode -> a -> Vector s a -> a
+  Op a -> Op a -> 
+  Opcode -> a -> a -> a
 alu op1 op2 Low    a b = op1 a b
 alu op1 op2 High   a b = op2 a b
-{-# LINE 139 "PolyAlu.lhs" #-}
-registerBank :: 
-  ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) => (RegState s a) -> a -> RangedWord s ->
-  RangedWord s -> Bit -> ((RegState s a), a )
-  
-registerBank (State mem) data_in rdaddr wraddr wrenable = 
+{-# LINE 108 "PolyAlu.lhs" #-}
+registers :: 
+  ((NaturalT s ,PositiveT (s :+: D1),((s :+: D1) :>: s) ~ True )) => a -> RangedWord s ->
+  RangedWord s -> (RegState s a) -> (RegState s a, a )
+{-# LINE 116 "PolyAlu.lhs" #-}
+registers data_in rdaddr wraddr (State mem) = 
   ((State mem'), data_out)
   where
-    data_out  =   mem!rdaddr
-    mem'  | wrenable == Low    = mem
-          | otherwise          = replace mem wraddr data_in
-{-# LINE 167 "PolyAlu.lhs" #-}
-{-# ANN actual_cpu TopEntity#-}
-actual_cpu :: 
-  (Opcode, Word, Vector D4 Word, RangedWord D9, 
-  RangedWord D9, Bit) ->  RegState D9 Word ->
-  (RegState D9 Word, Word)
+    data_out  = mem!rdaddr
+    mem'      = replace mem wraddr data_in
+{-# LINE 138 "PolyAlu.lhs" #-}
+type Instruction = (Opcode, Word, RangedWord D9, RangedWord D9)
+{-# LINE 142 "PolyAlu.lhs" #-}
+{-# ANN cpu TopEntity#-}
+cpu :: 
+  Instruction -> RegState D9 Word -> (RegState D9 Word, Word)
 
-actual_cpu (opc, a ,b, rdaddr, wraddr, wren) ram = (ram', alu_out)
+cpu (opc, d, rdaddr, wraddr) ram = (ram', alu_out)
   where
-    alu_out = alu (primOp (+)) (vectOp (+)) opc ram_out b
-    (ram',ram_out)  = registerBank ram a rdaddr wraddr wren
-{-# LINE 191 "PolyAlu.lhs" #-}
+    alu_out         = alu (+) (-) opc d ram_out
+    (ram',ram_out)  = registers alu_out rdaddr wraddr ram
+{-# LINE 165 "PolyAlu.lhs" #-}
 {-# ANN initstate InitState#-}
 initstate :: RegState D9 Word
 initstate = State (copy (0 :: Word))  
   
 {-# ANN program TestInput#-}
-program :: [(Opcode, Word, Vector D4 Word, RangedWord D9, RangedWord D9, Bit)]
+program :: [Instruction]
 program =
-  [ (Low, 4, copy (0), 0, 0, High) --  Write 4 to Reg0, out = 0
-  , (Low, 3, copy (0), 0, 1, High) --  Write 3 to Reg1, out = 8
-  , (High,0, copy (3), 1, 0, Low)  --  No Write       , out = 15
+  [ (Low, 4, 0, 0) --  Write 4   to Reg0
+  , (Low, 3, 0, 1) --  Write 3+4 to Reg1
+  , (High,8, 1, 2) --  Write 8-7 to Reg2
   ]
 
 run func state [] = []
@@ -73,6 +65,6 @@ main :: IO ()
 main = do
   let input = program
   let istate = initstate
-  let output = run actual_cpu istate input
+  let output = run cpu istate input
   mapM_ (\x -> putStr $ ("(" P.++ (show x) P.++ ")\n")) output
   return ()