1 {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
2 module BitSerialHardware(Wire,BitSerialHardwarePrimitives(..)) where
4 import Control.Category
6 import Prelude hiding (id, (.))
7 import Text.PrettyPrint.HughesPJ
12 ------------------------------------------------------------------------------
13 -- Bit-Serial Hardware Primitives
17 class (GArrowSwap v (,) (), GArrowDrop v (,) (), GArrowCopy v (,) (), GArrowLoop v (,) ()) =>
18 BitSerialHardwarePrimitives v where
23 xor :: v (Wire,Wire) Wire
24 or :: v (Wire,Wire) Wire
25 and :: v (Wire,Wire) Wire
26 mux2 :: v (Wire,(Wire,Wire)) Wire
27 maj3 :: v (Wire,(Wire,Wire)) Wire
30 loop :: [Bool] -> v () Wire
31 fifo :: Int -> v Wire Wire
33 probe :: Int -> v Wire Wire
34 oracle :: Int -> v () Wire
36 instance BitSerialHardwarePrimitives SourceCode where
37 high = SC False $ text "high"
38 low = SC False $ text "low"
39 not = SC False $ text "not"
40 xor = SC False $ text "xor"
41 or = SC False $ text "or"
42 and = SC False $ text "and"
43 mux2 = SC False $ text "mux2"
44 maj3 = SC False $ text "maj3"
45 reg = SC False $ text "reg"
46 loop vals = SC False $ text "loop" <+> (brackets $ hcat $ punctuate comma $ map (text . show) vals)
47 fifo len = SC False $ text "fifo" <+> (text . show) len
48 probe id = SC False $ text "probe" <+> (text . show) id
49 oracle id = SC False $ text "oracle" <+> (text . show) id
51 instance BitSerialHardwarePrimitives (GArrowSkeleton Opaque) where
53 where reg' = MkOpaque "reg" $
55 return $ GASPortPassthrough (PortFree x) (PortFree x) reg'
57 where xor' = MkOpaque "xor" $
59 return $ GASPortPassthrough (PortTensor (PortFree x) (PortFree x)) (PortFree x) xor'