[commit: ghc] wip/orf-reboot: Defuse dfid_rep_tycon landmine, albeit in a stupid way for now (8535533)

[git at git.haskell.org]

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

On branch  : wip/orf-reboot
Link       : http://ghc.haskell.org/trac/ghc/changeset/85355339c58de42e81de3e1a7f0a3d217d1dbd4c/ghc

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

commit 85355339c58de42e81de3e1a7f0a3d217d1dbd4c
Author: Adam Gundry <adam at well-typed.com>
Date:   Mon Mar 2 10:58:29 2015 +0000

    Defuse dfid_rep_tycon landmine, albeit in a stupid way for now


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

85355339c58de42e81de3e1a7f0a3d217d1dbd4c
 compiler/hsSyn/HsDecls.hs        | 8 ++++----
 compiler/rename/RnNames.hs       | 3 ++-
 compiler/rename/RnSource.hs      | 9 +++++----
 compiler/typecheck/TcInstDcls.hs | 5 +++--
 4 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 009b1ca..b203ef2 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1085,7 +1085,7 @@ type LDataFamInstDecl name = Located (DataFamInstDecl name)
 data DataFamInstDecl name
   = DataFamInstDecl
        { dfid_tycon     :: Located name
-       , dfid_rep_tycon :: name  -- See Note [Assigning names to instance declarations] in RnSource
+       , dfid_rep_tycon :: Maybe name  -- See Note [Assigning names to instance declarations] in RnSource
        , dfid_pats      :: HsTyPats   name       -- LHS
        , dfid_defn      :: HsDataDefn name       -- RHS
        , dfid_fvs       :: PostRn name NameSet } -- Free vars for dependency analysis
@@ -1099,9 +1099,9 @@ data DataFamInstDecl name
   deriving( Typeable )
 deriving instance (DataId name) => Data (DataFamInstDecl name)
 
-placeHolderRepTyCon :: name -- AMG TODO
--- Used for dfid_rep_tycon in DataFamInstDecl prior to the renamer
-placeHolderRepTyCon = panic "placeHolderRepTyCon"
+-- | Used for dfid_rep_tycon in DataFamInstDecl prior to the renamer
+placeHolderRepTyCon :: Maybe name
+placeHolderRepTyCon = Nothing
 
 
 ----------------- Class instances -------------
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index ade177e..b42d4bd 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -626,7 +626,8 @@ getLocalNonValBinders fixity_env
         = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
              ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
              ; sub_names <- mapM newTopSrcBinder bndrs
-             ; flds' <- mapM (new_rec_sel overload_ok (rdrNameOcc (dfid_rep_tycon ti_decl)) . fstOf3) flds
+             ; let rep_tycon = expectJust "getLocalNonValBinders/new_di" $ dfid_rep_tycon ti_decl
+             ; flds' <- mapM (new_rec_sel overload_ok (rdrNameOcc rep_tycon) . fstOf3) flds
              ; let avail    = AvailTC (unLoc main_name) sub_names
                                   (fieldLabelsToAvailFields flds')
                                   -- main_name is not bound here!
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 330062b..46b3eda 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -53,7 +53,7 @@ import Data.List( partition, sortBy )
 #if __GLASGOW_HASKELL__ < 709
 import Data.Traversable (traverse)
 #endif
-import Maybes( orElse, mapMaybe )
+import Maybes( orElse, mapMaybe, expectJust )
 
 {-
 @rnSourceDecl@ `renames' declarations.
@@ -276,7 +276,7 @@ assignNamesClsInstDecl cid = do
 assignNamesDataFamInstDecl :: DataFamInstDecl RdrName -> State OccSet (DataFamInstDecl RdrName)
 assignNamesDataFamInstDecl dfid = do
     occ <- assignOccName (mkInstTyTcOcc info_string)
-    return dfid { dfid_rep_tycon = mkRdrUnqual occ }
+    return dfid { dfid_rep_tycon = Just $ mkRdrUnqual occ }
   where
     info_string = occNameString (rdrNameOcc $ unLoc $ dfid_tycon dfid)
                     ++ concatMap (getDFunHsTypeKey . unLoc) (hswb_cts (dfid_pats dfid))
@@ -669,15 +669,16 @@ rnDataFamInstDecl :: Maybe (Name, [Name])
                   -> DataFamInstDecl RdrName
                   -> RnM (DataFamInstDecl Name, FreeVars)
 rnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_tycon = tycon
-                                          , dfid_rep_tycon = rep_tycon
+                                          , dfid_rep_tycon = mb_rep_tycon
                                           , dfid_pats  = HsWB { hswb_cts = pats }
                                           , dfid_defn  = defn })
   = do { (tycon', pats', defn', fvs) <-
            rnFamInstDecl (TyDataCtx tycon) mb_cls tycon pats defn rnDataDefn
        ; mod <- getModule
+       ; let rep_tycon = expectJust "rnDataFamInstDecl" mb_rep_tycon
        ; rep_tycon' <- newGlobalBinder mod (rdrNameOcc rep_tycon) (getLoc tycon)
        ; return (DataFamInstDecl { dfid_tycon = tycon'
-                                 , dfid_rep_tycon = rep_tycon'
+                                 , dfid_rep_tycon = Just rep_tycon'
                                  , dfid_pats  = pats'
                                  , dfid_defn  = defn'
                                  , dfid_fvs   = fvs }, fvs) }
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index e61955f..090a741 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -60,7 +60,7 @@ import Util
 import BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
 
 import Control.Monad
-import Maybes     ( isNothing, isJust, whenIsJust, catMaybes )
+import Maybes     ( isNothing, isJust, whenIsJust, catMaybes, expectJust )
 import Data.List  ( mapAccumL, partition )
 
 {-
@@ -663,7 +663,7 @@ tcDataFamInstDecl mb_clsinfo
     (L loc decl@(DataFamInstDecl
        { dfid_pats = pats
        , dfid_tycon = fam_tc_name
-       , dfid_rep_tycon = rep_tc_name
+       , dfid_rep_tycon = mb_rep_tc_name
        , dfid_defn = defn at HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                                      , dd_ctxt = ctxt, dd_cons = cons } }))
   = setSrcSpan loc             $
@@ -693,6 +693,7 @@ tcDataFamInstDecl mb_clsinfo
        ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons
 
          -- Construct representation tycon
+       ; let rep_tc_name = expectJust "tcDamFamInstDecl" mb_rep_tc_name
        ; axiom_name  <- newImplicitBinder rep_tc_name mkInstTyCoOcc
        ; let orig_res_ty = mkTyConApp fam_tc pats'