From a37aac300ad93f0fd5edbed645655c2af2915002 Mon Sep 17 00:00:00 2001
From: christiaanb <christiaan.baaij@gmail.com>
Date: Thu, 17 Jun 2010 17:00:10 +0200
Subject: [PATCH] Add higherordercpu and matrix multiplication examples

---
 HigherOrderCPU.hs | 55 +++++++++++++++++++++++++++++++++++++++++++++++
 mmult.hs          | 32 +++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)
 create mode 100644 HigherOrderCPU.hs
 create mode 100644 mmult.hs

diff --git a/HigherOrderCPU.hs b/HigherOrderCPU.hs
new file mode 100644
index 0000000..8e3f0da
--- /dev/null
+++ b/HigherOrderCPU.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module HigherOrderCPU where
+
+-- hide default prelude functions
+import qualified Prelude as P
+
+-- import CλaSH specific types
+import CLasH.HardwareTypes
+import CLasH.Translator.Annotations
+
+type CpuState = State (Vector D4 (Signed D16))
+
+fu op inputs (a1, a2) = 
+  op (inputs!a1) (inputs!a2)
+
+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
+
+fu0 c = fu (multiop c)
+
+{-# ANN cpu TopEntity #-}
+{-# ANN cpu (InitState 'cpuState) #-}
+cpu :: CpuState 
+  -> (Signed D16, Opcode, Vector D4 (Index D7, Index D7))
+  -> (CpuState, Signed D16)
+cpu (State s) (x,opc,addrs) = (State s', out)
+  where
+    inputs  = x +> (0 +> (1 +> s))
+    s'      = (fu0 opc inputs (addrs!0)) +> (
+              (fu1     inputs (addrs!1)) +> (
+              (fu2     inputs (addrs!2)) +> (
+              (fu3     inputs (addrs!3)) +> empty)))
+    out     = last s
+
+
+
+
+
+
+
+-- Some minor details
+cpuState :: Vector D4 (Signed D16)
+cpuState = copy 0
+
+const a b = a
+xor = const
+shift = const
diff --git a/mmult.hs b/mmult.hs
new file mode 100644
index 0000000..efed9a0
--- /dev/null
+++ b/mmult.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE TypeOperators, TemplateHaskell, TypeFamilies, ScopedTypeVariables, FlexibleContexts #-}
+
+module MMult where
+
+-- hide default prelude functions
+import qualified Prelude as P
+
+-- import CλaSH specific types
+import CLasH.HardwareTypes
+import CLasH.Translator.Annotations
+
+type Word = Signed D16
+
+foldl1 f xs = foldl f (head xs) (tail xs)
+as ** bs    = foldl1 (+) (zipWith (*) as bs)
+
+{-# ANN mmult2x4_4x3 TopEntity #-}
+mmult2x4_4x3 :: Vector D2 (Vector D4 Word) -> Vector D4 (Vector D3 Word) -> Vector D2 (Vector D3 Word)
+mmult2x4_4x3 a b = mmult a b
+
+mmult xss yss = map f xss
+ where
+   f xs  = map (xs **) colsy
+   colsy = transpose yss (iterate (1+) 0)
+
+transpose :: 
+ ( PositiveT s1
+ , PositiveT s2
+ ) => Vector s1 (Vector s2 a) -> 
+ Vector s2 (Index s2) -> 
+ Vector s2 (Vector s1 a)
+transpose m ixs = map (\x-> map (!x) m) ixs
\ No newline at end of file
-- 
2.30.2