[Improve lambda/pi printing code
Samuel Bronson <naesten@gmail.com>**20080411230159
 Only only put as many lambda/pi abstractions on a line as will fit.
 Use sortKindLike to get the uppercase lambdas for type variables of
 kind other than *. (For instance, * -> *.)
 
 I had to make E.TypeCheck, E.Eval and E.Subst import E.Show with a {-#
 SOURCE #-} pragma before I could use sortKindLike. (I also had to
 write the .hs-boot file, of course).
] hunk ./E/Eval.hs 12
-import E.Show
+import {-# SOURCE #-} E.Show
hunk ./E/Show.hs 14
+import E.TypeCheck
hunk ./E/Show.hs 143
+-- collects lambda and pi abstractions
+collectAbstractions e0 = go e0 [] where
+    go e1@(EPi tvr e)  xs | tvrIdent tvr == 0                = done e1 xs
+                          | not (sortKindLike (tvrType tvr)) = go e ((UC.pI,     tvr, True) :xs)
+                          | dump FD.EVerbose || tvrIdent tvr `member` (freeVars e::IdSet)
+                                                             = go e ((UC.forall, tvr, False):xs)
+                          | otherwise                        = done e1 xs
+    go e1@(ELam tvr e) xs | sortKindLike (tvrType tvr)       = go e ((UC.lAmbda, tvr, False):xs)
+                          | otherwise                        = go e ((UC.lambda, tvr, True) :xs)
+    go  e           xs = done e xs
+    done e xs = (reverse xs, e)
+                                                  
hunk ./E/Show.hs 177
-        f (EPi tvr@(TVr {  tvrType =  z}) e) | z == eStar = allocTVr tvr $ do
-            tvr <- showTVr' tvr
-            liftM2 dot (return $ pop (retOp UC.forall) tvr) (showE e)
-        f (EPi t e) = allocTVr t $ do
-            tvr <- showTVr t
-            e <- showE e
-            return $ (pop (retOp UC.pI) tvr) `dot` e
-        f (ELam tvr@TVr {tvrType =  z} e) | z == eStar = allocTVr tvr $ do
-            tvr <- showTVr' tvr
-            liftM2 dot (return $ pop (retOp UC.lAmbda) tvr) (showE e)
-        f (ELam t e) = allocTVr t $ do
-            tvr <- showTVr t
-            e <- showE e
-            return $ (pop (retOp UC.lambda) tvr) `dot` e
+        f e0 | (as@(_:_), e) <- collectAbstractions e0 =
+            foldr (\(_, tvr, _) -> allocTVr tvr)
+                  (do tops <- mapM p as
+                      e <- showE e
+                      return (atom $ group $ (align $ skipToNest <> fillCat tops) <$> unparse e))
+                  as
+            where 
+              p :: (Doc, TVr, Bool) -> SEM Doc
+              p (c,t,detailed) = do tvr <- if detailed then showTVr t else showTVr' t
+                                    return (retOp c <> unparse tvr <> retOp (char '.'))
hunk ./E/Show.hs 262
+-- skip to the current nesting level, breaking the line if already past it
+skipToNest      = column (\k ->
+                  nesting (\i -> if k > i
+                                 then linebreak
+                                 else text (replicate (i-k) ' ')))
addfile ./E/Show.hs-boot
hunk ./E/Show.hs-boot 1
+-- -*- Haskell -*-
+
+module E.Show(ePretty,render,prettyE,ePrettyEx) where
+
+import E.E
+import Doc.DocLike
+import Doc.Pretty
+import Doc.PPrint
+
+render :: Doc -> String
+prettyE :: E -> String
+ePrettyEx :: E -> Doc 
+ePretty :: E -> Doc
+
+instance DocLike d => PPrint d TVr
+instance PPrint Doc E
+instance PPrint String E
+instance PPrint String (Lit E E)
hunk ./E/Subst.hs 48
-import E.Show
+import Name.Names (tc_Arrow)
+import {-# SOURCE #-} E.Show
hunk ./E/TypeCheck.hs 24
-import E.Show
+import {-# SOURCE #-} E.Show