[commit: ghc] master: Shrink a couple of hs-boot files (226860e)

git at git.haskell.org git at git.haskell.org
Fri May 26 12:22:42 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/226860e786ccb2c5660b64c9cf66e58eaf4dc672/ghc

>---------------------------------------------------------------

commit 226860e786ccb2c5660b64c9cf66e58eaf4dc672
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu May 25 16:07:09 2017 +0100

    Shrink a couple of hs-boot files
    
    IfaceType.hs-boot and ToIface.hs-boot were bigger than they
    needed to be, so I'm shrinking them.


>---------------------------------------------------------------

226860e786ccb2c5660b64c9cf66e58eaf4dc672
 compiler/iface/IfaceType.hs-boot | 29 ++++++-----------------------
 compiler/iface/ToIface.hs-boot   |  5 ++---
 2 files changed, 8 insertions(+), 26 deletions(-)

diff --git a/compiler/iface/IfaceType.hs-boot b/compiler/iface/IfaceType.hs-boot
index 2a5331e..4807419 100644
--- a/compiler/iface/IfaceType.hs-boot
+++ b/compiler/iface/IfaceType.hs-boot
@@ -1,37 +1,20 @@
--- Exists to allow TyCoRep to import pretty-printers
-module IfaceType where
+-- Used only by ToIface.hs-boot
+
+module IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr
+                , IfaceCoercion, IfaceTyLit, IfaceTcArgs ) where
 
 import Var (TyVarBndr, ArgFlag)
 import TyCon (TyConBndrVis)
-import BasicTypes (TyPrec)
-import Outputable (Outputable, SDoc)
 import FastString (FastString)
 
+data IfaceTcArgs
 type IfLclName = FastString
 type IfaceKind = IfaceType
-type IfacePredType = IfaceType
 
-data ShowForAllFlag
 data IfaceType
 data IfaceTyCon
 data IfaceTyLit
 data IfaceCoercion
-data IfaceTcArgs
-type IfaceTvBndr = (IfLclName, IfaceKind)
+type IfaceTvBndr      = (IfLclName, IfaceKind)
 type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
 type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
-
-instance Outputable IfaceType
-
-pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
-pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
-pprIfaceTyLit :: IfaceTyLit -> SDoc
-pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
-pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
-pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
-pprIfaceContext :: [IfacePredType] -> SDoc
-pprIfaceContextArr :: [IfacePredType] -> SDoc
-pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
-pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
-pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
-pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
diff --git a/compiler/iface/ToIface.hs-boot b/compiler/iface/ToIface.hs-boot
index 04ceab6..f361427 100644
--- a/compiler/iface/ToIface.hs-boot
+++ b/compiler/iface/ToIface.hs-boot
@@ -1,17 +1,16 @@
 module ToIface where
 
 import {-# SOURCE #-} TyCoRep
-import {-# SOURCE #-} IfaceType
+import {-# SOURCE #-} IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr
+                               , IfaceCoercion, IfaceTyLit, IfaceTcArgs )
 import Var ( TyVar, TyVarBinder )
 import TyCon ( TyCon )
 import VarSet( VarSet )
 
 -- For TyCoRep
-toIfaceType :: Type -> IfaceType
 toIfaceTypeX :: VarSet -> Type -> IfaceType
 toIfaceTyLit :: TyLit -> IfaceTyLit
 toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
-toIfaceTvBndr :: TyVar -> IfaceTvBndr
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
 toIfaceCoercion :: Coercion -> IfaceCoercion



More information about the ghc-commits mailing list