Commit b085ee40 authored by simonmar's avatar simonmar

[project @ 2002-04-29 14:03:38 by simonmar]

FastString cleanup, stage 1.

The FastString type is no longer a mixture of hashed strings and
literal strings, it contains hashed strings only with O(1) comparison
(except for UnicodeStr, but that will also go away in due course).  To
create a literal instance of FastString, use FSLIT("..").

By far the most common use of the old literal version of FastString
was in the pattern

	  ptext SLIT("...")

this combination still works, although it doesn't go via FastString
any more.  The next stage will be to remove the need to use this
special combination at all, using a RULE.

To convert a FastString into an SDoc, now use 'ftext' instead of
'ptext'.

I've also removed all the FAST_STRING related macros from HsVersions.h
except for SLIT and FSLIT, just use the relevant functions from
FastString instead.
parent f6124b6c
......@@ -37,8 +37,6 @@ name = Util.global (value) :: IORef (ty); \
#define UASSERT2(e,msg)
#endif
#if __GLASGOW_HASKELL__ >= 23
-- This #ifndef lets us switch off the "import FastString"
-- when compiling FastString itself
#ifndef COMPILING_FAST_STRING
......@@ -46,36 +44,7 @@ name = Util.global (value) :: IORef (ty); \
import qualified FastString
#endif
# define USE_FAST_STRINGS 1
# define FAST_STRING FastString.FastString
# define SLIT(x) (FastString.mkFastCharString# (x#))
# define FSLIT(x) (FastString.mkFastString# (x#))
# define _NULL_ FastString.nullFastString
# define _NIL_ (FastString.mkFastString "")
# define _CONS_ FastString.consFS
# define _HEAD_ FastString.headFS
# define _HEAD_INT_ FastString.headIntFS
# define _TAIL_ FastString.tailFS
# define _LENGTH_ FastString.lengthFS
# define _PK_ FastString.mkFastString
# define _UNPK_ FastString.unpackFS
# define _UNPK_INT_ FastString.unpackIntFS
# define _APPEND_ `FastString.appendFS`
#else
# error I think that FastString is now always used. If not, fix this.
# define FAST_STRING String
# define SLIT(x) (x)
# define _CMP_STRING_ cmpString
# define _NULL_ null
# define _NIL_ ""
# define _CONS_ (:)
# define _HEAD_ head
# define _TAIL_ tail
# define _LENGTH_ length
# define _PK_ (\x->x)
# define _UNPK_ (\x->x)
# define _SUBSTR_ substr{-from Utils-}
# define _APPEND_ ++
#endif
#define SLIT(x) (FastString.mkLitString# (x#))
#define FSLIT(x) (FastString.mkFastString# (x#))
#endif
#endif // HSVERSIONS_H
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.46 2002/03/02 18:02:30 sof Exp $
% $Id: AbsCSyn.lhs,v 1.47 2002/04/29 14:03:39 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -53,8 +53,7 @@ import StgSyn ( StgOp )
import TyCon ( TyCon )
import BitSet -- for liveness masks
import FastTypes
import Outputable
import FastString
\end{code}
@AbstractC@ is a list of Abstract~C statements, but the data structure
......@@ -174,8 +173,8 @@ stored in a mixed type location.)
-- see the notes about these next few; they follow below...
| CMacroStmt CStmtMacro [CAddrMode]
| CCallProfCtrMacro FAST_STRING [CAddrMode]
| CCallProfCCMacro FAST_STRING [CAddrMode]
| CCallProfCtrMacro FastString [CAddrMode]
| CCallProfCCMacro FastString [CAddrMode]
{- The presence of this constructor is a makeshift solution;
it being used to work around a gcc-related problem of
......@@ -401,7 +400,7 @@ Convenience functions:
mkIntCLit :: Int -> CAddrMode
mkIntCLit i = CLit (mkMachInt (toInteger i))
mkCString :: FAST_STRING -> CAddrMode
mkCString :: FastString -> CAddrMode
mkCString s = CLit (MachStr s)
mkCCostCentre :: CostCentre -> CAddrMode
......
......@@ -367,7 +367,7 @@ flatAbsC stmt@(CCheck macro amodes code)
-- the TICKY_CTR macro always needs to be hoisted out to the top level.
-- This is a HACK.
flatAbsC stmt@(CCallProfCtrMacro str amodes)
| str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
| str == FSLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
| otherwise = returnFlt (stmt, AbsCNop)
-- Some statements need no flattening at all:
......@@ -401,7 +401,7 @@ flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs)
= COpStmt
[]
(StgFCallOp
(CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str)))
(CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str)))
defaultCCallConv (PlaySafe False)))
uu
)
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.51 2002/03/14 15:27:15 simonpj Exp $
% $Id: CLabel.lhs,v 1.52 2002/04/29 14:03:39 simonmar Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -90,6 +90,7 @@ import Unique ( pprUnique, Unique )
import PrimOp ( PrimOp )
import CostCentre ( CostCentre, CostCentreStack )
import Outputable
import FastString
\end{code}
things we want to find out:
......@@ -126,7 +127,7 @@ data CLabel
| RtsLabel RtsLabelInfo
| ForeignLabel FAST_STRING Bool -- a 'C' (or otherwise foreign) label
| ForeignLabel FastString Bool -- a 'C' (or otherwise foreign) label
-- Bool <=> is dynamic
| CC_Label CostCentre
......@@ -173,7 +174,7 @@ data CaseLabelInfo
data RtsLabelInfo
= RtsShouldNeverHappenCode
| RtsBlackHoleInfoTbl FAST_STRING -- black hole with info table name
| RtsBlackHoleInfoTbl FastString -- black hole with info table name
| RtsUpdInfo -- upd_frame_info
| RtsSeqInfo -- seq_frame_info
......@@ -254,10 +255,10 @@ mkMAP_FROZEN_infoLabel = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
mkEMPTY_MVAR_infoLabel = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
mkTopTickyCtrLabel = RtsLabel RtsTopTickyCtr
mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
mkBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_BLACKHOLE_info"))
mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_CAF_BLACKHOLE_info"))
mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_SE_CAF_BLACKHOLE_info"))
else -- RTS won't have info table unless -ticky is on
panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
......@@ -272,7 +273,7 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
-- Foreign labels
mkForeignLabel :: FAST_STRING -> Bool -> CLabel
mkForeignLabel :: FastString -> Bool -> CLabel
mkForeignLabel str is_dynamic = ForeignLabel str is_dynamic
-- Cost centres etc.
......@@ -472,7 +473,7 @@ pprCLbl (RtsLabel (Rts_Code str)) = text str
pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ftext info
pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
= hcat [ptext SLIT("stg_sel_"), text (show offset),
......@@ -509,7 +510,7 @@ pprCLbl (RtsLabel RtsModuleRegd)
= ptext SLIT("module_registered")
pprCLbl (ForeignLabel str _)
= ptext str
= ftext str
pprCLbl (TyConLabel tc)
= hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
......@@ -521,7 +522,7 @@ pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (ModuleInitLabel mod)
= ptext SLIT("__stginit_") <> ptext (moduleNameFS (moduleName mod))
= ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
ppIdFlavor :: IdLabelInfo -> SDoc
......
......@@ -4,7 +4,7 @@ This module deals with printing C string literals
module CStrings(
CLabelString, isCLabelString, pprCLabelString,
cSEP, pp_cSEP,
pp_cSEP,
pprFSInCStyle, pprStringInCStyle
) where
......@@ -12,31 +12,32 @@ module CStrings(
#include "HsVersions.h"
import Char ( ord, chr, isAlphaNum )
import FastString
import Outputable
\end{code}
\begin{code}
type CLabelString = FAST_STRING -- A C label, completely unencoded
type CLabelString = FastString -- A C label, completely unencoded
pprCLabelString lbl = ptext lbl
pprCLabelString :: CLabelString -> SDoc
pprCLabelString lbl = ftext lbl
isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
isCLabelString lbl
= all ok (_UNPK_ lbl)
= all ok (unpackFS lbl)
where
ok c = isAlphaNum c || c == '_' || c == '.'
-- The '.' appears in e.g. "foo.so" in the
-- module part of a ExtName. Maybe it should be separate
cSEP = SLIT("_") -- official C separator
pp_cSEP = char '_'
\end{code}
\begin{code}
pprFSInCStyle :: FAST_STRING -> SDoc
pprFSInCStyle :: FastString -> SDoc
-- Assumes it contains only characters '\0'..'\xFF'!
pprFSInCStyle fs = pprStringInCStyle (_UNPK_ fs)
pprFSInCStyle fs = pprStringInCStyle (unpackFS fs)
pprStringInCStyle :: String -> SDoc
pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
......
......@@ -59,6 +59,7 @@ import StgSyn ( StgOp(..) )
import BitSet ( BitSet, intBS )
import Outputable
import GlaExts
import FastString
import Util ( lengthExceeds, listLengthCmp )
import ST
......@@ -309,10 +310,10 @@ pprAbsC (CMacroStmt macro as) _
= 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,
= hcat [ftext op, lparen,
hcat (punctuate comma (map ppr_amode as)),pp_paren_semi]
pprAbsC (CCallProfCCMacro op as) _
= hcat [ptext op, lparen,
= hcat [ftext op, lparen,
hcat (punctuate comma (map ppr_amode as)),pp_paren_semi]
pprAbsC stmt@(CCallTypedef is_tdef (CCallSpec op_str cconv _) uniq results args) _
= hsep [ ptext (if is_tdef then SLIT("typedef") else SLIT("extern"))
......@@ -971,7 +972,7 @@ pprFCall call@(CCall (CCallSpec target cconv safety)) uniq args results vol_regs
= ppr_casm_results non_void_results
call_str = case target of
CasmTarget str -> _UNPK_ str
CasmTarget str -> unpackFS str
StaticTarget fn -> mk_ccall_str (pprCLabelString fn) ccall_args
DynamicTarget -> mk_ccall_str dyn_fun (tail ccall_args)
......
......@@ -36,6 +36,7 @@ import CStrings ( pprFSInCStyle )
import Outputable
import FastTypes
import FastString
import Binary
import Util ( thenCmp )
......@@ -98,7 +99,7 @@ data Literal
= ------------------
-- First the primitive guys
MachChar Int -- Char# At least 31 bits
| MachStr FAST_STRING
| MachStr FastString
| MachAddr Integer -- Whatever this machine thinks is a "pointer"
......@@ -114,13 +115,13 @@ data Literal
-- "foreign label" declaration.
-- string argument is the name of a symbol. This literal
-- refers to the *address* of the label.
| MachLabel FAST_STRING -- always an Addr#
| MachLabel FastString -- always an Addr#
-- lit-lits only work for via-C compilation, hence they
-- are deprecated. The string is emitted verbatim into
-- the C file, and can therefore be any C expression,
-- macro call, #defined constant etc.
| MachLitLit FAST_STRING Type -- Type might be Addr# or Int# etc
| MachLitLit FastString Type -- Type might be Addr# or Int# etc
\end{code}
Binary instance: must do this manually, because we don't want the type
......@@ -399,10 +400,10 @@ pprLit lit
MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
| otherwise -> ptext SLIT("__addr") <+> integer p
MachLabel l | code_style -> ptext SLIT("(&") <> ptext l <> char ')'
MachLabel l | code_style -> ptext SLIT("(&") <> ftext l <> char ')'
| otherwise -> ptext SLIT("__label") <+> pprHsString l
MachLitLit s ty | code_style -> ptext s
MachLitLit s ty | code_style -> ftext s
| otherwise -> parens (hsep [ptext SLIT("__litlit"),
pprHsString s,
pprParendType ty])
......@@ -457,6 +458,6 @@ hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-- The 1+ is to avoid zero, which is a Bad Number
-- since we use * to combine hash values
hashFS :: FAST_STRING -> Int
hashFS :: FastString -> Int
hashFS s = iBox (uniqueOfFS s)
\end{code}
......@@ -93,6 +93,7 @@ import PrelNames
import Maybe ( isJust )
import Util ( dropList, isSingleton )
import Outputable
import FastString
import ListSetOps ( assoc, assocMaybe )
import UnicodeUtil ( stringToUtf8 )
import List ( nubBy )
......@@ -914,7 +915,7 @@ mkRuntimeErrorApp
mkRuntimeErrorApp err_id res_ty err_msg
= mkApps (Var err_id) [Type res_ty, err_string]
where
err_string = Lit (MachStr (_PK_ (stringToUtf8 err_msg)))
err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrIdKey FSLIT("recSelError")
rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorIdKey FSLIT("runtimeError")
......@@ -948,7 +949,7 @@ errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy
%************************************************************************
\begin{code}
pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
pcMiscPrelId :: Unique{-IdKey-} -> Module -> FastString -> Type -> IdInfo -> Id
pcMiscPrelId key mod str ty info
= let
name = mkWiredInName mod (mkVarOcc str) key
......
......@@ -93,6 +93,7 @@ import Unique ( Uniquable(..) )
import UniqFM
import UniqSet
import Binary
import FastString
\end{code}
......@@ -212,14 +213,14 @@ moduleNameFS :: ModuleName -> EncodedFS
moduleNameFS (ModuleName mod) = mod
moduleNameString :: ModuleName -> EncodedString
moduleNameString (ModuleName mod) = _UNPK_ mod
moduleNameString (ModuleName mod) = unpackFS mod
moduleNameUserString :: ModuleName -> UserString
moduleNameUserString (ModuleName mod) = decode (_UNPK_ mod)
moduleNameUserString (ModuleName mod) = decode (unpackFS mod)
-- used to be called mkSrcModule
mkModuleName :: UserString -> ModuleName
mkModuleName s = ModuleName (_PK_ (encode s))
mkModuleName s = ModuleName (mkFastString (encode s))
-- used to be called mkSrcModuleFS
mkModuleNameFS :: UserFS -> ModuleName
......@@ -294,7 +295,7 @@ mkPrelModule :: ModuleName -> Module
mkPrelModule name = mkModule name preludePackage
moduleString :: Module -> EncodedString
moduleString (Module (ModuleName fs) _) = _UNPK_ fs
moduleString (Module (ModuleName fs) _) = unpackFS fs
moduleName :: Module -> ModuleName
moduleName (Module mod pkg_info) = mod
......
......@@ -46,6 +46,7 @@ import Char ( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
import Util ( thenCmp )
import Unique ( Unique )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
import FastString
import Outputable
import Binary
......@@ -64,8 +65,8 @@ code the encoding operation is not performed on each occurrence.
These type synonyms help documentation.
\begin{code}
type UserFS = FAST_STRING -- As the user typed it
type EncodedFS = FAST_STRING -- Encoded form
type UserFS = FastString -- As the user typed it
type EncodedFS = FastString -- Encoded form
type UserString = String -- As the user typed it
type EncodedString = String -- Encoded form
......@@ -75,9 +76,9 @@ pprEncodedFS :: EncodedFS -> SDoc
pprEncodedFS fs
= getPprStyle $ \ sty ->
if userStyle sty
-- ptext (decodeFS fs) would needlessly pack the string again
then text (decode (_UNPK_ fs))
else ptext fs
-- ftext (decodeFS fs) would needlessly pack the string again
then text (decode (unpackFS fs))
else ftext fs
\end{code}
%************************************************************************
......@@ -165,7 +166,7 @@ already encoded
\begin{code}
mkSysOcc :: NameSpace -> EncodedString -> OccName
mkSysOcc occ_sp str = ASSERT2( alreadyEncoded str, text str )
OccName occ_sp (_PK_ str)
OccName occ_sp (mkFastString str)
mkSysOccFS :: NameSpace -> EncodedFS -> OccName
mkSysOccFS occ_sp fs = ASSERT2( alreadyEncodedFS fs, ppr fs )
......@@ -176,7 +177,7 @@ mkFCallOcc :: EncodedString -> OccName
-- because it will be something like "{__ccall f dyn Int# -> Int#}"
-- This encodes a lot into something that then parses like an Id.
-- But then alreadyEncoded complains about the braces!
mkFCallOcc str = OccName varName (_PK_ str)
mkFCallOcc str = OccName varName (mkFastString str)
-- Kind constructors get a special function. Uniquely, they are not encoded,
-- so that they have names like '*'. This means that *even in interface files*
......@@ -212,7 +213,7 @@ occNameFS :: OccName -> EncodedFS
occNameFS (OccName _ s) = s
occNameString :: OccName -> EncodedString
occNameString (OccName _ s) = _UNPK_ s
occNameString (OccName _ s) = unpackFS s
occNameUserString :: OccName -> UserString
occNameUserString occ = decode (occNameString occ)
......@@ -384,7 +385,7 @@ because that isn't a single lexeme. So we encode it to 'lle' and *then*
tack on the '1', if necessary.
\begin{code}
type TidyOccEnv = FiniteMap FAST_STRING Int -- The in-scope OccNames
type TidyOccEnv = FiniteMap FastString Int -- The in-scope OccNames
emptyTidyOccEnv = emptyFM
initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
......@@ -397,7 +398,7 @@ tidyOccName in_scope occ@(OccName occ_sp fs)
= (addToFM in_scope fs 1, occ) -- First occurrence
| otherwise -- Already occurs
= go in_scope (_UNPK_ fs)
= go in_scope (unpackFS fs)
where
go in_scope str = case lookupFM in_scope pk_str of
......@@ -408,7 +409,7 @@ tidyOccName in_scope occ@(OccName occ_sp fs)
Nothing -> (addToFM in_scope pk_str 1, mkSysOccFS occ_sp pk_str)
-- str is now unique
where
pk_str = _PK_ str
pk_str = mkFastString str
\end{code}
......@@ -469,8 +470,8 @@ alreadyEncoded s = all ok s
-- reject them here
ok ch = isAlphaNum ch
alreadyEncodedFS :: FAST_STRING -> Bool
alreadyEncodedFS fs = alreadyEncoded (_UNPK_ fs)
alreadyEncodedFS :: FastString -> Bool
alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
encode :: UserString -> EncodedString
encode cs = case maybe_tuple cs of
......@@ -496,9 +497,9 @@ count_commas n cs = (n,cs)
encodeFS :: UserFS -> EncodedFS
encodeFS fast_str | all unencodedChar str = fast_str
| otherwise = _PK_ (encode str)
| otherwise = mkFastString (encode str)
where
str = _UNPK_ fast_str
str = unpackFS fast_str
unencodedChar :: Char -> Bool -- True for chars that don't need encoding
unencodedChar 'Z' = False
......@@ -544,8 +545,8 @@ encode_ch c = 'z' : shows (ord c) "U"
Decode is used for user printing.
\begin{code}
decodeFS :: FAST_STRING -> FAST_STRING
decodeFS fs = _PK_ (decode (_UNPK_ fs))
decodeFS :: FastString -> FastString
decodeFS fs = mkFastString (decode (unpackFS fs))
decode :: EncodedString -> UserString
decode [] = []
......@@ -610,8 +611,8 @@ These functions test strings to see if they fit the lexical categories
defined in the Haskell report.
\begin{code}
isLexCon, isLexVar, isLexId, isLexSym :: FAST_STRING -> Bool
isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FAST_STRING -> Bool
isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
isLexCon cs = isLexConId cs || isLexConSym cs
isLexVar cs = isLexVarId cs || isLexVarSym cs
......@@ -622,22 +623,22 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs
-------------
isLexConId cs -- Prefix type or data constructors
| _NULL_ cs = False -- e.g. "Foo", "[]", "(,)"
| nullFastString cs = False -- e.g. "Foo", "[]", "(,)"
| cs == FSLIT("[]") = True
| otherwise = startsConId (_HEAD_ cs)
| otherwise = startsConId (headFS cs)
isLexVarId cs -- Ordinary prefix identifiers
| _NULL_ cs = False -- e.g. "x", "_x"
| otherwise = startsVarId (_HEAD_ cs)
| nullFastString cs = False -- e.g. "x", "_x"
| otherwise = startsVarId (headFS cs)
isLexConSym cs -- Infix type or data constructors
| _NULL_ cs = False -- e.g. ":-:", ":", "->"
| nullFastString cs = False -- e.g. ":-:", ":", "->"
| cs == FSLIT("->") = True
| otherwise = startsConSym (_HEAD_ cs)
| otherwise = startsConSym (headFS cs)
isLexVarSym cs -- Infix identifiers
| _NULL_ cs = False -- e.g. "+"
| otherwise = startsVarSym (_HEAD_ cs)
| nullFastString cs = False -- e.g. "+"
| otherwise = startsVarSym (headFS cs)
-------------
startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
......
......@@ -30,6 +30,7 @@ import Util ( thenCmp )
import Outputable
import FastString ( unpackFS )
import FastTypes
import FastString
import GlaExts ( (+#) )
\end{code}
......@@ -43,10 +44,10 @@ We keep information about the {\em definition} point for each entity;
this is the obvious stuff:
\begin{code}
data SrcLoc
= SrcLoc FAST_STRING -- A precise location (file name)
= SrcLoc FastString -- A precise location (file name)
FastInt
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
| UnhelpfulSrcLoc FastString -- Just a general indication
| NoSrcLoc
\end{code}
......@@ -66,14 +67,14 @@ Things to make 'em:
\begin{code}
mkSrcLoc x y = SrcLoc x (iUnbox y)
noSrcLoc = NoSrcLoc
importedSrcLoc = UnhelpfulSrcLoc SLIT("<imported>")
builtinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
generatedSrcLoc = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
importedSrcLoc = UnhelpfulSrcLoc FSLIT("<imported>")
builtinSrcLoc = UnhelpfulSrcLoc FSLIT("<built-into-the-compiler>")
generatedSrcLoc = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
isGoodSrcLoc (SrcLoc _ _) = True
isGoodSrcLoc other = False
srcLocFile :: SrcLoc -> FAST_STRING
srcLocFile :: SrcLoc -> FastString
srcLocFile (SrcLoc fname _) = fname
srcLocLine :: SrcLoc -> FastInt
......@@ -120,18 +121,15 @@ cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 `
instance Outputable SrcLoc where
ppr (SrcLoc src_path src_line)
= getPprStyle $ \ sty ->
if userStyle sty then
hcat [ text src_file, char ':', int (iBox src_line) ]
else
if debugStyle sty then
hcat [ ptext src_path, char ':', int (iBox src_line) ]
if userStyle sty || debugStyle sty then
hcat [ ftext src_path, char ':', int (iBox src_line) ]
else
hcat [text "{-# LINE ", int (iBox src_line), space,
char '\"', ptext src_path, text " #-}"]
char '\"', ftext src_path, text " #-}"]
where
src_file = unpackFS src_path -- Leave the directory prefix intact,
-- so emacs can find the file
ppr (UnhelpfulSrcLoc s) = ptext s
ppr (UnhelpfulSrcLoc s) = ftext s
ppr NoSrcLoc = ptext SLIT("<No locn>")
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.56 2001/12/17 12:33:45 simonmar Exp $
% $Id: CgCase.lhs,v 1.57 2002/04/29 14:03:41 simonmar Exp $
%
%********************************************************
%* *
......@@ -638,14 +638,14 @@ cgSemiTaggedAlts binder alts deflt
st_deflt (StgBindDefault _)
= Just (Just binder,
(CCallProfCtrMacro SLIT("RET_SEMI_BY_DEFAULT") [], -- ToDo: monadise?
(CCallProfCtrMacro FSLIT("RET_SEMI_BY_DEFAULT") [], -- ToDo: monadise?
mkDefaultLabel uniq)
)
st_alt (con, args, use_mask, _)
= -- Ha! Nothing to do; Node already points to the thing
(con_tag,
(CCallProfCtrMacro SLIT("RET_SEMI_IN_HEAP") -- ToDo: monadise?
(CCallProfCtrMacro FSLIT("RET_SEMI_IN_HEAP") -- ToDo: monadise?
[mkIntCLit (length args)], -- how big the thing in the heap is
join_label)
)
......@@ -798,7 +798,7 @@ restoreCurrentCostCentre Nothing = returnFC AbsCNop
restoreCurrentCostCentre (Just slot)
= getSpRelOffset slot `thenFC` \ sp_rel ->
freeStackSlots [slot] `thenC`
returnFC (CCallProfCCMacro SLIT("RESTORE_CCCS") [CVal sp_rel CostCentreRep])
returnFC (CCallProfCCMacro FSLIT("RESTORE_CCCS") [CVal sp_rel CostCentreRep])
-- we use the RESTORE_CCCS macro, rather than just
-- assigning into CurCostCentre, in case RESTORE_CCCS
-- has some sanity-checking in it.
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.56 2002/03/14 15:27:17 simonpj Exp $
% $Id: CgClosure.lhs,v 1.57 2002/04/29 14:03:41 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -54,6 +54,7 @@ import PprType ( showTypeCategory )
import Util ( isIn, splitAtList )
import CmdLineOpts ( opt_SccProfilingOn )
import Outputable
import FastString
import Name ( nameOccName )
import OccName ( occNameFS )
......@@ -262,8 +263,8 @@ closureCodeBody binder_info closure_info cc [] body
is_box = case body of { StgApp fun [] -> True; _ -> False }