X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FPprAbsC.lhs;h=197bee54cc6e70b48ebc40d215376d661fa3ffc2;hb=e1a4f2a5be6e4cd06d96b601fefd519c2569ba99;hp=67b22b551fb0293085c676c3b75acc274a709162;hpb=74b1006ed8565ff3c39edcdaf859d606dd652641;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 67b22b5..197bee5 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -28,8 +28,9 @@ import AbsCUtils ( getAmodeRep, nonemptyAbsC, import Constants ( mIN_UPD_SIZE ) import CallConv ( CallConv, callConvAttribute, cCallConv ) import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel, - isReadOnly, needsCDecl, pprCLabel, - mkReturnInfoLabel, mkReturnPtLabel, + needsCDecl, pprCLabel, + mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel, + mkStaticClosureLabel, CLabel, CLabelType(..), labelType, labelDynamic ) @@ -40,6 +41,9 @@ import Costs ( costs, addrModeCosts, CostRes(..), Side(..) ) import CStrings ( stringToC ) import FiniteMap ( addToFM, emptyFM, lookupFM, FiniteMap ) import Const ( Literal(..) ) +import TyCon ( tyConDataCons ) +import Name ( NamedThing(..) ) +import DataCon ( DataCon{-instance NamedThing-} ) import Maybes ( maybeToBool, catMaybes ) import PrimOp ( primOpNeedsWrapper, pprPrimOp, PrimOp(..) ) import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep ) @@ -139,10 +143,11 @@ pprAbsC (CReturn am return_info) c (hcat [text jmp_lit, target, pp_paren_semi ]) where target = case return_info of - DirectReturn -> hcat [char '(', pprAmode am, rparen] + DirectReturn -> hcat [ptext SLIT("ENTRY_CODE"), lparen, + pprAmode am, rparen] DynamicVectoredReturn am' -> mk_vector (pprAmode am') StaticVectoredReturn n -> mk_vector (int n) -- Always positive - mk_vector x = hcat [text "RET_VEC", char '(', pprAmode am, comma, + mk_vector x = hcat [ptext SLIT("RET_VEC"), char '(', pprAmode am, comma, x, rparen ] pprAbsC (CSplitMarker) _ = ptext SLIT("/* SPLIT */") @@ -223,15 +228,15 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _ the_op = ppr_op_call non_void_results non_void_args -- liveness mask is *in* the non_void_args in - case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) -> if primOpNeedsWrapper op then + case (ppr_vol_regs vol_regs) of { (pp_saves, pp_restores) -> vcat [ pp_saves, the_op, pp_restores ] + } else the_op - } where ppr_op_call results args = hcat [ pprPrimOp op, lparen, @@ -251,10 +256,6 @@ pprAbsC stmt@(CSRT lbl closures) c $$ nest 2 (hcat (punctuate comma (map pp_closure_lbl closures))) <> ptext SLIT("};") } - where - pp_closure_lbl lbl - | labelDynamic lbl = text "DLL_SRT_ENTRY" <> parens (pprCLabel lbl) - | otherwise = char '&' <> pprCLabel lbl pprAbsC stmt@(CBitmap lbl mask) c = vcat [ @@ -270,12 +271,12 @@ pprAbsC (CSimultaneous abs_c) c = hcat [ptext SLIT("{{"), pprAbsC abs_c c, ptext SLIT("}}")] pprAbsC (CCheck macro as code) c - = hcat [text (show macro), lparen, + = hcat [ptext (cCheckMacroText macro), lparen, hcat (punctuate comma (map ppr_amode as)), comma, pprAbsC code c, pp_paren_semi ] pprAbsC (CMacroStmt macro as) _ - = hcat [text (show macro), lparen, + = hcat [ptext (cStmtMacroText macro), lparen, hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] -- no casting pprAbsC (CCallProfCtrMacro op as) _ = hcat [ptext op, lparen, @@ -283,18 +284,51 @@ pprAbsC (CCallProfCtrMacro op as) _ pprAbsC (CCallProfCCMacro op as) _ = hcat [ptext op, lparen, hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] -pprAbsC stmt@(CCallTypedef op@(CCallOp op_str is_asm may_gc cconv) results args) _ - = hsep [ ptext SLIT("typedef") +pprAbsC stmt@(CCallTypedef is_tdef op@(CCallOp op_str is_asm may_gc cconv) results args) _ + = hsep [ ptext (if is_tdef then SLIT("typedef") else SLIT("extern")) , ccall_res_ty , fun_nm , parens (hsep (punctuate comma ccall_decl_ty_args)) ] <> semi where - fun_nm = parens (text (callConvAttribute cconv) <+> char '*' <> ccall_fun_ty) + {- + In the non-casm case, to ensure that we're entering the given external + entry point using the correct calling convention, we have to do the following: + + - When entering via a function pointer (the `dynamic' case) using the specified + calling convention, we emit a typedefn declaration attributed with the + calling convention to use together with the result and parameter types we're + assuming. Coerce the function pointer to this type and go. + + - to enter the function at a given code label, we emit an extern declaration + for the label here, stating the calling convention together with result and + argument types we're assuming. + + The C compiler will hopefully use this extern declaration to good effect, + reporting any discrepancies between our extern decl and any other that + may be in scope. + + Re: calling convention, notice that gcc (2.8.1 and egcs-1.0.2) will for + the external function `foo' use the calling convention of the first `foo' + prototype it encounters (nor does it complain about conflicting attribute + declarations). The consequence of this is that you cannot override the + calling convention of `foo' using an extern declaration (you'd have to use + a typedef), but why you would want to do such a thing in the first place + is totally beyond me. + + ToDo: petition the gcc folks to add code to warn about conflicting attribute + declarations. + + -} + + fun_nm + | is_tdef = parens (text (callConvAttribute cconv) <+> char '*' <> ccall_fun_ty) + | otherwise = text (callConvAttribute cconv) <+> ccall_fun_ty ccall_fun_ty = case op_str of Right u -> ptext SLIT("_ccall_fun_ty") <> ppr u + Left x -> ptext x ccall_res_ty = case non_void_results of @@ -302,7 +336,10 @@ pprAbsC stmt@(CCallTypedef op@(CCallOp op_str is_asm may_gc cconv) results args) [amode] -> text (showPrimRep (getAmodeRep amode)) _ -> panic "pprAbsC{CCallTypedef}: ccall_res_ty" - ccall_decl_ty_args = tail ccall_arg_tys + ccall_decl_ty_args + | is_tdef = tail ccall_arg_tys + | otherwise = ccall_arg_tys + ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args -- the first argument will be the "I/O world" token (a VoidRep) @@ -317,16 +354,16 @@ pprAbsC stmt@(CCallTypedef op@(CCallOp op_str is_asm may_gc cconv) results args) let nvrs = grab_non_void_amodes results in ASSERT (length nvrs <= 1) nvrs -pprAbsC (CCodeBlock label abs_C) _ +pprAbsC (CCodeBlock lbl abs_C) _ = if not (maybeToBool(nonemptyAbsC abs_C)) then - pprTrace "pprAbsC: curious empty code block for" (pprCLabel label) empty + pprTrace "pprAbsC: curious empty code block for" (pprCLabel lbl) empty else case (pprTempAndExternDecls abs_C) of { (pp_temps, pp_exts) -> vcat [ - hcat [text (if (externallyVisibleCLabel label) + hcat [text (if (externallyVisibleCLabel lbl) then "FN_(" -- abbreviations to save on output else "IFN_("), - pprCLabel label, text ") {"], + pprCLabel lbl, text ") {"], pp_exts, pp_temps, @@ -337,9 +374,9 @@ pprAbsC (CCodeBlock label abs_C) _ } -pprAbsC (CInitHdr cl_info reg_rel cost_centre) _ +pprAbsC (CInitHdr cl_info amode cost_centre) _ = hcat [ ptext SLIT("SET_HDR_"), char '(', - ppr_amode (CAddr reg_rel), comma, + ppr_amode amode, comma, pprCLabelAddr info_lbl, comma, if_profiling (pprAmode cost_centre), pp_paren_semi ] @@ -461,6 +498,15 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast cl_descr) _ pp_descr = hcat [char '"', text (stringToC cl_descr), char '"'] pp_type = hcat [char '"', text (stringToC (closureTypeDescr cl_info)), char '"'] +pprAbsC stmt@(CClosureTbl tycon) _ + = vcat ( + ptext SLIT("CLOSURE_TBL") <> + lparen <> pprCLabel (mkClosureTblLabel tycon) <> rparen : + punctuate comma ( + map (pp_closure_lbl . mkStaticClosureLabel . getName) (tyConDataCons tycon) + ) + ) $$ ptext SLIT("};") + pprAbsC stmt@(CRetDirect uniq code srt liveness) _ = vcat [ hcat [ @@ -488,33 +534,25 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _ LvSmall _ -> SLIT("RET_SMALL") LvLarge _ -> SLIT("RET_BIG") -pprAbsC stmt@(CRetVector label amodes srt liveness) _ - = vcat [ - pp_vector, +pprAbsC stmt@(CRetVector lbl amodes srt liveness) _ + = case (pprTempAndExternDecls stmt) of { (_, pp_exts) -> + vcat [ + pp_exts, hcat [ - ptext SLIT(" }"), comma, ptext SLIT("\n VEC_INFO_TABLE"), - lparen, - pp_liveness liveness, comma, -- bitmap liveness mask - pp_srt_info srt, -- SRT - ptext type_str, -- or big, depending on the size - -- of the liveness mask. - rparen - ], - text "};" + ptext SLIT("VEC_INFO_") <> int size, + lparen, + pprCLabel lbl, comma, + pp_liveness liveness, comma, -- bitmap liveness mask + pp_srt_info srt, -- SRT + ptext type_str, comma, + ppLocalness lbl, comma + ], + nest 2 (sep (punctuate comma (map ppr_item amodes))), + text ");" ] + } where - pp_vector = - case (pprTempAndExternDecls stmt) of { (_, pp_exts) -> - vcat [ - pp_exts, - hcat [ppLocalness label, - ptext SLIT(" vec_info_"), int size, space, - pprCLabel label, text "= { {" - ], - nest 2 (sep (punctuate comma (map ppr_item (reverse amodes)))) - ] } - ppr_item item = (<>) (text "(F_) ") (ppr_amode item) size = length amodes @@ -528,15 +566,10 @@ pprAbsC (CCostCentreStackDecl ccs) _ = pprCostCentreStackDecl ccs \end{code} \begin{code} -ppLocalness label - = (<>) static const - where - static = if (externallyVisibleCLabel label) +ppLocalness lbl + = if (externallyVisibleCLabel lbl) then empty else ptext SLIT("static ") - const = if not (isReadOnly label) - then empty - else ptext SLIT("const") -- Horrible macros for declaring the types and locality of labels (see -- StgMacros.h). @@ -546,13 +579,11 @@ ppLocalnessMacro include_dyn_prefix clabel = visiblity_prefix, dyn_prefix, case label_type of - ClosureType -> ptext SLIT("C_") - CodeType -> ptext SLIT("F_") - InfoTblType -> ptext SLIT("I_") - DataType -> ptext SLIT("D_") <> - if isReadOnly clabel - then ptext SLIT("RO_") - else empty + ClosureType -> ptext SLIT("C_") + CodeType -> ptext SLIT("F_") + InfoTblType -> ptext SLIT("I_") + ClosureTblType -> ptext SLIT("CP_") + DataType -> ptext SLIT("D_") ] where is_visible = externallyVisibleCLabel clabel @@ -628,6 +659,12 @@ pp_srt_info srt = \end{code} \begin{code} +pp_closure_lbl lbl + | labelDynamic lbl = text "DLL_SRT_ENTRY" <> parens (pprCLabel lbl) + | otherwise = char '&' <> pprCLabel lbl +\end{code} + +\begin{code} if_profiling pretty = if opt_SccProfilingOn then pretty @@ -742,7 +779,6 @@ pprCCall op@(CCallOp op_str is_asm may_gc cconv) args results vol_regs declare_local_vars, -- local var for *result* vcat local_arg_decls, pp_save_context, - declare_fun_extern, -- declare expected function type. process_casm local_vars pp_non_void_args casm_str, pp_restore_context, assign_results, @@ -751,8 +787,8 @@ pprCCall op@(CCallOp op_str is_asm may_gc cconv) args results vol_regs where (pp_saves, pp_restores) = ppr_vol_regs vol_regs (pp_save_context, pp_restore_context) - | may_gc = ( text "do { SaveThreadState();" - , text "LoadThreadState();} while(0);" + | may_gc = ( text "{ I_ id; SUSPEND_THREAD(id);" + , text "RESUME_THREAD(id);}" ) | otherwise = ( pp_basic_saves $$ pp_saves, pp_basic_restores $$ pp_restores) @@ -772,58 +808,6 @@ pprCCall op@(CCallOp op_str is_asm may_gc cconv) args results vol_regs (local_arg_decls, pp_non_void_args) = unzip [ ppr_casm_arg a i | (a,i) <- non_void_args `zip` [1..] ] - - {- - In the non-casm case, to ensure that we're entering the given external - entry point using the correct calling convention, we have to do the following: - - - When entering via a function pointer (the `dynamic' case) using the specified - calling convention, we emit a typedefn declaration attributed with the - calling convention to use together with the result and parameter types we're - assuming. Coerce the function pointer to this type and go. - - - to enter the function at a given code label, we emit an extern declaration - for the label here, stating the calling convention together with result and - argument types we're assuming. - - The C compiler will hopefully use this extern declaration to good effect, - reporting any discrepancies between our extern decl and any other that - may be in scope. - - Re: calling convention, notice that gcc (2.8.1 and egcs-1.0.2) will for - the external function `foo' use the calling convention of the first `foo' - prototype it encounters (nor does it complain about conflicting attribute - declarations). The consequence of this is that you cannot override the - calling convention of `foo' using an extern declaration (you'd have to use - a typedef), but why you would want to do such a thing in the first place - is totally beyond me. - - ToDo: petition the gcc folks to add code to warn about conflicting attribute - declarations. - - -} - declare_fun_extern - | is_dynamic || is_asm || not opt_EmitCExternDecls = empty - | otherwise = - hsep [ typedef_or_extern - , ccall_res_ty - , fun_nm - , parens (hsep (punctuate comma ccall_decl_ty_args)) - ] <> semi - where - typedef_or_extern - | is_dynamic = ptext SLIT("typedef") - | otherwise = ptext SLIT("extern") - - fun_nm - | is_dynamic = parens (text (callConvAttribute cconv) <+> char '*' <> ccall_fun_ty) - | otherwise = text (callConvAttribute cconv) <+> ptext asm_str - - -- leave out function pointer - ccall_decl_ty_args - | is_dynamic = tail ccall_arg_tys - | otherwise = ccall_arg_tys - ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args ccall_res_ty = @@ -1035,13 +1019,13 @@ pprAssign Word64Rep dest@(CVal reg_rel _) src Lastly, the question is: will the C compiler think the types of the two sides of the assignment match? - We assume that the types will match - if neither side is a @CVal@ addressing mode for any register - which can point into the heap or B stack. + We assume that the types will match if neither side is a + @CVal@ addressing mode for any register which can point into + the heap or stack. -Why? Because the heap and B stack are used to store miscellaneous things, -whereas the A stack, temporaries, registers, etc., are only used for things -of fixed type. +Why? Because the heap and stack are used to store miscellaneous +things, whereas the temporaries, registers, etc., are only used for +things of fixed type. \begin{code} pprAssign kind (CReg (VanillaReg _ dest)) (CReg (VanillaReg _ src)) @@ -1136,16 +1120,13 @@ ppr_amode (CReg magic_id) = pprMagicId magic_id ppr_amode (CTemp uniq kind) = char '_' <> pprUnique uniq <> char '_' -ppr_amode (CLbl label kind) = pprCLabelAddr label +ppr_amode (CLbl lbl kind) = pprCLabelAddr lbl ppr_amode (CCharLike ch) = hcat [ptext SLIT("CHARLIKE_CLOSURE"), char '(', pprAmode ch, rparen ] ppr_amode (CIntLike int) = hcat [ptext SLIT("INTLIKE_CLOSURE"), char '(', pprAmode int, rparen ] -ppr_amode (CString str) = hcat [char '"', text (stringToC (_UNPK_ str)), char '"'] - -- ToDo: are these *used* for anything? - ppr_amode (CLit lit) = pprBasicLit lit ppr_amode (CLitLit str _) = ptext str @@ -1153,17 +1134,50 @@ ppr_amode (CLitLit str _) = ptext str ppr_amode (CJoinPoint _) = panic "ppr_amode: CJoinPoint" -ppr_amode (CTableEntry base index kind) - = hcat [text "((", pprPrimKind kind, text " *)(", - ppr_amode base, text "))[(I_)(", ppr_amode index, - ptext SLIT(")]")] - ppr_amode (CMacroExpr pk macro as) - = parens (pprPrimKind pk) <+> - parens (text (show macro) <> + = parens (pprPrimKind pk) <> + parens (ptext (cExprMacroText macro) <> parens (hcat (punctuate comma (map pprAmode as)))) \end{code} +\begin{code} +cExprMacroText ENTRY_CODE = SLIT("ENTRY_CODE") +cExprMacroText ARG_TAG = SLIT("ARG_TAG") +cExprMacroText GET_TAG = SLIT("GET_TAG") +cExprMacroText UPD_FRAME_UPDATEE = SLIT("UPD_FRAME_UPDATEE") + +cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK") +cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE") +cStmtMacroText UPD_CAF = SLIT("UPD_CAF") +cStmtMacroText UPD_BH_UPDATABLE = SLIT("UPD_BH_UPDATABLE") +cStmtMacroText UPD_BH_SINGLE_ENTRY = SLIT("UPD_BH_SINGLE_ENTRY") +cStmtMacroText PUSH_UPD_FRAME = SLIT("PUSH_UPD_FRAME") +cStmtMacroText PUSH_SEQ_FRAME = SLIT("PUSH_SEQ_FRAME") +cStmtMacroText UPDATE_SU_FROM_UPD_FRAME = SLIT("UPDATE_SU_FROM_UPD_FRAME") +cStmtMacroText SET_TAG = SLIT("SET_TAG") +cStmtMacroText GRAN_FETCH = SLIT("GRAN_FETCH") +cStmtMacroText GRAN_RESCHEDULE = SLIT("GRAN_RESCHEDULE") +cStmtMacroText GRAN_FETCH_AND_RESCHEDULE= SLIT("GRAN_FETCH_AND_RESCHEDULE") +cStmtMacroText THREAD_CONTEXT_SWITCH = SLIT("THREAD_CONTEXT_SWITCH") +cStmtMacroText GRAN_YIELD = SLIT("GRAN_YIELD") + +cCheckMacroText HP_CHK_NP = SLIT("HP_CHK_NP") +cCheckMacroText STK_CHK_NP = SLIT("STK_CHK_NP") +cCheckMacroText HP_STK_CHK_NP = SLIT("HP_STK_CHK_NP") +cCheckMacroText HP_CHK_SEQ_NP = SLIT("HP_CHK_SEQ_NP") +cCheckMacroText HP_CHK = SLIT("HP_CHK") +cCheckMacroText STK_CHK = SLIT("STK_CHK") +cCheckMacroText HP_STK_CHK = SLIT("HP_STK_CHK") +cCheckMacroText HP_CHK_NOREGS = SLIT("HP_CHK_NOREGS") +cCheckMacroText HP_CHK_UNPT_R1 = SLIT("HP_CHK_UNPT_R1") +cCheckMacroText HP_CHK_UNBX_R1 = SLIT("HP_CHK_UNBX_R1") +cCheckMacroText HP_CHK_F1 = SLIT("HP_CHK_F1") +cCheckMacroText HP_CHK_D1 = SLIT("HP_CHK_D1") +cCheckMacroText HP_CHK_L1 = SLIT("HP_CHK_L1") +cCheckMacroText HP_CHK_UT_ALT = SLIT("HP_CHK_UT_ALT") +cCheckMacroText HP_CHK_GEN = SLIT("HP_CHK_GEN") +\end{code} + %************************************************************************ %* * \subsection[ppr-liveness-masks]{Liveness Masks} @@ -1174,8 +1188,12 @@ ppr_amode (CMacroExpr pk macro as) pp_liveness :: Liveness -> SDoc pp_liveness lv = case lv of - LvSmall mask -> int (intBS mask) LvLarge lbl -> char '&' <> pprCLabel lbl + LvSmall mask + | bitmap_int == (minBound :: Int) -> int (bitmap_int+1) <> text "-1" + | otherwise -> int bitmap_int + where + bitmap_int = intBS mask \end{code} %************************************************************************ @@ -1222,6 +1240,11 @@ pprRegRelative sign_wanted (NodeRel o) else (pp_Node, Just (addPlusSign sign_wanted (int off))) +pprRegRelative sign_wanted (CIndex base offset kind) + = ( hcat [text "((", pprPrimKind kind, text " *)(", ppr_amode base, text "))"] + , Just (hcat [if sign_wanted then char '+' else empty, + text "(I_)(", ppr_amode offset, ptext SLIT(")")]) + ) \end{code} @pprMagicId@ just prints the register name. @VanillaReg@ registers are @@ -1373,11 +1396,11 @@ tempSeenTE uniq env@(seen_uniqs, seen_labels) False) labelSeenTE :: CLabel -> TeM Bool -labelSeenTE label env@(seen_uniqs, seen_labels) - = if (label `elementOfCLabelSet` seen_labels) +labelSeenTE lbl env@(seen_uniqs, seen_labels) + = if (lbl `elementOfCLabelSet` seen_labels) then (env, True) else ((seen_uniqs, - addToCLabelSet seen_labels label), + addToCLabelSet seen_labels lbl), False) \end{code} @@ -1430,7 +1453,7 @@ ppr_decls_AbsC (CSwitch discrim alts deflt) where ppr_alt_stuff (_, absC) = ppr_decls_AbsC absC -ppr_decls_AbsC (CCodeBlock label absC) +ppr_decls_AbsC (CCodeBlock lbl absC) = ppr_decls_AbsC absC ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre) @@ -1490,10 +1513,11 @@ ppr_decls_AbsC (CRetVector _ amodes _ _) = ppr_decls_Amodes amodes \begin{code} ppr_decls_Amode :: CAddrMode -> TeM (Maybe SDoc, Maybe SDoc) +ppr_decls_Amode (CVal (CIndex base offset _) _) = ppr_decls_Amodes [base,offset] +ppr_decls_Amode (CAddr (CIndex base offset _)) = ppr_decls_Amodes [base,offset] ppr_decls_Amode (CVal _ _) = returnTE (Nothing, Nothing) ppr_decls_Amode (CAddr _) = returnTE (Nothing, Nothing) ppr_decls_Amode (CReg _) = returnTE (Nothing, Nothing) -ppr_decls_Amode (CString _) = returnTE (Nothing, Nothing) ppr_decls_Amode (CLit _) = returnTE (Nothing, Nothing) ppr_decls_Amode (CLitLit _ _) = returnTE (Nothing, Nothing) @@ -1513,18 +1537,13 @@ ppr_decls_Amode (CTemp uniq kind) returnTE (if temp_seen then Nothing else Just (pprTempDecl uniq kind), Nothing) -ppr_decls_Amode (CLbl label VoidRep) +ppr_decls_Amode (CLbl lbl VoidRep) = returnTE (Nothing, Nothing) -ppr_decls_Amode (CLbl label kind) - = labelSeenTE label `thenTE` \ label_seen -> +ppr_decls_Amode (CLbl lbl kind) + = labelSeenTE lbl `thenTE` \ label_seen -> returnTE (Nothing, - if label_seen then Nothing else Just (pprExternDecl False{-not in an SRT decl-} label)) - -ppr_decls_Amode (CTableEntry base index _) - = ppr_decls_Amode base `thenTE` \ p1 -> - ppr_decls_Amode index `thenTE` \ p2 -> - returnTE (maybe_vcat [p1, p2]) + if label_seen then Nothing else Just (pprExternDecl False{-not in an SRT decl-} lbl)) ppr_decls_Amode (CMacroExpr _ _ amodes) = ppr_decls_Amodes amodes