mkConEntryLabel,
mkStaticConEntryLabel,
mkRednCountsLabel,
+ mkConInfoTableLabel,
mkPhantomInfoTableLabel,
+ mkStaticClosureLabel,
mkStaticInfoTableLabel,
mkVapEntryLabel,
mkVapInfoTableLabel,
needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
- pprCLabel, pprCLabel_asm
-
-#ifdef GRAN
- , isSlowEntryCCodeBlock
+ pprCLabel
+#if ! OMIT_NATIVE_CODEGEN
+ , pprCLabel_asm
#endif
) where
-import Ubiq{-uitous-}
-import AbsCLoop ( CtrlReturnConvention(..),
+IMP_Ubiq(){-uitous-}
+IMPORT_DELOOPER(AbsCLoop) ( CtrlReturnConvention(..),
ctrlReturnConvAlg
)
-import NcgLoop ( underscorePrefix, fmtAsmLbl )
+#if ! OMIT_NATIVE_CODEGEN
+IMPORT_DELOOPER(NcgLoop) ( underscorePrefix, fmtAsmLbl )
+#endif
import CStrings ( pp_cSEP )
import Id ( externallyVisibleId, cmpId_withSpecDataCon,
isConstMethodId_maybe,
isDefaultMethodId_maybe,
isSuperDictSelId_maybe, fIRST_TAG,
- ConTag(..), GenId{-instance Outputable-}
+ SYN_IE(ConTag), GenId{-instance Outputable-}
)
import Maybes ( maybeToBool )
import PprStyle ( PprStyle(..) )
import PprType ( showTyCon, GenType{-instance Outputable-} )
-import Pretty ( prettyToUn )
+import Pretty ( prettyToUn{-, ppPStr ToDo:rm-} )
import TyCon ( TyCon{-instance Eq-} )
import Unique ( showUnique, pprUnique, Unique{-instance Eq-} )
import Unpretty -- NOTE!! ********************
-import Util ( assertPanic )
+import Util ( assertPanic{-, pprTraceToDo:rm-} )
\end{code}
things we want to find out:
\begin{code}
data CLabelId = CLabelId Id
+instance Ord3 CLabelId where
+ cmp (CLabelId a) (CLabelId b) = cmpId_withSpecDataCon a b
+
instance Eq CLabelId where
- CLabelId a == CLabelId b = case cmpId_withSpecDataCon a b of { EQ_ -> True; _ -> False }
- CLabelId a /= CLabelId b = case cmpId_withSpecDataCon a b of { EQ_ -> False; _ -> True }
+ CLabelId a == CLabelId b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
+ CLabelId a /= CLabelId b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
instance Ord CLabelId where
- CLabelId a <= CLabelId b = case cmpId_withSpecDataCon a b
- of { LT_ -> True; EQ_ -> True; GT__ -> False }
- CLabelId a < CLabelId b = case cmpId_withSpecDataCon a b
- of { LT_ -> True; EQ_ -> False; GT__ -> False }
- CLabelId a >= CLabelId b = case cmpId_withSpecDataCon a b
- of { LT_ -> False; EQ_ -> True; GT__ -> True }
- CLabelId a > CLabelId b = case cmpId_withSpecDataCon a b
- of { LT_ -> False; EQ_ -> False; GT__ -> True }
- _tagCmp (CLabelId a) (CLabelId b) = case cmpId_withSpecDataCon a b
- of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
+ CLabelId a <= CLabelId b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
+ CLabelId a < CLabelId b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
+ CLabelId a >= CLabelId b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
+ CLabelId a > CLabelId b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
+ _tagCmp (CLabelId a) (CLabelId b) = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
\end{code}
\begin{code}
data IdLabelInfo
= Closure -- Label for (static???) closure
+ | StaticClosure -- Static closure -- e.g., nullary constructor
| InfoTbl -- Info table for a closure; always read-only
-- encoded into the name)
| ConEntry -- the only kind of entry pt for constructors
- | StaticConEntry -- static constructor entry point
+ | ConInfoTbl -- corresponding info table
+ | StaticConEntry -- static constructor entry point
| StaticInfoTbl -- corresponding info table
| PhantomInfoTbl -- for phantom constructors that only exist in regs
| VapInfoTbl Bool -- True <=> the update-reqd version; False <=> the no-update-reqd version
- | VapEntry Bool
+ | VapEntry Bool
-- Ticky-ticky counting
| RednCounts -- Label of place to keep reduction-count info for this Id
\end{code}
\begin{code}
-mkClosureLabel id = IdLabel (CLabelId id) Closure
-mkInfoTableLabel id = IdLabel (CLabelId id) InfoTbl
-mkStdEntryLabel id = IdLabel (CLabelId id) EntryStd
+mkClosureLabel id = IdLabel (CLabelId id) Closure
+mkInfoTableLabel id = IdLabel (CLabelId id) InfoTbl
+mkStdEntryLabel id = IdLabel (CLabelId id) EntryStd
mkFastEntryLabel id arity = ASSERT(arity > 0)
- IdLabel (CLabelId id) (EntryFast arity)
-mkConEntryLabel id = IdLabel (CLabelId id) ConEntry
-mkStaticConEntryLabel id = IdLabel (CLabelId id) StaticConEntry
-mkRednCountsLabel id = IdLabel (CLabelId id) RednCounts
-mkPhantomInfoTableLabel id = IdLabel (CLabelId id) PhantomInfoTbl
-mkStaticInfoTableLabel id = IdLabel (CLabelId id) StaticInfoTbl
-mkVapEntryLabel id upd_flag = IdLabel (CLabelId id) (VapEntry upd_flag)
-mkVapInfoTableLabel id upd_flag = IdLabel (CLabelId id) (VapInfoTbl upd_flag)
+ IdLabel (CLabelId id) (EntryFast arity)
+
+mkStaticClosureLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) StaticClosure
+mkStaticInfoTableLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) StaticInfoTbl
+mkConInfoTableLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) ConInfoTbl
+mkPhantomInfoTableLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) PhantomInfoTbl
+mkConEntryLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) ConEntry
+mkStaticConEntryLabel con = ASSERT(isDataCon con)
+ IdLabel (CLabelId con) StaticConEntry
+
+mkRednCountsLabel id = IdLabel (CLabelId id) RednCounts
+mkVapEntryLabel id upd_flag = IdLabel (CLabelId id) (VapEntry upd_flag)
+mkVapInfoTableLabel id upd_flag = IdLabel (CLabelId id) (VapInfoTbl upd_flag)
mkConUpdCodePtrVecLabel tycon tag = TyConLabel tycon (VecConUpdCode tag)
mkStdUpdCodePtrVecLabel tycon tag = TyConLabel tycon (StdUpdCode tag)
Whether the labelled thing can be put in C "text space":
\begin{code}
-isReadOnly (IdLabel _ InfoTbl) = True -- info-tables: yes
-isReadOnly (IdLabel _ StaticInfoTbl) = True -- and so on, for other
-isReadOnly (IdLabel _ PhantomInfoTbl) = True
-isReadOnly (IdLabel _ (VapInfoTbl _)) = True
-isReadOnly (IdLabel _ other) = False -- others: pessimistically, no
+isReadOnly (IdLabel _ InfoTbl) = True -- info-tables: yes
+isReadOnly (IdLabel _ ConInfoTbl) = True -- and so on, for other
+isReadOnly (IdLabel _ StaticInfoTbl) = True
+isReadOnly (IdLabel _ PhantomInfoTbl) = True
+isReadOnly (IdLabel _ (VapInfoTbl _)) = True
+isReadOnly (IdLabel _ other) = False -- others: pessimistically, no
isReadOnly (TyConLabel _ _) = True
isReadOnly (CaseLabel _ _) = True
is_SuperDictSelId id = maybeToBool (isSuperDictSelId_maybe id)
\end{code}
-These GRAN functions are needed for spitting out GRAN_FETCH() at the
+OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
right places. It is used to detect when the abstractC statement of an
CCodeBlock actually contains the code for a slow entry point. -- HWL
-\begin{code}
-#ifdef GRAN
-
-isSlowEntryCCodeBlock :: CLabel -> Bool
-isSlowEntryCCodeBlock _ = False
--- Worth keeping? ToDo (WDP)
-
-#endif {-GRAN-}
-\end{code}
-
We need at least @Eq@ for @CLabels@, because we want to avoid
duplicate declarations in generating C (see @labelSeenTE@ in
@PprAbsC@).
\begin{code}
-- specialised for PprAsm: saves lots of arg passing in NCG
+#if ! OMIT_NATIVE_CODEGEN
pprCLabel_asm = pprCLabel (PprForAsm underscorePrefix fmtAsmLbl)
+#endif
pprCLabel :: PprStyle -> CLabel -> Unpretty
prLbl = pprCLabel PprForC lbl
pprCLabel sty (TyConLabel tc UnvecConUpdCode)
- = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc),
+ = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, uppPStr SLIT("upd")]
pprCLabel sty (TyConLabel tc (VecConUpdCode tag))
- = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc), pp_cSEP,
+ = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
uppInt tag, pp_cSEP, uppPStr SLIT("upd")]
pprCLabel sty (TyConLabel tc (StdUpdCode tag))
VectoredReturn _ -> uppBeside (uppPStr SLIT("IndUpdRetV")) (uppInt (tag - fIRST_TAG))
pprCLabel sty (TyConLabel tc InfoTblVecTbl)
- = uppBesides [uppStr (showTyCon sty tc), pp_cSEP, uppPStr SLIT("itblvtbl")]
+ = uppBesides [ppr_tycon sty tc, pp_cSEP, uppPStr SLIT("itblvtbl")]
pprCLabel sty (TyConLabel tc StdUpdVecTbl)
- = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, uppStr (showTyCon sty tc),
+ = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, uppPStr SLIT("upd")]
pprCLabel sty (CaseLabel u CaseReturnPt)
ppr_u u = prettyToUn (pprUnique u)
+ppr_tycon sty tc
+ = let
+ str = showTyCon sty tc
+ in
+ --pprTrace "ppr_tycon:" (ppStr str) $
+ uppStr str
+
ppFlavor :: IdLabelInfo -> Unpretty
ppFlavor x = uppBeside pp_cSEP
EntryStd -> uppPStr SLIT("entry")
EntryFast arity -> --false:ASSERT (arity > 0)
uppBeside (uppPStr SLIT("fast")) (uppInt arity)
- ConEntry -> uppPStr SLIT("entry")
+ StaticClosure -> uppPStr SLIT("static_closure")
+ ConEntry -> uppPStr SLIT("con_entry")
+ ConInfoTbl -> uppPStr SLIT("con_info")
StaticConEntry -> uppPStr SLIT("static_entry")
StaticInfoTbl -> uppPStr SLIT("static_info")
PhantomInfoTbl -> uppPStr SLIT("inregs_info")
projects / ghc-hetmet.git / blobdiff