diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs
index 1d4edf00ee13ff5f705e9a0857c76069462c667e..05049891a8b2192d768015bcdce5e216a7aaee6d 100644
--- a/ghc/compiler/deSugar/Check.lhs
+++ b/ghc/compiler/deSugar/Check.lhs
@@ -540,7 +540,7 @@ simplify_pat pat@(LitPat lit lit_ty)
 
   | lit_ty == charTy = ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy]
 
-  | otherwise = pat --pprPanic "tidy1:LitPat:" (ppr pat)
+  | otherwise = pprPanic "tidy1:LitPat:" (ppr pat)
   where
     mk_char (HsChar c)    = HsCharPrim c
 
diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
index a147fbfaa5e114d67c1bfa22550a444500ff9656..d7c3bdb4c1c130dca3e5247afe05cb03d13d25e2 100644
--- a/ghc/compiler/deSugar/Match.lhs
+++ b/ghc/compiler/deSugar/Match.lhs
@@ -499,9 +499,7 @@ tidy1 v pat@(LitPat lit lit_ty) match_result
   = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
 	      match_result)
 
-  | otherwise 
-  --= pprPanic "tidy1:LitPat:" (ppr pat)
-  = returnDs (pat, match_result)
+  | otherwise = pprPanic "tidy1:LitPat:" (ppr pat)
   where
     mk_char (HsChar c)    = HsCharPrim c
 
diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index 5017e6cfe5677061b860c0e462562a4d01f0e3d1..7ffbdae5bbd3aee85f5156435977e08b62a4cf97 100644
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/ghc/compiler/deSugar/MatchLit.lhs
@@ -73,8 +73,8 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal lit_t
 	mk_core_lit ty (HsStringPrim  s) = MachStr    s
 	mk_core_lit ty (HsFloatPrim   f) = MachFloat  f
 	mk_core_lit ty (HsDoublePrim  d) = MachDouble d
-	mk_core_lit ty (HsLitLit      s) = --ASSERT(isUnpointedType ty)
-					   MachLitLit s IntRep -- (panic "MatchLit.matchLiterals:mk_core_lit:HsLitLit; typePrimRep???")
+	mk_core_lit ty (HsLitLit      s) = ASSERT(isUnpointedType ty)
+					   achLitLit s (panic "MatchLit.matchLiterals:mk_core_lit:HsLitLit; typePrimRep???")
     	mk_core_lit ty other	         = panic "matchLiterals:mk_core_lit:unhandled"
 \end{code}