X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchCon.lhs;h=bba9d42815bec4f1a98cf105e9a33d1951ffa1f6;hb=ed8a98a544e23108c09c4b6b5411d30795ce2a5f;hp=3baa9666e98df957380243f00cb0ec521a6fb478;hpb=ea722559243ea0640903b1ac663563cd7eb8d7e9;p=ghc-hetmet.git diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs index 3baa966..bba9d42 100644 --- a/compiler/deSugar/MatchCon.lhs +++ b/compiler/deSugar/MatchCon.lhs @@ -15,8 +15,6 @@ Pattern-matching constructors module MatchCon ( matchConFamily ) where --- XXX This define is a bit of a hack, and should be done more nicely -#define FAST_STRING_NOT_NEEDED 1 #include "HsVersions.h" import {-# SOURCE #-} Match ( match ) @@ -27,6 +25,7 @@ import DataCon import TcType import Type import CoreSyn +import MkCore import DsMonad import DsUtils import Util ( takeList ) @@ -104,7 +103,7 @@ matchOneCon vars ty (eqn1 : eqns) -- All eqns for a single constructor = do { (wraps, eqns') <- mapAndUnzipM shift (eqn1:eqns) ; arg_vars <- selectMatchVars (take (dataConSourceArity con1) (eqn_pats (head eqns'))) - -- Use the new arugment patterns as a source of + -- Use the new argument patterns as a source of -- suggestions for the new variables ; match_result <- match (arg_vars ++ vars) ty eqns' ; return (con1, tvs1 ++ dicts1 ++ arg_vars, @@ -126,7 +125,7 @@ matchOneCon vars ty (eqn1 : eqns) -- All eqns for a single constructor = do { prs <- dsLHsBinds bind ; return (wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) - . mkDsLet (Rec prs), + . mkCoreLet (Rec prs), eqn { eqn_pats = conArgPats con1 arg_tys args ++ pats }) } conArgPats :: DataCon