Skip to content
GitLab
Commit dcef38ba authored by sof's avatar sof
Browse files

[project @ 1997-05-19 00:12:10 by sof] 

2.04 changes
parent f1815aa4
Expand all Hide whitespace changes
Inline Side-by-side
ghc/compiler/absCSyn/AbsCLoop.hs 0 → 100644
View file @ dcef38ba
module AbsCLoop
(
module MachMisc,
module CLabel,
module ClosureInfo,
module CgRetConv
)where
import MachMisc
import CLabel
import ClosureInfo
import CgRetConv
ghc/compiler/absCSyn/AbsCSyn.lhs
View file @ dcef38ba
......@@ -36,6 +36,7 @@ module AbsCSyn {- (
)-} where
IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(AbsCLoop)
import Constants ( mAX_Vanilla_REG, mAX_Float_REG,
mAX_Double_REG, lIVENESS_R1, lIVENESS_R2,
......@@ -43,10 +44,15 @@ import Constants ( mAX_Vanilla_REG, mAX_Float_REG,
lIVENESS_R6, lIVENESS_R7, lIVENESS_R8
)
import HeapOffs ( SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
SYN_IE(VirtualHeapOffset)
SYN_IE(VirtualHeapOffset), HeapOffset
)
import Literal ( mkMachInt )
import CLabel ( CLabel )
import CostCentre ( CostCentre )
import Literal ( mkMachInt, Literal )
import PrimRep ( isFollowableRep, PrimRep(..) )
import PrimOp ( PrimOp )
import Unique ( Unique )
\end{code}
@AbstractC@ is a list of Abstract~C statements, but the data structure
......
ghc/compiler/absCSyn/AbsCUtils.lhs
View file @ dcef38ba
......@@ -23,15 +23,15 @@ IMP_Ubiq(){-uitous-}
import AbsCSyn
import CLabel ( mkReturnPtLabel )
import Digraph ( stronglyConnComp )
import CLabel ( mkReturnPtLabel, CLabel )
import Digraph ( stronglyConnComp, SCC(..) )
import HeapOffs ( possiblyEqualHeapOffset )
import Id ( fIRST_TAG, SYN_IE(ConTag) )
import Literal ( literalPrimRep, Literal(..) )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import Unique ( Unique{-instance Eq-} )
import UniqSupply ( getUnique, getUniques, splitUniqSupply )
import Util ( panic )
import UniqSupply ( getUnique, getUniques, splitUniqSupply, UniqSupply )
import Util ( assocDefaultUsing, panic, Ord3(..) )
infixr 9 `thenFlt`
\end{code}
......@@ -628,38 +628,22 @@ sameAmode other1 other2 = False
doSimultaneously1 :: [CVertex] -> FlatM AbstractC
doSimultaneously1 vertices
= let
edges :: [CEdge]
edges = concat (map edges_from vertices)
edges_from :: CVertex -> [CEdge]
edges_from v1 = [(v1,v2) | v2 <- vertices, v1 `should_follow` v2]
should_follow :: CVertex -> CVertex -> Bool
(n1, CAssign dest1 _) `should_follow` (n2, CAssign _ src2)
= dest1 `conflictsWith` src2
(n1, COpStmt dests1 _ _ _ _) `should_follow` (n2, CAssign _ src2)
= or [dest1 `conflictsWith` src2 | dest1 <- dests1]
(n1, CAssign dest1 _)`should_follow` (n2, COpStmt _ _ srcs2 _ _)
= or [dest1 `conflictsWith` src2 | src2 <- srcs2]
(n1, COpStmt dests1 _ _ _ _) `should_follow` (n2, COpStmt _ _ srcs2 _ _)
= or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
-- (_, COpStmt _ _ _ _ _) `should_follow` (_, CCallProfCtrMacro _ _) = False
-- (_, CCallProfCtrMacro _ _) `should_follow` (_, COpStmt _ _ _ _ _) = False
eq_vertex :: CVertex -> CVertex -> Bool
(n1, _) `eq_vertex` (n2, _) = n1 == n2
components = stronglyConnComp eq_vertex edges vertices
edges = [ (vertex, key1, edges_from stmt1)
| vertex@(key1, stmt1) <- vertices
]
edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
stmt1 `should_follow` stmt2
]
components = stronglyConnComp edges
-- do_components deal with one strongly-connected component
do_component :: [CVertex] -> FlatM AbstractC
-- A singleton? Then just do it.
do_component [(n,abs_c)] = returnFlt abs_c
-- Not cyclic, or singleton? Just do it
do_component (AcyclicSCC (n,abs_c)) = returnFlt abs_c
do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
-- Two or more? Then go via temporaries.
do_component ((n,first_stmt):rest)
-- Cyclic? Then go via temporaries. Pick one to
-- break the loop and try again with the rest.
do_component (CyclicSCC ((n,first_stmt) : rest))
= doSimultaneously1 rest `thenFlt` \ abs_cs ->
go_via_temps first_stmt `thenFlt` \ (to_temps, from_temps) ->
returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
......@@ -681,6 +665,22 @@ doSimultaneously1 vertices
in
mapFlt do_component components `thenFlt` \ abs_cs ->
returnFlt (mkAbstractCs abs_cs)
where
should_follow :: AbstractC -> AbstractC -> Bool
(CAssign dest1 _) `should_follow` (CAssign _ src2)
= dest1 `conflictsWith` src2
(COpStmt dests1 _ _ _ _) `should_follow` (CAssign _ src2)
= or [dest1 `conflictsWith` src2 | dest1 <- dests1]
(CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _ _)
= or [dest1 `conflictsWith` src2 | src2 <- srcs2]
(COpStmt dests1 _ _ _ _) `should_follow` (COpStmt _ _ srcs2 _ _)
= or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
-- (COpStmt _ _ _ _ _) `should_follow` (CCallProfCtrMacro _ _) = False
-- (CCallProfCtrMacro _ _) `should_follow` (COpStmt _ _ _ _ _) = False
\end{code}
......
ghc/compiler/absCSyn/CLabel.hi-boot 0 → 100644
View file @ dcef38ba
_interface_ CLabel 1
_exports_
CLabel CLabel;
_declarations_
1 data CLabel;
ghc/compiler/absCSyn/CLabel.lhs
View file @ dcef38ba
......@@ -61,16 +61,20 @@ import Id ( externallyVisibleId, cmpId_withSpecDataCon,
isConstMethodId_maybe,
isDefaultMethodId_maybe,
isSuperDictSelId_maybe, fIRST_TAG,
SYN_IE(ConTag), GenId{-instance Outputable-}
SYN_IE(ConTag), GenId{-instance Outputable-},
SYN_IE(Id)
)
import Maybes ( maybeToBool )
import PprStyle ( PprStyle(..) )
import PprType ( showTyCon, GenType{-instance Outputable-} )
import Pretty ( prettyToUn{-, ppPStr ToDo:rm-} )
import TyCon ( TyCon{-instance Eq-} )
import Unique ( showUnique, pprUnique, Unique{-instance Eq-} )
import Unpretty -- NOTE!! ********************
import Util ( assertPanic{-, pprTraceToDo:rm-} )
import Pretty
import Util ( assertPanic{-, pprTraceToDo:rm-}, Ord3(..) )
#if __GLASGOW_HASKELL__ >= 202
import Outputable ( Outputable(..) )
#endif
\end{code}
things we want to find out:
......@@ -316,92 +320,92 @@ duplicate declarations in generating C (see @labelSeenTE@ in
pprCLabel_asm = pprCLabel (PprForAsm underscorePrefix fmtAsmLbl)
#endif
pprCLabel :: PprStyle -> CLabel -> Unpretty
pprCLabel :: PprStyle -> CLabel -> Doc
pprCLabel (PprForAsm _ fmtAsmLbl) (AsmTempLabel u)
= uppStr (fmtAsmLbl (_UNPK_ (showUnique u)))
= text (fmtAsmLbl (_UNPK_ (showUnique u)))
pprCLabel (PprForAsm prepend_cSEP _) lbl
= if prepend_cSEP
then uppBeside pp_cSEP prLbl
then (<>) pp_cSEP prLbl
else prLbl
where
prLbl = pprCLabel PprForC lbl
pprCLabel sty (TyConLabel tc UnvecConUpdCode)
= uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, uppPStr SLIT("upd")]
= hcat [ptext SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, ptext SLIT("upd")]
pprCLabel sty (TyConLabel tc (VecConUpdCode tag))
= uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
uppInt tag, pp_cSEP, uppPStr SLIT("upd")]
= hcat [ptext SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
int tag, pp_cSEP, ptext SLIT("upd")]
pprCLabel sty (TyConLabel tc (StdUpdCode tag))
= case (ctrlReturnConvAlg tc) of
UnvectoredReturn _ -> uppPStr SLIT("IndUpdRetDir")
VectoredReturn _ -> uppBeside (uppPStr SLIT("IndUpdRetV")) (uppInt (tag - fIRST_TAG))
UnvectoredReturn _ -> ptext SLIT("IndUpdRetDir")
VectoredReturn _ -> (<>) (ptext SLIT("IndUpdRetV")) (int (tag - fIRST_TAG))
pprCLabel sty (TyConLabel tc InfoTblVecTbl)
= uppBesides [ppr_tycon sty tc, pp_cSEP, uppPStr SLIT("itblvtbl")]
= hcat [ppr_tycon sty tc, pp_cSEP, ptext SLIT("itblvtbl")]
pprCLabel sty (TyConLabel tc StdUpdVecTbl)
= uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, uppPStr SLIT("upd")]
= hcat [ptext SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
pp_cSEP, ptext SLIT("upd")]
pprCLabel sty (CaseLabel u CaseReturnPt)
= uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_u u]
= hcat [ptext SLIT("ret"), pp_cSEP, ppr_u u]
pprCLabel sty (CaseLabel u CaseVecTbl)
= uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_u u]
= hcat [ptext SLIT("vtbl"), pp_cSEP, ppr_u u]
pprCLabel sty (CaseLabel u (CaseAlt tag))
= uppBesides [uppPStr SLIT("djn"), pp_cSEP, ppr_u u, pp_cSEP, uppInt tag]
= hcat [ptext SLIT("djn"), pp_cSEP, ppr_u u, pp_cSEP, int tag]
pprCLabel sty (CaseLabel u CaseDefault)
= uppBesides [uppPStr SLIT("djn"), pp_cSEP, ppr_u u]
= hcat [ptext SLIT("djn"), pp_cSEP, ppr_u u]
pprCLabel sty (RtsLabel RtsShouldNeverHappenCode) = uppPStr SLIT("StdErrorCode")
pprCLabel sty (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("StdErrorCode")
pprCLabel sty (RtsLabel RtsBlackHoleInfoTbl) = uppPStr SLIT("BH_UPD_info")
pprCLabel sty (RtsLabel RtsBlackHoleInfoTbl) = ptext SLIT("BH_UPD_info")
pprCLabel sty (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
= uppBesides [uppPStr SLIT("__sel_info_"), uppStr (show offset),
uppPStr (if upd_reqd then SLIT("upd") else SLIT("noupd")),
uppPStr SLIT("__")]
= hcat [ptext SLIT("__sel_info_"), text (show offset),
ptext (if upd_reqd then SLIT("upd") else SLIT("noupd")),
ptext SLIT("__")]
pprCLabel sty (RtsLabel (RtsSelectorEntry upd_reqd offset))
= uppBesides [uppPStr SLIT("__sel_entry_"), uppStr (show offset),
uppPStr (if upd_reqd then SLIT("upd") else SLIT("noupd")),
uppPStr SLIT("__")]
= hcat [ptext SLIT("__sel_entry_"), text (show offset),
ptext (if upd_reqd then SLIT("upd") else SLIT("noupd")),
ptext SLIT("__")]
pprCLabel sty (IdLabel (CLabelId id) flavor)
= uppBeside (prettyToUn (ppr sty id)) (ppFlavor flavor)
= (<>) (ppr sty id) (ppFlavor flavor)
ppr_u u = prettyToUn (pprUnique u)
ppr_u u = pprUnique u
ppr_tycon sty tc
= let
str = showTyCon sty tc
in
--pprTrace "ppr_tycon:" (ppStr str) $
uppStr str
--pprTrace "ppr_tycon:" (text str) $
text str
ppFlavor :: IdLabelInfo -> Unpretty
ppFlavor :: IdLabelInfo -> Doc
ppFlavor x = uppBeside pp_cSEP
ppFlavor x = (<>) pp_cSEP
(case x of
Closure -> uppPStr SLIT("closure")
InfoTbl -> uppPStr SLIT("info")
EntryStd -> uppPStr SLIT("entry")
Closure -> ptext SLIT("closure")
InfoTbl -> ptext SLIT("info")
EntryStd -> ptext SLIT("entry")
EntryFast arity -> --false:ASSERT (arity > 0)
uppBeside (uppPStr SLIT("fast")) (uppInt arity)
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")
VapInfoTbl True -> uppPStr SLIT("vap_info")
VapInfoTbl False -> uppPStr SLIT("vap_noupd_info")
VapEntry True -> uppPStr SLIT("vap_entry")
VapEntry False -> uppPStr SLIT("vap_noupd_entry")
RednCounts -> uppPStr SLIT("ct")
(<>) (ptext SLIT("fast")) (int arity)
StaticClosure -> ptext SLIT("static_closure")
ConEntry -> ptext SLIT("con_entry")
ConInfoTbl -> ptext SLIT("con_info")
StaticConEntry -> ptext SLIT("static_entry")
StaticInfoTbl -> ptext SLIT("static_info")
PhantomInfoTbl -> ptext SLIT("inregs_info")
VapInfoTbl True -> ptext SLIT("vap_info")
VapInfoTbl False -> ptext SLIT("vap_noupd_info")
VapEntry True -> ptext SLIT("vap_entry")
VapEntry False -> ptext SLIT("vap_noupd_entry")
RednCounts -> ptext SLIT("ct")
)
\end{code}
ghc/compiler/absCSyn/CStrings.lhs
View file @ dcef38ba
......@@ -17,13 +17,8 @@ module CStrings(
CHK_Ubiq() -- debugging consistency check
import Pretty
import Unpretty( uppChar )
IMPORT_1_3(Char (isAlphanum))
#ifdef REALLY_HASKELL_1_3
ord = fromEnum :: Char -> Int
chr = toEnum :: Int -> Char
#endif
IMPORT_1_3(Char (isAlphanum,ord,chr))
\end{code}
......@@ -42,9 +37,9 @@ Prelude<x> ZP<x>
\begin{code}
cSEP = SLIT("_") -- official C separator
pp_cSEP = uppChar '_'
pp_cSEP = char '_'
identToC :: FAST_STRING -> Pretty
identToC :: FAST_STRING -> Doc
modnameToC :: FAST_STRING -> FAST_STRING
stringToC :: String -> String
charToC, charToEasyHaskell :: Char -> String
......@@ -105,36 +100,36 @@ identToC ps
= let
str = _UNPK_ ps
in
ppBeside
(<>)
(case str of
's':'t':'d':_ -> -- avoid "stdin", "stdout", and "stderr"...
ppChar 'Z'
_ -> ppNil)
char 'Z'
_ -> empty)
(if (all isAlphanum str) -- we gamble that this test will succeed...
then ppPStr ps
else ppIntersperse ppNil (map char_to_c str))
then ptext ps
else hcat (map char_to_c str))
where
char_to_c 'Z' = ppPStr SLIT("ZZ")
char_to_c '&' = ppPStr SLIT("Za")
char_to_c '|' = ppPStr SLIT("Zb")
char_to_c ':' = ppPStr SLIT("Zc")
char_to_c '/' = ppPStr SLIT("Zd")
char_to_c '=' = ppPStr SLIT("Ze")
char_to_c '>' = ppPStr SLIT("Zg")
char_to_c '#' = ppPStr SLIT("Zh")
char_to_c '<' = ppPStr SLIT("Zl")
char_to_c '-' = ppPStr SLIT("Zm")
char_to_c '!' = ppPStr SLIT("Zn")
char_to_c '.' = ppPStr SLIT("_")
char_to_c '+' = ppPStr SLIT("Zp")
char_to_c '\'' = ppPStr SLIT("Zq")
char_to_c '*' = ppPStr SLIT("Zt")
char_to_c '_' = ppPStr SLIT("Zu")
char_to_c 'Z' = ptext SLIT("ZZ")
char_to_c '&' = ptext SLIT("Za")
char_to_c '|' = ptext SLIT("Zb")
char_to_c ':' = ptext SLIT("Zc")
char_to_c '/' = ptext SLIT("Zd")
char_to_c '=' = ptext SLIT("Ze")
char_to_c '>' = ptext SLIT("Zg")
char_to_c '#' = ptext SLIT("Zh")
char_to_c '<' = ptext SLIT("Zl")
char_to_c '-' = ptext SLIT("Zm")
char_to_c '!' = ptext SLIT("Zn")
char_to_c '.' = ptext SLIT("_")
char_to_c '+' = ptext SLIT("Zp")
char_to_c '\'' = ptext SLIT("Zq")
char_to_c '*' = ptext SLIT("Zt")
char_to_c '_' = ptext SLIT("Zu")
char_to_c c = if isAlphanum c
then ppChar c
else ppBeside (ppChar 'Z') (ppInt (ord c))
then char c
else (<>) (char 'Z') (int (ord c))
\end{code}
For \tr{modnameToC}, we really only have to worry about \tr{'}s (quote
......
ghc/compiler/absCSyn/HeapOffs.lhs
View file @ dcef38ba
......@@ -38,8 +38,9 @@ IMPORT_DELOOPER(AbsCLoop) ( fixedHdrSizeInWords, varHdrSizeInWords )
import Maybes ( catMaybes )
import SMRep
import Unpretty -- ********** NOTE **********
import Pretty -- ********** NOTE **********
import Util ( panic )
import PprStyle ( PprStyle )
\end{code}
%************************************************************************
......@@ -264,19 +265,19 @@ print either a single value, or a parenthesised value. No need for
the caller to parenthesise.
\begin{code}
pprHeapOffset :: PprStyle -> HeapOffset -> Unpretty
pprHeapOffset :: PprStyle -> HeapOffset -> Doc
pprHeapOffset sty ZeroHeapOffset = uppChar '0'
pprHeapOffset sty ZeroHeapOffset = char '0'
pprHeapOffset sty (MaxHeapOffset off1 off2)
= uppBeside (uppPStr SLIT("STG_MAX"))
(uppParens (uppBesides [pprHeapOffset sty off1, uppComma, pprHeapOffset sty off2]))
= (<>) (ptext SLIT("STG_MAX"))
(parens (hcat [pprHeapOffset sty off1, comma, pprHeapOffset sty off2]))
pprHeapOffset sty (AddHeapOffset off1 off2)
= uppParens (uppBesides [pprHeapOffset sty off1, uppChar '+',
= parens (hcat [pprHeapOffset sty off1, char '+',
pprHeapOffset sty off2])
pprHeapOffset sty (SubHeapOffset off1 off2)
= uppParens (uppBesides [pprHeapOffset sty off1, uppChar '-',
= parens (hcat [pprHeapOffset sty off1, char '-',
pprHeapOffset sty off2])
pprHeapOffset sty (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
......@@ -289,44 +290,44 @@ pprHeapOffsetPieces :: PprStyle
-> FAST_INT -- Fixed hdrs
-> [SMRep__Int] -- Var hdrs
-> [SMRep__Int] -- Tot hdrs
-> Unpretty
-> Doc
pprHeapOffsetPieces sty n ILIT(0) [] [] = uppInt IBOX(n) -- Deals with zero case too
pprHeapOffsetPieces sty n ILIT(0) [] [] = int IBOX(n) -- Deals with zero case too
pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
= let pp_int_offs =
if int_offs _EQ_ ILIT(0)
then Nothing
else Just (uppInt IBOX(int_offs))
else Just (int IBOX(int_offs))
pp_fxdhdr_offs =
if fxdhdr_offs _EQ_ ILIT(0) then
Nothing
else if fxdhdr_offs _EQ_ ILIT(1) then
Just (uppPStr SLIT("_FHS"))
Just (ptext SLIT("_FHS"))
else
Just (uppBesides [uppChar '(', uppPStr SLIT("_FHS*"), uppInt IBOX(fxdhdr_offs), uppChar ')'])
Just (hcat [char '(', ptext SLIT("_FHS*"), int IBOX(fxdhdr_offs), char ')'])
pp_varhdr_offs = pp_hdrs (uppPStr SLIT("_VHS")) varhdr_offs
pp_varhdr_offs = pp_hdrs (ptext SLIT("_VHS")) varhdr_offs
pp_tothdr_offs = pp_hdrs (uppPStr SLIT("_HS")) tothdr_offs
pp_tothdr_offs = pp_hdrs (ptext SLIT("_HS")) tothdr_offs
in
case (catMaybes [pp_tothdr_offs, pp_varhdr_offs, pp_fxdhdr_offs, pp_int_offs]) of
[] -> uppChar '0'
[] -> char '0'
[pp] -> pp -- Each blob is parenthesised if necessary
pps -> uppParens (uppIntersperse (uppChar '+') pps)
pps -> parens (cat (punctuate (char '+') pps))
where
pp_hdrs hdr_pp [] = Nothing
pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just (uppBeside (uppStr (show rep)) hdr_pp)
pp_hdrs hdr_pp hdrs = Just (uppParens (uppInterleave (uppChar '+')
(map (pp_hdr hdr_pp) hdrs)))
pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just ((<>) (text (show rep)) hdr_pp)
pp_hdrs hdr_pp hdrs = Just (parens (sep (punctuate (char '+')
(map (pp_hdr hdr_pp) hdrs))))
pp_hdr :: Unpretty -> SMRep__Int -> Unpretty
pp_hdr :: Doc -> SMRep__Int -> Doc
pp_hdr pp_str (SMRI(rep, n))
= if n _EQ_ ILIT(1) then
uppBeside (uppStr (show rep)) pp_str
(<>) (text (show rep)) pp_str
else
uppBesides [uppInt IBOX(n), uppChar '*', uppStr (show rep), pp_str]
hcat [int IBOX(n), char '*', text (show rep), pp_str]
\end{code}
%************************************************************************
......
ghc/compiler/absCSyn/PprAbsC.lhs
View file @ dcef38ba
This diff is collapsed.
ghc/compiler/basicTypes/Demand.lhs
View file @ dcef38ba
......@@ -10,7 +10,7 @@ module Demand where
import PprStyle ( PprStyle )
import Outputable
import Pretty ( SYN_IE(Pretty), PrettyRep, ppStr )
import Pretty ( Doc, text )
import Util ( panic )
\end{code}
......@@ -124,7 +124,7 @@ instance Show Demand where
ch = if wu then "U" else "u"
instance Outputable Demand where
ppr sty si = ppStr (showList [si] "")
ppr sty si = text (showList [si] "")
\end{code}
......
ghc/compiler/basicTypes/FieldLabel.hi-boot 0 → 100644
View file @ dcef38ba
_interface_ FieldLabel 1
_exports_
FieldLabel FieldLabel;
_declarations_
1 data FieldLabel;
ghc/compiler/basicTypes/FieldLabel.lhs
View file @ dcef38ba
......@@ -10,13 +10,16 @@ module FieldLabel where
IMP_Ubiq(){-uitous-}
import Name ( Name{-instance Eq/Outputable-}, nameUnique )
import Name --( Name{-instance Eq/Outputable-}, nameUnique )
import Type ( SYN_IE(Type) )
import Outputable
import UniqFM ( SYN_IE(Uniquable) )
\end{code}
\begin{code}
data FieldLabel
= FieldLabel Name
= FieldLabel Name -- Also used as the Name of the field selector Id
Type
FieldLabelTag
......
ghc/compiler/basicTypes/Id.hi-boot
View file @ dcef38ba
_interface_ Id 1
_exports_
Id Id GenId StrictnessMark(MarkedStrict NotMarkedStrict) dataConArgTys idType isNullaryDataCon mkDataCon mkTupleCon nmbrId;
_instances_
instance {Outputable.Outputable Id} = $d1;
_declarations_
1 $d1 _:_ {Outputable.Outputable Id} ;;
1 type Id = Id.GenId Type.Type ;
1 data GenId ty ;
1 data StrictnessMark = MarkedStrict | NotMarkedStrict ;
1 dataConArgTys _:_ Id -> [Type.Type] -> [Type.Type] ;;
1 idType _:_ Id -> Type.Type ;;
1 isNullaryDataCon _:_ Id -> PrelBase.Bool ;;
1 mkDataCon _:_ Name.Name -> [StrictnessMark] -> [FieldLabel.FieldLabel] -> [TyVar.TyVar] -> [(Class.Class,Type.Type)] -> [TyVar.TyVar] -> [(Class.Class,Type.Type)] -> [Type.Type] -> TyCon.TyCon -> Id ;;
1 mkTupleCon _:_ PrelBase.Int -> Name.Name -> Type.Type -> Id ;;
1 nmbrId _:_ Id -> PprEnv.NmbrEnv -> (PprEnv.NmbrEnv, Id) ;;
ghc/compiler/basicTypes/Id.lhs
View file @ dcef38ba
......@@ -19,7 +19,7 @@ module Id (
mkDataCon,
mkDefaultMethodId,
mkDictFunId,
mkIdWithNewUniq,
mkIdWithNewUniq, mkIdWithNewName,
mkImported,
mkInstId,
mkMethodSelId,
......@@ -41,7 +41,6 @@ module Id (
dataConRepType,
dataConArgTys,
dataConArity,
dataConNumFields,
dataConFieldLabels,
dataConRawArgTys,
......@@ -59,8 +58,8 @@ module Id (
cmpId_withSpecDataCon,
externallyVisibleId,
idHasNoFreeTyVars,
idWantsToBeINLINEd,
idMustBeINLINEd,
idWantsToBeINLINEd, getInlinePragma,
idMustBeINLINEd, idMustNotBeINLINEd,
isBottomingId,
isConstMethodId,
isConstMethodId_maybe,
......@@ -111,7 +110,7 @@ module Id (
getIdUpdateInfo,
getPragmaInfo,
replaceIdInfo,
addInlinePragma,
addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
-- IdEnvs AND IdSets
SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
......@@ -145,25 +144,30 @@ module Id (
) where
IMP_Ubiq()
IMPORT_DELOOPER(IdLoop) -- for paranoia checking
IMPORT_DELOOPER(TyLoop) -- for paranoia checking
import Bag
import Class ( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
import IdInfo
import Maybes ( maybeToBool )
import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
import Name {- ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
mkCompoundName, mkInstDeclName,
isLocallyDefinedName, occNameString, modAndOcc,
isLocallyDefined, changeUnique, isWiredInName,
nameString, getOccString, setNameVisibility,
isExported, ExportFlag(..), DefnInfo, Provenance,
OccName(..), Name
)
) -}
import PrelMods ( pREL_TUP, pREL_BASE )
import Lex ( mkTupNameStr )
import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
import PragmaInfo ( PragmaInfo(..) )
#if __GLASGOW_HASKELL__ >= 202
import PrimOp ( PrimOp )
#endif
import PprEnv -- ( SYN_IE(NmbrM), NmbrEnv(..) )
import PprType ( getTypeString, specMaybeTysSuffix,
nmbrType, nmbrTyVar,
......@@ -172,15 +176,15 @@ import PprType ( getTypeString, specMaybeTysSuffix,
import PprStyle
import Pretty
import MatchEnv ( MatchEnv )
import SrcLoc ( mkBuiltinSrcLoc )
import SrcLoc --( mkBuiltinSrcLoc )
import TysWiredIn ( tupleTyCon )
import TyCon ( TyCon, tyConDataCons )
import Type ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
import TyCon --( TyCon, tyConDataCons )
import Type {- ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
applyTyCon, instantiateTy, mkForAllTys,
tyVarsOfType, applyTypeEnvToTy, typePrimRep,
GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
)