From: Adam Megacz <megacz@cs.berkeley.edu>
Date: Sun, 2 Oct 2011 01:56:25 +0000 (-0700)
Subject: GArrowTikZ: improve rendering of ga_drop
X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=commitdiff_plain;h=5632630c3828941a4c3b3d4f5706261d775dfe1a;ds=sidebyside

GArrowTikZ: improve rendering of ga_drop
---

diff --git a/examples/GArrowTikZ.hs b/examples/GArrowTikZ.hs
index d3ae2e0..b090c85 100644
--- a/examples/GArrowTikZ.hs
+++ b/examples/GArrowTikZ.hs
@@ -204,7 +204,10 @@ mkdiag (GASPortShapeWrapper inp outp x) = mkdiag' x
                                                       drawWires tp x1 x x2 x "black" ++
                                                       drawLine  ((x1+x2)/2) (tp!lowermost x) x2 (tp!uppermost y) "gray!50" "dashed"
                              ; return $ DiagramBox 2 top x r (TT x y) bot  }
- mkdiag' GAS_drop       = do { (top,    x   ,bot) <- alloc inp ; simpleDiag      "drop" top x x bot [] }
+ mkdiag' GAS_drop       = do { (top,    x   ,bot) <- alloc inp
+                             ; (_,      y   ,_)   <- alloc outp
+                             ; constrainEq x y
+                             ; simpleDiag   "drop" top x y bot [] }
  mkdiag' (GAS_const i)  = do { (top,    x   ,bot) <- alloc inp
                              ; (_,      y   ,_)   <- alloc outp
                              ; constrainEq x y