summaryrefslogtreecommitdiff
path: root/ghc/compiler/absCSyn
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/absCSyn')
-rw-r--r--ghc/compiler/absCSyn/AbsCSyn.lhs11
-rw-r--r--ghc/compiler/absCSyn/AbsCUtils.lhs4
-rw-r--r--ghc/compiler/absCSyn/CLabel.lhs21
-rw-r--r--ghc/compiler/absCSyn/CStrings.lhs15
-rw-r--r--ghc/compiler/absCSyn/PprAbsC.lhs7
5 files changed, 30 insertions, 28 deletions
diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index 36d3db7e6e..2389512c77 100644
--- a/ghc/compiler/absCSyn/AbsCSyn.lhs
+++ b/ghc/compiler/absCSyn/AbsCSyn.lhs
@@ -1,7 +1,7 @@
%
% (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
diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 5643da8309..90988cdebc 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -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
)
diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index b56db8d269..a26d9d7a51 100644
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
%
% (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
diff --git a/ghc/compiler/absCSyn/CStrings.lhs b/ghc/compiler/absCSyn/CStrings.lhs
index 6f2a0e3570..f25e6c204f 100644
--- a/ghc/compiler/absCSyn/CStrings.lhs
+++ b/ghc/compiler/absCSyn/CStrings.lhs
@@ -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))
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index df93726227..c08740cdd5 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -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)