Commit 7a3bd641 authored by simonpj's avatar simonpj

[project @ 1996-12-19 09:10:02 by simonpj]

SLPJ new renamer and lots more
parent f65044d1
......@@ -110,6 +110,7 @@ you will screw up the layout where they are used in case expressions!
# define FAST_STRING _PackedString
# define SLIT(x) (_packCString (A# x#))
# define _CMP_STRING_ cmpPString
/* cmpPString defined in utils/Util.lhs */
# define _NULL_ _nullPS
# define _NIL_ _nilPS
# define _CONS_ _consPS
......
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.4 1996/12/18 18:42:48 dnt Exp $
# $Id: Makefile,v 1.5 1996/12/19 09:10:03 simonpj Exp $
TOP = ../..
FlexSuffixRules = YES
......@@ -100,12 +100,26 @@ endif
INCLUDEDIRS = $(foreach dir,$(DIRS),-i$(dir))
SRCS = \
$(foreach dir,$(DIRS),$(wildcard $(dir)/*.lhs)) \
$(UGNHS) rename/ParseIface.hs
$(UGNHS) rename/ParseIface.hs \
main/LoopHack.hc
# LoopHack.lhc is an SLPJ addition to fix a profiling problem. See comments
# inside it.
LOOPS = $(patsubst %.lhi, %.hi, $(wildcard */*.lhi))
HCS = $(patsubst %.hs, %.hc, $(patsubst %.lhs, %.hc, $(SRCS)))
OBJS = \
$(patsubst %.hc, %.o, $(HCS)) rename/ParseIface.o \
parser/hsclink.o parser/hschooks.o libhsp.a
parser/hsclink.o parser/hschooks.o libhsp.a \
main/LoopHack.o
main/LoopHack.hc : main/LoopHack.lhc
$(RM) $@
$(GHC_UNLIT) $< $@ || ( $(RM) $@ && exit 1 )
@chmod 444 $@
main/LoopHack.o : main/LoopHack.hc
$(HC) -v -c $(HC_OPTS) $<
# -----------------------------------------------------------------------------
# options for the Haskell compiler
......@@ -141,7 +155,9 @@ endif
all :: hsc libhsp.a
hsc : $(OBJS)
$(HC) $(HC_OPTS) -o $@ $^
# $(HC) -no-link-chk "-pgml time /projects/pacsoft/ghc/src/pureatria/purelink-1.2.2-solaris2/purelink gcc" $(HC_OPTS) -o $@ $^
$(HC) -no-link-chk "-pgml time gcc -B/projects/unsupported/gnu/sparc-sunos5/bin/g" $(HC_OPTS) -o $@ $^
# $(HC) -no-link-chk "-pgml time gcc" $(HC_OPTS) -o $@ $^
parser/hschooks.o : parser/hschooks.c
@$(RM) $@
......@@ -149,7 +165,7 @@ parser/hschooks.o : parser/hschooks.c
rename/ParseIface.hs : rename/ParseIface.y
@$(RM) rename/ParseIface.hs rename/ParseIface.hinfo
happy -g rename/ParseIface.y
happy +RTS -K2m -RTS -g rename/ParseIface.y
@chmod 444 rename/ParseIface.hs
# ----------------------------------------------------------------------------
......
......@@ -37,7 +37,7 @@ module AbsCSyn {- (
IMP_Ubiq(){-uitous-}
import CgCompInfo ( mAX_Vanilla_REG, mAX_Float_REG,
import Constants ( mAX_Vanilla_REG, mAX_Float_REG,
mAX_Double_REG, lIVENESS_R1, lIVENESS_R2,
lIVENESS_R3, lIVENESS_R4, lIVENESS_R5,
lIVENESS_R6, lIVENESS_R7, lIVENESS_R8
......
......@@ -290,22 +290,16 @@ isAsmTemp _ = False
\end{code}
C ``static'' or not...
From the point of view of the code generator, a name is
externally visible if it should be given put in the .o file's
symbol table; that is, made static.
\begin{code}
externallyVisibleCLabel (TyConLabel tc _) = True
externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (IdLabel (CLabelId id) _)
| isDataCon id = True
| is_ConstMethodId id = True -- These are here to ensure splitting works
| isDictFunId id = True -- when these values have not been exported
| is_DefaultMethodId id = True
| is_SuperDictSelId id = True
| otherwise = externallyVisibleId id
where
is_ConstMethodId id = maybeToBool (isConstMethodId_maybe id)
is_DefaultMethodId id = maybeToBool (isDefaultMethodId_maybe id)
is_SuperDictSelId id = maybeToBool (isSuperDictSelId_maybe id)
externallyVisibleCLabel (IdLabel (CLabelId id) _) = externallyVisibleId id
\end{code}
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
......
......@@ -126,7 +126,7 @@ identToC ps
char_to_c '<' = ppPStr SLIT("Zl")
char_to_c '-' = ppPStr SLIT("Zm")
char_to_c '!' = ppPStr SLIT("Zn")
char_to_c '.' = ppPStr SLIT("Zo")
char_to_c '.' = ppPStr SLIT("_")
char_to_c '+' = ppPStr SLIT("Zp")
char_to_c '\'' = ppPStr SLIT("Zq")
char_to_c '*' = ppPStr SLIT("Zt")
......
......@@ -29,7 +29,7 @@ import AbsCSyn
import AbsCUtils ( getAmodeRep, nonemptyAbsC,
mixedPtrLocn, mixedTypeLocn
)
import CgCompInfo ( spARelToInt, spBRelToInt, mIN_UPD_SIZE )
import Constants ( spARelToInt, spBRelToInt, mIN_UPD_SIZE )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
isReadOnly, needsCDecl, pprCLabel,
CLabel{-instance Ord-}
......
......@@ -10,7 +10,7 @@ module FieldLabel where
IMP_Ubiq(){-uitous-}
import Name ( Name{-instance Eq/Outputable-} )
import Name ( Name{-instance Eq/Outputable-}, nameUnique )
import Type ( SYN_IE(Type) )
\end{code}
......@@ -42,4 +42,7 @@ instance Outputable FieldLabel where
instance NamedThing FieldLabel where
getName (FieldLabel n _ _) = n
instance Uniquable FieldLabel where
uniqueOf (FieldLabel n _ _) = nameUnique n
\end{code}
This diff is collapsed.
This diff is collapsed.
......@@ -9,7 +9,7 @@ import PreludeStdIO ( Maybe )
import BinderInfo ( BinderInfo )
import CoreSyn ( CoreExpr(..), GenCoreExpr, GenCoreArg )
import CoreUnfold ( Unfolding(..), UnfoldingGuidance(..),
SimpleUnfolding(..), FormSummary(..) )
SimpleUnfolding(..), FormSummary(..), noUnfolding )
import CoreUtils ( unTagBinders )
import Id ( externallyVisibleId, isDataCon, isWorkerId, isWrapperId,
unfoldingUnfriendlyId, getIdInfo, nmbrId,
......@@ -34,11 +34,16 @@ import Unique ( Unique )
import Usage ( GenUsage )
import Util ( Ord3(..) )
import WwLib ( mAX_WORKER_ARGS )
import StdIdInfo ( addStandardIdInfo ) -- Used in Id, but StdIdInfo needs lots of stuff from Id
addStandardIdInfo :: Id -> Id
nullSpecEnv :: SpecEnv
isNullSpecEnv :: SpecEnv -> Bool
occurAnalyseGlobalExpr :: GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique -> GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique
-- occurAnalyseGlobalExpr :: GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique -> GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique
-- unTagBinders :: GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), a) b c d -> GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) b c d
externallyVisibleId :: Id -> Bool
isDataCon :: GenId ty -> Bool
isWorkerId :: GenId ty -> Bool
......@@ -49,9 +54,7 @@ nullIdEnv :: UniqFM a
lookupIdEnv :: UniqFM b -> GenId a -> Maybe b
mAX_WORKER_ARGS :: Int
nmbrId :: Id -> NmbrEnv -> (NmbrEnv, Id)
pprParendGenType :: (Eq a, Outputable a, Eq b, Outputable b) => PprStyle -> GenType a b -> Int -> Bool -> PrettyRep
unTagBinders :: GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), a) b c d -> GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) b c d
pprParendGenType :: (Eq a, Outputable a, Eq b, Outputable b) => PprStyle -> GenType a b -> Int -> Bool -> PrettyRep
mkMagicUnfoldingFun :: Unique -> MagicUnfoldingFun
type IdEnv a = UniqFM a
......@@ -73,13 +76,15 @@ data NmbrEnv
data MagicUnfoldingFun
data FormSummary = VarForm | ValueForm | BottomForm | OtherForm
data Unfolding
= NoUnfolding
| CoreUnfolding SimpleUnfolding
| MagicUnfolding Unique MagicUnfoldingFun
-- data Unfolding
-- = NoUnfolding
-- | CoreUnfolding SimpleUnfolding
-- | MagicUnfolding Unique MagicUnfoldingFun
data Unfolding
noUnfolding :: Unfolding
data SimpleUnfolding = SimpleUnfolding FormSummary UnfoldingGuidance (GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique)
-- data SimpleUnfolding = SimpleUnfolding FormSummary UnfoldingGuidance (GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique)
data UnfoldingGuidance
......
......@@ -6,21 +6,21 @@
\begin{code}
#include "HsVersions.h"
module IdUtils ( primOpNameInfo, primOpId ) where
module IdUtils ( primOpName ) where
IMP_Ubiq()
IMPORT_DELOOPER(PrelLoop) -- here for paranoia checking
IMPORT_DELOOPER(IdLoop) (SpecEnv)
import CoreSyn
import CoreUnfold ( UnfoldingGuidance(..), Unfolding )
import Id ( mkImported, mkTemplateLocals )
import CoreUnfold ( UnfoldingGuidance(..), Unfolding, mkUnfolding )
import Id ( mkPrimitiveId, mkTemplateLocals )
import IdInfo -- quite a few things
import Name ( mkPrimitiveName, OrigName(..) )
import PrelMods ( gHC_BUILTINS )
import StdIdInfo
import Name ( mkWiredInIdName )
import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
PrimOpInfo(..), PrimOpResultInfo(..) )
import RnHsSyn ( RnName(..) )
import PrelMods ( gHC__ )
import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyVarTy, applyTyCon )
import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique )
......@@ -28,66 +28,45 @@ import Util ( panic )
\end{code}
\begin{code}
primOpNameInfo :: PrimOp -> (FAST_STRING, RnName)
primOpId :: PrimOp -> Id
primOpNameInfo op = (primOp_str op, WiredInId (primOpId op))
primOpId op
primOpName :: PrimOp -> Name
primOpName op
= case (primOpInfo op) of
Dyadic str ty ->
mk_prim_Id op str [] [ty,ty] (dyadic_fun_ty ty) 2
mk_prim_name op str [] [ty,ty] (dyadic_fun_ty ty) 2
Monadic str ty ->
mk_prim_Id op str [] [ty] (monadic_fun_ty ty) 1
mk_prim_name op str [] [ty] (monadic_fun_ty ty) 1
Compare str ty ->
mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2
mk_prim_name op str [] [ty,ty] (compare_fun_ty ty) 2
Coercing str ty1 ty2 ->
mk_prim_Id op str [] [ty1] (ty1 `mkFunTy` ty2) 1
mk_prim_name op str [] [ty1] (ty1 `mkFunTy` ty2) 1
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
mk_prim_Id op str
mk_prim_name op str
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys)))
(length arg_tys) -- arity
AlgResult str tyvars arg_tys tycon res_tys ->
mk_prim_Id op str
mk_prim_name op str
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys)))
(length arg_tys) -- arity
where
mk_prim_Id prim_op name tyvar_tmpls arg_tys ty arity
= mkImported (mkPrimitiveName key (OrigName gHC_BUILTINS name)) ty
(noIdInfo `addInfo` (mkArityInfo arity)
`addInfo_UF` (mkUnfolding UnfoldAlways
(mk_prim_unfold prim_op tyvar_tmpls arg_tys)))
mk_prim_name prim_op occ_name tyvar_tmpls arg_tys ty arity
= name
where
key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
name = mkWiredInIdName key gHC__ occ_name the_id
the_id = mkPrimitiveId name ty prim_op
\end{code}
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
monadic_fun_ty ty = ty `mkFunTy` ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
The functions to make common unfoldings are tedious.
\begin{code}
mk_prim_unfold :: PrimOp -> [TyVar] -> [Type] -> CoreExpr{-template-}
mk_prim_unfold prim_op tyvars arg_tys
= let
vars = mkTemplateLocals arg_tys
in
mkLam tyvars vars $
Prim prim_op
([TyArg (mkTyVarTy tv) | tv <- tyvars] ++ [VarArg v | v <- vars])
\end{code}
This diff is collapsed.
......@@ -12,7 +12,7 @@ module PprEnv (
initPprEnv,
pCon, pLit, pMajBndr, pMinBndr, pOcc, pPrim, pSCC, pStyle,
pTy, pTyVar, pUVar, pUse,
pTy, pTyVarB, pTyVarO, pUVar, pUse,
NmbrEnv(..),
SYN_IE(NmbrM), initNmbr,
......@@ -45,7 +45,9 @@ data PprEnv tyvar uvar bndr occ
(PrimOp -> Pretty)
(CostCentre -> Pretty)
(tyvar -> Pretty) -- to print tyvars
(tyvar -> Pretty) -- to print tyvar binders
(tyvar -> Pretty) -- to print tyvar occurrences
(uvar -> Pretty) -- to print usage vars
(bndr -> Pretty) -- to print "major" val_bdrs
......@@ -64,6 +66,7 @@ initPprEnv
-> Maybe (PrimOp -> Pretty)
-> Maybe (CostCentre -> Pretty)
-> Maybe (tyvar -> Pretty)
-> Maybe (tyvar -> Pretty)
-> Maybe (uvar -> Pretty)
-> Maybe (bndr -> Pretty)
-> Maybe (bndr -> Pretty)
......@@ -75,13 +78,14 @@ initPprEnv
-- you can specify all the printers individually; if
-- you don't specify one, you get bottom
initPprEnv sty l d p c tv uv maj_bndr min_bndr occ ty use
initPprEnv sty l d p c tvb tvo uv maj_bndr min_bndr occ ty use
= PE sty
(demaybe l)
(demaybe d)
(demaybe p)
(demaybe c)
(demaybe tv)
(demaybe tvb)
(demaybe tvo)
(demaybe uv)
(demaybe maj_bndr)
(demaybe min_bndr)
......@@ -112,21 +116,22 @@ initPprEnv sty pmaj pmin pocc
\end{code}
\begin{code}
pStyle (PE s _ _ _ _ _ _ _ _ _ _ _) = s
pLit (PE _ pp _ _ _ _ _ _ _ _ _ _) = pp
pCon (PE _ _ pp _ _ _ _ _ _ _ _ _) = pp
pPrim (PE _ _ _ pp _ _ _ _ _ _ _ _) = pp
pSCC (PE _ _ _ _ pp _ _ _ _ _ _ _) = pp
pTyVar (PE _ _ _ _ _ pp _ _ _ _ _ _) = pp
pUVar (PE _ _ _ _ _ _ pp _ _ _ _ _) = pp
pMajBndr (PE _ _ _ _ _ _ _ pp _ _ _ _) = pp
pMinBndr (PE _ _ _ _ _ _ _ _ pp _ _ _) = pp
pOcc (PE _ _ _ _ _ _ _ _ _ pp _ _) = pp
pTy (PE _ _ _ _ _ _ _ _ _ _ pp _) = pp
pUse (PE _ _ _ _ _ _ _ _ _ _ _ pp) = pp
pStyle (PE s _ _ _ _ _ _ _ _ _ _ _ _) = s
pLit (PE _ pp _ _ _ _ _ _ _ _ _ _ _) = pp
pCon (PE _ _ pp _ _ _ _ _ _ _ _ _ _) = pp
pPrim (PE _ _ _ pp _ _ _ _ _ _ _ _ _) = pp
pSCC (PE _ _ _ _ pp _ _ _ _ _ _ _ _) = pp
pTyVarB (PE _ _ _ _ _ pp _ _ _ _ _ _ _) = pp
pTyVarO (PE _ _ _ _ _ _ pp _ _ _ _ _ _) = pp
pUVar (PE _ _ _ _ _ _ _ pp _ _ _ _ _) = pp
pMajBndr (PE _ _ _ _ _ _ _ _ pp _ _ _ _) = pp
pMinBndr (PE _ _ _ _ _ _ _ _ _ pp _ _ _) = pp
pOcc (PE _ _ _ _ _ _ _ _ _ _ pp _ _) = pp
pTy (PE _ _ _ _ _ _ _ _ _ _ _ pp _) = pp
pUse (PE _ _ _ _ _ _ _ _ _ _ _ _ pp) = pp
\end{code}
We tend to {\em renumber} everything before printing, so that
......
......@@ -11,15 +11,17 @@
#include "HsVersions.h"
module SrcLoc (
SrcLoc, -- abstract
SrcLoc, -- Abstract
mkSrcLoc,
noSrcLoc, isNoSrcLoc, -- "I'm sorry, I haven't a clue"
mkSrcLoc, mkSrcLoc2, -- the usual
mkUnknownSrcLoc, -- "I'm sorry, I haven't a clue"
mkIfaceSrcLoc, -- Unknown place in an interface
-- (this one can die eventually ToDo)
mkBuiltinSrcLoc, -- something wired into the compiler
mkGeneratedSrcLoc, -- code generated within the compiler
unpackSrcLoc
mkBuiltinSrcLoc, -- Something wired into the compiler
mkGeneratedSrcLoc -- Code generated within the compiler
) where
IMP_Ubiq()
......@@ -38,10 +40,12 @@ We keep information about the {\em definition} point for each entity;
this is the obvious stuff:
\begin{code}
data SrcLoc
= SrcLoc FAST_STRING -- source file name
FAST_STRING -- line number in source file
| SrcLoc2 FAST_STRING -- same, but w/ an Int line#
= NoSrcLoc
| SrcLoc FAST_STRING -- A precise location
FAST_INT
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
\end{code}
Note that an entity might be imported via more than one route, and
......@@ -57,15 +61,15 @@ rare case.
Things to make 'em:
\begin{code}
mkSrcLoc = SrcLoc
mkSrcLoc2 x IBOX(y) = SrcLoc2 x y
mkUnknownSrcLoc = SrcLoc SLIT("<unknown>") SLIT("<unknown>")
mkIfaceSrcLoc = SrcLoc SLIT("<an interface file>") SLIT("<unknown>")
mkBuiltinSrcLoc = SrcLoc SLIT("<built-into-the-compiler>") SLIT("<none>")
mkGeneratedSrcLoc = SrcLoc SLIT("<compiler-generated-code>") SLIT("<none>")
unpackSrcLoc (SrcLoc src_file src_line) = (src_file, src_line)
unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line)))
noSrcLoc = NoSrcLoc
mkSrcLoc x IBOX(y) = SrcLoc x y
mkIfaceSrcLoc = UnhelpfulSrcLoc SLIT("<an interface file>")
mkBuiltinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
mkGeneratedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
isNoSrcLoc NoSrcLoc = True
isNoSrcLoc other = False
\end{code}
%************************************************************************
......@@ -77,12 +81,13 @@ unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line))
\begin{code}
instance Outputable SrcLoc where
ppr PprForUser (SrcLoc src_file src_line)
= ppBesides [ ppChar '"', ppPStr src_file, ppStr "\", line ", ppPStr src_line ]
= ppBesides [ ppPStr src_file, ppStr ": ", ppStr (show IBOX(src_line)) ]
ppr sty (SrcLoc src_file src_line)
= ppBesides [ppPStr SLIT("{-# LINE "), ppPStr src_line, ppSP,
= ppBesides [ppPStr SLIT("{-# LINE "), ppStr (show IBOX(src_line)), ppSP,
ppChar '"', ppPStr src_file, ppPStr SLIT("\" #-}")]
ppr sty (SrcLoc2 src_file src_line)
= ppr sty (SrcLoc src_file (_PK_ (show IBOX(src_line))))
ppr sty (UnhelpfulSrcLoc s) = ppPStr s
ppr sty NoSrcLoc = ppStr "<NoSrcLoc>"
\end{code}
......@@ -13,7 +13,7 @@ module UniqSupply (
getUnique, getUniques, -- basic ops
SYN_IE(UniqSM), -- type: unique supply monad
initUs, thenUs, returnUs,
initUs, thenUs, returnUs, fixUs,
mapUs, mapAndUnzipUs, mapAndUnzip3Us,
thenMaybeUs, mapAccumLUs,
......@@ -147,6 +147,10 @@ initUs init_us m
@thenUs@ is where we split the @UniqSupply@.
\begin{code}
fixUs :: (a -> UniqSM a) -> UniqSM a
fixUs m us
= r where r = m r us
thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
thenUs expr cont us
......
......@@ -87,6 +87,7 @@ module Unique (
foreignObjTyConKey,
forkIdKey,
fractionalClassKey,
fromEnumClassOpKey,
fromIntClassOpKey,
fromIntegerClassOpKey,
fromRationalClassOpKey,
......@@ -212,6 +213,7 @@ module Unique (
, parAtRelIdKey
, parGlobalIdKey
, parLocalIdKey
, unboundKey
) where
import PreludeGlaST
......@@ -664,4 +666,7 @@ eqClassOpKey = mkPreludeMiscIdUnique 60
geClassOpKey = mkPreludeMiscIdUnique 61
zeroClassOpKey = mkPreludeMiscIdUnique 62
thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
-- variables produced by the renamer
fromEnumClassOpKey = mkPreludeMiscIdUnique 65
\end{code}
......@@ -44,7 +44,7 @@ import Id ( idPrimRep, toplevelishId, isDataCon,
GenId{-instance NamedThing-}
)
import Maybes ( catMaybes )
import Name ( isLocallyDefined, oddlyImportedName, Name{-instance NamedThing-} )
import Name ( isLocallyDefined, isWiredInName, Name{-instance NamedThing-} )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
......@@ -195,8 +195,8 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
getCAddrModeAndInfo id
| not (isLocallyDefined name) || oddlyImportedName name
{- Why the "oddlyImported"?
| not (isLocallyDefined name) || isWiredInName name
{- Why the "isWiredInName"?
Imagine you are compiling GHCbase.hs (a module that
supplies some of the wired-in values). What can
happen is that the compiler will inject calls to
......
......@@ -26,7 +26,7 @@ import CgBindery ( getCAddrMode, getArgAmodes,
bindNewToReg, bindArgsToRegs,
stableAmodeIdInfo, heapIdInfo, CgIdInfo
)
import CgCompInfo ( spARelToInt, spBRelToInt )
import Constants ( spARelToInt, spBRelToInt )
import CgUpdate ( pushUpdateFrame )
import CgHeapery ( allocDynClosure, heapCheck
, heapCheckOnly, fetchAndReschedule, yield -- HWL
......@@ -41,7 +41,7 @@ import CgUsages ( getVirtSps, setRealAndVirtualSps,
getSpARelOffset, getSpBRelOffset,
getHpRelOffset
)
import CLabel ( mkClosureLabel, mkConUpdCodePtrVecLabel,
import CLabel ( mkClosureLabel, mkConUpdCodePtrVecLabel, mkFastEntryLabel,
mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel,
mkErrorStdEntryLabel, mkRednCountsLabel
)
......@@ -313,7 +313,8 @@ cgVapInfoTable perhaps_bind_the_fun upd_flag fun args fun_in_payload fun_lf_info
-- If f is not top-level, then f is one of the free variables too,
-- hence "payload_ids" isn't the same as "arg_ids".
--
vap_entry_rhs = StgApp (StgVarArg fun) (map StgVarArg args) emptyIdSet
stg_args = map StgVarArg args
vap_entry_rhs = StgApp (StgVarArg fun) stg_args emptyIdSet
-- Empty live vars
arg_ids_w_info = [(name,mkLFArgument) | name <- args]
......@@ -323,8 +324,7 @@ cgVapInfoTable perhaps_bind_the_fun upd_flag fun args fun_in_payload fun_lf_info
payload_ids | fun_in_payload = fun : args -- Sigh; needed for mkClosureLFInfo
| otherwise = args
vap_lf_info = mkClosureLFInfo False {-not top level-} payload_ids
upd_flag [] vap_entry_rhs
vap_lf_info = mkVapLFInfo payload_ids upd_flag fun stg_args fun_in_payload
-- It's not top level, even if we're currently compiling a top-level
-- function, because any VAP *use* of this function will be for a
-- local thunk, thus
......@@ -434,10 +434,6 @@ closureCodeBody binder_info closure_info cc all_args body
= getEntryConvention id lf_info
(map idPrimRep all_args) `thenFC` \ entry_conv ->
let
is_concurrent = opt_ForConcurrent
stg_arity = length all_args
-- Arg mapping for standard (slow) entry point; all args on stack
(spA_all_args, spB_all_args, all_bxd_w_offsets, all_ubxd_w_offsets)
= mkVirtStkOffsets
......@@ -510,8 +506,12 @@ closureCodeBody binder_info closure_info cc all_args body
mkIntCLit spA_stk_args, -- # passed on A stk
mkIntCLit spB_stk_args, -- B stk (rest in regs)
CString (_PK_ (map (showTypeCategory . idType) all_args)),
CString (_PK_ (show_wrapper_name wrapper_maybe)),
CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
CString SLIT(""), CString SLIT("")
-- Nuked for now; see comment at end of file
-- CString (_PK_ (show_wrapper_name wrapper_maybe)),
-- CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
] `thenC`
-- Bind args to regs/stack as appropriate, and
......@@ -544,6 +544,8 @@ closureCodeBody binder_info closure_info cc all_args body
CCodeBlock fast_label fast_abs_c
)