diff options
Diffstat (limited to 'compiler/GHC/Iface/Ext/Ast.hs')
| -rw-r--r-- | compiler/GHC/Iface/Ext/Ast.hs | 40 |
1 files changed, 27 insertions, 13 deletions
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 19f198e2c3..5fa5d0f281 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -1381,9 +1381,19 @@ instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg re toHie (RecCon rec) = toHie rec toHie (InfixCon a b) = concatM [ toHie a, toHie b] -instance ToHie (HsConDeclGADTDetails GhcRn) where - toHie (PrefixConGADT args) = toHie args - toHie (RecConGADT rec _) = toHie rec +instance ToHie (ConGadtSigBody GhcRn) where + toHie (PrefixConGADT body) = toHie body + toHie (RecConGADT flds _ res_ty) = concatM + [ toHie flds + , toHie res_ty + ] + +instance ToHie (PrefixConGadtSigBody GhcRn) where + toHie (PCGSRes res_ty) = toHie res_ty + toHie (PCGSAnonArg arg_ty body) = concatM + [ toHie arg_ty + , toHie body + ] instance HiePass p => ToHie (LocatedAn NoEpAnns (HsCmdTop (GhcPass p))) where toHie (L span top) = concatM $ makeNodeA top span : case top of @@ -1599,8 +1609,7 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where instance ToHie (LocatedA (ConDecl GhcRn)) where toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs - , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ - , con_doc = doc} -> + , con_mb_cxt = ctx, con_body = body, con_doc = doc } -> [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names , case outer_bndrs of HsOuterImplicit{hso_ximplicit = imp_vars} -> @@ -1609,18 +1618,23 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where HsOuterExplicit{hso_bndrs = exp_bndrs} -> toHie $ tvScopes resScope NoScope exp_bndrs , toHie ctx - , toHie args - , toHie typ + , toHie body , toHie doc ] where - rhsScope = combineScopes argsScope tyScope ctxScope = maybe NoScope mkLScopeA ctx - argsScope = case args of - PrefixConGADT xs -> scaled_args_scope xs - RecConGADT x _ -> mkLScopeA x - tyScope = mkLScopeA typ + rhsScope = case body of + PrefixConGADT prefix_body -> + prefix_con_gadt_sig_body_scope prefix_body + RecConGADT flds _ res_ty -> + combineScopes (mkLScopeA flds) (mkLScopeA res_ty) resScope = ResolvedScopes [ctxScope, rhsScope] + + prefix_con_gadt_sig_body_scope :: PrefixConGadtSigBody GhcRn -> Scope + prefix_con_gadt_sig_body_scope (PCGSRes res_ty) = mkLScopeA res_ty + prefix_con_gadt_sig_body_scope (PCGSAnonArg arg_ty body') = + combineScopes (mkLScopeA $ hsScaledThing arg_ty) + (prefix_con_gadt_sig_body_scope body') ConDeclH98 { con_name = name, con_ex_tvs = qvars , con_mb_cxt = ctx, con_args = dets , con_doc = doc} -> @@ -1637,7 +1651,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where PrefixCon _ xs -> scaled_args_scope xs InfixCon a b -> scaled_args_scope [a, b] RecCon x -> mkLScopeA x - where scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope + scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope scaled_args_scope = foldr combineScopes NoScope . map (mkLScopeA . hsScaledThing) instance ToHie (LocatedL [LocatedA (ConDeclField GhcRn)]) where |