--- /dev/null
+{-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -ddump-types -XNoMonoPatBinds #-}
+module GArrowVerilog
+where
+import Prelude hiding ( id, (.) )
+
+--
+-- Please ignore this; I didn't manage to finish it
+--
+
+
+{-
+-- A verilog module is an SDoc (chunk of text) giving the module's
+-- definition. The UniqueSupply avoids name clashes.
+data VerilogModule =
+ VerilogModule
+ [VerilogModule] -- dependencies
+ String -> -- module name
+ (Tree String -> -- input port names
+ Tree String -> -- output port names
+ SDoc) -- raw verilog code for the body
+
+
+instance Show VerilogModule where
+ show VerilogModule dep name body =
+ "module "++name++"(FIXME)"++(body FIXME FIXME)
+
+data VerilogWrappedType a =
+ { vwt_rep :: String }
+
+-- A "verilog garrow" from A to B is, concretely, the source code for a
+-- verilog module having input ports of type A and output ports of type B;
+-- the UniqueSupply lets us generate names.
+data GArrowVerilog a b =
+ UniqueSupply ->
+ VerilogWrappedType a ->
+ VerilogWrappedType b ->
+ GArrowVerilog SDoc
+
+instance GArrow GArrowVerilog (,) where
+ ga_id = VerilogModule [] "ga_id" (\ inp outp -> zipTree ... "assign "++outp++" = "++inp)
+ ga_comp f g = VerilogModule [] "ga_comp"
+ ga_first :: g x y -> g (x ** z) (y ** z)
+ ga_second f = ga_comp (ga_comp ga_swap (ga_first f)) ga_swap
+ ga_cancell f = VerilogModule [] "ga_cancell" (\ [in1,in2] [outp] -> "assign "++outp++" = "++in2)
+ ga_cancelr f = VerilogModule [] "ga_cancelr" (\ [in1,in2] [outp] -> "assign "++outp++" = "++in1)
+ ga_uncancell f = VerilogModule [] "ga_cancelr" (\ [in1] [out1,out2] -> "assign "++out1++"=1'b0;\n assign"++out2++"="++in1)
+ ga_uncancelr f = VerilogModule [] "ga_cancelr" (\ [in1] [out1,out2] -> "assign "++out2++"=1'b0;\n assign"++out1++"="++in1)
+ ga_assoc f =
+ ga_unassoc :: g (x**(y**z)) ((x**y)**z)
+
+instance GArrowDrop GArrowVerilog (,) where
+ ga_drop =
+
+instance GArrowCopy GArrowVerilog (,) where
+ ga_copy =
+
+instance GArrowSwap GArrowVerilog (,) where
+ ga_swap =
+
+instance GArrowLoop GArrowVerilog (,) where
+ ga_loop =
+
+instance GArrowLiteral GArrowVerilog (,) where
+ ga_literal =
+-}