[project @ 1999-11-09 11:37:38 by simonmar]

Fixes to Simon's lit-lit pattern commit

ghc/compiler/deSugar/Check.lhs

@@ -28,24 +28,10 @@ import Name             ( Name, mkLocalName, getOccName, isDataSymOcc, getName,
 import Type		( Type, splitAlgTyConApp, mkTyVarTys,
                           isUnboxedType, splitTyConApp_maybe
 			)
-import TysPrim		( intPrimTy, 
-                          charPrimTy, 
-                          floatPrimTy, 
-                          doublePrimTy,
-			  addrPrimTy, 
-                          wordPrimTy
-			)
 import TysWiredIn	( nilDataCon, consDataCon, 
-                          mkTupleTy, tupleCon,
-			  mkUnboxedTupleTy, unboxedTupleCon,
                           mkListTy, 
-                          charTy, charDataCon, 
-                          intTy, intDataCon,
-			  floatTy, floatDataCon, 
-                          doubleTy, doubleDataCon, 
-                          addrTy, addrDataCon,
-                          wordTy, wordDataCon,
-			  stringTy
+                          mkTupleTy, tupleCon,
+			  mkUnboxedTupleTy, unboxedTupleCon
 			)
 import Unique		( unboundKey )
 import TyCon            ( tyConDataCons )

ghc/compiler/deSugar/DsUtils.lhs

@@ -31,7 +31,7 @@ module DsUtils (
 
 import {-# SOURCE #-} Match ( matchSimply )
 
-import HsSyn		( OutPat(..) )
+import HsSyn
 import TcHsSyn		( TypecheckedPat )
 import DsHsSyn		( outPatType, collectTypedPatBinders )
 import CoreSyn
@@ -43,14 +43,29 @@ import PrelInfo		( iRREFUT_PAT_ERROR_ID )
 import Id		( idType, Id, mkWildId )
 import Const		( Literal(..), Con(..) )
 import TyCon		( isNewTyCon, tyConDataCons )
-import DataCon		( DataCon, StrictnessMark, maybeMarkedUnboxed, dataConStrictMarks, 
-			  dataConId, splitProductType_maybe
+import DataCon		( DataCon, StrictnessMark, maybeMarkedUnboxed, 
+			  dataConStrictMarks, dataConId, splitProductType_maybe
 			)
 import Type		( mkFunTy, isUnLiftedType, splitAlgTyConApp, unUsgTy,
 			  Type
 			)
-import TysWiredIn	( unitDataCon, tupleCon, stringTy, unitTy, unitDataCon,
-			  nilDataCon, consDataCon
+import TysPrim		( intPrimTy, 
+                          charPrimTy, 
+                          floatPrimTy, 
+                          doublePrimTy,
+			  addrPrimTy, 
+                          wordPrimTy
+			)
+import TysWiredIn	( nilDataCon, consDataCon, 
+                          tupleCon,
+			  stringTy,
+			  unitDataCon, unitTy,
+                          charTy, charDataCon, 
+                          intTy, intDataCon,
+			  floatTy, floatDataCon, 
+                          doubleTy, doubleDataCon, 
+                          addrTy, addrDataCon,
+                          wordTy, wordDataCon
 			)
 import UniqSet		( mkUniqSet, minusUniqSet, isEmptyUniqSet, UniqSet )
 import Outputable
@@ -105,7 +120,7 @@ tidyLitPat lit lit_ty default_pat
 
     one_str_lit (HsString s) = _LENGTH_ s == (1::Int)
     one_str_lit other_lit    = False
-    mk_first_char_lit (HsString s) = ConPat charDataCon charTy [] [] [LitPat (HsCharPrim (_HEAD_ s))]
+    mk_first_char_lit (HsString s) = ConPat charDataCon charTy [] [] [LitPat (HsCharPrim (_HEAD_ s)) charPrimTy]
 \end{code}
 
 

ghc/compiler/deSugar/MatchLit.lhs

@@ -73,8 +73,7 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal lit_t
 	mk_core_lit ty (HsFloatPrim   f) = MachFloat  f
 	mk_core_lit ty (HsDoublePrim  d) = MachDouble d
 	mk_core_lit ty (HsLitLit      s) = ASSERT(isUnLiftedType ty)
-          MachLitLit s (panic
-             "MatchLit.matchLiterals:mk_core_lit:HsLitLit; typePrimRep???")
+				           MachLitLit s ty
     	mk_core_lit ty other	         = panic "matchLiterals:mk_core_lit:unhandled"
 \end{code}
 

ghc/compiler/typecheck/TcPat.lhs

@@ -22,7 +22,7 @@ import Inst		( Inst, OverloadedLit(..), InstOrigin(..),
 			)
 import Name		( Name, getOccName, getSrcLoc )
 import FieldLabel	( fieldLabelName )
-import TcEnv		( tcLookupValue, 
+import TcEnv		( tcLookupValue, tcLookupClassByKey,
 			  tcLookupValueByKey, newLocalId, badCon
 			)
 import TcType 		( TcType, TcTyVar, tcInstTyVars, newTyVarTy )
@@ -33,7 +33,9 @@ import TcUnify 		( unifyTauTy, unifyListTy,
 
 import Bag		( Bag )
 import CmdLineOpts	( opt_IrrefutableTuples )
-import DataCon		( DataCon, dataConSig, dataConFieldLabels, dataConSourceArity )
+import DataCon		( DataCon, dataConSig, dataConFieldLabels, 
+			  dataConSourceArity
+			)
 import Id		( Id, idType, isDataConId_maybe )
 import Type		( Type, isTauTy, mkTyConApp, boxedTypeKind )
 import Subst		( substTy, substTheta )
@@ -42,7 +44,9 @@ import TysPrim		( charPrimTy, intPrimTy, floatPrimTy,
 			)
 import TysWiredIn	( charTy, stringTy, intTy )
 import SrcLoc		( SrcLoc )
-import Unique		( eqClassOpKey, geClassOpKey, minusClassOpKey )
+import Unique		( eqClassOpKey, geClassOpKey, minusClassOpKey,
+			  cCallableClassKey
+			)
 import Bag
 import Util		( zipEqual )
 import Outputable