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

Fixes to Simon's lit-lit pattern commit

diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs
index cefba7e..821332a 100644 (file)
--- a/ghc/compiler/deSugar/Check.lhs
+++ b/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 )

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index c1c822d..d029aee 100644 (file)
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/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}
 
 

diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index 5040362..af80397 100644 (file)
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/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}
 

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 2056b89..a708509 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/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