examples/GArrowVerilog.hs

   1 {-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -ddump-types -XNoMonoPatBinds  #-}
   2 module GArrowVerilog
   3 where
   4 import Prelude hiding ( id, (.) )
   5
   6 --
   7 --  Please ignore this; I didn't manage to finish it
   8 --
   9
  10
  11 {-
  12 -- A verilog module is an SDoc (chunk of text) giving the module's
  13 -- definition.  The UniqueSupply avoids name clashes.
  14 data VerilogModule =
  15   VerilogModule
  16     [VerilogModule]     -- dependencies
  17     String ->           -- module name
  18     (Tree String ->        -- input port names
  19      Tree String ->        -- output port names
  20      SDoc)              -- raw verilog code for the body
  21
  22
  23 instance Show VerilogModule where
  24   show VerilogModule dep name body =
  25     "module "++name++"(FIXME)"++(body FIXME FIXME)
  26
  27 data VerilogWrappedType a =
  28   { vwt_rep :: String }
  29
  30 -- A "verilog garrow" from A to B is, concretely, the source code for a
  31 -- verilog module having input ports of type A and output ports of type B;
  32 -- the UniqueSupply lets us generate names.
  33 data GArrowVerilog a b =
  34   UniqueSupply ->
  35   VerilogWrappedType a ->
  36   VerilogWrappedType b ->
  37   GArrowVerilog SDoc
  38
  39 instance GArrow GArrowVerilog (,) where
  40   ga_id            =  VerilogModule [] "ga_id"   (\ inp outp -> zipTree ... "assign "++outp++" = "++inp)
  41   ga_comp      f g =  VerilogModule [] "ga_comp"
  42   ga_first     :: g x y -> g (x ** z) (y ** z)
  43   ga_second    f   =  ga_comp (ga_comp ga_swap (ga_first f)) ga_swap
  44   ga_cancell   f   =  VerilogModule [] "ga_cancell" (\ [in1,in2] [outp]      -> "assign "++outp++" = "++in2)
  45   ga_cancelr   f   =  VerilogModule [] "ga_cancelr" (\ [in1,in2] [outp]      -> "assign "++outp++" = "++in1)
  46   ga_uncancell f   =  VerilogModule [] "ga_cancelr" (\ [in1]     [out1,out2] -> "assign "++out1++"=1'b0;\n assign"++out2++"="++in1)
  47   ga_uncancelr f   =  VerilogModule [] "ga_cancelr" (\ [in1]     [out1,out2] -> "assign "++out2++"=1'b0;\n assign"++out1++"="++in1)
  48   ga_assoc     f   =
  49   ga_unassoc   :: g (x**(y**z)) ((x**y)**z)
  50
  51 instance GArrowDrop GArrowVerilog (,) where
  52   ga_drop      =
  53
  54 instance GArrowCopy GArrowVerilog (,) where
  55   ga_copy      =
  56
  57 instance GArrowSwap GArrowVerilog (,) where
  58   ga_swap      =
  59
  60 instance GArrowLoop GArrowVerilog (,) where
  61   ga_loop      =
  62
  63 instance GArrowLiteral GArrowVerilog (,) where
  64   ga_literal   =
  65 -}