Don't generate stub files when -fno-code is given.
[ghc-hetmet.git] / ghc / compiler / deSugar / MatchCon.lhs
index c76b748..6ff502a 100644 (file)
@@ -8,13 +8,15 @@ module MatchCon ( matchConFamily ) where
 
 #include "HsVersions.h"
 
+import Id( idType )
+
 import {-# SOURCE #-} Match    ( match )
 
 import HsSyn           ( Pat(..), HsConDetails(..) )
-import DsBinds         ( dsHsNestedBinds )
-import DataCon         ( isVanillaDataCon, dataConTyVars, dataConOrigArgTys )
+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 +127,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 +136,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}