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, 4 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)