{-# 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 data Wire = Wire class (GArrowSwap v (,) (), GArrowDrop v (,) (), GArrowCopy v (,) (), GArrowLoop v (,) ()) => BitSerialHardwarePrimitives v where high :: v () Wire low :: v () Wire not :: v Wire Wire xor :: v (Wire,Wire) Wire or :: v (Wire,Wire) Wire and :: v (Wire,Wire) Wire mux2 :: v (Wire,(Wire,Wire)) Wire maj3 :: v (Wire,(Wire,Wire)) Wire reg :: v Wire Wire loop :: [Bool] -> v () Wire fifo :: Int -> v Wire Wire probe :: Int -> v Wire Wire oracle :: Int -> v () Wire instance BitSerialHardwarePrimitives SourceCode where high = SC False $ text "high" low = SC False $ text "low" not = SC False $ text "not" xor = SC False $ text "xor" or = SC False $ text "or" and = SC False $ text "and" mux2 = SC False $ text "mux2" maj3 = SC False $ text "maj3" reg = SC False $ text "reg" loop vals = SC False $ text "loop" <+> (brackets $ hcat $ punctuate comma $ map (text . show) vals) fifo len = SC False $ text "fifo" <+> (text . show) len 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