Ticket #9023: fix_9023.patch

File fix_9023.patch, 2.3 KB (added by archblob, 15 months ago)
  • compiler/deSugar/MatchCon.lhs

    From 2717580d9fd0c65978ce3b77fd06fd9986de1040 Mon Sep 17 00:00:00 2001
    From: archblob <[email protected]>
    Date: Wed, 4 Jun 2014 18:24:41 +0300
    Subject: [PATCH] Fix #9023.
    
    ---
     compiler/deSugar/MatchCon.lhs | 25 +++++++++++++------------
     1 file changed, 13 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
    index ef74bff..e00b484 100644
    a b import Util 
    3333import ListSetOps ( runs )
    3434import Id
    3535import NameEnv
     36import VarSet
    3637import SrcLoc
    3738import DynFlags
    3839import Outputable
    matchOneConLike vars ty (eqn1 : eqns) -- All eqns for a single constructor 
    148149        RealDataCon dcon1 -> dataConFieldLabels dcon1
    149150        PatSynCon{} -> []
    150151
    151     arg_tys  = inst inst_tys
    152       where
    153         inst = case con1 of
    154             RealDataCon dcon1 -> dataConInstOrigArgTys dcon1
    155             PatSynCon psyn1 -> patSynInstArgTys psyn1
    156     inst_tys = tcTyConAppArgs pat_ty1 ++
    157                mkTyVarTys (takeList exVars tvs1)
     152    arg_tys =
     153      let exTys = mkTyVarTys (takeList exVars tvs1)
     154          tyConAppArgs = tcTyConAppArgs pat_ty1
     155          getTyVarTys = mkTyVarTys . varSetElems . tyVarsOfTypes
     156          exVars = case con1 of
     157                     RealDataCon dcon1 -> dataConExTyVars dcon1
     158                     PatSynCon psyn1 -> patSynExTyVars psyn1
     159      in case con1 of
     160           RealDataCon dcon1
     161             -> dataConInstOrigArgTys dcon1 $ tyConAppArgs ++ exTys
     162           PatSynCon psyn1
     163             -> patSynInstArgTys psyn1 $ (getTyVarTys tyConAppArgs) ++ exTys
    158164        -- Newtypes opaque, hence tcTyConAppArgs
    159165        -- dataConInstOrigArgTys takes the univ and existential tyvars
    160166        -- and returns the types of the *value* args, which is what we want
    161       where
    162         exVars = case con1 of
    163             RealDataCon dcon1 -> dataConExTyVars dcon1
    164             PatSynCon psyn1 -> patSynExTyVars psyn1
    165167
    166168    match_group :: [Id] -> [(ConArgPats, EquationInfo)] -> DsM MatchResult
    167169    -- All members of the group have compatible ConArgPats
    Originally I tried to use 
    294296        (\b -> let e = d in expr2) a
    295297to do this substitution.  While this is "correct" in a way, it fails
    296298Lint, because e::Ord b but d::Ord a. 
    297