diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/parser/Parser.y | 43 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 6 |
2 files changed, 25 insertions, 24 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index ce5c523e6f..e33b715b51 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1142,20 +1142,20 @@ inst_decl :: { LInstDecl GhcPs } -- data/newtype instance declaration | data_or_newtype 'instance' capi_ctype tycl_hdr_inst constrs maybe_derivings - {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4 + {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4) Nothing (reverse (snd $ unLoc $5)) (fmap reverse $6)) - ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) } + ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)) } -- GADT instance declaration | data_or_newtype 'instance' capi_ctype tycl_hdr_inst opt_kind_sig gadt_constrlist maybe_derivings - {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4 + {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (snd $ unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6) (fmap reverse $7)) ((fst $ unLoc $1):mj AnnInstance $2 - :(fst $ unLoc $5)++(fst $ unLoc $6)) } + :(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) } overlap_pragma :: { Maybe (Located OverlapMode) } : '{-# OVERLAPPABLE' '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))) @@ -1241,8 +1241,8 @@ ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) } : 'forall' tv_bndrs '.' type '=' ktype {% do { hintExplicitForall (getLoc $1) ; (eqn,ann) <- mkTyFamInstEqn (Just $2) $4 $6 - ; ams (sLL $4 $> (mj AnnEqual $5:ann, eqn)) - [mu AnnForall $1, mj AnnDot $3] } } + ; return (sLL $1 $> + (mu AnnForall $1:mj AnnDot $3:mj AnnEqual $5:ann,eqn)) } } | type '=' ktype {% do { (eqn,ann) <- mkTyFamInstEqn Nothing $1 $3 ; return (sLL $1 $> (mj AnnEqual $2:ann, eqn)) } } @@ -1312,16 +1312,16 @@ at_decl_inst :: { LInstDecl GhcPs } -- data/newtype instance declaration, with optional 'instance' keyword -- (can't use opt_instance because you get reduce/reduce errors) | data_or_newtype capi_ctype tycl_hdr_inst constrs maybe_derivings - {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3 + {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 (snd $ unLoc $3) Nothing (reverse (snd $ unLoc $4)) (fmap reverse $5)) - ((fst $ unLoc $1):(fst $ unLoc $4)) } + ((fst $ unLoc $1):(fst $ unLoc $3) ++ (fst $ unLoc $4)) } | data_or_newtype 'instance' capi_ctype tycl_hdr_inst constrs maybe_derivings - {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4 + {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4) Nothing (reverse (snd $ unLoc $5)) (fmap reverse $6)) - ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) } + ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)) } -- GADT instance declaration, with optional 'instance' keyword -- (can't use opt_instance because you get reduce/reduce errors) @@ -1329,17 +1329,17 @@ at_decl_inst :: { LInstDecl GhcPs } gadt_constrlist maybe_derivings {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 - $3 (snd $ unLoc $4) (snd $ unLoc $5) + (snd $ unLoc $3) (snd $ unLoc $4) (snd $ unLoc $5) (fmap reverse $6)) - ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) } + ((fst $ unLoc $1):(fst $ unLoc $3)++(fst $ unLoc $4)++(fst $ unLoc $5)) } | data_or_newtype 'instance' capi_ctype tycl_hdr_inst opt_kind_sig gadt_constrlist maybe_derivings {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 - $4 (snd $ unLoc $5) (snd $ unLoc $6) + (snd $ unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6) (fmap reverse $7)) - ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)++(fst $ unLoc $6)) } + ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) } data_or_newtype :: { Located (AddAnn, NewOrData) } : 'data' { sL1 $1 (mj AnnData $1,DataType) } @@ -1382,20 +1382,21 @@ tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } } | type { sL1 $1 (Nothing, $1) } -tycl_hdr_inst :: { Located (Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs) } +tycl_hdr_inst :: { Located ([AddAnn],(Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs)) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall (getLoc $1) >> (addAnnotation (gl $4) (toUnicodeAnn AnnDarrow $5) (gl $5) - >> ams (sLL $1 $> $ (Just $4, Just $2, $6)) - [mu AnnForall $1, mj AnnDot $3]) + >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3] + , (Just $4, Just $2, $6))) + ) } | 'forall' tv_bndrs '.' type {% hintExplicitForall (getLoc $1) - >> ams (sLL $1 $> $ (Nothing, Just $2, $4)) - [mu AnnForall $1, mj AnnDot $3] + >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3] + , (Nothing, Just $2, $4))) } | context '=>' type {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) - >> (return (sLL $1 $> (Just $1, Nothing, $3))) + >> (return (sLL $1 $>([], (Just $1, Nothing, $3)))) } - | type { sL1 $1 (Nothing, Nothing, $1) } + | type { sL1 $1 ([], (Nothing, Nothing, $1)) } capi_ctype :: { Maybe (Located CType) } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 6a756544d9..0766b04ada 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -263,13 +263,13 @@ mkTyFamInstEqn bndrs lhs rhs mkDataFamInst :: SrcSpan -> NewOrData -> Maybe (Located CType) - -> Located ( Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs] - , LHsType GhcPs) + -> (Maybe ( LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs] + , LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> HsDeriving GhcPs -> P (LInstDecl GhcPs) -mkDataFamInst loc new_or_data cType (dL->L _ (mcxt, bndrs, tycl_hdr)) +mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) ksig data_cons maybe_deriv = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan |