[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