GArrowPortShape: add detectShape

diff --git a/examples/GArrowPortShape.hs b/examples/GArrowPortShape.hs
index 8e5078b..34f14c8 100644 (file)
--- a/examples/GArrowPortShape.hs
+++ b/examples/GArrowPortShape.hs
@@ -19,7 +19,7 @@
 -- information for certain nodes (the inference mechanism below adds
 -- it on every node).
 --
-module GArrowPortShape (GArrowPortShape(..), PortShape(..))
+module GArrowPortShape (GArrowPortShape(..), PortShape(..), detectShape)
 where
 import Prelude hiding ( id, (.), lookup )
 import Control.Category
@@ -58,7 +58,9 @@ type UPort = PortShape UVar
 
 instance Unifiable UPort where
   unify' (PortTensor x1 y1) (PortTensor x2 y2) = mergeU (unify x1 x2) (unify y1 y2)
-  unify' _ _                                   = error "impossible"
+  unify' PortUnit PortUnit                     = emptyUnifier
+  unify' s1 s2                                 = error $ "Unifiable UPort got impossible unification case: "
+--                                                          ++ show s1 ++ " and " ++ show s2
   inject                                       = PortFree
   project (PortFree v)                         = Just v
   project _                                    = Nothing
@@ -117,6 +119,9 @@ resolveG u (GASPortShapeWrapper x y g) = GASPortShapeWrapper (getU' u x) (getU'
   resolveG' (GAS_loopr f)       = GAS_loopr (resolveG' f)
   resolveG' (GAS_misc g )       = GAS_misc $ resolveG u g
 
+detectShape :: GArrowSkeleton m a b -> GArrowPortShape m () a b
+detectShape g = runM (detect g)
+
 runM :: DetectM (GArrowPortShape m UVar a b) -> GArrowPortShape m () a b
 runM f = let s     = (emptyUnifier,uvarSupply)
              g     = evalState f s
@@ -125,10 +130,10 @@ runM f = let s     = (emptyUnifier,uvarSupply)
 
 detect :: GArrowSkeleton m a b -> DetectM (GArrowPortShape m UVar a b)
 detect (GAS_id      ) = do { x <- freshM ; return $ GASPortShapeWrapper (PortFree x) (PortFree x) GAS_id }
-detect (GAS_comp g f) = do { f' <- detect f
+detect (GAS_comp f g) = do { f' <- detect f
                            ; g' <- detect g
                            ; unifyM (snd $ shapes f') (fst $ shapes g')
-                           ; return $ GASPortShapeWrapper (fst $ shapes f') (snd $ shapes g') (GAS_comp (GAS_misc g') (GAS_misc f'))
+                           ; return $ GASPortShapeWrapper (fst $ shapes f') (snd $ shapes g') (GAS_comp (GAS_misc f') (GAS_misc g'))
                            }
 detect (GAS_first  f) = do { x <- freshM
                            ; f' <- detect f
@@ -176,8 +181,11 @@ detect GAS_unassoc    = do { x <- freshM; y <- freshM; z <- freshM
                                         GAS_unassoc
                            }
 detect (GAS_const i)  = do { x <- freshM; return $ GASPortShapeWrapper PortUnit (PortFree x) (GAS_const i) }
+
+-- FIXME: I need to fix the occurs check before I can make these different again
 detect GAS_merge      = do { x <- freshM
-                           ; return $ GASPortShapeWrapper (PortTensor (PortFree x) (PortFree x)) (PortFree x) GAS_merge }
+                           ; y <- freshM
+                           ; return $ GASPortShapeWrapper (PortTensor (PortFree x) (PortFree y)) (PortFree x) GAS_merge }
 detect (GAS_loopl f)  = error "not implemented"
 detect (GAS_loopr f)  = error "not implemented"
 

diff --git a/examples/x b/examples/x
deleted file mode 100644 (file)
index 48cdc1c..0000000
--- a/examples/x
+++ /dev/null
@@ -1,1184 +0,0 @@
-[3 of 3] Compiling Main             ( Demo.hs, .build/Main.o )
-
-==================== Desugared, before opt ====================
-@ co_aLI::() ~ ()
-co_aLI = TYPE ()
-
-@ co_aHe::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ ~ ()
-co_aHe = TYPE trans GArrowTikZ.TFCo:R:GArrowUnitGArrowTikZ co_aLI
-
-Rec {
-$dGArrowSTKC_aHd
-  :: GHC.HetMet.GArrow.GArrowSTKC GArrowTikZ.GArrowTikZ
-[LclId]
-$dGArrowSTKC_aHd = GArrowTikZ.$fGArrowSTKCGArrowTikZ
-
-Main.foo
-  :: forall (t_aD6 :: * -> * -> *) t_aD7.
-     <[t_aD7]>@t_aD6 -> <[t_aD7]>@t_aD6
-[LclId]
-Main.foo =
-  \ (@ t_aD6::* -> * -> *) (@ t_aD7) ->
-    letrec {
-      foo_aD5 :: <[t_aD7]>@t_aD6 -> <[t_aD7]>@t_aD6
-      [LclId]
-      foo_aD5 =
-        \ (x_aD4 :: <[t_aD7]>@t_aD6) ->
-          GHC.HetMet.CodeTypes.hetmet_brak
-            @ t_aD6
-            @ t_aD7
-            ((GHC.HetMet.CodeTypes.hetmet_esc @ t_aD6 @ t_aD7 x_aD4)
-             `cast` (t_aD7 :: t_aD7 ~ t_aD7)); } in
-    foo_aD5
-
-Main.foo'
-  :: forall (g_aFo :: * -> * -> *) y_aFp.
-     (GHC.HetMet.GArrow.GArrowSTKC g_aFo,
-      GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()) =>
-     GHC.HetMet.Private.PGArrow g_aFo () y_aFp -> g_aFo () y_aFp
-[LclId]
-Main.foo' =
-  \ (@ g_aFo::* -> * -> *)
-    (@ y_aFp)
-    ($dGArrowSTKC_aFq :: GHC.HetMet.GArrow.GArrowSTKC g_aFo)
-    (@ co_aFr::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()) ->
-    let {
-      @ co_aMM::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMM = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aML::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aML = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMK::() ~ ()
-      co_aMK = TYPE () } in
-    let {
-      @ co_aMJ::() ~ ()
-      co_aMJ = TYPE () } in
-    let {
-      @ co_aMI::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMI = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMH::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMH = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMG::() ~ ()
-      co_aMG = TYPE () } in
-    let {
-      @ co_aMF::() ~ ()
-      co_aMF = TYPE () } in
-    let {
-      @ co_aME::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aME = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMD::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMD = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMC::() ~ ()
-      co_aMC = TYPE () } in
-    let {
-      @ co_aMB::() ~ ()
-      co_aMB = TYPE () } in
-    let {
-      @ co_aMz::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aMz = TYPE trans co_aFr (sym co_aMB) } in
-    let {
-      @ co_aMu::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aMu = TYPE trans co_aFr (sym co_aMF) } in
-    let {
-      @ co_aMp::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aMp = TYPE trans co_aFr (sym co_aMJ) } in
-    let {
-      @ co_aM1::GHC.HetMet.GArrow.GArrowUnit g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowUnit g_aFo
-      co_aM1 = TYPE GHC.HetMet.GArrow.GArrowUnit g_aFo } in
-    let {
-      @ co_aM4::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aM4 = TYPE trans (sym co_aM1) co_aFr } in
-    let {
-      @ co_aLZ::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aLZ = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aMn::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMn = TYPE trans co_aLZ (sym co_aML) } in
-    let {
-      @ co_aMs::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMs = TYPE trans co_aLZ (sym co_aMH) } in
-    let {
-      @ co_aMx::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aMx = TYPE trans co_aLZ (sym co_aMD) } in
-    let {
-      @ co_aLV::GHC.HetMet.GArrow.GArrowUnit g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowUnit g_aFo
-      co_aLV = TYPE GHC.HetMet.GArrow.GArrowUnit g_aFo } in
-    let {
-      @ co_aM5::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aM5 = TYPE trans (sym co_aLV) co_aFr } in
-    let {
-      @ co_aLT::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aLT = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aM6::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aM6 = TYPE trans (sym co_aLT) co_aLZ } in
-    let {
-      @ co_aLP::GHC.HetMet.GArrow.GArrowUnit g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowUnit g_aFo
-      co_aLP = TYPE GHC.HetMet.GArrow.GArrowUnit g_aFo } in
-    let {
-      @ co_aM7::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aM7 = TYPE trans (sym co_aLP) co_aFr } in
-    let {
-      @ co_aLN::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aLN = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aM8::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aM8 = TYPE trans (sym co_aLN) co_aLZ } in
-    let {
-      $dGArrowSwap_aLL
-        :: GHC.HetMet.GArrow.GArrowSwap
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrowSwap_aLL =
-        GHC.HetMet.GArrow.$p3GArrowSTKC @ g_aFo $dGArrowSTKC_aFq } in
-    let {
-      $dGArrow_aM2
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrow_aM2 =
-        GHC.HetMet.GArrow.$p1GArrowSwap
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrowSwap_aLL } in
-    let {
-      $dCategory_aM3 :: Control.Category.Category g_aFo
-      [LclId]
-      $dCategory_aM3 =
-        GHC.HetMet.GArrow.$p1GArrow
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrow_aM2 } in
-    let {
-      $dGArrow_aMa
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrow_aMa =
-        $dGArrow_aM2
-        `cast` (GHC.HetMet.GArrow.T:GArrow
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM4
-                :: GHC.HetMet.GArrow.T:GArrow
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrowSwap_aM9
-        :: GHC.HetMet.GArrow.GArrowSwap
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrowSwap_aM9 =
-        $dGArrowSwap_aLL
-        `cast` (GHC.HetMet.GArrow.T:GArrowSwap
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM4
-                :: GHC.HetMet.GArrow.T:GArrowSwap
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrowSwap
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrowCopy_aLK
-        :: GHC.HetMet.GArrow.GArrowCopy
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrowCopy_aLK =
-        GHC.HetMet.GArrow.$p2GArrowSTKC @ g_aFo $dGArrowSTKC_aFq } in
-    let {
-      $dGArrow_aLW
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrow_aLW =
-        GHC.HetMet.GArrow.$p1GArrowCopy
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrowCopy_aLK } in
-    let {
-      $dCategory_aLX :: Control.Category.Category g_aFo
-      [LclId]
-      $dCategory_aLX =
-        GHC.HetMet.GArrow.$p1GArrow
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrow_aLW } in
-    let {
-      $dGArrow_aMd
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrow_aMd =
-        $dGArrow_aLW
-        `cast` (GHC.HetMet.GArrow.T:GArrow
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM5
-                :: GHC.HetMet.GArrow.T:GArrow
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrow_aMe
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrow_aMe =
-        $dGArrow_aMd
-        `cast` (GHC.HetMet.GArrow.T:GArrow g_aFo co_aM6 ()
-                :: GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-                     ~
-                   GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrowCopy_aMb
-        :: GHC.HetMet.GArrow.GArrowCopy
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrowCopy_aMb =
-        $dGArrowCopy_aLK
-        `cast` (GHC.HetMet.GArrow.T:GArrowCopy
-                  g_aFo co_aM6 (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                :: GHC.HetMet.GArrow.T:GArrowCopy
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrowCopy
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)) } in
-    let {
-      $dGArrowCopy_aMc
-        :: GHC.HetMet.GArrow.GArrowCopy
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrowCopy_aMc =
-        $dGArrowCopy_aMb
-        `cast` (GHC.HetMet.GArrow.T:GArrowCopy
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM5
-                :: GHC.HetMet.GArrow.T:GArrowCopy
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrowCopy
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrowDrop_aLJ
-        :: GHC.HetMet.GArrow.GArrowDrop
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrowDrop_aLJ =
-        GHC.HetMet.GArrow.$p1GArrowSTKC @ g_aFo $dGArrowSTKC_aFq } in
-    let {
-      $dGArrow_aLQ
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrow_aLQ =
-        GHC.HetMet.GArrow.$p1GArrowDrop
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrowDrop_aLJ } in
-    let {
-      $dCategory_aLR :: Control.Category.Category g_aFo
-      [LclId]
-      $dCategory_aLR =
-        GHC.HetMet.GArrow.$p1GArrow
-          @ g_aFo
-          @ (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-          @ (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-          $dGArrow_aLQ } in
-    let {
-      $dGArrow_aMh
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrow_aMh =
-        $dGArrow_aLQ
-        `cast` (GHC.HetMet.GArrow.T:GArrow
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM7
-                :: GHC.HetMet.GArrow.T:GArrow
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrow_aMi
-        :: GHC.HetMet.GArrow.GArrow
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrow_aMi =
-        $dGArrow_aMh
-        `cast` (GHC.HetMet.GArrow.T:GArrow g_aFo co_aM8 ()
-                :: GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-                     ~
-                   GHC.HetMet.GArrow.T:GArrow
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      $dGArrowDrop_aMf
-        :: GHC.HetMet.GArrow.GArrowDrop
-             g_aFo
-             (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-             (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-      [LclId]
-      $dGArrowDrop_aMf =
-        $dGArrowDrop_aLJ
-        `cast` (GHC.HetMet.GArrow.T:GArrowDrop
-                  g_aFo co_aM8 (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                :: GHC.HetMet.GArrow.T:GArrowDrop
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrowDrop
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)) } in
-    let {
-      $dGArrowDrop_aMg
-        :: GHC.HetMet.GArrow.GArrowDrop
-             g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()
-      [LclId]
-      $dGArrowDrop_aMg =
-        $dGArrowDrop_aMf
-        `cast` (GHC.HetMet.GArrow.T:GArrowDrop
-                  g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aM7
-                :: GHC.HetMet.GArrow.T:GArrowDrop
-                     g_aFo
-                     (GHC.HetMet.GArrow.GArrowTensor g_aFo)
-                     (GHC.HetMet.GArrow.GArrowUnit g_aFo)
-                     ~
-                   GHC.HetMet.GArrow.T:GArrowDrop
-                     g_aFo (GHC.HetMet.GArrow.GArrowTensor g_aFo) ()) } in
-    let {
-      @ co_aF3::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aF3 = TYPE co_aFr } in
-    let {
-      @ co_aEX::() ~ ()
-      co_aEX = TYPE () } in
-    let {
-      @ co_aEI::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEI = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aEG::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEG = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aEF::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEF = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aEE::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aEE =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowUnit g_aFo) co_aF3)
-               (sym co_aEX) } in
-    let {
-      @ co_aEz::() ~ ()
-      co_aEz = TYPE () } in
-    let {
-      @ co_aF0::() ~ ()
-      co_aF0 = TYPE trans co_aEz co_aEX } in
-    let {
-      @ co_aEy::() ~ ()
-      co_aEy = TYPE () } in
-    let {
-      @ co_aEx::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEx =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aEI)
-               (sym co_aEG) } in
-    let {
-      @ co_aEw::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEw = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aEH::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEH = TYPE trans co_aEw co_aEG } in
-    let {
-      @ co_aEv::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEv = TYPE GHC.HetMet.GArrow.GArrowTensor g_aFo } in
-    let {
-      @ co_aEu::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aEu =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowUnit g_aFo) co_aEE)
-               (sym co_aEz) } in
-    let {
-      @ co_aEq::() ~ ()
-      co_aEq = TYPE () } in
-    let {
-      @ co_aEC::() ~ ()
-      co_aEC = TYPE trans co_aEq co_aEz } in
-    let {
-      @ co_aEZ::() ~ ()
-      co_aEZ = TYPE trans co_aEC co_aEX } in
-    let {
-      @ co_aEp::() ~ ()
-      co_aEp = TYPE () } in
-    let {
-      @ co_aEo::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aEo =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowUnit g_aFo) co_aEu)
-               (sym co_aEq) } in
-    let {
-      @ co_aEl::() ~ ()
-      co_aEl = TYPE () } in
-    let {
-      @ co_aEs::() ~ ()
-      co_aEs = TYPE trans co_aEl co_aEq } in
-    let {
-      @ co_aED::() ~ ()
-      co_aED = TYPE trans co_aEs co_aEz } in
-    let {
-      @ co_aF1::() ~ ()
-      co_aF1 = TYPE trans co_aED co_aEX } in
-    let {
-      @ co_aEk::() ~ ()
-      co_aEk = TYPE () } in
-    let {
-      @ co_aEj::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aEj =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowUnit g_aFo) co_aEo)
-               (sym co_aEl) } in
-    let {
-      @ co_aEh::() ~ ()
-      co_aEh = TYPE () } in
-    let {
-      @ co_aEn::() ~ ()
-      co_aEn = TYPE trans co_aEh co_aEl } in
-    let {
-      @ co_aEr::() ~ ()
-      co_aEr = TYPE trans co_aEn co_aEq } in
-    let {
-      @ co_aEA::() ~ ()
-      co_aEA = TYPE trans co_aEr co_aEz } in
-    let {
-      @ co_aEY::() ~ ()
-      co_aEY = TYPE trans co_aEA co_aEX } in
-    let {
-      @ co_aEg::() ~ ()
-      co_aEg = TYPE () } in
-    let {
-      @ co_aEf::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aEf = TYPE GHC.HetMet.Private.PGArrow g_aFo () y_aFp } in
-    let {
-      @ co_aEi::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aEi =
-        TYPE trans
-               co_aEf (GHC.HetMet.Private.PGArrow g_aFo co_aEh y_aFp) } in
-    let {
-      @ co_aEm::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aEm =
-        TYPE trans
-               co_aEi (GHC.HetMet.Private.PGArrow g_aFo co_aEl y_aFp) } in
-    let {
-      @ co_aEt::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aEt =
-        TYPE trans
-               co_aEm (GHC.HetMet.Private.PGArrow g_aFo co_aEq y_aFp) } in
-    let {
-      @ co_aEB::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aEB =
-        TYPE trans
-               co_aEt (GHC.HetMet.Private.PGArrow g_aFo co_aEz y_aFp) } in
-    let {
-      @ co_aF2::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aF2 =
-        TYPE trans
-               co_aEB (GHC.HetMet.Private.PGArrow g_aFo co_aEX y_aFp) } in
-    let {
-      @ co_aEd::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aEd = TYPE trans co_aEj (sym co_aEk) } in
-    let {
-      @ co_aEb::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aEb =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowTensor g_aFo) co_aEx)
-               (sym co_aEw) } in
-    let {
-      @ co_aE8::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aE8 = TYPE trans co_aEo (sym co_aEp) } in
-    let {
-      @ co_aE6::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aE6 = TYPE trans co_aEb (sym co_aEv) } in
-    let {
-      @ co_aE3::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aE3 = TYPE trans co_aEu (sym co_aEy) } in
-    let {
-      @ co_aE1::GHC.HetMet.GArrow.GArrowTensor g_aFo
-                  ~
-                GHC.HetMet.GArrow.GArrowTensor g_aFo
-      co_aE1 = TYPE trans co_aEx (sym co_aEF) } in
-    let {
-      @ co_aDD::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aDD = TYPE GHC.HetMet.Private.PGArrow g_aFo () y_aFp } in
-    let {
-      @ co_aDC::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aDC =
-        TYPE trans
-               (trans (GHC.HetMet.GArrow.GArrowUnit g_aFo) co_aEj)
-               (sym co_aEh) } in
-    let {
-      @ co_aDA::GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow
-                  g_aFo (GHC.HetMet.GArrow.GArrowUnit g_aFo) y_aFp
-      co_aDA =
-        TYPE trans
-               co_aDD
-               (GHC.HetMet.Private.PGArrow
-                  g_aFo
-                  (trans (sym co_aDC) (GHC.HetMet.GArrow.GArrowUnit g_aFo))
-                  y_aFp) } in
-    let {
-      @ co_aDv::GHC.HetMet.Private.PGArrow
-                  g_aFo (GHC.HetMet.GArrow.GArrowUnit g_aFo) y_aFp
-                  ~
-                GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-      co_aDv = TYPE sym co_aDA } in
-    let {
-      @ co_aDr::GHC.HetMet.GArrow.GArrowUnit g_aFo ~ ()
-      co_aDr = TYPE trans co_aDC (sym co_aEg) } in
-    let {
-      $dGArrowSTKC_aDm :: GHC.HetMet.GArrow.GArrowSTKC g_aFo
-      [LclId]
-      $dGArrowSTKC_aDm = $dGArrowSTKC_aFq } in
-    letrec {
-      foo'_aDw
-        :: GHC.HetMet.Private.PGArrow g_aFo () y_aFp -> g_aFo () y_aFp
-      [LclId]
-      foo'_aDw =
-        GHC.Base..
-          @ (GHC.HetMet.Private.PGArrow g_aFo () y_aFp)
-          @ (g_aFo () y_aFp)
-          @ (GHC.HetMet.Private.PGArrow g_aFo () y_aFp)
-          (GHC.HetMet.Private.unG @ g_aFo @ () @ y_aFp $dGArrowSTKC_aDm)
-          (GHC.Base..
-             @ <[y_aFp]>@g_aFo
-             @ (GHC.HetMet.Private.PGArrow g_aFo () y_aFp)
-             @ (GHC.HetMet.Private.PGArrow g_aFo () y_aFp)
-             ((GHC.HetMet.CodeTypes.pga_flatten @ g_aFo @ GHC.Prim.Any @ y_aFp)
-              `cast` (<[y_aFp]>@g_aFo
-                      -> GHC.HetMet.Private.PGArrow g_aFo co_aDr y_aFp
-                      :: (<[y_aFp]>@g_aFo
-                          -> GHC.HetMet.Private.PGArrow
-                               g_aFo (GHC.HetMet.GArrow.GArrowUnit g_aFo) y_aFp)
-                           ~
-                         (<[y_aFp]>@g_aFo -> GHC.HetMet.Private.PGArrow g_aFo () y_aFp)))
-             (GHC.Base..
-                @ <[y_aFp]>@g_aFo
-                @ <[y_aFp]>@g_aFo
-                @ (GHC.HetMet.Private.PGArrow g_aFo () y_aFp)
-                (Main.foo @ g_aFo @ y_aFp)
-                ((GHC.HetMet.CodeTypes.pga_unflatten
-                    @ g_aFo @ GHC.Prim.Any @ y_aFp)
-                 `cast` (co_aDv -> <[y_aFp]>@g_aFo
-                         :: (GHC.HetMet.Private.PGArrow
-                               g_aFo (GHC.HetMet.GArrow.GArrowUnit g_aFo) y_aFp
-                             -> <[y_aFp]>@g_aFo)
-                              ~
-                            (GHC.HetMet.Private.PGArrow g_aFo () y_aFp
-                             -> <[y_aFp]>@g_aFo))))); } in
-    foo'_aDw
-
-Main.main :: GHC.Types.IO ()
-[LclIdX]
-Main.main =
-  let {
-    @ co_aLu::GHC.Types.Int ~ GHC.Types.Int
-    co_aLu = TYPE GHC.Types.Int } in
-  let {
-    @ co_aLt::GHC.Types.Int ~ GHC.Types.Int
-    co_aLt = TYPE GHC.Types.Int } in
-  letrec {
-    main_aHj :: GHC.Types.IO ()
-    [LclId]
-    main_aHj =
-      GArrowTikZ.tikz
-        @ ()
-        @ GHC.Types.Int
-        (Main.foo'
-           @ GArrowTikZ.GArrowTikZ
-           @ GHC.Types.Int
-           $dGArrowSTKC_aHd
-           @ co_aHe
-           (GHC.HetMet.Private.PGArrowD
-              @ GArrowTikZ.GArrowTikZ
-              @ ()
-              @ GHC.Types.Int
-              (\ ($dGArrowSTKC_aHg
-                    :: GHC.HetMet.GArrow.GArrowSTKC GArrowTikZ.GArrowTikZ) ->
-                 let {
-                   @ co_aHD::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                   co_aHD =
-                     TYPE GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aHG::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ ~ ()
-                   co_aHG =
-                     TYPE trans (sym co_aHD) GArrowTikZ.TFCo:R:GArrowUnitGArrowTikZ } in
-                 let {
-                   @ co_aHB::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                   co_aHB =
-                     TYPE GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aHH::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             (,)
-                   co_aHH =
-                     TYPE trans
-                            (sym co_aHB) GArrowTikZ.TFCo:R:GArrowTensorGArrowTikZ } in
-                 let {
-                   @ co_aHx::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                   co_aHx =
-                     TYPE GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aLd::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ ~ ()
-                   co_aLd =
-                     TYPE trans (sym co_aHx) GArrowTikZ.TFCo:R:GArrowUnitGArrowTikZ } in
-                 let {
-                   @ co_aHv::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                   co_aHv =
-                     TYPE GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aLe::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             (,)
-                   co_aLe =
-                     TYPE trans
-                            (sym co_aHv) GArrowTikZ.TFCo:R:GArrowTensorGArrowTikZ } in
-                 let {
-                   @ co_aHr::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ
-                   co_aHr =
-                     TYPE GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aLf::GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ ~ ()
-                   co_aLf =
-                     TYPE trans (sym co_aHr) GArrowTikZ.TFCo:R:GArrowUnitGArrowTikZ } in
-                 let {
-                   @ co_aHp::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                   co_aHp =
-                     TYPE GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ } in
-                 let {
-                   @ co_aLg::GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ
-                               ~
-                             (,)
-                   co_aLg =
-                     TYPE trans
-                            (sym co_aHp) GArrowTikZ.TFCo:R:GArrowTensorGArrowTikZ } in
-                 let {
-                   $dGArrowSwap_aHn
-                     :: GHC.HetMet.GArrow.GArrowSwap
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrowSwap_aHn =
-                     GHC.HetMet.GArrow.$p3GArrowSTKC
-                       @ GArrowTikZ.GArrowTikZ $dGArrowSTKC_aHg } in
-                 let {
-                   $dGArrow_aHE
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrow_aHE =
-                     GHC.HetMet.GArrow.$p1GArrowSwap
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrowSwap_aHn } in
-                 let {
-                   $dCategory_aHF :: Control.Category.Category GArrowTikZ.GArrowTikZ
-                   [LclId]
-                   $dCategory_aHF =
-                     GHC.HetMet.GArrow.$p1GArrow
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrow_aHE } in
-                 let {
-                   $dGArrow_aLj
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (,)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrow_aLj =
-                     $dGArrow_aHE
-                     `cast` (GHC.HetMet.GArrow.T:GArrow
-                               GArrowTikZ.GArrowTikZ
-                               co_aHH
-                               (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)) } in
-                 let {
-                   $dGArrow_aLk
-                     :: GHC.HetMet.GArrow.GArrow GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrow_aLk =
-                     $dGArrow_aLj
-                     `cast` (GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ (,) co_aHG
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   $dGArrowSwap_aLh
-                     :: GHC.HetMet.GArrow.GArrowSwap
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          ()
-                   [LclId]
-                   $dGArrowSwap_aLh =
-                     $dGArrowSwap_aHn
-                     `cast` (GHC.HetMet.GArrow.T:GArrowSwap
-                               GArrowTikZ.GArrowTikZ
-                               (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                               co_aHG
-                             :: GHC.HetMet.GArrow.T:GArrowSwap
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowSwap
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()) } in
-                 let {
-                   $dGArrowSwap_aLi
-                     :: GHC.HetMet.GArrow.GArrowSwap GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrowSwap_aLi =
-                     $dGArrowSwap_aLh
-                     `cast` (GHC.HetMet.GArrow.T:GArrowSwap
-                               GArrowTikZ.GArrowTikZ co_aHH ()
-                             :: GHC.HetMet.GArrow.T:GArrowSwap
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowSwap GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   $dGArrowCopy_aHm
-                     :: GHC.HetMet.GArrow.GArrowCopy
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrowCopy_aHm =
-                     GHC.HetMet.GArrow.$p2GArrowSTKC
-                       @ GArrowTikZ.GArrowTikZ $dGArrowSTKC_aHg } in
-                 let {
-                   $dGArrow_aHy
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrow_aHy =
-                     GHC.HetMet.GArrow.$p1GArrowCopy
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrowCopy_aHm } in
-                 let {
-                   $dCategory_aHz :: Control.Category.Category GArrowTikZ.GArrowTikZ
-                   [LclId]
-                   $dCategory_aHz =
-                     GHC.HetMet.GArrow.$p1GArrow
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrow_aHy } in
-                 let {
-                   $dGArrow_aLn
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          ()
-                   [LclId]
-                   $dGArrow_aLn =
-                     $dGArrow_aHy
-                     `cast` (GHC.HetMet.GArrow.T:GArrow
-                               GArrowTikZ.GArrowTikZ
-                               (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                               co_aLd
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()) } in
-                 let {
-                   $dGArrow_aLo
-                     :: GHC.HetMet.GArrow.GArrow GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrow_aLo =
-                     $dGArrow_aLn
-                     `cast` (GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ co_aLe ()
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   $dGArrowCopy_aLl
-                     :: GHC.HetMet.GArrow.GArrowCopy
-                          GArrowTikZ.GArrowTikZ
-                          (,)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrowCopy_aLl =
-                     $dGArrowCopy_aHm
-                     `cast` (GHC.HetMet.GArrow.T:GArrowCopy
-                               GArrowTikZ.GArrowTikZ
-                               co_aLe
-                               (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                             :: GHC.HetMet.GArrow.T:GArrowCopy
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowCopy
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)) } in
-                 let {
-                   $dGArrowCopy_aLm
-                     :: GHC.HetMet.GArrow.GArrowCopy GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrowCopy_aLm =
-                     $dGArrowCopy_aLl
-                     `cast` (GHC.HetMet.GArrow.T:GArrowCopy
-                               GArrowTikZ.GArrowTikZ (,) co_aLd
-                             :: GHC.HetMet.GArrow.T:GArrowCopy
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowCopy GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   $dGArrowDrop_aHl
-                     :: GHC.HetMet.GArrow.GArrowDrop
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrowDrop_aHl =
-                     GHC.HetMet.GArrow.$p1GArrowSTKC
-                       @ GArrowTikZ.GArrowTikZ $dGArrowSTKC_aHg } in
-                 let {
-                   $dGArrow_aHs
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrow_aHs =
-                     GHC.HetMet.GArrow.$p1GArrowDrop
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrowDrop_aHl } in
-                 let {
-                   $dCategory_aHt :: Control.Category.Category GArrowTikZ.GArrowTikZ
-                   [LclId]
-                   $dCategory_aHt =
-                     GHC.HetMet.GArrow.$p1GArrow
-                       @ GArrowTikZ.GArrowTikZ
-                       @ (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                       @ (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                       $dGArrow_aHs } in
-                 let {
-                   $dGArrow_aLr
-                     :: GHC.HetMet.GArrow.GArrow
-                          GArrowTikZ.GArrowTikZ
-                          (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                          ()
-                   [LclId]
-                   $dGArrow_aLr =
-                     $dGArrow_aHs
-                     `cast` (GHC.HetMet.GArrow.T:GArrow
-                               GArrowTikZ.GArrowTikZ
-                               (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                               co_aLf
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()) } in
-                 let {
-                   $dGArrow_aLs
-                     :: GHC.HetMet.GArrow.GArrow GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrow_aLs =
-                     $dGArrow_aLr
-                     `cast` (GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ co_aLg ()
-                             :: GHC.HetMet.GArrow.T:GArrow
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  ()
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrow GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   $dGArrowDrop_aLp
-                     :: GHC.HetMet.GArrow.GArrowDrop
-                          GArrowTikZ.GArrowTikZ
-                          (,)
-                          (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                   [LclId]
-                   $dGArrowDrop_aLp =
-                     $dGArrowDrop_aHl
-                     `cast` (GHC.HetMet.GArrow.T:GArrowDrop
-                               GArrowTikZ.GArrowTikZ
-                               co_aLg
-                               (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                             :: GHC.HetMet.GArrow.T:GArrowDrop
-                                  GArrowTikZ.GArrowTikZ
-                                  (GHC.HetMet.GArrow.GArrowTensor GArrowTikZ.GArrowTikZ)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowDrop
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)) } in
-                 let {
-                   $dGArrowDrop_aLq
-                     :: GHC.HetMet.GArrow.GArrowDrop GArrowTikZ.GArrowTikZ (,) ()
-                   [LclId]
-                   $dGArrowDrop_aLq =
-                     $dGArrowDrop_aLp
-                     `cast` (GHC.HetMet.GArrow.T:GArrowDrop
-                               GArrowTikZ.GArrowTikZ (,) co_aLf
-                             :: GHC.HetMet.GArrow.T:GArrowDrop
-                                  GArrowTikZ.GArrowTikZ
-                                  (,)
-                                  (GHC.HetMet.GArrow.GArrowUnit GArrowTikZ.GArrowTikZ)
-                                  ~
-                                GHC.HetMet.GArrow.T:GArrowDrop GArrowTikZ.GArrowTikZ (,) ()) } in
-                 let {
-                   @ co_aHh::GHC.Types.Int ~ GHC.Types.Int
-                   co_aHh = TYPE sym co_aLt } in
-                 (GArrowTikZ.$WTikZ_const (GHC.Types.I# 12))
-                 `cast` (GArrowTikZ.GArrowTikZ () co_aHh
-                         :: GArrowTikZ.GArrowTikZ () GHC.Types.Int
-                              ~
-                            GArrowTikZ.GArrowTikZ () GHC.Types.Int)))); } in
-  main_aHj
-
-:Main.main :: GHC.Types.IO ()
-[LclIdX]
-:Main.main = GHC.TopHandler.runMainIO @ () Main.main
-end Rec }
-
-
-
-
-==================== Desugar ====================
-Main.foo
-  :: forall (tv_~N6 :: * -> * -> *) tv_~N7.
-     GHC.HetMet.Private.PGArrow
-       tv_~N6 (GHC.HetMet.GArrow.GArrowUnit tv_~N6) tv_~N7
-     -> GHC.HetMet.Private.PGArrow
-          tv_~N6 (GHC.HetMet.GArrow.GArrowUnit tv_~N6) tv_~N7
-[LclId]
-Main.foo =
-  \ (@ tv_~N6::* -> * -> *)
-    (@ tv_~N7)
-    (ev_~N8
-       :: GHC.HetMet.Private.PGArrow
-            tv_~N6 (GHC.HetMet.GArrow.GArrowUnit tv_~N6) tv_~N7) ->
-    let {
-      ev_~N9
-        :: GHC.HetMet.Private.PGArrow
-             tv_~N6
-             (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-             (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-      [LclId]
-      ev_~N9 =
-        GHC.HetMet.Private.pga_id
-          @ tv_~N6 @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6) } in
-    let {
-      ev_~Na
-        :: GHC.HetMet.Private.PGArrow
-             tv_~N6 (GHC.HetMet.GArrow.GArrowUnit tv_~N6) tv_~N7
-      [LclId]
-      ev_~Na =
-        let {
-          ev_~Nh
-            :: GHC.HetMet.Private.PGArrow
-                 tv_~N6
-                 (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-                 (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-          [LclId]
-          ev_~Nh =
-            GHC.HetMet.Private.pga_id
-              @ tv_~N6 @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6) } in
-        let {
-          ev_~Ni
-            :: GHC.HetMet.Private.PGArrow
-                 tv_~N6 (GHC.HetMet.GArrow.GArrowUnit tv_~N6) tv_~N7
-          [LclId]
-          ev_~Ni = ev_~N8 } in
-        let {
-          ev_~Nj
-            :: GHC.HetMet.Private.PGArrow
-                 tv_~N6
-                 (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-                 (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-          [LclId]
-          ev_~Nj =
-            GHC.HetMet.Private.pga_drop
-              @ tv_~N6 @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6) } in
-        GHC.HetMet.Private.pga_comp
-          @ tv_~N6
-          @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-          @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-          @ tv_~N7
-          ev_~Nj
-          ev_~Ni } in
-    GHC.HetMet.Private.pga_comp
-      @ tv_~N6
-      @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-      @ (GHC.HetMet.GArrow.GArrowUnit tv_~N6)
-      @ tv_~N7
-      ev_~N9
-      ev_~Na
-
-Main.maincoercionKind
-    base:GHC.HetMet.GArrow.GArrowUnit{tc 02y}
-      main:GArrowTikZ.GArrowTikZ{tc roV}
-      ~
-    ghc-prim:GHC.Unit.(){(w) tc 40}
-ghc-stage2: coreTypeToWeakType
-  hit a bare EqPred