[project @ 2005-10-27 14:35:20 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / MatchCon.lhs

diff --git a/ghc/compiler/deSugar/MatchCon.lhs b/ghc/compiler/deSugar/MatchCon.lhs
index a84c96d..90675fb 100644 (file)
--- a/ghc/compiler/deSugar/MatchCon.lhs
+++ b/ghc/compiler/deSugar/MatchCon.lhs
@@ -10,11 +10,11 @@ module MatchCon ( matchConFamily ) where
 
 import {-# SOURCE #-} Match    ( match )
 
-import HsSyn           ( Pat(..), HsConDetails(..), isEmptyLHsBinds )
-import DsBinds         ( dsHsNestedBinds )
-import DataCon         ( isVanillaDataCon, dataConTyVars, dataConOrigArgTys )
+import HsSyn           ( Pat(..), HsConDetails(..) )
+import DsBinds         ( dsLHsBinds )
+import DataCon         ( isVanillaDataCon, dataConInstOrigArgTys )
 import TcType          ( tcTyConAppArgs )
-import Type            ( substTys, zipTopTvSubst, mkTyVarTys )
+import Type            ( mkTyVarTys )
 import CoreSyn
 import DsMonad
 import DsUtils
@@ -125,7 +125,7 @@ match_con vars ty eqns
 
     shift eqn@(EqnInfo { eqn_wrap = wrap, 
                         eqn_pats = ConPatOut _ tvs ds bind (PrefixCon arg_pats) _ : pats })
-       = do { prs <- dsHsNestedBinds bind
+       = do { prs <- dsLHsBinds bind
             ; return (eqn { eqn_wrap = wrap . wrapBinds (tvs `zip` tvs1) 
                                             . wrapBinds (ds  `zip` dicts1)
                                             . mkDsLet (Rec prs),
@@ -134,8 +134,7 @@ match_con vars ty eqns
        -- Get the arg types, which we use to type the new vars
        -- to match on, from the "outside"; the types of pats1 may 
        -- be more refined, and hence won't do
-    arg_tys = substTys (zipTopTvSubst (dataConTyVars con) inst_tys)
-                      (dataConOrigArgTys con)
+    arg_tys = dataConInstOrigArgTys con inst_tys
     inst_tys | isVanillaDataCon con = tcTyConAppArgs pat_ty    -- Newtypes opaque!
             | otherwise            = mkTyVarTys tvs1
 \end{code}