Ticket #5886: ghc-th-tf_insts-in-cls_insts.patch

File ghc-th-tf_insts-in-cls_insts.patch, 2.3 KB (added by mikhail.vorozhtsov, 3 years ago)
  • compiler/hsSyn/Convert.lhs

    From 4565f14cc4e58eb3acd4e87f7d93fe8b19058607 Mon Sep 17 00:00:00 2001
    From: Mikhail Vorozhtsov <[email protected]>
    Date: Mon, 20 Feb 2012 18:11:54 +0700
    Subject: [PATCH] Fix TH decls partitioning in classes and instances.
    
    Related to f92591defcb5c4803c301558d51e3f8c9c92a985.
    ---
     compiler/hsSyn/Convert.lhs |   20 +++++++++++---------
     1 files changed, 11 insertions(+), 9 deletions(-)
    
    diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
    index 0d7c960..059801e 100644
    a b cvt_ci_decs :: MsgDoc -> [TH.Dec] 
    245245-- Convert the declarations inside a class or instance decl 
    246246-- ie signatures, bindings, and associated types 
    247247cvt_ci_decs doc decs 
    248   = do  { decs' <- mapM cvtDec decs 
    249         ; let (ats', bind_sig_decs') = partitionWith is_tycl decs' 
    250         ; let (sigs', prob_binds') = partitionWith is_sig bind_sig_decs' 
    251         ; let (binds', bads) = partitionWith is_bind prob_binds' 
    252         ; unless (null bads) (failWith (mkBadDecMsg doc bads)) 
    253         ; return (listToBag binds', sigs', ats') } 
     248  = do { decs' <- mapM cvtDec decs 
     249       ; let (ats', bind_sig_decs') = partitionWith is_ats decs' 
     250       ; let (sigs', prob_binds') = partitionWith is_sig bind_sig_decs' 
     251       ; let (binds', bads) = partitionWith is_bind prob_binds' 
     252       ; unless (null bads) (failWith (mkBadDecMsg doc bads)) 
     253       ; return (listToBag binds', sigs', ats') } 
    254254 
    255255---------------- 
    256256cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr] 
    cvt_tyinst_hdr cxt tc tys 
    298298--              Partitioning declarations 
    299299------------------------------------------------------------------- 
    300300 
    301 is_tycl :: LHsDecl RdrName -> Either (LTyClDecl RdrName) (LHsDecl RdrName) 
    302 is_tycl (L loc (Hs.TyClD tcd)) = Left (L loc tcd) 
    303 is_tycl decl                   = Right decl 
     301is_ats :: LHsDecl RdrName -> Either (LTyClDecl RdrName) (LHsDecl RdrName) 
     302is_ats (L loc (Hs.TyClD tcd@(TyFamily {})))                = Left (L loc tcd) 
     303is_ats (L loc (Hs.InstD (FamInstDecl tcd@(TyData {}))))    = Left (L loc tcd) 
     304is_ats (L loc (Hs.InstD (FamInstDecl tcd@(TySynonym {})))) = Left (L loc tcd) 
     305is_ats decl                                                = Right decl 
    304306 
    305307is_sig :: LHsDecl RdrName -> Either (LSig RdrName) (LHsDecl RdrName) 
    306308is_sig (L loc (Hs.SigD sig)) = Left (L loc sig)