From f91f525ef00bf1663d280f60f2d1f9ba17967d5a Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 9 Nov 1999 11:37:40 +0000 Subject: [PATCH] [project @ 1999-11-09 11:37:38 by simonmar] Fixes to Simon's lit-lit pattern commit --- ghc/compiler/deSugar/Check.lhs | 18 ++---------------- ghc/compiler/deSugar/DsUtils.lhs | 27 +++++++++++++++++++++------ ghc/compiler/deSugar/MatchLit.lhs | 3 +-- ghc/compiler/typecheck/TcPat.lhs | 10 +++++++--- 4 files changed, 31 insertions(+), 27 deletions(-) diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs index cefba7e..821332a 100644 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4