X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=blobdiff_plain;f=examples%2FBitSerialHardware.hs;h=0a35247ad37a8cc9f57f2c2f93d338765e1409c3;hp=2e82b0dc51588acb4f85d75f0725e027b0c1c4e3;hb=c700f5a65d664d4c0a3e76d33aa3769266bf330c;hpb=ec996e8cb550676d89d187061db7d018af9ec88d

diff --git a/examples/BitSerialHardware.hs b/examples/BitSerialHardware.hs
index 2e82b0d..0a35247 100644
--- a/examples/BitSerialHardware.hs
+++ b/examples/BitSerialHardware.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
 module BitSerialHardware(Wire,BitSerialHardwarePrimitives(..)) where
 import Control.GArrow
 import Control.Category
 import GArrowPretty
 import Prelude hiding (id, (.))
 import Text.PrettyPrint.HughesPJ
+import GArrowPortShape
+import GArrowSkeleton
+import GArrowTikZ
 
 ------------------------------------------------------------------------------
 -- Bit-Serial Hardware Primitives
@@ -45,3 +48,23 @@ instance BitSerialHardwarePrimitives SourceCode where
   probe  id   = SC False $ text "probe"  <+> (text . show) id
   oracle id   = SC False $ text "oracle" <+> (text . show) id
 
+instance BitSerialHardwarePrimitives (GArrowSkeleton Opaque) where
+  reg         = GAS_misc reg'
+                where reg' = MkOpaque "reg" $
+                             do x <- freshM
+                                return $ GASPortPassthrough (PortFree x) (PortFree x) reg'
+  xor         = GAS_misc xor'
+                where xor' = MkOpaque "xor" $
+                             do x <- freshM
+                                return $ GASPortPassthrough (PortTensor (PortFree x) (PortFree x)) (PortFree x) xor'
+  high        = undefined
+  low         = undefined
+  not         = undefined
+  or          = undefined
+  and         = undefined
+  mux2        = undefined
+  maj3        = undefined
+  loop   vals = undefined
+  fifo   len  = undefined
+  probe  id   = undefined
+  oracle id   = undefined