examples/GArrowTikZ.hs

   1 {-# OPTIONS_GHC -XModalTypes -XMultiParamTypeClasses -XNoMonoPatBinds -XKindSignatures -XGADTs -XFlexibleContexts -XFlexibleInstances -XTypeOperators -XUndecidableInstances -XTypeFamilies #-}
   2 module GArrowTikZ (tikz, tikz', GArrowTikZ(..))
   3 where
   4 import Prelude hiding ( id, (.), lookup )
   5 import Control.Category
   6 import GHC.HetMet.GArrow
   7 import Data.List hiding (lookup, insert)
   8 import Data.Map hiding (map, (!))
   9 import Unify
  10 import GHC.HetMet.Private
  11
  12 {-
  13 TO DO:
  14     - have "resolve" turn a (Diagram UnifVal) into (Diagram Int)
  15     - custom rendering
  16     - bias right now is for all edges to be uppermost; try for bias
  17       towards smallest nodes?
  18     - curvy boxes (like XOR gates)
  19 -}
  20
  21
  22 -- a unification value is basically a LISP-ish expression
  23 data UVal =
  24    UVVar  UVar
  25  | UVVal  [UVal]
  26
  27 instance Unifiable UVal where
  28   unify' (UVVal vl1) (UVVal vl2)
  29       | length vl1 /= length vl2  = error "length mismatch during unification"
  30       | otherwise                 = foldr mergeU emptyUnifier (map (\(x,y) -> unify x y) $ zip vl1 vl2)
  31   unify' _ _                      = error "impossible"
  32   inject                          = UVVar
  33   project (UVVar v)               = Just v
  34   project _                       = Nothing
  35   occurrences (UVVar v)           = [v]
  36   occurrences (UVVal vl)          = concatMap occurrences vl
  37
  38 -- | Resolves a unification variable; the answer to this query will change if subsequent unifications are performed
  39 getU' :: Unifier UVal -> UVal -> UVal
  40 getU' u (UVVal vl)    = UVVal $ map (getU' u) vl
  41 getU' u x@(UVVar v)   = case Unify.getU u v  of
  42                                      Nothing -> x
  43                                      Just x' -> getU' u x'
  44
  45
  46
  47
  48 --
  49 -- | Render a fully-polymorphic GArrow term as a boxes-and-wires diagram using TikZ
  50 --
  51
  52 type Constraints = [(UVal, Int, UVal)]
  53
  54 -- the unification monad
  55 data UyM t a = UyM (([UVar],Unifier UVal,Constraints) -> ([UVar],Unifier UVal,Constraints,a))
  56 instance Monad (UyM t)
  57  where
  58   return x      = UyM $ \(i,u,k) -> (i,u,k,x)
  59   (UyM f) >>= g = UyM $ \(i,u,k) -> let (i',u',k',x) = f (i,u,k) in let UyM g' = g x in g' (i',u',k')
  60
  61
  62 getU        = UyM $ \(i,u,k) -> (i,u,k,u)
  63 getM    v   = UyM $ \(i,u,k) -> (i,u,k,getU' u v)
  64 occursU v x = UyM $ \(i,u,k) -> (i,u,k,occurs u v x)
  65 unifyM :: Eq t => UVal -> UVal -> UyM t ()
  66 unifyM v1 v2 = UyM $ \(i,u,k) -> (i,mergeU u (unify v1 v2),k,())
  67 freshU :: UyM t UVar
  68 freshU = UyM $ \(i:is,u,k) -> (is,u,k,i)
  69 constrain :: UVal -> Int -> UVal -> UyM t ()
  70 constrain v1 d v2 = UyM $ \(i,u,k) -> (i,u,((v1,d,v2):k),())
  71 getK :: UyM t [(UVal, Int, UVal)]
  72 getK = UyM $ \(i,u,k) -> (i,u,k,k)
  73 runU :: UyM t a -> ([UVar],Unifier UVal,Constraints,a)
  74 runU (UyM f) = (f (uvarSupply,emptyUnifier,[]))
  75
  76 data GArrowTikZ :: * -> * -> *
  77  where
  78   TikZ_const     ::                             Int ->  GArrowTikZ () Int
  79   TikZ_id        ::                                     GArrowTikZ x x
  80   TikZ_comp      :: GArrowTikZ y z -> GArrowTikZ x y -> GArrowTikZ x z
  81   TikZ_first     :: GArrowTikZ x y                   -> GArrowTikZ (x**z)  (y**z)
  82   TikZ_second    :: GArrowTikZ x y                   -> GArrowTikZ (z**x)  (z**y)
  83   TikZ_cancell   ::                                     GArrowTikZ (()**x) x
  84   TikZ_cancelr   ::                                     GArrowTikZ (x**()) x
  85   TikZ_uncancell ::                                     GArrowTikZ x (()**x)
  86   TikZ_uncancelr ::                                     GArrowTikZ x (x**())
  87   TikZ_assoc     ::                                     GArrowTikZ ((x**y)**z) (x**(y**z))
  88   TikZ_unassoc   ::                                     GArrowTikZ (x**(y**z)) ((x**y)**z)
  89   TikZ_drop      ::                                     GArrowTikZ x         ()
  90   TikZ_copy      ::                                     GArrowTikZ x         (x**x)
  91   TikZ_swap      ::                                     GArrowTikZ (x**y)     (y**x)
  92   TikZ_merge     ::                                     GArrowTikZ (x**y)     z
  93   TikZ_loopl     ::           GArrowTikZ (x**z) (y**z) -> GArrowTikZ x y
  94   TikZ_loopr     ::           GArrowTikZ (z**x) (z**y) -> GArrowTikZ x y
  95
  96 --
  97 -- Technically this instance violates the laws (and RULEs) for
  98 -- Control.Category; the compiler might choose to optimize (f >>> id)
  99 -- into f, and this optimization would produce a change in behavior
 100 -- below.  In practice this means that the user must be prepared for
 101 -- the rendered TikZ diagram to be merely *equivalent to* his/her
 102 -- term, rather than structurally exactly equal to it.
 103 --
 104 instance Category GArrowTikZ where
 105   id           = TikZ_id
 106   (.)          = TikZ_comp
 107
 108 instance GArrow GArrowTikZ (**) () where
 109   ga_first     = TikZ_first
 110   ga_second    = TikZ_second
 111   ga_cancell   = TikZ_cancell
 112   ga_cancelr   = TikZ_cancelr
 113   ga_uncancell = TikZ_uncancell
 114   ga_uncancelr = TikZ_uncancelr
 115   ga_assoc     = TikZ_assoc
 116   ga_unassoc   = TikZ_unassoc
 117
 118 instance GArrowDrop GArrowTikZ (**) () where
 119   ga_drop      = TikZ_drop
 120
 121 instance GArrowCopy GArrowTikZ (**) () where
 122   ga_copy      = TikZ_copy
 123
 124 instance GArrowSwap GArrowTikZ (**) () where
 125   ga_swap      = TikZ_swap
 126
 127 instance GArrowLoop GArrowTikZ (**) () where
 128   ga_loopl     = TikZ_loopl
 129   ga_loopr     = TikZ_loopr
 130
 131 type instance GArrowTensor      GArrowTikZ = (,)
 132 type instance GArrowUnit        GArrowTikZ = ()
 133 type instance GArrowExponent    GArrowTikZ = (->)
 134
 135 instance GArrowSTKC GArrowTikZ
 136
 137
 138 name :: GArrowTikZ a b -> String
 139 name TikZ_id              = "id"
 140 name (TikZ_const i)       = "const " ++ show i
 141 name (TikZ_comp      _ _) = "comp"
 142 name (TikZ_first     _  ) = "first"
 143 name (TikZ_second    _  ) = "second"
 144 name TikZ_cancell         = "cancell"
 145 name TikZ_cancelr         = "cancelr"
 146 name TikZ_uncancell       = "uncancell"
 147 name TikZ_uncancelr       = "uncancelr"
 148 name TikZ_drop            = "drop"
 149 name TikZ_copy            = "copy"
 150 name TikZ_swap            = "swap"
 151 name (TikZ_loopl     _ )  = "loopl"
 152 name (TikZ_loopr     _ )  = "loopr"
 153 name TikZ_assoc           = "assoc"
 154 name TikZ_unassoc         = "unassoc"
 155
 156 fresh1 :: UyM () Ports
 157 fresh1 = do { x <- freshU
 158             ; return $ UVVar x
 159             }
 160
 161 fresh2 :: UyM () (Ports,Ports)
 162 fresh2 = do { x <- freshU
 163             ; y <- freshU
 164             ; constrain (UVVar x) 1 (UVVar y)
 165             ; return $ (UVVar x,UVVar y)
 166             }
 167
 168 fresh3 :: UyM () (Ports,Ports,Ports)
 169 fresh3 = do { x <- freshU
 170             ; y <- freshU
 171             ; z <- freshU
 172             ; constrain (UVVar x) 1 (UVVar y)
 173             ; constrain (UVVar y) 1 (UVVar z)
 174             ; return $ (UVVar x,UVVar y,UVVar z)
 175             }
 176
 177 fresh4 :: UyM () (Ports,Ports,Ports,Ports)
 178 fresh4 = do { x1 <- freshU
 179             ; x2 <- freshU
 180             ; x3 <- freshU
 181             ; x4 <- freshU
 182             ; constrain (UVVar x1) 1 (UVVar x2)
 183             ; constrain (UVVar x2) 1 (UVVar x3)
 184             ; constrain (UVVar x3) 1 (UVVar x4)
 185             ; return $ (UVVar x1,UVVar x2,UVVar x3,UVVar x4)
 186             }
 187
 188 fresh5 :: UyM () (Ports,Ports,Ports,Ports,Ports)
 189 fresh5 = do { x1 <- freshU
 190             ; x2 <- freshU
 191             ; x3 <- freshU
 192             ; x4 <- freshU
 193             ; x5 <- freshU
 194             ; constrain (UVVar x1) 1 (UVVar x2)
 195             ; constrain (UVVar x2) 1 (UVVar x3)
 196             ; constrain (UVVar x3) 1 (UVVar x4)
 197             ; constrain (UVVar x4) 1 (UVVar x5)
 198             ; return $ (UVVar x1,UVVar x2,UVVar x3,UVVar x4,UVVar x5)
 199             }
 200
 201
 202
 203
 204 --example = ga_first ga_drop >>> ga_cancell >>> ga_first id >>> ga_swap >>> ga_first id >>> TikZ_merge
 205 --example :: forall x y z. forall g. (GArrow g (,) (), GArrowCopy g (,) (), GArrowSwap g (,) ()) => g x ((x,x),x)
 206 --example = ga_copy >>> ga_second ga_copy >>> ga_second (ga_first id) >>> ga_unassoc >>> ga_first ga_swap
 207 --example = ga_copy >>> ga_second ga_copy >>> ga_second (ga_second id) >>> ga_unassoc >>> ga_first id >>> ga_first ga_swap
 208 --example :: forall x. forall g. (GArrow g (,) (), GArrowCopy g (,) (), GArrowSwap g (,) ()) => g x x
 209 --example = id >>> id
 210
 211 data Diagram p = DiagramComp      (Diagram p) (Diagram p)
 212                | DiagramPrim      String p p p p (String -> Int -> Int -> Int -> p -> p -> Int -> String)
 213                | DiagramBypassTop p (Diagram p)
 214                | DiagramBypassBot (Diagram p) p
 215                -- | DiagramLoopTop   Diagram
 216                -- | DiagramLoopBot   Diagram
 217
 218 type Ports = UVal
 219
 220 getOut :: Diagram Ports -> Ports
 221 getOut (DiagramComp f g)                     = getOut g
 222 getOut (DiagramPrim s ptop pin pout pbot _)  = pout
 223 getOut (DiagramBypassTop p f)                = UVVal [p, (getOut f)]
 224 getOut (DiagramBypassBot f p)                = UVVal [(getOut f), p]
 225
 226 getIn :: Diagram Ports -> Ports
 227 getIn (DiagramComp f g)                      = getIn f
 228 getIn (DiagramPrim s ptop pin pout pbot _)   = pin
 229 getIn (DiagramBypassTop p f)                 = UVVal [p, (getIn f)]
 230 getIn (DiagramBypassBot f p)                 = UVVal [(getIn f), p]
 231
 232 -- constrain that Ports is at least Int units above the topmost portion of Diagram
 233 constrainTop :: Ports -> Int -> Diagram Ports -> UyM () ()
 234 constrainTop v i (DiagramComp d1 d2)                  = do { constrainTop v i d1 ; constrainTop v i d2 ; return () }
 235 constrainTop v i (DiagramBypassTop p d)               = constrain v 2 p
 236 constrainTop v i (DiagramBypassBot d p)               = constrainTop v (i+1) d
 237 constrainTop v i (DiagramPrim s ptop pin pout pbot _) = constrain v i ptop
 238
 239 -- constrain that Ports is at least Int units below the bottommost portion of Diagram
 240 constrainBot :: Diagram Ports -> Int -> Ports -> UyM () ()
 241 constrainBot (DiagramComp d1 d2)                  i v = do { constrainBot d1 i v ; constrainBot d2 i v ; return () }
 242 constrainBot (DiagramBypassTop p d)               i v = constrainBot d (i+1) v
 243 constrainBot (DiagramBypassBot d p)               i v = constrain p 2 v
 244 constrainBot (DiagramPrim s ptop pin pout pbot _) i v = constrain pbot i v
 245
 246 ga2diag :: GArrowTikZ a b -> UyM () (Diagram Ports)
 247 ga2diag (TikZ_id           ) = do { (top,x,bot) <- fresh3 ; return $ DiagramPrim "id" top x x bot defren }
 248 ga2diag (TikZ_comp      g f) = do { f' <- ga2diag f
 249                                   ; g' <- ga2diag g
 250                                   ; unifyM (getOut f') (getIn g')
 251                                   ; return $ DiagramComp f' g' }
 252 ga2diag (TikZ_first  f) = do { x <- fresh1; f' <- ga2diag f ; constrainBot f' 1 x  ; return $ DiagramBypassBot f' x  }
 253 ga2diag (TikZ_second f) = do { x <- fresh1; f' <- ga2diag f ; constrainTop x  1 f' ; return $ DiagramBypassTop x f'  }
 254 ga2diag TikZ_cancell    = do { (top,x,y  ,bot) <- fresh4  ; return $ DiagramPrim   "cancell" top (UVVal [x,y]) y bot defren }
 255 ga2diag TikZ_cancelr    = do { (top,x,y  ,bot) <- fresh4  ; return $ DiagramPrim   "cancelr" top (UVVal [x,y]) x bot defren }
 256 ga2diag TikZ_uncancell  = do { (top,x,y  ,bot) <- fresh4  ; return $ DiagramPrim "uncancell" top y (UVVal [x,y]) bot defren }
 257 ga2diag TikZ_uncancelr  = do { (top,x,y  ,bot) <- fresh4  ; return $ DiagramPrim "uncancelr" top x (UVVal [x,y]) bot defren }
 258 ga2diag TikZ_drop       = do { (top,x    ,bot) <- fresh3  ; return $ DiagramPrim      "drop" top x x bot defren }
 259 ga2diag (TikZ_const i)  = do { (top,x    ,bot) <- fresh3  ; return $ DiagramPrim  ("const " ++ show i) top x x bot defren }
 260 ga2diag TikZ_copy       = do { (top,x,y,z,bot) <- fresh5
 261                              ; return $ DiagramPrim      "copy" top y (UVVal [x,z]) bot defren }
 262 ga2diag TikZ_merge      = do { (top,x,y,z,bot) <- fresh5
 263                              ; return $ DiagramPrim      "merge" top (UVVal [x,z]) y bot defren }
 264 ga2diag TikZ_swap       = do { (top,x,y  ,bot) <- fresh4
 265                              ; return $ DiagramPrim      "swap" top (UVVal [x,y]) (UVVal [x,y]) bot defren }
 266 ga2diag TikZ_assoc      = do { (top,x,y,z,bot) <- fresh5
 267                              ; return $ DiagramPrim  "assoc" top (UVVal [UVVal [x,y],z])(UVVal [x,UVVal [y,z]]) bot defren }
 268 ga2diag TikZ_unassoc    = do { (top,x,y,z,bot) <- fresh5
 269                              ; return $ DiagramPrim "unassoc" top (UVVal [x,UVVal [y,z]])(UVVal [UVVal [x,y],z]) bot defren }
 270 ga2diag (TikZ_loopl f) = error "not implemented"
 271 ga2diag (TikZ_loopr f) = error "not implemented"
 272
 273 defren :: String -> Int -> Int -> Int -> Ports -> Ports -> Int -> String
 274 defren s x w top p1 p2 bot
 275       = drawBox x top (x+w) bot "black" s
 276 --        ++ wires (x-1) p1  x    "green"
 277 --        ++ wires  (x+w) p2 (x+w+1) "red"
 278
 279 xscale = 1
 280 yscale = 1
 281
 282 textc x y text color =
 283     "\\node[anchor=center,color="++color++"] at ("++show (x*xscale)++"cm,"++show (y*yscale)++"cm) "++
 284     "{{\\tt{"++text++"}}};\n"
 285
 286 drawBox x1 y1 x2 y2 color text =
 287     "\\node[anchor=north west] at ("++show (x1*xscale)++"cm,"++show (y1*yscale)++"cm) "++
 288     "{{\\tt{"++text++"}}};\n"
 289     ++
 290     "\\path[draw,color="++color++"]"++
 291        " ("++show (x1*xscale)++","++show (y1*yscale)++") rectangle ("++
 292            show (x2*xscale)++","++show (y2*yscale)++");\n"
 293
 294 drawLine x1 y1 x2 y2 color style =
 295   "\\path[draw,color="++color++","++style++"] "++
 296   "("++show (x1*xscale)++","++show (y1*yscale)++") -- " ++
 297   "("++show (x2*xscale)++","++show (y2*yscale)++");\n"
 298
 299 width :: Diagram Ports -> Int
 300 width (DiagramComp d1 d2)         = (width d1) + 1 + (width d2)
 301 width (DiagramPrim s _ p1 p2 _ _) = 2
 302 width (DiagramBypassTop p d)      = (width d) + 2
 303 width (DiagramBypassBot d p)      = (width d) + 2
 304
 305 (!) :: Map UVar Int -> UVar -> Int
 306 m ! x = case lookup x m of
 307           Nothing -> 0
 308           Just y -> y
 309
 310 tikZ :: Map UVar Int ->
 311         Diagram Ports ->
 312         Int ->                -- horizontal position
 313         String
 314 tikZ m = tikZ'
 315  where
 316   tikZ'  d@(DiagramComp d1 d2)    x = tikZ' d1 x
 317                                       ++ wires (x+width d1) (getOut d1) (x+width d1+1) "black"
 318                                       ++ tikZ' d2 (x + width d1 + 1)
 319   tikZ' d'@(DiagramBypassTop p d) x = let top = getTop d' in
 320                                       let bot = getBot d' in
 321                                       drawBox  x top (x+width d') bot "gray!50" "second"
 322                                       ++ drawLine x (top+1) (x+width d') (top+1) "black" "->"
 323                                       ++ wires x (getIn d) (x+1) "black"
 324                                       ++ tikZ' d (x+1)
 325                                       ++ wires (x+1+width d) (getOut d) (x+1+width d+1) "black"
 326   tikZ' d'@(DiagramBypassBot d p) x = let top = getTop d' in
 327                                       let bot = getBot d' in
 328                                       drawBox  x top (x+width d') bot "gray!50" "first"
 329                                       ++ drawLine x (bot-1) (x+width d') (bot-1) "black" "->"
 330                                       ++ wires x (getIn d) (x+1) "black"
 331                                       ++ tikZ' d (x+1)
 332                                       ++ wires (x+1+width d) (getOut d) (x+1+width d+1) "black"
 333   tikZ'  d@(DiagramPrim s (UVVar top) p1 p2 (UVVar bot) r)  x = r s x (width d) (m ! top) p1 p2 (m ! bot)
 334
 335   wires :: Int -> Ports -> Int -> String -> String
 336   wires x1 (UVVar v)    x2 color = drawLine x1 (m ! v) x2 (m ! v) color "->"
 337                                   -- ++ textc ((x1+x2) `div` 2) (m!v) (show v) "purple"
 338   wires x1 (UVVal vl) x2 color = foldr (\x y -> x ++ " " ++ y) [] (map (\v -> wires x1 v x2 color) vl)
 339
 340   getTop :: Diagram Ports -> Int
 341   getTop (DiagramComp d1 d2)                = min (getTop d1) (getTop d2)
 342   getTop (DiagramBypassTop p d)             = (m ! getleft p) - 1
 343   getTop (DiagramBypassBot d p)             = getTop d - 1
 344   getTop (DiagramPrim s (UVVar ptop) _ _ _ _)  = m ! ptop
 345
 346   getBot :: Diagram Ports -> Int
 347   getBot (DiagramComp d1 d2)                = max (getBot d1) (getBot d2)
 348   getBot (DiagramBypassTop p d)             = getBot d + 1
 349   getBot (DiagramBypassBot d p)             = (m ! getright p) + 1
 350   getBot (DiagramPrim s _ _ _ (UVVar pbot) _)  = m ! pbot
 351
 352 resolve' (DiagramComp d1 d2)    = do { d1' <- resolve' d1 ; d2' <- resolve' d2 ; return $ DiagramComp d1' d2'    }
 353 resolve' (DiagramBypassTop p d) = do { p'  <- getM p     ; d'  <- resolve' d  ; return $ DiagramBypassTop p' d' }
 354 resolve' (DiagramBypassBot d p) = do { p'  <- getM p     ; d'  <- resolve' d  ; return $ DiagramBypassBot d' p' }
 355 resolve' (DiagramPrim s ptop pin pout pbot r)
 356     = do { ptop' <- getM ptop
 357          ; pbot' <- getM pbot
 358          ; pin'  <- getM pin
 359          ; pout' <- getM pout
 360          ; return $ DiagramPrim s ptop' pin' pout' pbot' r }
 361
 362 getleft (UVVar   v)  = v
 363 getleft (UVVal  vl) = getleft (head vl)
 364
 365 getright (UVVar   v)  = v
 366 getright (UVVal  vl) = getright (last vl)
 367
 368 strip :: [(Ports,Int,Ports)] -> [(UVar,Int,UVar)]
 369 strip = map (\(v1,x,v2) -> (getright v1, x, getleft v2))
 370
 371
 372 -- must use bubblesort because the ordering isn't transitive
 373 sortit :: [(UVar,Int,UVar)] -> [(UVar,Int,UVar)]
 374 sortit x = stupidSort x []
 375  where
 376   stupidSort []    x = x
 377   stupidSort (h:t) x = stupidSort t (stupidInsert h x)
 378
 379   stupidInsert t []    = [t]
 380   stupidInsert t@(_,_,t') ((a@(_,_,a')):b) = if cmp' x t' a' == LT
 381                                              then t:a:b
 382                                              else a:(stupidInsert t b)
 383
 384   cmp' :: [(UVar,Int,UVar)] -> UVar -> UVar -> Ordering
 385   cmp' [] a b = EQ -- compare a b
 386   cmp' ((v1,_,v2):r) a b = if a == v1 && b==v2
 387                            then LT
 388                            else if a == v2 && b==v1
 389                                 then GT
 390                                 else cmp' r a b
 391
 392 lookup'' :: Map UVar Int -> UVar -> Int
 393 lookup'' m x = case lookup x m of
 394                  Nothing -> 0
 395                  Just y -> y
 396
 397 valuatit :: Map UVar Int -> [(UVar,Int,UVar)] -> Map UVar Int
 398 valuatit m []            = m
 399 valuatit m ((v1,k,v2):r) = valuatit m' r
 400                             where
 401                               m'  = insert v2 v2' m
 402                               v2' = max (lookup'' m v2) (k+(lookup'' m v1))
 403
 404 resolve'k :: UyM () [(Ports,Int,Ports)]
 405 resolve'k = do { k  <- getK
 406               ; k' <- mapM (\(v1,x,v2) -> do { v1' <- getM v1 ; v2' <- getM v2 ; return (v1',x,v2') }) k
 407               ; return k'
 408               }
 409
 410 toTikZ :: GArrowTikZ a b -> String
 411 toTikZ g = tikZ m d 0
 412             where
 413               (_,_,_,(d,k)) = runU $ do { d <- ga2diag g
 414                                         ; d' <- resolve' d
 415                                         ; k' <- resolve'k
 416                                         ; return (d',k') }
 417               s = sortit (strip k)
 418               m = valuatit empty s
 419 toTikZ' :: GArrowTikZ a b -> String
 420 toTikZ' g = foldr (\x y -> x++"\\\\\n"++y) [] (map foo s)
 421              where
 422                (_,_,_,k) = runU $ ga2diag g >>= resolve' >>= \_ -> resolve'k
 423                foo (v1,v,v2) = "x_{"++show v1++"} + "++show v++" \\leq x_{"++show v2++"} = " ++ (show $ lookup'' m v2)
 424                s = sortit (strip k)
 425                m = valuatit empty s
 426
 427 tikz' :: (forall g a . PGArrow g (GArrowUnit g) a -> PGArrow g (GArrowUnit g) a) -> IO ()
 428 tikz' x = tikz $ unG (x (PGArrowD { unG = TikZ_const 12 }))
 429 main = do putStrLn "hello"
 430 tikz example
 431      = do putStrLn "\\documentclass{article}"
 432           putStrLn "\\usepackage[landscape,paperheight=20in,textwidth=19in]{geometry}"
 433           putStrLn "\\usepackage{tikz}"
 434           putStrLn "\\usepackage{amsmath}"
 435           putStrLn "\\begin{document}"
 436           putStrLn $ "\\begin{tikzpicture}[every on chain/.style={join=by ->},yscale=-1]"
 437           putStrLn (toTikZ example)
 438           putStrLn "\\end{tikzpicture}"
 439 --          putStrLn "\\begin{align*}"
 440 --          putStr   (toTikZ' example)
 441 --          putStrLn "\\end{align*}"
 442           putStrLn "\\end{document}"