---
--- Technically this instance violates the laws (and RULEs) for
--- Control.Category; the compiler might choose to optimize (f >>> id)
--- into f, and this optimization would produce a change in behavior
--- below. In practice this means that the user must be prepared for
--- the rendered TikZ diagram to be merely *equivalent to* his/her
--- term, rather than structurally exactly equal to it.
---
-instance Category GArrowTikZ where
- id = TikZ_id
- (.) = TikZ_comp
-
-instance GArrow GArrowTikZ (**) () where
- ga_first = TikZ_first
- ga_second = TikZ_second
- ga_cancell = TikZ_cancell
- ga_cancelr = TikZ_cancelr
- ga_uncancell = TikZ_uncancell
- ga_uncancelr = TikZ_uncancelr
- ga_assoc = TikZ_assoc
- ga_unassoc = TikZ_unassoc
-
-instance GArrowDrop GArrowTikZ (**) () where
- ga_drop = TikZ_drop
-
-instance GArrowCopy GArrowTikZ (**) () where
- ga_copy = TikZ_copy
-
-instance GArrowSwap GArrowTikZ (**) () where
- ga_swap = TikZ_swap
-
-instance GArrowLoop GArrowTikZ (**) () where
- ga_loopl = TikZ_loopl
- ga_loopr = TikZ_loopr
-
-name :: GArrowTikZ a b -> String
-name TikZ_id = "id"
-name (TikZ_comp _ _) = "comp"
-name (TikZ_first _ ) = "first"
-name (TikZ_second _ ) = "second"
-name TikZ_cancell = "cancell"
-name TikZ_cancelr = "cancelr"
-name TikZ_uncancell = "uncancell"
-name TikZ_uncancelr = "uncancelr"
-name TikZ_drop = "drop"
-name TikZ_copy = "copy"
-name TikZ_swap = "swap"
-name (TikZ_loopl _ ) = "loopl"
-name (TikZ_loopr _ ) = "loopr"
-name TikZ_assoc = "assoc"
-name TikZ_unassoc = "unassoc"
-
-fresh1 :: UyM () Ports
-fresh1 = do { x <- freshU
- ; return $ UVVar x
- }
-
-fresh2 :: UyM () (Ports,Ports)
-fresh2 = do { x <- freshU
- ; y <- freshU
- ; constrain (UVVar x) 1 (UVVar y)
- ; return $ (UVVar x,UVVar y)
- }
-
-fresh3 :: UyM () (Ports,Ports,Ports)
-fresh3 = do { x <- freshU
- ; y <- freshU
- ; z <- freshU
- ; constrain (UVVar x) 1 (UVVar y)
- ; constrain (UVVar y) 1 (UVVar z)
- ; return $ (UVVar x,UVVar y,UVVar z)
- }
-
-fresh4 :: UyM () (Ports,Ports,Ports,Ports)
-fresh4 = do { x1 <- freshU
- ; x2 <- freshU
- ; x3 <- freshU
- ; x4 <- freshU
- ; constrain (UVVar x1) 1 (UVVar x2)
- ; constrain (UVVar x2) 1 (UVVar x3)
- ; constrain (UVVar x3) 1 (UVVar x4)
- ; return $ (UVVar x1,UVVar x2,UVVar x3,UVVar x4)
- }
-
-fresh5 :: UyM () (Ports,Ports,Ports,Ports,Ports)
-fresh5 = do { x1 <- freshU
- ; x2 <- freshU
- ; x3 <- freshU
- ; x4 <- freshU
- ; x5 <- freshU
- ; constrain (UVVar x1) 1 (UVVar x2)
- ; constrain (UVVar x2) 1 (UVVar x3)
- ; constrain (UVVar x3) 1 (UVVar x4)
- ; constrain (UVVar x4) 1 (UVVar x5)
- ; return $ (UVVar x1,UVVar x2,UVVar x3,UVVar x4,UVVar x5)
- }
-
-
-
-
-example = ga_first ga_drop >>> ga_cancell >>> ga_first id >>> ga_swap >>> ga_first id >>> TikZ_merge
---example :: forall x y z. forall g. (GArrow g (,) (), GArrowCopy g (,) (), GArrowSwap g (,) ()) => g x ((x,x),x)
---example = ga_copy >>> ga_second ga_copy >>> ga_second (ga_first id) >>> ga_unassoc >>> ga_first ga_swap
---example = ga_copy >>> ga_second ga_copy >>> ga_second (ga_second id) >>> ga_unassoc >>> ga_first id >>> ga_first ga_swap
---example :: forall x. forall g. (GArrow g (,) (), GArrowCopy g (,) (), GArrowSwap g (,) ()) => g x x
---example = id >>> id
+
+name :: GArrowSkeleton m a b -> String
+name GAS_id = "id"
+name (GAS_const i) = "const " ++ show i
+name (GAS_comp _ _) = "comp"
+name (GAS_first _ ) = "first"
+name (GAS_second _ ) = "second"
+name GAS_cancell = "cancell"
+name GAS_cancelr = "cancelr"
+name GAS_uncancell = "uncancell"
+name GAS_uncancelr = "uncancelr"
+name GAS_drop = "drop"
+name GAS_copy = "copy"
+name GAS_swap = "swap"
+name (GAS_loopl _ ) = "loopl"
+name (GAS_loopr _ ) = "loopr"
+name GAS_assoc = "assoc"
+name GAS_unassoc = "unassoc"
+name GAS_merge = "merge"
+name (GAS_misc _) = "misc"
+
+fresh :: Int -> UyM () [Ports]
+fresh 0 = return []
+fresh n = do { xs <- fresh (n-1)
+ ; x <- freshU
+ ; case xs of
+ [] -> return [UPortVar x]
+ (x':xs') -> do { constrain (UPortVar x) 1 x'
+ ; return $ (UPortVar x):x':xs'
+ }
+ }