Commit 13bb4bf4 authored by Sylvain Henry's avatar Sylvain Henry Committed by Ben Gamari
Browse files

Rename literal constructors

In a previous patch we replaced some built-in literal constructors
(MachInt, MachWord, etc.) with a single LitNumber constructor.

In this patch we replace the `Mach` prefix of the remaining constructors
with `Lit` for consistency (e.g., LitChar, LitLabel, etc.).

Sadly the name `LitString` was already taken for a kind of FastString
and it would become misleading to have both `LitStr` (literal
constructor renamed after `MachStr`) and `LitString` (FastString
variant). Hence this patch renames the FastString variant `PtrString`
(which is more accurate) and the literal string constructor now uses the
least surprising `LitString` name.

Both `Literal` and `LitString/PtrString` have recently seen breaking
changes so doing this kind of renaming now shouldn't harm much.

Reviewers: hvr, goldfire, bgamari, simonmar, jrtc27, tdammers

Subscribers: tdammers, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4881
parent f5fbecc8
This diff is collapsed.
...@@ -419,7 +419,7 @@ data RtsLabelInfo ...@@ -419,7 +419,7 @@ data RtsLabelInfo
| RtsSlowFastTickyCtr String | RtsSlowFastTickyCtr String
deriving (Eq, Ord) deriving (Eq, Ord)
-- NOTE: Eq on LitString compares the pointer only, so this isn't -- NOTE: Eq on PtrString compares the pointer only, so this isn't
-- a real equality. -- a real equality.
...@@ -1368,7 +1368,7 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform -> ...@@ -1368,7 +1368,7 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform ->
underscorePrefix :: Bool -- leading underscore on assembler labels? underscorePrefix :: Bool -- leading underscore on assembler labels?
underscorePrefix = (cLeadingUnderscore == "YES") underscorePrefix = (cLeadingUnderscore == "YES")
asmTempLabelPrefix :: Platform -> LitString -- for formatting labels asmTempLabelPrefix :: Platform -> PtrString -- for formatting labels
asmTempLabelPrefix platform = case platformOS platform of asmTempLabelPrefix platform = case platformOS platform of
OSDarwin -> sLit "L" OSDarwin -> sLit "L"
OSAIX -> sLit "__L" -- follow IBM XL C's convention OSAIX -> sLit "__L" -- follow IBM XL C's convention
......
...@@ -173,7 +173,7 @@ data Width = W8 | W16 | W32 | W64 ...@@ -173,7 +173,7 @@ data Width = W8 | W16 | W32 | W64
instance Outputable Width where instance Outputable Width where
ppr rep = ptext (mrStr rep) ppr rep = ptext (mrStr rep)
mrStr :: Width -> LitString mrStr :: Width -> PtrString
mrStr W8 = sLit("W8") mrStr W8 = sLit("W8")
mrStr W16 = sLit("W16") mrStr W16 = sLit("W16")
mrStr W32 = sLit("W32") mrStr W32 = sLit("W32")
......
...@@ -214,7 +214,7 @@ buildDynCon' dflags platform binder _ _cc con [arg] ...@@ -214,7 +214,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
buildDynCon' dflags platform binder _ _cc con [arg] buildDynCon' dflags platform binder _ _cc con [arg]
| maybeCharLikeCon con | maybeCharLikeCon con
, platformOS platform /= OSMinGW32 || not (positionIndependent dflags) , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)
, NonVoid (StgLitArg (MachChar val)) <- arg , NonVoid (StgLitArg (LitChar val)) <- arg
, let val_int = ord val :: Int , let val_int = ord val :: Int
, val_int <= mAX_CHARLIKE dflags , val_int <= mAX_CHARLIKE dflags
, val_int >= mIN_CHARLIKE dflags , val_int >= mIN_CHARLIKE dflags
......
...@@ -86,27 +86,27 @@ import Data.Word ...@@ -86,27 +86,27 @@ import Data.Word
------------------------------------------------------------------------- -------------------------------------------------------------------------
cgLit :: Literal -> FCode CmmLit cgLit :: Literal -> FCode CmmLit
cgLit (MachStr s) = newByteStringCLit (BS.unpack s) cgLit (LitString s) = newByteStringCLit (BS.unpack s)
-- not unpackFS; we want the UTF-8 byte stream. -- not unpackFS; we want the UTF-8 byte stream.
cgLit other_lit = do dflags <- getDynFlags cgLit other_lit = do dflags <- getDynFlags
return (mkSimpleLit dflags other_lit) return (mkSimpleLit dflags other_lit)
mkSimpleLit :: DynFlags -> Literal -> CmmLit mkSimpleLit :: DynFlags -> Literal -> CmmLit
mkSimpleLit dflags (MachChar c) = CmmInt (fromIntegral (ord c)) (wordWidth dflags) mkSimpleLit dflags (LitChar c) = CmmInt (fromIntegral (ord c))
mkSimpleLit dflags MachNullAddr = zeroCLit dflags (wordWidth dflags)
mkSimpleLit dflags LitNullAddr = zeroCLit dflags
mkSimpleLit dflags (LitNumber LitNumInt i _) = CmmInt i (wordWidth dflags) mkSimpleLit dflags (LitNumber LitNumInt i _) = CmmInt i (wordWidth dflags)
mkSimpleLit _ (LitNumber LitNumInt64 i _) = CmmInt i W64 mkSimpleLit _ (LitNumber LitNumInt64 i _) = CmmInt i W64
mkSimpleLit dflags (LitNumber LitNumWord i _) = CmmInt i (wordWidth dflags) mkSimpleLit dflags (LitNumber LitNumWord i _) = CmmInt i (wordWidth dflags)
mkSimpleLit _ (LitNumber LitNumWord64 i _) = CmmInt i W64 mkSimpleLit _ (LitNumber LitNumWord64 i _) = CmmInt i W64
mkSimpleLit _ (MachFloat r) = CmmFloat r W32 mkSimpleLit _ (LitFloat r) = CmmFloat r W32
mkSimpleLit _ (MachDouble r) = CmmFloat r W64 mkSimpleLit _ (LitDouble r) = CmmFloat r W64
mkSimpleLit _ (MachLabel fs ms fod) mkSimpleLit _ (LitLabel fs ms fod)
= CmmLabel (mkForeignLabel fs ms labelSrc fod) = let -- TODO: Literal labels might not actually be in the current package...
where labelSrc = ForeignLabelInThisPackage
-- TODO: Literal labels might not actually be in the current package... in CmmLabel (mkForeignLabel fs ms labelSrc fod)
labelSrc = ForeignLabelInThisPackage -- NB: LitRubbish should have been lowered in "CoreToStg"
-- NB: RubbishLit should have been lowered in "CoreToStg" mkSimpleLit _ other = pprPanic "mkSimpleLit" (ppr other)
mkSimpleLit _ other = pprPanic "mkSimpleLit" (ppr other)
-------------------------------------------------------------------------- --------------------------------------------------------------------------
-- --
......
...@@ -30,7 +30,7 @@ import CoreUtils ...@@ -30,7 +30,7 @@ import CoreUtils
import CoreFVs import CoreFVs
import PprCore ( pprCoreBindings, pprRules ) import PprCore ( pprCoreBindings, pprRules )
import OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import OccurAnal( occurAnalyseExpr, occurAnalysePgm )
import Literal ( Literal(MachStr) ) import Literal ( Literal(LitString) )
import Id import Id
import Var ( varType, isNonCoVarId ) import Var ( varType, isNonCoVarId )
import VarSet import VarSet
...@@ -816,8 +816,8 @@ exprIsConApp_maybe (in_scope, id_unf) expr ...@@ -816,8 +816,8 @@ exprIsConApp_maybe (in_scope, id_unf) expr
-- See Note [exprIsConApp_maybe on literal strings] -- See Note [exprIsConApp_maybe on literal strings]
| (fun `hasKey` unpackCStringIdKey) || | (fun `hasKey` unpackCStringIdKey) ||
(fun `hasKey` unpackCStringUtf8IdKey) (fun `hasKey` unpackCStringUtf8IdKey)
, [arg] <- args , [arg] <- args
, Just (MachStr str) <- exprIsLiteral_maybe (in_scope, id_unf) arg , Just (LitString str) <- exprIsLiteral_maybe (in_scope, id_unf) arg
= dealWithStringLiteral fun str co = dealWithStringLiteral fun str co
where where
unfolding = id_unf fun unfolding = id_unf fun
...@@ -858,7 +858,7 @@ dealWithStringLiteral fun str co ...@@ -858,7 +858,7 @@ dealWithStringLiteral fun str co
rest = if BS.null charTail rest = if BS.null charTail
then mkConApp nilDataCon [Type charTy] then mkConApp nilDataCon [Type charTy]
else App (Var fun) else App (Var fun)
(Lit (MachStr charTail)) (Lit (LitString charTail))
in pushCoDataCon consDataCon [Type charTy, char, rest] co in pushCoDataCon consDataCon [Type charTy, char, rest] co
......
...@@ -684,7 +684,7 @@ cvtLitInteger :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr ...@@ -684,7 +684,7 @@ cvtLitInteger :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr
-- See Note [Integer literals] in Literal -- See Note [Integer literals] in Literal
cvtLitInteger dflags _ (Just sdatacon) i cvtLitInteger dflags _ (Just sdatacon) i
| inIntRange dflags i -- Special case for small integers | inIntRange dflags i -- Special case for small integers
= mkConApp sdatacon [Lit (mkMachInt dflags i)] = mkConApp sdatacon [Lit (mkLitInt dflags i)]
cvtLitInteger dflags mk_integer _ i cvtLitInteger dflags mk_integer _ i
= mkApps (Var mk_integer) [isNonNegative, ints] = mkApps (Var mk_integer) [isNonNegative, ints]
...@@ -694,7 +694,7 @@ cvtLitInteger dflags mk_integer _ i ...@@ -694,7 +694,7 @@ cvtLitInteger dflags mk_integer _ i
f 0 = [] f 0 = []
f x = let low = x .&. mask f x = let low = x .&. mask
high = x `shiftR` bits high = x `shiftR` bits
in mkConApp intDataCon [Lit (mkMachInt dflags low)] : f high in mkConApp intDataCon [Lit (mkLitInt dflags low)] : f high
bits = 31 bits = 31
mask = 2 ^ bits - 1 mask = 2 ^ bits - 1
...@@ -704,7 +704,7 @@ cvtLitNatural :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr ...@@ -704,7 +704,7 @@ cvtLitNatural :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr
-- See Note [Natural literals] in Literal -- See Note [Natural literals] in Literal
cvtLitNatural dflags _ (Just sdatacon) i cvtLitNatural dflags _ (Just sdatacon) i
| inWordRange dflags i -- Special case for small naturals | inWordRange dflags i -- Special case for small naturals
= mkConApp sdatacon [Lit (mkMachWord dflags i)] = mkConApp sdatacon [Lit (mkLitWord dflags i)]
cvtLitNatural dflags mk_natural _ i cvtLitNatural dflags mk_natural _ i
= mkApps (Var mk_natural) [words] = mkApps (Var mk_natural) [words]
...@@ -712,7 +712,7 @@ cvtLitNatural dflags mk_natural _ i ...@@ -712,7 +712,7 @@ cvtLitNatural dflags mk_natural _ i
f 0 = [] f 0 = []
f x = let low = x .&. mask f x = let low = x .&. mask
high = x `shiftR` bits high = x `shiftR` bits
in mkConApp wordDataCon [Lit (mkMachWord dflags low)] : f high in mkConApp wordDataCon [Lit (mkLitWord dflags low)] : f high
bits = 32 bits = 32
mask = 2 ^ bits - 1 mask = 2 ^ bits - 1
......
...@@ -1854,8 +1854,8 @@ mkIntLit :: DynFlags -> Integer -> Expr b ...@@ -1854,8 +1854,8 @@ mkIntLit :: DynFlags -> Integer -> Expr b
-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr' -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
mkIntLitInt :: DynFlags -> Int -> Expr b mkIntLitInt :: DynFlags -> Int -> Expr b
mkIntLit dflags n = Lit (mkMachInt dflags n) mkIntLit dflags n = Lit (mkLitInt dflags n)
mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n)) mkIntLitInt dflags n = Lit (mkLitInt dflags (toInteger n))
-- | Create a machine word literal expression of type @Word#@ from an @Integer@. -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr' -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
...@@ -1864,14 +1864,14 @@ mkWordLit :: DynFlags -> Integer -> Expr b ...@@ -1864,14 +1864,14 @@ mkWordLit :: DynFlags -> Integer -> Expr b
-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr' -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
mkWordLitWord :: DynFlags -> Word -> Expr b mkWordLitWord :: DynFlags -> Word -> Expr b
mkWordLit dflags w = Lit (mkMachWord dflags w) mkWordLit dflags w = Lit (mkLitWord dflags w)
mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w)) mkWordLitWord dflags w = Lit (mkLitWord dflags (toInteger w))
mkWord64LitWord64 :: Word64 -> Expr b mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w)) mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
mkInt64LitInt64 :: Int64 -> Expr b mkInt64LitInt64 :: Int64 -> Expr b
mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w)) mkInt64LitInt64 w = Lit (mkLitInt64 (toInteger w))
-- | Create a machine character literal expression of type @Char#@. -- | Create a machine character literal expression of type @Char#@.
-- If you want an expression of type @Char@ use 'MkCore.mkCharExpr' -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
...@@ -1880,8 +1880,8 @@ mkCharLit :: Char -> Expr b ...@@ -1880,8 +1880,8 @@ mkCharLit :: Char -> Expr b
-- If you want an expression of type @String@ use 'MkCore.mkStringExpr' -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
mkStringLit :: String -> Expr b mkStringLit :: String -> Expr b
mkCharLit c = Lit (mkMachChar c) mkCharLit c = Lit (mkLitChar c)
mkStringLit s = Lit (mkMachString s) mkStringLit s = Lit (mkLitString s)
-- | Create a machine single precision literal expression of type @Float#@ from a @Rational@. -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr' -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
...@@ -1890,8 +1890,8 @@ mkFloatLit :: Rational -> Expr b ...@@ -1890,8 +1890,8 @@ mkFloatLit :: Rational -> Expr b
-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr' -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
mkFloatLitFloat :: Float -> Expr b mkFloatLitFloat :: Float -> Expr b
mkFloatLit f = Lit (mkMachFloat f) mkFloatLit f = Lit (mkLitFloat f)
mkFloatLitFloat f = Lit (mkMachFloat (toRational f)) mkFloatLitFloat f = Lit (mkLitFloat (toRational f))
-- | Create a machine double precision literal expression of type @Double#@ from a @Rational@. -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr' -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
...@@ -1900,8 +1900,8 @@ mkDoubleLit :: Rational -> Expr b ...@@ -1900,8 +1900,8 @@ mkDoubleLit :: Rational -> Expr b
-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr' -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
mkDoubleLitDouble :: Double -> Expr b mkDoubleLitDouble :: Double -> Expr b
mkDoubleLit d = Lit (mkMachDouble d) mkDoubleLit d = Lit (mkLitDouble d)
mkDoubleLitDouble d = Lit (mkMachDouble (toRational d)) mkDoubleLitDouble d = Lit (mkLitDouble (toRational d))
-- | Bind all supplied binding groups over an expression in a nested let expression. Assumes -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
-- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if -- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if
......
...@@ -772,7 +772,7 @@ litSize :: Literal -> Int ...@@ -772,7 +772,7 @@ litSize :: Literal -> Int
-- Used by CoreUnfold.sizeExpr -- Used by CoreUnfold.sizeExpr
litSize (LitNumber LitNumInteger _ _) = 100 -- Note [Size of literal integers] litSize (LitNumber LitNumInteger _ _) = 100 -- Note [Size of literal integers]
litSize (LitNumber LitNumNatural _ _) = 100 litSize (LitNumber LitNumNatural _ _) = 100
litSize (MachStr str) = 10 + 10 * ((BS.length str + 3) `div` 4) litSize (LitString str) = 10 + 10 * ((BS.length str + 3) `div` 4)
-- If size could be 0 then @f "x"@ might be too small -- If size could be 0 then @f "x"@ might be too small
-- [Sept03: make literal strings a bit bigger to avoid fruitless -- [Sept03: make literal strings a bit bigger to avoid fruitless
-- duplication of little strings] -- duplication of little strings]
......
...@@ -1527,7 +1527,7 @@ expr_ok primop_ok other_expr ...@@ -1527,7 +1527,7 @@ expr_ok primop_ok other_expr
| (expr, args) <- collectArgs other_expr | (expr, args) <- collectArgs other_expr
= case stripTicksTopE (not . tickishCounts) expr of = case stripTicksTopE (not . tickishCounts) expr of
Var f -> app_ok primop_ok f args Var f -> app_ok primop_ok f args
-- 'RubbishLit' is the only literal that can occur in the head of an -- 'LitRubbish' is the only literal that can occur in the head of an
-- application and will not be matched by the above case (Var /= Lit). -- application and will not be matched by the above case (Var /= Lit).
Lit lit -> ASSERT( lit == rubbishLit ) True Lit lit -> ASSERT( lit == rubbishLit ) True
_ -> False _ -> False
...@@ -1853,7 +1853,7 @@ exprIsTickedString = isJust . exprIsTickedString_maybe ...@@ -1853,7 +1853,7 @@ exprIsTickedString = isJust . exprIsTickedString_maybe
-- different shape. -- different shape.
-- Used to "look through" Ticks in places that need to handle literal strings. -- Used to "look through" Ticks in places that need to handle literal strings.
exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
exprIsTickedString_maybe (Lit (MachStr bs)) = Just bs exprIsTickedString_maybe (Lit (LitString bs)) = Just bs
exprIsTickedString_maybe (Tick t e) exprIsTickedString_maybe (Tick t e)
-- we don't tick literals with CostCentre ticks, compare to mkTick -- we don't tick literals with CostCentre ticks, compare to mkTick
| tickishPlace t == PlaceCostCentre = Nothing | tickishPlace t == PlaceCostCentre = Nothing
...@@ -2489,9 +2489,9 @@ rhsIsStatic platform is_dynamic_name cvt_literal rhs = is_static False rhs ...@@ -2489,9 +2489,9 @@ rhsIsStatic platform is_dynamic_name cvt_literal rhs = is_static False rhs
is_static in_arg (Lit (LitNumber nt i _)) = case cvt_literal nt i of is_static in_arg (Lit (LitNumber nt i _)) = case cvt_literal nt i of
Just e -> is_static in_arg e Just e -> is_static in_arg e
Nothing -> True Nothing -> True
is_static _ (Lit (MachLabel {})) = False is_static _ (Lit (LitLabel {})) = False
is_static _ (Lit _) = True is_static _ (Lit _) = True
-- A MachLabel (foreign import "&foo") in an argument -- A LitLabel (foreign import "&foo") in an argument
-- prevents a constructor application from being static. The -- prevents a constructor application from being static. The
-- reason is that it might give rise to unresolvable symbols -- reason is that it might give rise to unresolvable symbols
-- in the object file: under Linux, references to "weak" -- in the object file: under Linux, references to "weak"
......
...@@ -302,7 +302,7 @@ mkStringExprFSWith lookupM str ...@@ -302,7 +302,7 @@ mkStringExprFSWith lookupM str
where where
chars = unpackFS str chars = unpackFS str
safeChar c = ord c >= 1 && ord c <= 0x7F safeChar c = ord c >= 1 && ord c <= 0x7F
lit = Lit (MachStr (fastStringToByteString str)) lit = Lit (LitString (fastStringToByteString str))
{- {-
************************************************************************ ************************************************************************
...@@ -658,7 +658,7 @@ mkRuntimeErrorApp err_id res_ty err_msg ...@@ -658,7 +658,7 @@ mkRuntimeErrorApp err_id res_ty err_msg
= mkApps (Var err_id) [ Type (getRuntimeRep res_ty) = mkApps (Var err_id) [ Type (getRuntimeRep res_ty)
, Type res_ty, err_string ] , Type res_ty, err_string ]
where where
err_string = Lit (mkMachString err_msg) err_string = Lit (mkLitString err_msg)
mkImpossibleExpr :: Type -> CoreExpr mkImpossibleExpr :: Type -> CoreExpr
mkImpossibleExpr res_ty mkImpossibleExpr res_ty
...@@ -896,4 +896,4 @@ mkAbsentErrorApp :: Type -- The type to instantiate 'a' ...@@ -896,4 +896,4 @@ mkAbsentErrorApp :: Type -- The type to instantiate 'a'
mkAbsentErrorApp res_ty err_msg mkAbsentErrorApp res_ty err_msg
= mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ] = mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ]
where where
err_string = Lit (mkMachString err_msg) err_string = Lit (mkLitString err_msg)
...@@ -327,8 +327,8 @@ resultWrapper result_ty ...@@ -327,8 +327,8 @@ resultWrapper result_ty
= do { dflags <- getDynFlags = do { dflags <- getDynFlags
; let marshal_bool e ; let marshal_bool e
= mkWildCase e intPrimTy boolTy = mkWildCase e intPrimTy boolTy
[ (DEFAULT ,[],Var trueDataConId ) [ (DEFAULT ,[],Var trueDataConId )
, (LitAlt (mkMachInt dflags 0),[],Var falseDataConId)] , (LitAlt (mkLitInt dflags 0),[],Var falseDataConId)]
; return (Just intPrimTy, marshal_bool) } ; return (Just intPrimTy, marshal_bool) }
-- Newtypes -- Newtypes
......
...@@ -163,7 +163,7 @@ dsCImport id co (CLabel cid) cconv _ _ = do ...@@ -163,7 +163,7 @@ dsCImport id co (CLabel cid) cconv _ _ = do
(resTy, foRhs) <- resultWrapper ty (resTy, foRhs) <- resultWrapper ty
ASSERT(fromJust resTy `eqType` addrPrimTy) -- typechecker ensures this ASSERT(fromJust resTy `eqType` addrPrimTy) -- typechecker ensures this
let let
rhs = foRhs (Lit (MachLabel cid stdcall_info fod)) rhs = foRhs (Lit (LitLabel cid stdcall_info fod))
rhs' = Cast rhs co rhs' = Cast rhs co
stdcall_info = fun_type_arg_stdcall_info dflags cconv ty stdcall_info = fun_type_arg_stdcall_info dflags cconv ty
in in
...@@ -442,8 +442,8 @@ dsFExportDynamic id co0 cconv = do ...@@ -442,8 +442,8 @@ dsFExportDynamic id co0 cconv = do
-} -}
adj_args = [ mkIntLitInt dflags (ccallConvToInt cconv) adj_args = [ mkIntLitInt dflags (ccallConvToInt cconv)
, Var stbl_value , Var stbl_value
, Lit (MachLabel fe_nm mb_sz_args IsFunction) , Lit (LitLabel fe_nm mb_sz_args IsFunction)
, Lit (mkMachString typestring) , Lit (mkLitString typestring)
] ]
-- name of external entry point providing these services. -- name of external entry point providing these services.
-- (probably in the RTS.) -- (probably in the RTS.)
......
...@@ -82,7 +82,7 @@ import ErrUtils ...@@ -82,7 +82,7 @@ import ErrUtils
import FastString import FastString
import Var (EvVar) import Var (EvVar)
import UniqFM ( lookupWithDefaultUFM ) import UniqFM ( lookupWithDefaultUFM )
import Literal ( mkMachString ) import Literal ( mkLitString )
import CostCentreState import CostCentreState
import Data.IORef import Data.IORef
...@@ -609,5 +609,5 @@ pprRuntimeTrace str doc expr = do ...@@ -609,5 +609,5 @@ pprRuntimeTrace str doc expr = do
dflags <- getDynFlags dflags <- getDynFlags
let message :: CoreExpr let message :: CoreExpr
message = App (Var unpackCStringId) $ message = App (Var unpackCStringId) $
Lit $ mkMachString $ showSDoc dflags (hang (text str) 4 doc) Lit $ mkLitString $ showSDoc dflags (hang (text str) 4 doc)
return $ mkApps (Var traceId) [Type (exprType expr), message, expr] return $ mkApps (Var traceId) [Type (exprType expr), message, expr]
...@@ -403,8 +403,8 @@ mkErrorAppDs err_id ty msg = do ...@@ -403,8 +403,8 @@ mkErrorAppDs err_id ty msg = do
dflags <- getDynFlags dflags <- getDynFlags
let let
full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg]) full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
core_msg = Lit (mkMachString full_msg) core_msg = Lit (mkLitString full_msg)
-- mkMachString returns a result of type String# -- mkLitString returns a result of type String#
return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg]) return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])
{- {-
......
...@@ -848,8 +848,8 @@ Previously we had, as PatGroup constructors ...@@ -848,8 +848,8 @@ Previously we had, as PatGroup constructors
But Literal is really supposed to represent an *unboxed* literal, like Int#. But Literal is really supposed to represent an *unboxed* literal, like Int#.
We were sticking the literal from, say, an overloaded numeric literal pattern We were sticking the literal from, say, an overloaded numeric literal pattern
into a MachInt constructor. This didn't really make sense; and we now have into a LitInt constructor. This didn't really make sense; and we now have
the invariant that value in a MachInt must be in the range of the target the invariant that value in a LitInt must be in the range of the target
machine's Int# type, and an overloaded literal could meaningfully be larger. machine's Int# type, and an overloaded literal could meaningfully be larger.
Solution: For pattern grouping purposes, just store the literal directly in Solution: For pattern grouping purposes, just store the literal directly in
......
...@@ -80,14 +80,14 @@ dsLit :: HsLit GhcRn -> DsM CoreExpr ...@@ -80,14 +80,14 @@ dsLit :: HsLit GhcRn -> DsM CoreExpr
dsLit l = do dsLit l = do
dflags <- getDynFlags dflags <- getDynFlags
case l of case l of
HsStringPrim _ s -> return (Lit (MachStr s)) HsStringPrim _ s -> return (Lit (LitString s))
HsCharPrim _ c -> return (Lit (MachChar c)) HsCharPrim _ c -> return (Lit (LitChar c))
HsIntPrim _ i -> return (Lit (mkMachIntWrap dflags i)) HsIntPrim _ i -> return (Lit (mkLitIntWrap dflags i))
HsWordPrim _ w -> return (Lit (mkMachWordWrap dflags w)) HsWordPrim _ w -> return (Lit (mkLitWordWrap dflags w))
HsInt64Prim _ i -> return (Lit (mkMachInt64Wrap dflags i)) HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap dflags i))
HsWord64Prim _ w -> return (Lit (mkMachWord64Wrap dflags w)) HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap dflags w))
HsFloatPrim _ f -> return (Lit (MachFloat (fl_value f))) HsFloatPrim _ f -> return (Lit (LitFloat (fl_value f)))
HsDoublePrim _ d -> return (Lit (MachDouble (fl_value d))) HsDoublePrim _ d -> return (Lit (LitDouble (fl_value d)))
HsChar _ c -> return (mkCharExpr c) HsChar _ c -> return (mkCharExpr c)
HsString _ str -> mkStringExprFS str HsString _ str -> mkStringExprFS str
HsInteger _ i _ -> mkIntegerExpr i HsInteger _ i _ -> mkIntegerExpr i
...@@ -375,9 +375,9 @@ matchLiterals (var:vars) ty sub_groups ...@@ -375,9 +375,9 @@ matchLiterals (var:vars) ty sub_groups
wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
-- Equality check for string literals -- Equality check for string literals
wrap_str_guard eq_str (MachStr s, mr) wrap_str_guard eq_str (LitString s, mr)
= do { -- We now have to convert back to FastString. Perhaps there = do { -- We now have to convert back to FastString. Perhaps there
-- should be separate MachBytes and MachStr constructors? -- should be separate LitBytes and LitString constructors?
let s' = mkFastStringByteString s let s' = mkFastStringByteString s
; lit <- mkStringExprFS s' ; lit <- mkStringExprFS s'
; let pred = mkApps (Var eq_str) [Var var, lit] ; let pred = mkApps (Var eq_str) [Var var, lit]
...@@ -391,20 +391,20 @@ hsLitKey :: DynFlags -> HsLit GhcTc -> Literal ...@@ -391,20 +391,20 @@ hsLitKey :: DynFlags -> HsLit GhcTc -> Literal
-- Get the Core literal corresponding to a HsLit. -- Get the Core literal corresponding to a HsLit.
-- It only works for primitive types and strings; -- It only works for primitive types and strings;
-- others have been removed by tidy -- others have been removed by tidy
-- For HsString, it produces a MachStr, which really represents an _unboxed_ -- For HsString, it produces a LitString, which really represents an _unboxed_
-- string literal; and we deal with it in matchLiterals above. Otherwise, it -- string literal; and we deal with it in matchLiterals above. Otherwise, it
-- produces a primitive Literal of type matching the original HsLit. -- produces a primitive Literal of type matching the original HsLit.
-- In the case of the fixed-width numeric types, we need to wrap here -- In the case of the fixed-width numeric types, we need to wrap here
-- because Literal has an invariant that the literal is in range, while -- because Literal has an invariant that the literal is in range, while
-- HsLit does not. -- HsLit does not.
hsLitKey dflags (HsIntPrim _ i) = mkMachIntWrap dflags i hsLitKey dflags (HsIntPrim _ i) = mkLitIntWrap dflags i
hsLitKey dflags (HsWordPrim _ w) = mkMachWordWrap dflags w hsLitKey dflags (HsWordPrim _ w) = mkLitWordWrap dflags w
hsLitKey dflags (HsInt64Prim _ i) = mkMachInt64Wrap dflags i hsLitKey dflags (HsInt64Prim _ i) = mkLitInt64Wrap dflags i
hsLitKey dflags (HsWord64Prim _ w) = mkMachWord64Wrap dflags w hsLitKey dflags (HsWord64Prim _ w) = mkLitWord64Wrap dflags w
hsLitKey _ (HsCharPrim _ c) = mkMachChar c hsLitKey _ (HsCharPrim _ c) = mkLitChar c
hsLitKey _ (HsFloatPrim _ f) = mkMachFloat (fl_value f) hsLitKey _ (HsFloatPrim _ f) = mkLitFloat (fl_value f)
hsLitKey _ (HsDoublePrim _ d) = mkMachDouble (fl_value d) hsLitKey _ (HsDoublePrim _ d) = mkLitDouble (fl_value d)
hsLitKey _ (HsString _ s) = MachStr (fastStringToByteString s) hsLitKey _ (HsString _ s) = LitString (fastStringToByteString s)
hsLitKey _ l = pprPanic "hsLitKey" (ppr l) hsLitKey _ l = pprPanic "hsLitKey" (ppr l)
{- {-
......
...@@ -441,18 +441,18 @@ assembleI dflags i = case i of ...@@ -441,18 +441,18 @@ assembleI dflags i = case i of
Op q, Op np] Op q, Op np]
where where
literal (MachLabel fs (Just sz) _) literal (LitLabel fs (Just sz) _)
| platformOS (targetPlatform dflags) == OSMinGW32 | platformOS (targetPlatform dflags) == OSMinGW32
= litlabel (appendFS fs (mkFastString ('@':show sz))) = litlabel (appendFS fs (mkFastString ('@':show sz)))
-- On Windows, stdcall labels have a suffix indicating the no. of -- On Windows, stdcall labels have a suffix indicating the no. of