[commit: ghc] wip/spj-wildcard-refactor: Chugging along on this branch (4a1456d)

[git at git.haskell.org]

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

On branch  : wip/spj-wildcard-refactor
Link       : http://ghc.haskell.org/trac/ghc/changeset/4a1456db3acf68b5ffe3e942b59694d439a1a397/ghc

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

commit 4a1456db3acf68b5ffe3e942b59694d439a1a397
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Oct 27 17:35:41 2015 +0000

    Chugging along on this branch
    
    Uupdates the haddock submodule too


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

4a1456db3acf68b5ffe3e942b59694d439a1a397
 compiler/deSugar/DsMeta.hs       |  2 +-
 compiler/ghc.mk                  |  2 --
 compiler/hsSyn/HsTypes.hs        | 29 +++++++++++++++++++++++------
 compiler/typecheck/TcRnDriver.hs |  4 +---
 utils/haddock                    |  2 +-
 5 files changed, 26 insertions(+), 13 deletions(-)

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 427580e..3d8eae0 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -598,7 +598,7 @@ repRuleBndr (L _ (RuleBndr n))
        ; rep2 ruleVarName [n'] }
 repRuleBndr (L _ (RuleBndrSig n sig))
   = do { MkC n'  <- lookupLBinder n
-       ; MkC ty' <- repLTy (hsWcSigType sig)
+       ; MkC ty' <- repLTy (hsSigWcType sig)
        ; rep2 typedRuleVarName [n', ty'] }
 
 repAnnD :: LAnnDecl Name -> DsM (SrcSpan, Core TH.DecQ)
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 5883b8a..4f08caf 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -495,7 +495,6 @@ compiler_stage2_dll0_MODULES = \
 	CoreSeq \
 	CoreStats \
 	CostCentre \
-	Ctype \
 	DataCon \
 	Demand \
 	Digraph \
@@ -534,7 +533,6 @@ compiler_stage2_dll0_MODULES = \
 	InstEnv \
 	Kind \
 	Lexeme \
-	Lexer \
 	ListSetOps \
 	Literal \
 	Maybes \
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index f0ef451..abfd981 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -46,7 +46,8 @@ module HsTypes (
         wildCardName, sameWildCard, sameNamedWildCard,
         isAnonWildCard, isNamedWildCard,
 
-        mkHsImplicitBndrs, mkHsWildCardBndrs,
+        mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
+        mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
         mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, hsTvbAllKinded,
         hsScopedTvs, hsWcScopedTvs, dropWildCards,
         hsTyVarName, hsLKiTyVarNames,
@@ -57,7 +58,7 @@ module HsTypes (
         splitLHsClassTy_maybe,
         splitHsFunType, splitHsAppTys, hsTyGetAppHead_maybe,
         mkHsAppTys, mkHsOpTy,
-        ignoreParens, hsSigType, hsWcSigType,
+        ignoreParens, hsSigType, hsSigWcType,
         hsLTyVarBndrsToTypes,
 
         -- Printing
@@ -207,15 +208,18 @@ type LHsSigWcType name = HsImplicitBndrs name (LHsWcType name)  -- Both
 
 -- See Note [Representing type signatures]
 
+hsImplicitBody :: HsImplicitBndrs name thing -> thing
+hsImplicitBody (HsIB { hsib_body = body }) = body
+
 hsSigType :: LHsSigType name -> LHsType name
-hsSigType sig_ty = hsib_body sig_ty
+hsSigType = hsImplicitBody
 
-hsWcSigType :: LHsSigWcType name -> LHsType name
-hsWcSigType sig_ty = hswc_body (hsib_body sig_ty)
+hsSigWcType :: LHsSigWcType name -> LHsType name
+hsSigWcType sig_ty = hswc_body (hsib_body sig_ty)
 
 dropWildCards :: LHsSigWcType name -> LHsSigType name
 -- Drop the wildcard part of a LHsSigWcType
-dropWildCards sig_ty = sig_ty { hsib_body = hsWcSigType sig_ty }
+dropWildCards sig_ty = sig_ty { hsib_body = hsSigWcType sig_ty }
 
 {- Note [Representing type signatures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -248,6 +252,19 @@ mkHsWildCardBndrs x = HsWC { hswc_body = x
                            , hswc_wcs  = PlaceHolder
                            , hswc_ctx  = Nothing }
 
+-- Add empty binders.  This is a bit suspicious; what if
+-- the wrapped thing had free type variables?
+mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs Name thing
+mkEmptyImplicitBndrs x = HsIB { hsib_body = x
+                              , hsib_kvs = []
+                              , hsib_tvs = [] }
+
+mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs Name thing
+mkEmptyWildCardBndrs x = HsWC { hswc_body = x
+                              , hswc_wcs  = []
+                              , hswc_ctx  = Nothing }
+
+
 --------------------------------------------------
 -- | These names are used early on to store the names of implicit
 -- parameters.  They completely disappear after type-checking.
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 096cf97..439d749 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1751,9 +1751,7 @@ getGhciStepIO = do
                                      , hst_body  = nlHsFunTy ghciM ioM }
 
         stepTy :: LHsSigWcType Name  -- Urgh!
-        stepTy = HsIB { hsib_tvs = [], hsib_kvs = []
-                      , hsib_body = HsWC { hswc_wcs = [], hswc_ctx = Nothing
-                                         , hswc_body = step_ty } }
+        stepTy = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs step_ty)
     return (noLoc $ ExprWithTySig (nlHsVar ghciStepIoMName) stepTy)
 
 isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
diff --git a/utils/haddock b/utils/haddock
index a394ee8..ec20bd1 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit a394ee884befd8cc8ba31a6071afaec7cca14e7c
+Subproject commit ec20bd15e724d580a01d9fad98791bb53db5e57c