examples/BitSerialHardware.hs

   1 {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
   2 module BitSerialHardware(Wire,BitSerialHardwarePrimitives(..)) where
   3 import Control.GArrow
   4 import Control.Category
   5 import GArrowPretty
   6 import Prelude hiding (id, (.))
   7 import Text.PrettyPrint.HughesPJ
   8 import GArrowPortShape
   9 import GArrowSkeleton
  10 import GArrowTikZ
  11
  12 ------------------------------------------------------------------------------
  13 -- Bit-Serial Hardware Primitives
  14
  15 data Wire = Wire
  16
  17 class (GArrowSwap v (,) (), GArrowDrop v (,) (), GArrowCopy v (,) (), GArrowLoop v (,) ()) =>
  18       BitSerialHardwarePrimitives v where
  19   high    :: v () Wire
  20   low     :: v () Wire
  21
  22   not     :: v Wire        Wire
  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
  28   reg     :: v Wire Wire
  29
  30   loop    :: [Bool] -> v () Wire
  31   fifo    ::    Int -> v Wire Wire
  32
  33   probe   ::    Int -> v Wire Wire
  34   oracle  ::    Int -> v ()        Wire
  35
  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
  50
  51 instance BitSerialHardwarePrimitives (GArrowSkeleton Opaque) where
  52   reg         = GAS_misc reg'
  53                 where reg' = MkOpaque "reg" $
  54                              do x <- freshM
  55                                 return $ GASPortPassthrough (PortFree x) (PortFree x) reg'
  56   xor         = GAS_misc xor'
  57                 where xor' = MkOpaque "xor" $
  58                              do x <- freshM
  59                                 return $ GASPortPassthrough (PortTensor (PortFree x) (PortFree x)) (PortFree x) xor'
  60   high        = undefined
  61   low         = undefined
  62   not         = undefined
  63   or          = undefined
  64   and         = undefined
  65   mux2        = undefined
  66   maj3        = undefined
  67   loop   vals = undefined
  68   fifo   len  = undefined
  69   probe  id   = undefined
  70   oracle id   = undefined