[project @ 2000-08-17 16:28:44 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index f5045e4..e5b8847 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -8,8 +8,6 @@ module TcPat ( tcPat, tcPatBndr_NoSigs, badFieldCon, polyPatSig ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}  TcExpr( tcExpr )
-
 import HsSyn           ( InPat(..), OutPat(..), HsLit(..), HsExpr(..), Sig(..) )
 import RnHsSyn         ( RenamedPat )
 import TcHsSyn         ( TcPat, TcId )
@@ -34,13 +32,11 @@ import DataCon              ( DataCon, dataConSig, dataConFieldLabels,
                        )
 import Id              ( Id, idType, isDataConWrapId_maybe )
 import Type            ( Type, isTauTy, mkTyConApp, mkClassPred, boxedTypeKind )
-import PprType         ( {- instance Outputable Type -} )
 import Subst           ( substTy, substClasses )
 import TysPrim         ( charPrimTy, intPrimTy, floatPrimTy,
                          doublePrimTy, addrPrimTy
                        )
 import TysWiredIn      ( charTy, stringTy, intTy )
-import SrcLoc          ( SrcLoc )
 import Unique          ( eqClassOpKey, geClassOpKey, minusClassOpKey,
                          cCallableClassKey
                        )
@@ -217,9 +213,11 @@ tcPat tc_bndr pat@(RecPatIn name rpats) pat_ty
        -- Check the constructor itself
     tcConstructor pat name pat_ty      `thenTc` \ (data_con, ex_tvs, dicts, lie_avail1, arg_tys) ->
     let
-       field_tys = zipEqual "tcPat" 
-                            (map fieldLabelName (dataConFieldLabels data_con))
-                            arg_tys
+       -- not zipEqual: if the constructor isn't really a record, then
+       -- dataConFieldLabels will be empty (and each field in the pattern
+       -- will generate an error below).
+       field_tys = zip (map fieldLabelName (dataConFieldLabels data_con))
+                       arg_tys
     in
 
        -- Check the fields
@@ -396,7 +394,7 @@ tcConstructor pat con_name pat_ty
 
        -- Instantiate it
     let 
-       (tvs, theta, ex_tvs, ex_theta, arg_tys, tycon) = dataConSig data_con
+       (tvs, _, ex_tvs, ex_theta, arg_tys, tycon) = dataConSig data_con
             -- Ignore the theta; overloaded constructors only
             -- behave differently when called, not when used for
             -- matching.