examples/BitSerialHardware.hs

   1 {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
   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
   9 ------------------------------------------------------------------------------
  10 -- Bit-Serial Hardware Primitives
  11
  12 data Wire = Wire
  13
  14 class (GArrowSwap v (,) (), GArrowDrop v (,) (), GArrowCopy v (,) (), GArrowLoop v (,) ()) =>
  15       BitSerialHardwarePrimitives v where
  16   high    :: v () Wire
  17   low     :: v () Wire
  18
  19   not     :: v Wire        Wire
  20   xor     :: v (Wire,Wire) Wire
  21   or      :: v (Wire,Wire) Wire
  22   and     :: v (Wire,Wire) Wire
  23   mux2    :: v (Wire,(Wire,Wire)) Wire
  24   maj3    :: v (Wire,(Wire,Wire)) Wire
  25   reg     :: v Wire Wire
  26
  27   loop    :: [Bool] -> v () Wire
  28   fifo    ::    Int -> v Wire Wire
  29
  30   probe   ::    Int -> v Wire Wire
  31   oracle  ::    Int -> v ()        Wire
  32
  33 instance BitSerialHardwarePrimitives SourceCode where
  34   high        = SC False $ text "high"
  35   low         = SC False $ text "low"
  36   not         = SC False $ text "not"
  37   xor         = SC False $ text "xor"
  38   or          = SC False $ text "or"
  39   and         = SC False $ text "and"
  40   mux2        = SC False $ text "mux2"
  41   maj3        = SC False $ text "maj3"
  42   reg         = SC False $ text "reg"
  43   loop   vals = SC False $ text "loop"   <+> (brackets $ hcat $ punctuate comma $ map (text . show) vals)
  44   fifo   len  = SC False $ text "fifo"   <+> (text . show) len
  45   probe  id   = SC False $ text "probe"  <+> (text . show) id
  46   oracle id   = SC False $ text "oracle" <+> (text . show) id
  47