[reorganised pretty printing
martin.hofmann@uni-bamberg.de**20091210074858] hunk ./src/Igor2/Config.hs 15
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/CallDependencies.hs 35
-import PrettyPrinter hiding (group)
+import Igor2.Ppr hiding (group)
hunk ./src/Igor2/Data/HypoSpace.hs 21
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/Hypotheses.hs 21
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/IOData.hs 18
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/IgorMonad.hs 37
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/Rateable.hs 13
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Data/Rules.hs 44
-import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..), Lit(..))
-import Language.Haskell.TH.Ppr (pprint)
-
hunk ./src/Igor2/Data/Rules.hs 46
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Logging/Log.hs 10
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Logging/Logger.hs 38
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/Logging/MockLog.hs 10
-import PrettyPrinter
+import Igor2.Ppr
addfile ./src/Igor2/Ppr.hs
hunk ./src/Igor2/Ppr.hs 1
-
+{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell  -XTypeSynonymInstances #-}
+module Igor2.Ppr (
+
+    showp, set, asMap, asRepl, 
+
+    (<^>), ($$), patternNotDef,
+
+    module Text.PrettyPrint.ANSI.Leijen,
+)where
+
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Bimap as B
+import qualified Data.Foldable as F
+import Data.Maybe
+
+import Data.Maybe (maybeToList)
+
+--import System.Time
+import Debug.Trace
+
+import Text.PrettyPrint.ANSI.Leijen
+
+ 
+--------------------------------------------------------------------------------
+-- Pretty Utils
+--------------------------------------------------------------------------------
+
+x $$ y = align (x <$> y)
+x <^> y = x <$> ( indent 2 y )
+
+
+patternNotDef :: [Doc] -> Doc
+patternNotDef as = text "Pattern not defined !!!" <$>
+                   vsep [ text "arg" <> int (i+1) <+> (as !! i) | i <- [0 .. (length as)-1]]
+
+
+showp :: (Pretty a) => a -> String
+showp = show.pretty
+
+--------------------------------------------------------------------------------
+-- Pretty Helpers
+--------------------------------------------------------------------------------
+
+  
+set  l = braces $ align $ hcat $ punctuate comma l
+
+asMap (a,b) = 
+    lparen <> (pretty a) <+> ((text "|->" ) <> softbreak <> indent 2 (pretty b) <> rparen)
+    
+asRepl (a,b) = 
+    lparen <> (pretty a) <+> ((text "<~" ) <+> softbreak <> align (pretty b) <> rparen)
+
+
+
+--------------------------------------------------------------------------------
+-- Pretty Instances
+--------------------------------------------------------------------------------
+
+instance Pretty Ordering where
+    pretty = text.show
+   
+instance (Pretty a,Pretty b,Pretty c,Pretty d) => Pretty (a,b,c,d) where
+  pretty (w,x,y,z)= tupled [pretty w, pretty x, pretty y, pretty z]
+  
+instance (Pretty a,Pretty b) => Pretty (Either a b) where
+  pretty (Left a)= text "Left" <+> pretty a
+  pretty (Right b)= text "Right" <+> pretty b
+   
+instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e) => Pretty (a,b,c,d,e) where
+  pretty (v,w,x,y,z)= tupled [pretty v,pretty w, pretty x, pretty y, pretty z]
+   
+instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f) => Pretty (a,b,c,d,e,f) where
+  pretty (u,v,w,x,y,z)= tupled [pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
+
+instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g) => Pretty (a,b,c,d,e,f,g) where
+  pretty (t,u,v,w,x,y,z)= tupled [pretty t,pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
+
+instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g,Pretty h) => Pretty (a,b,c,d,e,f,g,h) where
+  pretty (s,t,u,v,w,x,y,z)= tupled [pretty s,pretty t,pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
+
+instance (Pretty k, Pretty v) => Pretty (M.Map k v) where
+    pretty m = list $ map asMap (M.toList m)
+    
+--instance (Pretty v) => Pretty (IM.IntMap v) where
+--    pretty m = list $ map asMap (IM.toList m)
+
+instance (Pretty e) => Pretty (S.Set e) where
+    pretty s = semiBraces $ map pretty (S.toList s)
+    
+--instance (Pretty e) => Pretty (Sq.Seq e) where
+--    pretty = pretty . F.toList
+--    
+--instance Pretty (IS.IntSet) where
+--    pretty s = set $ map pretty (IS.toList s)
+    
+instance (Pretty a, Pretty b) => Pretty (B.Bimap a b) where
+    pretty b = list $ map asMap (B.toAscList b) 
+    
+--instance Pretty TimeDiff where
+--    pretty t 
+--        | tdYear t == 0 && tdMonth t == 0 = 
+--            text (show $ 24 * tdDay t + tdHour t) <> text "h" <+>
+--            text (show $ tdMin t) <> text "m" <+>
+--            text (show $ fromIntegral (tdSec t)  + 1.0e-12 *  fromIntegral (tdPicosec t)) <> text "s"
+--        | otherwise = text "Cannot print a TimeDiff with Month or Year field set"
+            
hunk ./src/Igor2/RuleDevelopment.hs 15
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 18
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/RuleDevelopment/Matching.hs 13
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/RuleDevelopment/Partition.hs 20
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/RuleDevelopment/Subfunction.hs 12
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/SynthesisEngine.hs 18
-import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..))
hunk ./src/Igor2/SynthesisEngine.hs 19
-import PrettyPrinter 
+import Igor2.Ppr 
hunk ./src/Igor2/UI/Help.hs 4
-import PrettyPrinter
+import Igor2.Ppr
hunk ./src/Igor2/UI/UIStarter.hs 35
-import PrettyPrinter hiding (integer)
+import Igor2.Ppr hiding (integer)
hunk ./src/PrettyPrinter.hs 1
-{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell  -XTypeSynonymInstances #-}
-module PrettyPrinter  (
-
-    showp, set, asMap, asRepl, 
-
-    (<^>), ($$), patternNotDef,
-
-    module Text.PrettyPrint.ANSI.Leijen,
-)where
-
-
-import qualified Data.Map as M
-import qualified Data.Set as S
-import qualified Data.Sequence as Sq
-import qualified Data.IntMap as IM
-import qualified Data.IntSet as IS
-import qualified Data.Bimap as B
-import qualified Data.Foldable as F
-import Data.List (isPrefixOf, stripPrefix)
-import Data.Maybe
-
-import Data.Maybe (maybeToList)
---import Data.Time.Clock
---import Data.Time.Calendar
---import System.CPUTime
---import System.IO
-import System.Time
-import Debug.Trace
-import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..), Lit(..))
-import Language.Haskell.TH.Ppr (pprint)
-import Text.PrettyPrint.ANSI.Leijen
-
- 
---------------------------------------------------------------------------------
--- Pretty Utils
---------------------------------------------------------------------------------
-
-x $$ y = align (x <$> y)
-x <^> y = x <$> ( indent 2 y )
-
-
-patternNotDef :: [Doc] -> Doc
-patternNotDef as = text "Pattern not defined !!!" <$>
-                   vsep [ text "arg" <> int (i+1) <+> (as !! i) | i <- [0 .. (length as)-1]]
-
-
-showp :: (Pretty a) => a -> String
-showp = show.pretty
-
---------------------------------------------------------------------------------
--- Pretty Helpers
---------------------------------------------------------------------------------
-
-  
-set  l = braces $ align $ hcat $ punctuate comma l
-
-asMap (a,b) = 
-    lparen <> (pretty a) <+> ((text "|->" ) <> softbreak <> indent 2 (pretty b) <> rparen)
-    
-asRepl (a,b) = 
-    lparen <> (pretty a) <+> ((text "<~" ) <+> softbreak <> align (pretty b) <> rparen)
-
-
-
---------------------------------------------------------------------------------
--- Pretty Instances
---------------------------------------------------------------------------------
-
-instance (Pretty a, Pretty b) => Pretty (Either a b) where
-    pretty (Left a) = pretty a
-    pretty (Right a) = pretty a
-    
-instance Pretty Exp where
-    pretty = text.pprint
-    
-instance Pretty Pat where
-    pretty = text.pprint
-    
-      
-instance Pretty Dec where
-    pretty = vcat.(map text).fixbreaks.lines.unqual.pprint
-    
-
--- Quick and dirty HACKs!!
--- I am to lazy to not use the Ppr instance of Dec
--- And even if so, I should use Regex
-unqual [] = []
-unqual s@(x:xs)
-    | qualified s = unqual $ unqualifie s
-    | otherwise   = x:(unqual xs)
-    where
-    qualified  s  = any (flip isPrefixOf s) qualifiers
-    unqualifie s  = foldl stripFrom s qualifiers
-    stripFrom s p = maybe s id (stripPrefix p s)
-    qualifiers    = ["Data.Either.","Data.Maybe.","GHC.Bool."
-                    ,"GHC.Base.","GHC.Types.", "GHC.List."]
-                    
--- TH.pprint sometimes breaks lists in arguments, so I have to fix it
-fixbreaks [x] = [x]
-fixbreaks (x1:x2:xs)
-   | isPrefixOf "  " x2 = fixbreaks ( (x1++ (' ':(dropWhile (==' ')x2))):xs)
-   | otherwise          = x1 : (fixbreaks (x2:xs))
-       
---instance Pretty Name where
---    pretty = text.pprint
-    
---instance Pretty Type where
---    pretty = text.pprint
---    
---instance Pretty Clause where
---    pretty = text.pprint
-    
-instance Pretty Ordering where
-    pretty = text.show
-   
-instance (Pretty a,Pretty b,Pretty c,Pretty d) => Pretty (a,b,c,d) where
-  pretty (w,x,y,z)= tupled [pretty w, pretty x, pretty y, pretty z]
-   
-instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e) => Pretty (a,b,c,d,e) where
-  pretty (v,w,x,y,z)= tupled [pretty v,pretty w, pretty x, pretty y, pretty z]
-   
-instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f) => Pretty (a,b,c,d,e,f) where
-  pretty (u,v,w,x,y,z)= tupled [pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
-
-instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g) => Pretty (a,b,c,d,e,f,g) where
-  pretty (t,u,v,w,x,y,z)= tupled [pretty t,pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
-
-instance (Pretty a,Pretty b,Pretty c,Pretty d,Pretty e,Pretty f,Pretty g,Pretty h) => Pretty (a,b,c,d,e,f,g,h) where
-  pretty (s,t,u,v,w,x,y,z)= tupled [pretty s,pretty t,pretty u, pretty v, pretty w, pretty x, pretty y, pretty z]
-
-instance (Pretty k, Pretty v) => Pretty (M.Map k v) where
-    pretty m = list $ map asMap (M.toList m)
-    
-instance (Pretty v) => Pretty (IM.IntMap v) where
-    pretty m = list $ map asMap (IM.toList m)
-
-instance (Pretty e) => Pretty (S.Set e) where
-    pretty s = semiBraces $ map pretty (S.toList s)
-    
-instance (Pretty e) => Pretty (Sq.Seq e) where
-    pretty = pretty . F.toList
-    
-instance Pretty (IS.IntSet) where
-    pretty s = set $ map pretty (IS.toList s)
-    
-instance (Pretty a, Pretty b) => Pretty (B.Bimap a b) where
-    pretty b = list $ map asMap (B.toAscList b) 
-    
-instance Pretty TimeDiff where
-    pretty t 
-        | tdYear t == 0 && tdMonth t == 0 = 
-            text (show $ 24 * tdDay t + tdHour t) <> text "h" <+>
-            text (show $ tdMin t) <> text "m" <+>
-            text (show $ fromIntegral (tdSec t)  + 1.0e-12 *  fromIntegral (tdPicosec t)) <> text "s"
-        | otherwise = text "Cannot print a TimeDiff with Month or Year field set"
-            
+
rmfile ./src/PrettyPrinter.hs
hunk ./src/Syntax/Builder.hs 30
-import PrettyPrinter
---import Igor2.Logging
-
hunk ./src/Syntax/Builder.hs 34
+import Syntax.Ppr
hunk ./src/Syntax/Class/Antiunifier.hs 20
---import Syntax.Ppr
hunk ./src/Syntax/Class/Antiunifier.hs 21
-import PrettyPrinter
+import Text.PrettyPrint.ANSI.Leijen
hunk ./src/Syntax/Class/Unifier.hs 29
-
--- import Igor2.Logging
-import PrettyPrinter
-
hunk ./src/Syntax/Context.hs 20
---import Syntax.Ppr
hunk ./src/Syntax/Context.hs 21
-import PrettyPrinter
hunk ./src/Syntax/Expressions.hs 35
---import PrettyPrinter
addfile ./src/Syntax/Ppr.hs
hunk ./src/Syntax/Ppr.hs 1
-
+
+module Syntax.Ppr (
+
+    Pretty(..),
+    
+    ) where
+
+import Data.Function (on)
+import Data.List (sortBy,isPrefixOf, stripPrefix)
+import qualified Language.Haskell.Exts.Syntax as Hs
+import Language.Haskell.Exts.Pretty (prettyPrint)
+import qualified Language.Haskell.TH.Syntax as TH (Exp(..), Pat(..), Dec(..), Clause(..), Body(..), Lit(..))
+import Language.Haskell.TH.Ppr (pprint)
+import Syntax.Expressions
+import Syntax.Type (typeOf, Type(..), TyCxt)
+import Syntax.Name
+import Syntax.Class.Term
+import Syntax.Context
+import Syntax.Specification
+import Text.PrettyPrint.ANSI.Leijen
+import Igor2.Ppr
+
+instance Pretty Position where
+    pretty = text.show
+    
+instance Pretty TExp where
+    pretty e = pprTExp e <+> colon <> colon <+> pretty (typeOf e)    
+
+pprTExp (TVarE n t)         = pretty n
+pprTExp (TConE n t)         = pretty n
+pprTExp (TLitE l t)         = pretty l
+pprTExp (TAppE e1 e2 t)     = pprTExp e1 <+> pprTExp e2
+pprTExp (TInfixE p1 n p2 t) = hsep [ pprTExp p1, pprTExp n, pprTExp p2]
+pprTExp (TTupE es t)        = tupled (map pprTExp es)
+pprTExp (TListE l t)        = list (map pprTExp l)
+pprTExp (TWildE n t)        = red $ text "?" <> pretty n
+
+instance Pretty Lit where
+        pretty (Int i)        = integer i
+        pretty (Char c)       = text (show c)
+        pretty (String s)     = text (show s)
+        pretty (Frac r)       = double (fromRational r)
+
+instance Pretty Name where
+    pretty = text.pprint
+    
+--------------------------------------------------------------------------------
+-- PrettyPrinting Types
+
+    
+instance Pretty Type where
+    pretty (ForallT tvars ctxt ty) = 
+            text "forall" <+> hsep (map pretty tvars) <+> text "."
+                          <+> pprCxt ctxt <+> pretty ty
+    pretty ty = pprTyApp (split ty)
+
+-----------------------------------------
+-- PrettyPrinting Auxiliaries
+-- Stolen from Language.Haskell.TH.PPr
+
+pprParendType :: Type -> Doc
+pprParendType (VarT v)   = pretty v
+pprParendType (ConT c)   = pretty c
+pprParendType (TupleT 0) = text "()"
+pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma))
+pprParendType ArrowT     = parens (text "->")
+pprParendType ListT      = text "[]"
+pprParendType other      = parens (pretty other)
+
+pprTyApp :: (Type, [Type]) -> Doc
+pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", pretty arg2]
+pprTyApp (ListT, [arg]) = brackets (pretty arg)
+pprTyApp (TupleT n, args)
+ | length args == n = parens (sep (punctuate comma (map pretty args)))
+pprTyApp (fun, []) = pprParendType fun
+pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args)
+
+pprFunArgType :: Type -> Doc    -- Should really use a precedence argument
+-- Everything except forall and (->) binds more tightly than (->)
+pprFunArgType ty@(ForallT {})                 = parens (pretty ty)
+pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (pretty ty)
+pprFunArgType ty                              = pretty ty
+
+split :: Type -> (Type, [Type])    -- Split into function and args
+split t = go t []
+    where go (AppT t1 t2) args = go t1 (t2:args)
+          go ty           args = (ty, args)
+          
+pprCxt :: TyCxt -> Doc
+pprCxt []  = empty
+pprCxt [t] = pretty t <+> text "=>"
+pprCxt ts  = parens (hsep $ punctuate comma $ map pretty ts) <+> text "=>"
+
+-----------------------------------------
+
+instance Pretty FunBind where
+    pretty = vcat.(map text).fixbreaks.lines.unqual.pprint.toDec
+    
+
+-- Quick and dirty HACKs!!
+-- I am to lazy to not use the Ppr instance of Dec
+-- And even if so, I should use Regex
+unqual [] = []
+unqual s@(x:xs)
+    | qualified s = unqual $ unqualifie s
+    | otherwise   = x:(unqual xs)
+    where
+    qualified  s  = any (flip isPrefixOf s) qualifiers
+    unqualifie s  = foldl stripFrom s qualifiers
+    stripFrom s p = maybe s id (stripPrefix p s)
+    qualifiers    = ["Data.Either.","Data.Maybe.","GHC.Bool."
+                    ,"GHC.Base.","GHC.Types.", "GHC.List."
+                    ,"Generics.Pointless.Combinators."
+                    ,"Generics.Pointless.RecursionPatterns."]
+                    
+-- TH.pprint sometimes breaks lists in arguments, so I have to fix it
+fixbreaks [x] = [x]
+fixbreaks (x1:x2:xs)
+   | isPrefixOf "  " x2 = fixbreaks ( (x1++ (' ':(dropWhile (==' ')x2))):xs)
+   | otherwise          = x1 : (fixbreaks (x2:xs))
+   
+toDec :: FunBind  -> TH.Dec
+toDec (FunB f es) = TH.FunD f (toClauses es)
+
+toClauses :: [Equation] -> [TH.Clause]
+toClauses rs = map toClause  (sortByPatLength rs)
+    where
+    sortByPatLength  = sortBy (compare `on` (\(UnGuardEq ls _) -> size ls))
+     
+toClause :: Equation -> TH.Clause
+toClause (UnGuardEq ls rs) = TH.Clause (map toPat ls) (TH.NormalB . toExp $ rs) []                               
+           
+toExp (TVarE n _)         = TH.VarE n
+toExp (TWildE n _)        = TH.VarE (mkName ('?':(show n)))
+toExp (TLitE l _)         = TH.LitE (toLit l)
+toExp (TConE n _)         = TH.ConE n
+toExp (TListE l _)        = TH.ListE (map toExp l)
+toExp (TTupE l _)         = TH.TupE (map toExp l)
+toExp (TAppE a1 a2 _)     = TH.AppE (toExp a1) (toExp a2)                
+toExp (TInfixE e1 e2 e3 _) = 
+    TH.InfixE (Just . toExp $ e1)(toExp e2)(Just . toExp $ e3)
+    
+toLit (Char c)   = TH.CharL c
+toLit (String s) = TH.StringL s
+toLit (Int i)    = TH.IntegerL i
+toLit (Frac r)   = TH.RationalL r
+              
+toPat (TVarE n _)         = TH.VarP n
+toPat (TLitE l _)         = TH.LitP (toLit l)
+toPat (TWildE n _)        = TH.WildP
+toPat (TConE n _)         = TH.ConP n []
+toPat (TListE l _)        = TH.ListP (map toPat l)
+toPat (TTupE l _)         = TH.TupP (map toPat l)
+toPat e@(TAppE a1 a2 _)   = 
+    let ((TConE n _):as) =  unfoldTAppE e
+    in  TH.ConP n (map toPat as)                
+toPat (TInfixE l (TConE n _) r _) = 
+    TH.InfixP (toPat l) n (toPat r)
+--toPat e = error $ "Cannot translate to Pat: " ++ (show e) 
+
+instance Pretty Equation where
+    pretty = text . pprint . toClause
+    
+   
+instance Pretty Specification where
+    pretty ctx = linebreak <$> text "Context: " <$>
+               (indent 2 $ text "Bindings: " <$> indent 2 (pretty (spec_bindings ctx)) <$>
+                           text "Types   : " <$> indent 2 (pretty (spec_types ctx)) <$>
+                           text "Ctors   : " <$> indent 2 (pretty (spec_ctors ctx)) <$>
+                           text "Classes : " <$> indent 2 (pretty (spec_classes ctx)) <$>
+                           text "Members : " <$> indent 2 (pretty (spec_members ctx)) <$>
+                           text "Instancs: " <$> indent 2 (pretty (spec_instances ctx)) <$>
+                           text "Synonyms: " <$> indent 2 (pretty (spec_typesyns ctx)))
+
+instance Pretty Context where
+    pretty ctx = linebreak <$> text "Context: " <$>
+               (indent 2 $ text "Types   : " <$> pretty (ctx_types ctx) <$>
+                           text "Ctors   : " <$> pretty (ctx_ctors ctx) <$>
+                           text "Classes : " <$> pretty (ctx_classes ctx) <$>
+                           text "Members : " <$> pretty (ctx_members ctx) <$>
+                           text "Instancs: " <$> pretty (ctx_instances ctx) <$>
+                           text "Synonyms: " <$> pretty (ctx_typesyns ctx))        
hunk ./src/Syntax/Specification.hs 19
---import PrettyPrinter
+
hunk ./src/Syntax/Type.hs 52
-import PrettyPrinter