1 {-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -ddump-types -XNoMonoPatBinds #-}
4 import Prelude hiding ( id, (.) )
7 -- Please ignore this; I didn't manage to finish it
12 -- A verilog module is an SDoc (chunk of text) giving the module's
13 -- definition. The UniqueSupply avoids name clashes.
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
23 instance Show VerilogModule where
24 show VerilogModule dep name body =
25 "module "++name++"(FIXME)"++(body FIXME FIXME)
27 data VerilogWrappedType a =
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 =
35 VerilogWrappedType a ->
36 VerilogWrappedType b ->
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)
49 ga_unassoc :: g (x**(y**z)) ((x**y)**z)
51 instance GArrowDrop GArrowVerilog (,) where
54 instance GArrowCopy GArrowVerilog (,) where
57 instance GArrowSwap GArrowVerilog (,) where
60 instance GArrowLoop GArrowVerilog (,) where
63 instance GArrowLiteral GArrowVerilog (,) where