Ticket #9023: fix_9023.patch

File fix_9023.patch, 2.3 KB (added by archblob, 11 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