Revert "trees that grow" work

As documented in #14490, the Data instances currently blow up
compilation time by too much to stomach. Alan will continue working on
this in a branch and we will perhaps merge to 8.2 before 8.2.1 to avoid
having to perform painful cherry-picks in 8.2 minor releases.

Reverts haddock submodule.

This reverts commit 47ad6578ea460999b53eb4293c3a3b3017a56d65.
This reverts commit e3ec2e7ae94524ebd111963faf34b84d942265b4.
This reverts commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905.
This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb.

1 files changed, 52 insertions, 55 deletions

diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 4cb8bf35ba..7a3ee6853c 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -251,7 +251,7 @@ matchBangs [] _ _ = panic "matchBangs"
 matchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
 -- Apply the coercion to the match variable and then match that
 matchCoercion (var:vars) ty (eqns@(eqn1:_))
-  = do  { let CoPat _ co pat _ = firstPat eqn1
+  = do  { let CoPat co pat _ = firstPat eqn1
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
         ; match_result <- match (var':vars) ty $
@@ -267,7 +267,7 @@ matchView (var:vars) ty (eqns@(eqn1:_))
   = do  { -- we could pass in the expr from the PgView,
          -- but this needs to extract the pat anyway
          -- to figure out the type of the fresh variable
-         let ViewPat _ viewExpr (L _ pat) = firstPat eqn1
+         let ViewPat viewExpr (L _ pat) _ = firstPat eqn1
          -- do the rest of the compilation
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
@@ -284,7 +284,7 @@ matchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
 matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
 -- Since overloaded list patterns are treated as view patterns,
 -- the code is roughly the same as for matchView
-  = do { let ListPat _ _ elt_ty (Just (_,e)) = firstPat eqn1
+  = do { let ListPat _ elt_ty (Just (_,e)) = firstPat eqn1
        ; var' <- newUniqueId var (mkListTy elt_ty)  -- we construct the overall type by hand
        ; match_result <- match (var':vars) ty $
                             map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern
@@ -299,13 +299,13 @@ decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
 decomposeFirstPat _ _ = panic "decomposeFirstPat"
 
 getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc
-getCoPat (CoPat _ _ pat _)   = pat
+getCoPat (CoPat _ pat _)     = pat
 getCoPat _                   = panic "getCoPat"
-getBangPat (BangPat _ pat  ) = unLoc pat
+getBangPat (BangPat pat  )   = unLoc pat
 getBangPat _                 = panic "getBangPat"
-getViewPat (ViewPat _ _ pat) = unLoc pat
+getViewPat (ViewPat _ pat _) = unLoc pat
 getViewPat _                 = panic "getViewPat"
-getOLPat (ListPat x pats ty (Just _)) = ListPat x pats ty Nothing
+getOLPat (ListPat pats ty (Just _)) = ListPat pats ty Nothing
 getOLPat _                   = panic "getOLPat"
 
 {-
@@ -398,19 +398,19 @@ tidy1 :: Id                  -- The Id being scrutinised
 -- It eliminates many pattern forms (as-patterns, variable patterns,
 -- list patterns, etc) and returns any created bindings in the wrapper.
 
-tidy1 v (ParPat _ pat)      = tidy1 v (unLoc pat)
-tidy1 v (SigPat _ pat)      = tidy1 v (unLoc pat)
-tidy1 _ (WildPat ty)        = return (idDsWrapper, WildPat ty)
-tidy1 v (BangPat _ (L l p)) = tidy_bang_pat v l p
+tidy1 v (ParPat pat)      = tidy1 v (unLoc pat)
+tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat)
+tidy1 _ (WildPat ty)      = return (idDsWrapper, WildPat ty)
+tidy1 v (BangPat (L l p)) = tidy_bang_pat v l p
 
         -- case v of { x -> mr[] }
         -- = case v of { _ -> let x=v in mr[] }
-tidy1 v (VarPat _ (L _ var))
+tidy1 v (VarPat (L _ var))
   = return (wrapBind var v, WildPat (idType var))
 
         -- case v of { x@p -> mr[] }
         -- = case v of { p -> let x=v in mr[] }
-tidy1 v (AsPat _ (L _ var) pat)
+tidy1 v (AsPat (L _ var) pat)
   = do  { (wrap, pat') <- tidy1 v (unLoc pat)
         ; return (wrapBind var v . wrap, pat') }
 
@@ -425,7 +425,7 @@ tidy1 v (AsPat _ (L _ var) pat)
     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 -}
 
-tidy1 v (LazyPat _ pat)
+tidy1 v (LazyPat pat)
     -- This is a convenient place to check for unlifted types under a lazy pattern.
     -- Doing this check during type-checking is unsatisfactory because we may
     -- not fully know the zonked types yet. We sure do here.
@@ -441,7 +441,7 @@ tidy1 v (LazyPat _ pat)
         ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
         ; return (mkCoreLets sel_binds, WildPat (idType v)) }
 
-tidy1 _ (ListPat _ pats ty Nothing)
+tidy1 _ (ListPat pats ty Nothing)
   = return (idDsWrapper, unLoc list_ConPat)
   where
     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
@@ -450,29 +450,29 @@ tidy1 _ (ListPat _ pats ty Nothing)
 
 -- Introduce fake parallel array constructors to be able to handle parallel
 -- arrays with the existing machinery for constructor pattern
-tidy1 _ (PArrPat ty pats)
+tidy1 _ (PArrPat pats ty)
   = return (idDsWrapper, unLoc parrConPat)
   where
     arity      = length pats
     parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]
 
-tidy1 _ (TuplePat tys pats boxity)
+tidy1 _ (TuplePat pats boxity tys)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
     arity = length pats
     tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys
 
-tidy1 _ (SumPat tys pat alt arity)
+tidy1 _ (SumPat pat alt arity tys)
   = return (idDsWrapper, unLoc sum_ConPat)
   where
     sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (LitPat _ lit)
+tidy1 _ (LitPat lit)
   = return (idDsWrapper, tidyLitPat lit)
 
 -- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (NPat ty (L _ lit) mb_neg eq)
+tidy1 _ (NPat (L _ lit) mb_neg eq ty)
   = return (idDsWrapper, tidyNPat tidyLitPat lit mb_neg eq ty)
 
 -- Everything else goes through unchanged...
@@ -484,14 +484,13 @@ tidy1 _ non_interesting_pat
 tidy_bang_pat :: Id -> SrcSpan -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
-tidy_bang_pat v _ (ParPat _ (L l p)) = tidy_bang_pat v l p
-tidy_bang_pat v _ (SigPat _ (L l p)) = tidy_bang_pat v l p
+tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
+tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p
 
 -- Push the bang-pattern inwards, in the hope that
 -- it may disappear next time
-tidy_bang_pat v l (AsPat x v' p) = tidy1 v (AsPat x v' (L l (BangPat noExt p)))
-tidy_bang_pat v l (CoPat x w p t)
-  = tidy1 v (CoPat x w (BangPat noExt (L l p)) t)
+tidy_bang_pat v l (AsPat v' p)  = tidy1 v (AsPat v' (L l (BangPat p)))
+tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
 
 -- Discard bang around strict pattern
 tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
@@ -527,7 +526,7 @@ tidy_bang_pat v l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
 --
 -- NB: SigPatIn, ConPatIn should not happen
 
-tidy_bang_pat _ l p = return (idDsWrapper, BangPat noExt (L l p))
+tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
 
 -------------------
 push_bang_into_newtype_arg :: SrcSpan
@@ -538,16 +537,15 @@ push_bang_into_newtype_arg :: SrcSpan
 -- We are transforming   !(N p)   into   (N !p)
 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
   = ASSERT( null args)
-    PrefixCon [L l (BangPat noExt arg)]
+    PrefixCon [L l (BangPat arg)]
 push_bang_into_newtype_arg l _ty (RecCon rf)
   | HsRecFields { rec_flds = L lf fld : flds } <- rf
   , HsRecField { hsRecFieldArg = arg } <- fld
   = ASSERT( null flds)
-    RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg
-                                           = L l (BangPat noExt arg) })] })
+    RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg = L l (BangPat arg) })] })
 push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
   | HsRecFields { rec_flds = [] } <- rf
-  = PrefixCon [L l (BangPat noExt (noLoc (WildPat ty)))]
+  = PrefixCon [L l (BangPat (noLoc (WildPat ty)))]
 push_bang_into_newtype_arg _ _ cd
   = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
 
@@ -977,18 +975,18 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
     -- real comparison is on HsExpr's
     -- strip parens
-    exp (HsPar _ (L _ e)) e'   = exp e e'
-    exp e (HsPar _ (L _ e'))   = exp e e'
+    exp (HsPar (L _ e)) e'   = exp e e'
+    exp e (HsPar (L _ e'))   = exp e e'
     -- because the expressions do not necessarily have the same type,
     -- we have to compare the wrappers
-    exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'
-    exp (HsVar _ i) (HsVar _ i') =  i == i'
-    exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c'
+    exp (HsWrap h e) (HsWrap h' e') = wrap h h' && exp e e'
+    exp (HsVar i) (HsVar i') =  i == i'
+    exp (HsConLikeOut c) (HsConLikeOut c') = c == c'
     -- the instance for IPName derives using the id, so this works if the
     -- above does
-    exp (HsIPVar _ i) (HsIPVar _ i') = i == i'
-    exp (HsOverLabel _ l x) (HsOverLabel _ l' x') = l == l' && x == x'
-    exp (HsOverLit _ l) (HsOverLit _ l') =
+    exp (HsIPVar i) (HsIPVar i') = i == i'
+    exp (HsOverLabel l x) (HsOverLabel l' x') = l == l' && x == x'
+    exp (HsOverLit l) (HsOverLit l') =
         -- Overloaded lits are equal if they have the same type
         -- and the data is the same.
         -- this is coarser than comparing the SyntaxExpr's in l and l',
@@ -996,20 +994,20 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         -- because these expressions get written as a bunch of different variables
         -- (presumably to improve sharing)
         eqType (overLitType l) (overLitType l') && l == l'
-    exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2'
+    exp (HsApp e1 e2) (HsApp e1' e2') = lexp e1 e1' && lexp e2 e2'
     -- the fixities have been straightened out by now, so it's safe
     -- to ignore them?
-    exp (OpApp _ l o ri) (OpApp _ l' o' ri') =
+    exp (OpApp l o _ ri) (OpApp l' o' _ ri') =
         lexp l l' && lexp o o' && lexp ri ri'
-    exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n'
-    exp (SectionL _ e1 e2) (SectionL _ e1' e2') =
+    exp (NegApp e n) (NegApp e' n') = lexp e e' && syn_exp n n'
+    exp (SectionL e1 e2) (SectionL e1' e2') =
         lexp e1 e1' && lexp e2 e2'
-    exp (SectionR _ e1 e2) (SectionR _ e1' e2') =
+    exp (SectionR e1 e2) (SectionR e1' e2') =
         lexp e1 e1' && lexp e2 e2'
-    exp (ExplicitTuple _ es1 _) (ExplicitTuple _ es2 _) =
+    exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) =
         eq_list tup_arg es1 es2
-    exp (ExplicitSum _ _ _ e) (ExplicitSum _ _ _ e') = lexp e e'
-    exp (HsIf _ _ e e1 e2) (HsIf _ _ e' e1' e2') =
+    exp (ExplicitSum _ _ e _) (ExplicitSum _ _ e' _) = lexp e e'
+    exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') =
         lexp e e' && lexp e1 e1' && lexp e2 e2'
 
     -- Enhancement: could implement equality for more expressions
@@ -1031,8 +1029,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         wrap res_wrap1 res_wrap2
 
     ---------
-    tup_arg (L _ (Present _ e1)) (L _ (Present _ e2)) = lexp e1 e2
-    tup_arg (L _ (Missing t1))   (L _ (Missing t2))   = eqType t1 t2
+    tup_arg (L _ (Present e1)) (L _ (Present e2)) = lexp e1 e2
+    tup_arg (L _ (Missing t1)) (L _ (Missing t2)) = eqType t1 t2
     tup_arg _ _ = False
 
     ---------
@@ -1073,7 +1071,7 @@ patGroup _ (ConPatOut { pat_con = L _ con
  | PatSynCon psyn <- con                = PgSyn psyn tys
 patGroup _ (WildPat {})                 = PgAny
 patGroup _ (BangPat {})                 = PgBang
-patGroup _ (NPat _ (L _ OverLit {ol_val=oval}) mb_neg _) =
+patGroup _ (NPat (L _ OverLit {ol_val=oval}) mb_neg _ _) =
   case (oval, isJust mb_neg) of
    (HsIntegral   i, False) -> PgN (fromInteger (il_value i))
    (HsIntegral   i, True ) -> PgN (-fromInteger (il_value i))
@@ -1081,15 +1079,14 @@ patGroup _ (NPat _ (L _ OverLit {ol_val=oval}) mb_neg _) =
    (HsFractional r, True ) -> PgN (-fl_value r)
    (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
                           PgOverS s
-patGroup _ (NPlusKPat _ _ (L _ OverLit {ol_val=oval}) _ _ _) =
+patGroup _ (NPlusKPat _ (L _ OverLit {ol_val=oval}) _ _ _ _) =
   case oval of
    HsIntegral i -> PgNpK (il_value i)
    _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
-patGroup _ (CoPat _ _ p _)              = PgCo  (hsPatType p)
-                                                    -- Type of innelexp pattern
-patGroup _ (ViewPat _ expr p)           = PgView expr (hsPatType (unLoc p))
-patGroup _ (ListPat _ _ _ (Just _))     = PgOverloadedList
-patGroup dflags (LitPat _ lit)          = PgLit (hsLitKey dflags lit)
+patGroup _ (CoPat _ p _)                = PgCo  (hsPatType p) -- Type of innelexp pattern
+patGroup _ (ViewPat expr p _)           = PgView expr (hsPatType (unLoc p))
+patGroup _ (ListPat _ _ (Just _))       = PgOverloadedList
+patGroup dflags (LitPat lit)            = PgLit (hsLitKey dflags lit)
 patGroup _ pat                          = pprPanic "patGroup" (ppr pat)
 
 {-