Remove HsNumTy and TypePati.

[ghc-hetmet.git] / compiler / typecheck / TcPat.lhs

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index a82584c..79603ea 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -459,9 +459,6 @@ tc_pat penv (SigPatIn pat sig_ty) pat_ty thing_inside
 
         ; return (mkHsWrapPat wrap (SigPatOut pat' inner_ty) pat_ty, res) }
 
-tc_pat _ pat@(TypePat _) _ _
-  = failWithTc (badTypePat pat)
-
 ------------------------
 -- Lists, tuples, arrays
 tc_pat penv (ListPat pats _) pat_ty thing_inside
@@ -669,10 +666,7 @@ tcConPat penv (L con_span con_name) pat_ty arg_pats thing_inside
        ; setSrcSpan con_span $ addDataConStupidTheta data_con ctxt_res_tys
 
        ; checkExistentials ex_tvs penv 
-        ; let skol_info = case pe_ctxt penv of
-                            LamPat mc -> PatSkol data_con mc
-                            LetPat {} -> UnkSkol -- Doesn't matter
-       ; ex_tvs' <- tcInstSkolTyVars skol_info ex_tvs  
+        ; ex_tvs' <- tcInstSuperSkolTyVars ex_tvs
                      -- Get location from monad, not from ex_tvs
 
         ; let pat_ty' = mkTyConApp tycon ctxt_res_tys
@@ -704,14 +698,17 @@ tcConPat penv (L con_span con_name) pat_ty arg_pats thing_inside
                            -- order is *important* as we generate the list of
                            -- dictionary binders from theta'
              no_equalities = not (any isEqPred theta')
-
+              skol_info = case pe_ctxt penv of
+                            LamPat mc -> PatSkol data_con mc
+                            LetPat {} -> UnkSkol -- Doesn't matter
+ 
         ; gadts_on <- xoptM Opt_GADTs
        ; checkTc (no_equalities || gadts_on)
                  (ptext (sLit "A pattern match on a GADT requires -XGADTs"))
                  -- Trac #2905 decided that a *pattern-match* of a GADT
                  -- should require the GADT language flag
 
-       ; given <- newEvVars theta'
+        ; given <- newEvVars theta'
         ; (ev_binds, (arg_pats', res))
             <- checkConstraints skol_info ex_tvs' given $
                 tcConArgs data_con arg_tys' arg_pats penv thing_inside
@@ -1047,9 +1044,6 @@ polyPatSig sig_ty
   = hang (ptext (sLit "Illegal polymorphic type signature in pattern:"))
        2 (ppr sig_ty)
 
-badTypePat :: Pat Name -> SDoc
-badTypePat pat = ptext (sLit "Illegal type pattern") <+> ppr pat
-
 lazyUnliftedPatErr :: OutputableBndr name => Pat name -> TcM ()
 lazyUnliftedPatErr pat
   = failWithTc $