Rename literal constructors
authorSylvain Henry <hsyl20@gmail.com>
Thu, 22 Nov 2018 16:31:16 +0000 (11:31 -0500)
committerBen Gamari <ben@smart-cactus.org>
Thu, 22 Nov 2018 17:11:15 +0000 (12:11 -0500)
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

40 files changed:
compiler/basicTypes/Literal.hs
compiler/cmm/CLabel.hs
compiler/cmm/CmmType.hs
compiler/codeGen/StgCmmCon.hs
compiler/codeGen/StgCmmUtils.hs
compiler/coreSyn/CoreOpt.hs
compiler/coreSyn/CorePrep.hs
compiler/coreSyn/CoreSyn.hs
compiler/coreSyn/CoreUnfold.hs
compiler/coreSyn/CoreUtils.hs
compiler/coreSyn/MkCore.hs
compiler/deSugar/DsCCall.hs
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsMonad.hs
compiler/deSugar/DsUtils.hs
compiler/deSugar/Match.hs
compiler/deSugar/MatchLit.hs
compiler/ghci/ByteCodeAsm.hs
compiler/ghci/ByteCodeGen.hs
compiler/llvmGen/Llvm/Types.hs
compiler/main/Finder.hs
compiler/nativeGen/Dwarf/Constants.hs
compiler/nativeGen/Dwarf/Types.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/Ppr.hs
compiler/prelude/PrelRules.hs
compiler/simplCore/SetLevels.hs
compiler/simplCore/Simplify.hs
compiler/simplStg/UnariseStg.hs
compiler/stgSyn/CoreToStg.hs
compiler/stranal/WwLib.hs
compiler/typecheck/TcEvTerm.hs
compiler/typecheck/TcSplice.hs
compiler/utils/BufWrite.hs
compiler/utils/FastString.hs
compiler/utils/Outputable.hs
compiler/utils/Pretty.hs
testsuite/tests/plugins/HomePackagePlugin.hs
testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs

index 0bf3897..7e49816 100644 (file)
@@ -2,7 +2,7 @@
 (c) The University of Glasgow 2006
 (c) The GRASP/AQUA Project, Glasgow University, 1998
 
-\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
+\section[Literal]{@Literal@: literals}
 -}
 
 {-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
@@ -14,12 +14,12 @@ module Literal
         , LitNumType(..)
 
         -- ** Creating Literals
-        , mkMachInt, mkMachIntWrap, mkMachIntWrapC
-        , mkMachWord, mkMachWordWrap, mkMachWordWrapC
-        , mkMachInt64, mkMachInt64Wrap
-        , mkMachWord64, mkMachWord64Wrap
-        , mkMachFloat, mkMachDouble
-        , mkMachChar, mkMachString
+        , mkLitInt, mkLitIntWrap, mkLitIntWrapC
+        , mkLitWord, mkLitWordWrap, mkLitWordWrapC
+        , mkLitInt64, mkLitInt64Wrap
+        , mkLitWord64, mkLitWord64Wrap
+        , mkLitFloat, mkLitDouble
+        , mkLitChar, mkLitString
         , mkLitInteger, mkLitNatural
         , mkLitNumber, mkLitNumberWrap
 
@@ -84,59 +84,66 @@ import Numeric ( fromRat )
 
 -- | So-called 'Literal's are one of:
 --
--- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
---   which is presumed to be surrounded by appropriate constructors
---   (@Int#@, etc.), so that the overall thing makes sense.
+-- * An unboxed numeric literal or floating-point literal which is presumed
+--   to be surrounded by appropriate constructors (@Int#@, etc.), so that
+--   the overall thing makes sense.
 --
---   We maintain the invariant that the 'Integer' the Mach{Int,Word}*
---   constructors are actually in the (possibly target-dependent) range.
---   The mkMach{Int,Word}*Wrap smart constructors ensure this by applying
+--   We maintain the invariant that the 'Integer' in the 'LitNumber'
+--   constructor is actually in the (possibly target-dependent) range.
+--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying
 --   the target machine's wrapping semantics. Use these in situations
 --   where you know the wrapping semantics are correct.
 --
 -- * The literal derived from the label mentioned in a \"foreign label\"
---   declaration ('MachLabel')
+--   declaration ('LitLabel')
 --
--- * A 'RubbishLit' to be used in place of values of 'UnliftedRep'
+-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'
 --   (i.e. 'MutVar#') when the the value is never used.
+--
+-- * A character
+-- * A string
+-- * The NULL pointer
+--
 data Literal
-  =     ------------------
-        -- First the primitive guys
-    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
+  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with
+                                -- 'mkLitChar'
 
   | LitNumber !LitNumType !Integer Type
-      --  ^ Any numeric literal that can be
-      -- internally represented with an Integer
+                                -- ^ Any numeric literal that can be
+                                -- internally represented with an Integer
 
-  | MachStr     ByteString      -- ^ A string-literal: stored and emitted
+  | LitString  ByteString       -- ^ A string-literal: stored and emitted
                                 -- UTF-8 encoded, we'll arrange to decode it
                                 -- at runtime.  Also emitted with a @'\0'@
-                                -- terminator. Create with 'mkMachString'
+                                -- terminator. Create with 'mkLitString'
 
-  | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
+  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value
                                 -- that can be represented as a Literal. Create
                                 -- with 'nullAddrLit'
 
-  | RubbishLit                  -- ^ A nonsense value, used when an unlifted
+  | LitRubbish                  -- ^ A nonsense value, used when an unlifted
                                 -- binding is absent and has type
                                 -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.
                                 -- May be lowered by code-gen to any possible
-                                -- value. Also see Note [RubbishLit]
-
-  | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
-  | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
-
-  | MachLabel   FastString
-                (Maybe Int)
-        FunctionOrData
-                -- ^ A label literal. Parameters:
-                --
-                -- 1) The name of the symbol mentioned in the declaration
-                --
-                -- 2) The size (in bytes) of the arguments
-                --    the label expects. Only applicable with
-                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
-                --    be appended to label name when emitting assembly.
+                                -- value. Also see Note [Rubbish literals]
+
+  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'
+  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'
+
+  | LitLabel   FastString (Maybe Int) FunctionOrData
+                                -- ^ A label literal. Parameters:
+                                --
+                                -- 1) The name of the symbol mentioned in the
+                                --    declaration
+                                --
+                                -- 2) The size (in bytes) of the arguments
+                                --    the label expects. Only applicable with
+                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
+                                --    be appended to label name when emitting
+                                --    assembly.
+                                --
+                                -- 3) Flag indicating whether the symbol
+                                --    references a function or a data
   deriving Data
 
 -- | Numeric literal type
@@ -190,12 +197,12 @@ instance Binary LitNumType where
       return (toEnum (fromIntegral h))
 
 instance Binary Literal where
-    put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
-    put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
-    put_ bh (MachNullAddr)    = do putByte bh 2
-    put_ bh (MachFloat ah)    = do putByte bh 3; put_ bh ah
-    put_ bh (MachDouble ai)   = do putByte bh 4; put_ bh ai
-    put_ bh (MachLabel aj mb fod)
+    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa
+    put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab
+    put_ bh (LitNullAddr)    = do putByte bh 2
+    put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah
+    put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai
+    put_ bh (LitLabel aj mb fod)
         = do putByte bh 5
              put_ bh aj
              put_ bh mb
@@ -204,29 +211,29 @@ instance Binary Literal where
         = do putByte bh 6
              put_ bh nt
              put_ bh i
-    put_ bh (RubbishLit)      = do putByte bh 7
+    put_ bh (LitRubbish)     = do putByte bh 7
     get bh = do
             h <- getByte bh
             case h of
               0 -> do
                     aa <- get bh
-                    return (MachChar aa)
+                    return (LitChar aa)
               1 -> do
                     ab <- get bh
-                    return (MachStr ab)
+                    return (LitString ab)
               2 -> do
-                    return (MachNullAddr)
+                    return (LitNullAddr)
               3 -> do
                     ah <- get bh
-                    return (MachFloat ah)
+                    return (LitFloat ah)
               4 -> do
                     ai <- get bh
-                    return (MachDouble ai)
+                    return (LitDouble ai)
               5 -> do
                     aj <- get bh
                     mb <- get bh
                     fod <- get bh
-                    return (MachLabel aj mb fod)
+                    return (LitLabel aj mb fod)
               6 -> do
                     nt <- get bh
                     i  <- get bh
@@ -243,7 +250,7 @@ instance Binary Literal where
                               panic "Evaluated the place holder for mkNatural"
                     return (LitNumber nt i t)
               _ -> do
-                    return (RubbishLit)
+                    return (LitRubbish)
 
 instance Outputable Literal where
     ppr lit = pprLiteral (\d -> d) lit
@@ -322,96 +329,96 @@ mkLitNumber dflags nt i t =
   (LitNumber nt i t)
 
 -- | Creates a 'Literal' of type @Int#@
-mkMachInt :: DynFlags -> Integer -> Literal
-mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
-                       (mkMachIntUnchecked x)
+mkLitInt :: DynFlags -> Integer -> Literal
+mkLitInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
+                       (mkLitIntUnchecked x)
 
 -- | Creates a 'Literal' of type @Int#@.
 --   If the argument is out of the (target-dependent) range, it is wrapped.
 --   See Note [Word/Int underflow/overflow]
-mkMachIntWrap :: DynFlags -> Integer -> Literal
-mkMachIntWrap dflags i = wrapLitNumber dflags $ mkMachIntUnchecked i
+mkLitIntWrap :: DynFlags -> Integer -> Literal
+mkLitIntWrap dflags i = wrapLitNumber dflags $ mkLitIntUnchecked i
 
 -- | Creates a 'Literal' of type @Int#@ without checking its range.
-mkMachIntUnchecked :: Integer -> Literal
-mkMachIntUnchecked i = LitNumber LitNumInt i intPrimTy
+mkLitIntUnchecked :: Integer -> Literal
+mkLitIntUnchecked i = LitNumber LitNumInt i intPrimTy
 
 -- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating
 --   overflow. That is, if the argument is out of the (target-dependent) range
 --   the argument is wrapped and the overflow flag will be set.
 --   See Note [Word/Int underflow/overflow]
-mkMachIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
-mkMachIntWrapC dflags i = (n, i /= i')
+mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
+mkLitIntWrapC dflags i = (n, i /= i')
   where
-    n@(LitNumber _ i' _) = mkMachIntWrap dflags i
+    n@(LitNumber _ i' _) = mkLitIntWrap dflags i
 
 -- | Creates a 'Literal' of type @Word#@
-mkMachWord :: DynFlags -> Integer -> Literal
-mkMachWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
-                        (mkMachWordUnchecked x)
+mkLitWord :: DynFlags -> Integer -> Literal
+mkLitWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
+                        (mkLitWordUnchecked x)
 
 -- | Creates a 'Literal' of type @Word#@.
 --   If the argument is out of the (target-dependent) range, it is wrapped.
 --   See Note [Word/Int underflow/overflow]
-mkMachWordWrap :: DynFlags -> Integer -> Literal
-mkMachWordWrap dflags i = wrapLitNumber dflags $ mkMachWordUnchecked i
+mkLitWordWrap :: DynFlags -> Integer -> Literal
+mkLitWordWrap dflags i = wrapLitNumber dflags $ mkLitWordUnchecked i
 
 -- | Creates a 'Literal' of type @Word#@ without checking its range.
-mkMachWordUnchecked :: Integer -> Literal
-mkMachWordUnchecked i = LitNumber LitNumWord i wordPrimTy
+mkLitWordUnchecked :: Integer -> Literal
+mkLitWordUnchecked i = LitNumber LitNumWord i wordPrimTy
 
 -- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating
 --   carry. That is, if the argument is out of the (target-dependent) range
 --   the argument is wrapped and the carry flag will be set.
 --   See Note [Word/Int underflow/overflow]
-mkMachWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
-mkMachWordWrapC dflags i = (n, i /= i')
+mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
+mkLitWordWrapC dflags i = (n, i /= i')
   where
-    n@(LitNumber _ i' _) = mkMachWordWrap dflags i
+    n@(LitNumber _ i' _) = mkLitWordWrap dflags i
 
 -- | Creates a 'Literal' of type @Int64#@
-mkMachInt64 :: Integer -> Literal
-mkMachInt64  x = ASSERT2( inInt64Range x, integer x ) (mkMachInt64Unchecked x)
+mkLitInt64 :: Integer -> Literal
+mkLitInt64  x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
 
 -- | Creates a 'Literal' of type @Int64#@.
 --   If the argument is out of the range, it is wrapped.
-mkMachInt64Wrap :: DynFlags -> Integer -> Literal
-mkMachInt64Wrap dflags i = wrapLitNumber dflags $ mkMachInt64Unchecked i
+mkLitInt64Wrap :: DynFlags -> Integer -> Literal
+mkLitInt64Wrap dflags i = wrapLitNumber dflags $ mkLitInt64Unchecked i
 
 -- | Creates a 'Literal' of type @Int64#@ without checking its range.
-mkMachInt64Unchecked :: Integer -> Literal
-mkMachInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy
+mkLitInt64Unchecked :: Integer -> Literal
+mkLitInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy
 
 -- | Creates a 'Literal' of type @Word64#@
-mkMachWord64 :: Integer -> Literal
-mkMachWord64 x = ASSERT2( inWord64Range x, integer x ) (mkMachWord64Unchecked x)
+mkLitWord64 :: Integer -> Literal
+mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
 
 -- | Creates a 'Literal' of type @Word64#@.
 --   If the argument is out of the range, it is wrapped.
-mkMachWord64Wrap :: DynFlags -> Integer -> Literal
-mkMachWord64Wrap dflags i = wrapLitNumber dflags $ mkMachWord64Unchecked i
+mkLitWord64Wrap :: DynFlags -> Integer -> Literal
+mkLitWord64Wrap dflags i = wrapLitNumber dflags $ mkLitWord64Unchecked i
 
 -- | Creates a 'Literal' of type @Word64#@ without checking its range.
-mkMachWord64Unchecked :: Integer -> Literal
-mkMachWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy
+mkLitWord64Unchecked :: Integer -> Literal
+mkLitWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy
 
 -- | Creates a 'Literal' of type @Float#@
-mkMachFloat :: Rational -> Literal
-mkMachFloat = MachFloat
+mkLitFloat :: Rational -> Literal
+mkLitFloat = LitFloat
 
 -- | Creates a 'Literal' of type @Double#@
-mkMachDouble :: Rational -> Literal
-mkMachDouble = MachDouble
+mkLitDouble :: Rational -> Literal
+mkLitDouble = LitDouble
 
 -- | Creates a 'Literal' of type @Char#@
-mkMachChar :: Char -> Literal
-mkMachChar = MachChar
+mkLitChar :: Char -> Literal
+mkLitChar = LitChar
 
 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
-mkMachString :: String -> Literal
+mkLitString :: String -> Literal
 -- stored UTF-8 encoded
-mkMachString s = MachStr (fastStringToByteString $ mkFastString s)
+mkLitString s = LitString (fastStringToByteString $ mkFastString s)
 
 mkLitInteger :: Integer -> Type -> Literal
 mkLitInteger x ty = LitNumber LitNumInteger x ty
@@ -439,8 +446,8 @@ inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 -- | Tests whether the literal represents a zero of whatever type it is
 isZeroLit :: Literal -> Bool
 isZeroLit (LitNumber _ 0 _) = True
-isZeroLit (MachFloat  0)    = True
-isZeroLit (MachDouble 0)    = True
+isZeroLit (LitFloat  0)     = True
+isZeroLit (LitDouble 0)     = True
 isZeroLit _                 = False
 
 -- | Returns the 'Integer' contained in the 'Literal', for when that makes
@@ -453,7 +460,7 @@ litValue l = case isLitValue_maybe l of
 -- | Returns the 'Integer' contained in the 'Literal', for when that makes
 -- sense, i.e. for 'Char' and numbers.
 isLitValue_maybe  :: Literal -> Maybe Integer
-isLitValue_maybe (MachChar   c)    = Just $ toInteger $ ord c
+isLitValue_maybe (LitChar   c)     = Just $ toInteger $ ord c
 isLitValue_maybe (LitNumber _ i _) = Just i
 isLitValue_maybe _                 = Nothing
 
@@ -463,7 +470,7 @@ isLitValue_maybe _                 = Nothing
 -- with the semantics of the target type.
 -- See Note [Word/Int underflow/overflow]
 mapLitValue  :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
-mapLitValue _      f (MachChar   c)     = mkMachChar (fchar c)
+mapLitValue _      f (LitChar   c)      = mkLitChar (fchar c)
    where fchar = chr . fromInteger . f . toInteger . ord
 mapLitValue dflags f (LitNumber nt i t) = wrapLitNumber dflags
                                                         (LitNumber nt (f i) t)
@@ -488,13 +495,19 @@ narrow8IntLit, narrow16IntLit, narrow32IntLit,
 
 word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
 word2IntLit dflags (LitNumber LitNumWord w _)
-  | w > tARGET_MAX_INT dflags = mkMachInt dflags (w - tARGET_MAX_WORD dflags - 1)
-  | otherwise                 = mkMachInt dflags w
+  -- Map Word range [max_int+1, max_word]
+  -- to Int range   [min_int  , -1]
+  -- Range [0,max_int] has the same representation with both Int and Word
+  | w > tARGET_MAX_INT dflags = mkLitInt dflags (w - tARGET_MAX_WORD dflags - 1)
+  | otherwise                 = mkLitInt dflags w
 word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
 
 int2WordLit dflags (LitNumber LitNumInt i _)
-  | i < 0     = mkMachWord dflags (1 + tARGET_MAX_WORD dflags + i)      -- (-1)  --->  tARGET_MAX_WORD
-  | otherwise = mkMachWord dflags i
+  -- Map Int range [min_int  , -1]
+  -- to Word range [max_int+1, max_word]
+  -- Range [0,max_int] has the same representation with both Int and Word
+  | i < 0     = mkLitWord dflags (1 + tARGET_MAX_WORD dflags + i)
+  | otherwise = mkLitWord dflags i
 int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
 
 -- | Narrow a literal number (unchecked result range)
@@ -509,32 +522,32 @@ narrow8WordLit  = narrowLit (Proxy :: Proxy Word8)
 narrow16WordLit = narrowLit (Proxy :: Proxy Word16)
 narrow32WordLit = narrowLit (Proxy :: Proxy Word32)
 
-char2IntLit (MachChar c) = mkMachIntUnchecked (toInteger (ord c))
-char2IntLit l            = pprPanic "char2IntLit" (ppr l)
-int2CharLit (LitNumber _ i _) = MachChar (chr (fromInteger i))
+char2IntLit (LitChar c)       = mkLitIntUnchecked (toInteger (ord c))
+char2IntLit l                 = pprPanic "char2IntLit" (ppr l)
+int2CharLit (LitNumber _ i _) = LitChar (chr (fromInteger i))
 int2CharLit l                 = pprPanic "int2CharLit" (ppr l)
 
-float2IntLit (MachFloat f) = mkMachIntUnchecked (truncate f)
-float2IntLit l             = pprPanic "float2IntLit" (ppr l)
-int2FloatLit (LitNumber _ i _) = MachFloat (fromInteger i)
+float2IntLit (LitFloat f)      = mkLitIntUnchecked (truncate f)
+float2IntLit l                 = pprPanic "float2IntLit" (ppr l)
+int2FloatLit (LitNumber _ i _) = LitFloat (fromInteger i)
 int2FloatLit l                 = pprPanic "int2FloatLit" (ppr l)
 
-double2IntLit (MachDouble f) = mkMachIntUnchecked (truncate f)
-double2IntLit l              = pprPanic "double2IntLit" (ppr l)
-int2DoubleLit (LitNumber _ i _) = MachDouble (fromInteger i)
+double2IntLit (LitDouble f)     = mkLitIntUnchecked (truncate f)
+double2IntLit l                 = pprPanic "double2IntLit" (ppr l)
+int2DoubleLit (LitNumber _ i _) = LitDouble (fromInteger i)
 int2DoubleLit l                 = pprPanic "int2DoubleLit" (ppr l)
 
-float2DoubleLit (MachFloat  f) = MachDouble f
-float2DoubleLit l              = pprPanic "float2DoubleLit" (ppr l)
-double2FloatLit (MachDouble d) = MachFloat  d
-double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
+float2DoubleLit (LitFloat  f) = LitDouble f
+float2DoubleLit l             = pprPanic "float2DoubleLit" (ppr l)
+double2FloatLit (LitDouble d) = LitFloat  d
+double2FloatLit l             = pprPanic "double2FloatLit" (ppr l)
 
 nullAddrLit :: Literal
-nullAddrLit = MachNullAddr
+nullAddrLit = LitNullAddr
 
 -- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.
 rubbishLit :: Literal
-rubbishLit = RubbishLit
+rubbishLit = LitRubbish
 
 {-
         Predicates
@@ -576,7 +589,7 @@ rubbishLit = RubbishLit
 -- user code. One approach to this is described in #8472.
 litIsTrivial :: Literal -> Bool
 --      c.f. CoreUtils.exprIsTrivial
-litIsTrivial (MachStr _)      = False
+litIsTrivial (LitString _)      = False
 litIsTrivial (LitNumber nt _ _) = case nt of
   LitNumInteger -> False
   LitNumNatural -> False
@@ -584,12 +597,12 @@ litIsTrivial (LitNumber nt _ _) = case nt of
   LitNumInt64   -> True
   LitNumWord    -> True
   LitNumWord64  -> True
-litIsTrivial _                = True
+litIsTrivial _                  = True
 
 -- | True if code space does not go bad if we duplicate this literal
 litIsDupable :: DynFlags -> Literal -> Bool
 --      c.f. CoreUtils.exprIsDupable
-litIsDupable _      (MachStr _)      = False
+litIsDupable _      (LitString _)      = False
 litIsDupable dflags (LitNumber nt i _) = case nt of
   LitNumInteger -> inIntRange dflags i
   LitNumNatural -> inIntRange dflags i
@@ -597,7 +610,7 @@ litIsDupable dflags (LitNumber nt i _) = case nt of
   LitNumInt64   -> True
   LitNumWord    -> True
   LitNumWord64  -> True
-litIsDupable _      _                = True
+litIsDupable _      _                  = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (LitNumber _ i _) = i >= toInteger (ord minBound)
@@ -612,7 +625,7 @@ litIsLifted (LitNumber nt _ _) = case nt of
   LitNumInt64   -> False
   LitNumWord    -> False
   LitNumWord64  -> False
-litIsLifted _               = False
+litIsLifted _                  = False
 
 {-
         Types
@@ -621,34 +634,34 @@ litIsLifted _               = False
 
 -- | Find the Haskell 'Type' the literal occupies
 literalType :: Literal -> Type
-literalType MachNullAddr      = addrPrimTy
-literalType (MachChar _)      = charPrimTy
-literalType (MachStr  _)      = addrPrimTy
-literalType (MachFloat _)     = floatPrimTy
-literalType (MachDouble _)    = doublePrimTy
-literalType (MachLabel _ _ _) = addrPrimTy
+literalType LitNullAddr       = addrPrimTy
+literalType (LitChar _)       = charPrimTy
+literalType (LitString  _)    = addrPrimTy
+literalType (LitFloat _)      = floatPrimTy
+literalType (LitDouble _)     = doublePrimTy
+literalType (LitLabel _ _ _)  = addrPrimTy
 literalType (LitNumber _ _ t) = t
-literalType (RubbishLit)      = mkForAllTy a Inferred (mkTyVarTy a)
+literalType (LitRubbish)      = mkForAllTy a Inferred (mkTyVarTy a)
   where
     a = alphaTyVarUnliftedRep
 
 absentLiteralOf :: TyCon -> Maybe Literal
 -- Return a literal of the appropriate primitive
 -- TyCon, to use as a placeholder when it doesn't matter
--- RubbishLits are handled in WwLib, because
+-- Rubbish literals are handled in WwLib, because
 --  1. Looking at the TyCon is not enough, we need the actual type
 --  2. This would need to return a type application to a literal
 absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
 
 absent_lits :: UniqFM Literal
-absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
-                        , (charPrimTyConKey,    MachChar 'x')
-                        , (intPrimTyConKey,     mkMachIntUnchecked 0)
-                        , (int64PrimTyConKey,   mkMachInt64Unchecked 0)
-                        , (wordPrimTyConKey,    mkMachWordUnchecked 0)
-                        , (word64PrimTyConKey,  mkMachWord64Unchecked 0)
-                        , (floatPrimTyConKey,   MachFloat 0)
-                        , (doublePrimTyConKey,  MachDouble 0)
+absent_lits = listToUFM [ (addrPrimTyConKey,    LitNullAddr)
+                        , (charPrimTyConKey,    LitChar 'x')
+                        , (intPrimTyConKey,     mkLitIntUnchecked 0)
+                        , (int64PrimTyConKey,   mkLitInt64Unchecked 0)
+                        , (wordPrimTyConKey,    mkLitWordUnchecked 0)
+                        , (word64PrimTyConKey,  mkLitWord64Unchecked 0)
+                        , (floatPrimTyConKey,   LitFloat 0)
+                        , (doublePrimTyConKey,  LitDouble 0)
                         ]
 
 {-
@@ -657,29 +670,29 @@ absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
 -}
 
 cmpLit :: Literal -> Literal -> Ordering
-cmpLit (MachChar      a)     (MachChar       b)     = a `compare` b
-cmpLit (MachStr       a)     (MachStr        b)     = a `compare` b
-cmpLit (MachNullAddr)        (MachNullAddr)         = EQ
-cmpLit (MachFloat     a)     (MachFloat      b)     = a `compare` b
-cmpLit (MachDouble    a)     (MachDouble     b)     = a `compare` b
-cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
-cmpLit (LitNumber nt1 a _)   (LitNumber nt2  b _)
+cmpLit (LitChar      a)     (LitChar       b)     = a `compare` b
+cmpLit (LitString    a)     (LitString     b)     = a `compare` b
+cmpLit (LitNullAddr)        (LitNullAddr)         = EQ
+cmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b
+cmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b
+cmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `compare` b
+cmpLit (LitNumber nt1 a _)  (LitNumber nt2  b _)
   | nt1 == nt2 = a   `compare` b
   | otherwise  = nt1 `compare` nt2
-cmpLit (RubbishLit)          (RubbishLit)           = EQ
+cmpLit (LitRubbish)         (LitRubbish)          = EQ
 cmpLit lit1 lit2
   | litTag lit1 < litTag lit2 = LT
   | otherwise                 = GT
 
 litTag :: Literal -> Int
-litTag (MachChar      _)   = 1
-litTag (MachStr       _)   = 2
-litTag (MachNullAddr)      = 3
-litTag (MachFloat     _)   = 4
-litTag (MachDouble    _)   = 5
-litTag (MachLabel _ _ _)   = 6
-litTag (LitNumber  {})     = 7
-litTag (RubbishLit)        = 8
+litTag (LitChar      _)   = 1
+litTag (LitString    _)   = 2
+litTag (LitNullAddr)      = 3
+litTag (LitFloat     _)   = 4
+litTag (LitDouble    _)   = 5
+litTag (LitLabel _ _ _)   = 6
+litTag (LitNumber  {})    = 7
+litTag (LitRubbish)       = 8
 
 {-
         Printing
@@ -688,11 +701,11 @@ litTag (RubbishLit)        = 8
 -}
 
 pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
-pprLiteral _       (MachChar c)     = pprPrimChar c
-pprLiteral _       (MachStr s)      = pprHsBytes s
-pprLiteral _       (MachNullAddr)   = text "__NULL"
-pprLiteral _       (MachFloat f)    = float (fromRat f) <> primFloatSuffix
-pprLiteral _       (MachDouble d)   = double (fromRat d) <> primDoubleSuffix
+pprLiteral _       (LitChar c)     = pprPrimChar c
+pprLiteral _       (LitString s)   = pprHsBytes s
+pprLiteral _       (LitNullAddr)   = text "__NULL"
+pprLiteral _       (LitFloat f)    = float (fromRat f) <> primFloatSuffix
+pprLiteral _       (LitDouble d)   = double (fromRat d) <> primDoubleSuffix
 pprLiteral add_par (LitNumber nt i _)
    = case nt of
        LitNumInteger -> pprIntegerVal add_par i
@@ -701,11 +714,12 @@ pprLiteral add_par (LitNumber nt i _)
        LitNumInt64   -> pprPrimInt64 i
        LitNumWord    -> pprPrimWord i
        LitNumWord64  -> pprPrimWord64 i
-pprLiteral add_par (MachLabel l mb fod) = add_par (text "__label" <+> b <+> ppr fod)
+pprLiteral add_par (LitLabel l mb fod) =
+    add_par (text "__label" <+> b <+> ppr fod)
     where b = case mb of
               Nothing -> pprHsString l
               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
-pprLiteral _       (RubbishLit)     = text "__RUBBISH"
+pprLiteral _       (LitRubbish)     = text "__RUBBISH"
 
 pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
 -- See Note [Printing of literals in Core].
@@ -716,7 +730,7 @@ pprIntegerVal add_par i | i < 0     = add_par (integer i)
 Note [Printing of literals in Core]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The function `add_par` is used to wrap parenthesis around negative integers
-(`LitInteger`) and labels (`MachLabel`), if they occur in a context requiring
+(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring
 an atomic thing (for example function application).
 
 Although not all Core literals would be valid Haskell, we are trying to stay
@@ -736,21 +750,21 @@ To that end:
 Literal         Output             Output if context requires
                                    an atom (if different)
 -------         -------            ----------------------
-MachChar        'a'#
-MachStr         "aaa"#
-MachNullAddr    "__NULL"
-MachInt         -1#
-MachInt64       -1L#
-MachWord         1##
-MachWord64       1L##
-MachFloat       -1.0#
-MachDouble      -1.0##
+LitChar         'a'#
+LitString       "aaa"#
+LitNullAddr     "__NULL"
+LitInt          -1#
+LitInt64        -1L#
+LitWord          1##
+LitWord64        1L##
+LitFloat        -1.0#
+LitDouble       -1.0##
 LitInteger      -1                 (-1)
-MachLabel       "__label" ...      ("__label" ...)
-RubbishLit      "__RUBBISH"
+LitLabel        "__label" ...      ("__label" ...)
+LitRubbish      "__RUBBISH"
 
-Note [RubbishLit]
-~~~~~~~~~~~~~~~~~
+Note [Rubbish literals]
+~~~~~~~~~~~~~~~~~~~~~~~
 During worker/wrapper after demand analysis, where an argument
 is unused (absent) we do the following w/w split (supposing that
 y is absent):
@@ -772,12 +786,12 @@ What is <absent value>?
 * But what about /unlifted/ but /boxed/ types like MutVar# or
   Array#?   We need a literal value of that type.
 
-That is 'RubbishLit'.  Since we need a rubbish literal for
-many boxed, unlifted types, we say that RubbishLit has type
-  RubbishLit :: forall (a :: TYPE UnliftedRep). a
+That is 'LitRubbish'.  Since we need a rubbish literal for
+many boxed, unlifted types, we say that LitRubbish has type
+  LitRubbish :: forall (a :: TYPE UnliftedRep). a
 
 So we might see a w/w split like
-  $wf x z = let y :: Array# Int = RubbishLit @(Array# Int)
+  $wf x z = let y :: Array# Int = LitRubbish @(Array# Int)
             in e
 
 Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted
@@ -785,19 +799,19 @@ heap pointers.
 
 Here are the moving parts:
 
-* We define RubbishLit as a constructor in Literal.Literal
+* We define LitRubbish as a constructor in Literal.Literal
 
 * It is given its polymoprhic type by Literal.literalType
 
-* WwLib.mk_absent_let introduces a RubbishLit for absent
-  arguments of boxed, unliftd type.
+* WwLib.mk_absent_let introduces a LitRubbish for absent
+  arguments of boxed, unlifted type.
 
 * In CoreToSTG we convert (RubishLit @t) to just ().  STG is
   untyped, so it doesn't matter that it points to a lifted
   value. The important thing is that it is a heap pointer,
   which the garbage collector can follow if it encounters it.
 
-  We considered maintaining RubbishLit in STG, and lowering
+  We considered maintaining LitRubbish in STG, and lowering
   it in the code genreators, but it seems simpler to do it
   once and for all in CoreToSTG.
 
index 3f7c97f..40b4e70 100644 (file)
@@ -419,7 +419,7 @@ data RtsLabelInfo
   | RtsSlowFastTickyCtr String
 
   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.
 
 
@@ -1368,7 +1368,7 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform ->
 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 underscorePrefix = (cLeadingUnderscore == "YES")
 
-asmTempLabelPrefix :: Platform -> LitString  -- for formatting labels
+asmTempLabelPrefix :: Platform -> PtrString  -- for formatting labels
 asmTempLabelPrefix platform = case platformOS platform of
     OSDarwin -> sLit "L"
     OSAIX    -> sLit "__L" -- follow IBM XL C's convention
index 97b181a..77d894b 100644 (file)
@@ -173,7 +173,7 @@ data Width   = W8 | W16 | W32 | W64
 instance Outputable Width where
    ppr rep = ptext (mrStr rep)
 
-mrStr :: Width -> LitString
+mrStr :: Width -> PtrString
 mrStr W8   = sLit("W8")
 mrStr W16  = sLit("W16")
 mrStr W32  = sLit("W32")
index a8ec300..2ddeceb 100644 (file)
@@ -214,7 +214,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
 buildDynCon' dflags platform binder _ _cc con [arg]
   | maybeCharLikeCon con
   , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)
-  , NonVoid (StgLitArg (MachChar val)) <- arg
+  , NonVoid (StgLitArg (LitChar val)) <- arg
   , let val_int = ord val :: Int
   , val_int <= mAX_CHARLIKE dflags
   , val_int >= mIN_CHARLIKE dflags
index 94e19e4..4a61356 100644 (file)
@@ -86,27 +86,27 @@ import Data.Word
 -------------------------------------------------------------------------
 
 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.
-cgLit other_lit   = do dflags <- getDynFlags
-                       return (mkSimpleLit dflags other_lit)
+cgLit other_lit     = do dflags <- getDynFlags
+                         return (mkSimpleLit dflags other_lit)
 
 mkSimpleLit :: DynFlags -> Literal -> CmmLit
-mkSimpleLit dflags (MachChar   c)    = CmmInt (fromIntegral (ord c)) (wordWidth dflags)
-mkSimpleLit dflags MachNullAddr      = zeroCLit dflags
+mkSimpleLit dflags (LitChar   c)                = CmmInt (fromIntegral (ord c))
+                                                         (wordWidth dflags)
+mkSimpleLit dflags LitNullAddr                  = zeroCLit dflags
 mkSimpleLit dflags (LitNumber LitNumInt i _)    = CmmInt i (wordWidth dflags)
 mkSimpleLit _      (LitNumber LitNumInt64 i _)  = CmmInt i W64
 mkSimpleLit dflags (LitNumber LitNumWord i _)   = CmmInt i (wordWidth dflags)
 mkSimpleLit _      (LitNumber LitNumWord64 i _) = CmmInt i W64
-mkSimpleLit _      (MachFloat r)     = CmmFloat r W32
-mkSimpleLit _      (MachDouble r)    = CmmFloat r W64
-mkSimpleLit _      (MachLabel fs ms fod)
-        = CmmLabel (mkForeignLabel fs ms labelSrc fod)
-        where
-                -- TODO: Literal labels might not actually be in the current package...
-                labelSrc = ForeignLabelInThisPackage
--- NB: RubbishLit should have been lowered in "CoreToStg"
-mkSimpleLit _ other             = pprPanic "mkSimpleLit" (ppr other)
+mkSimpleLit _      (LitFloat r)                 = CmmFloat r W32
+mkSimpleLit _      (LitDouble r)                = CmmFloat r W64
+mkSimpleLit _      (LitLabel fs ms fod)
+  = let -- TODO: Literal labels might not actually be in the current package...
+        labelSrc = ForeignLabelInThisPackage
+    in CmmLabel (mkForeignLabel fs ms labelSrc fod)
+-- NB: LitRubbish should have been lowered in "CoreToStg"
+mkSimpleLit _      other = pprPanic "mkSimpleLit" (ppr other)
 
 --------------------------------------------------------------------------
 --
index cc0ae6f..aebd0e3 100644 (file)
@@ -30,7 +30,7 @@ import CoreUtils
 import CoreFVs
 import PprCore  ( pprCoreBindings, pprRules )
 import OccurAnal( occurAnalyseExpr, occurAnalysePgm )
-import Literal  ( Literal(MachStr) )
+import Literal  ( Literal(LitString) )
 import Id
 import Var      ( varType, isNonCoVarId )
 import VarSet
@@ -816,8 +816,8 @@ exprIsConApp_maybe (in_scope, id_unf) expr
         -- See Note [exprIsConApp_maybe on literal strings]
         | (fun `hasKey` unpackCStringIdKey) ||
           (fun `hasKey` unpackCStringUtf8IdKey)
-        , [arg]              <- args
-        , Just (MachStr str) <- exprIsLiteral_maybe (in_scope, id_unf) arg
+        , [arg]                <- args
+        , Just (LitString str) <- exprIsLiteral_maybe (in_scope, id_unf) arg
         = dealWithStringLiteral fun str co
         where
           unfolding = id_unf fun
@@ -858,7 +858,7 @@ dealWithStringLiteral fun str co
         rest = if BS.null charTail
                  then mkConApp nilDataCon [Type charTy]
                  else App (Var fun)
-                          (Lit (MachStr charTail))
+                          (Lit (LitString charTail))
 
     in pushCoDataCon consDataCon [Type charTy, char, rest] co
 
index 19b6364..58a7162 100644 (file)
@@ -684,7 +684,7 @@ cvtLitInteger :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr
 -- See Note [Integer literals] in Literal
 cvtLitInteger dflags _ (Just sdatacon) i
   | 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
     = mkApps (Var mk_integer) [isNonNegative, ints]
@@ -694,7 +694,7 @@ cvtLitInteger dflags mk_integer _ i
         f 0 = []
         f x = let low  = x .&. mask
                   high = x `shiftR` bits
-              in mkConApp intDataCon [Lit (mkMachInt dflags low)] : f high
+              in mkConApp intDataCon [Lit (mkLitInt dflags low)] : f high
         bits = 31
         mask = 2 ^ bits - 1
 
@@ -704,7 +704,7 @@ cvtLitNatural :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr
 -- See Note [Natural literals] in Literal
 cvtLitNatural dflags _ (Just sdatacon) i
   | 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
     = mkApps (Var mk_natural) [words]
@@ -712,7 +712,7 @@ cvtLitNatural dflags mk_natural _ i
         f 0 = []
         f x = let low  = x .&. mask
                   high = x `shiftR` bits
-              in mkConApp wordDataCon [Lit (mkMachWord dflags low)] : f high
+              in mkConApp wordDataCon [Lit (mkLitWord dflags low)] : f high
         bits = 32
         mask = 2 ^ bits - 1
 
index aa27d7a..53a3992 100644 (file)
@@ -1854,8 +1854,8 @@ mkIntLit      :: DynFlags -> Integer -> Expr b
 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 mkIntLitInt   :: DynFlags -> Int     -> Expr b
 
-mkIntLit    dflags n = Lit (mkMachInt dflags n)
-mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
+mkIntLit    dflags n = Lit (mkLitInt dflags n)
+mkIntLitInt dflags n = Lit (mkLitInt dflags (toInteger n))
 
 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
@@ -1864,14 +1864,14 @@ mkWordLit     :: DynFlags -> Integer -> Expr b
 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 mkWordLitWord :: DynFlags -> Word -> Expr b
 
-mkWordLit     dflags w = Lit (mkMachWord dflags w)
-mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
+mkWordLit     dflags w = Lit (mkLitWord dflags w)
+mkWordLitWord dflags w = Lit (mkLitWord dflags (toInteger w))
 
 mkWord64LitWord64 :: Word64 -> Expr b
-mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
+mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
 
 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#@.
 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
@@ -1880,8 +1880,8 @@ mkCharLit :: Char -> Expr b
 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
 mkStringLit :: String -> Expr b
 
-mkCharLit   c = Lit (mkMachChar c)
-mkStringLit s = Lit (mkMachString s)
+mkCharLit   c = Lit (mkLitChar c)
+mkStringLit s = Lit (mkLitString s)
 
 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
@@ -1890,8 +1890,8 @@ mkFloatLit :: Rational -> Expr b
 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 mkFloatLitFloat :: Float -> Expr b
 
-mkFloatLit      f = Lit (mkMachFloat f)
-mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
+mkFloatLit      f = Lit (mkLitFloat f)
+mkFloatLitFloat f = Lit (mkLitFloat (toRational f))
 
 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
@@ -1900,8 +1900,8 @@ mkDoubleLit :: Rational -> Expr b
 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 mkDoubleLitDouble :: Double -> Expr b
 
-mkDoubleLit       d = Lit (mkMachDouble d)
-mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
+mkDoubleLit       d = Lit (mkLitDouble d)
+mkDoubleLitDouble d = Lit (mkLitDouble (toRational d))
 
 -- | 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
index adb399e..020aa85 100644 (file)
@@ -772,7 +772,7 @@ litSize :: Literal -> Int
 -- Used by CoreUnfold.sizeExpr
 litSize (LitNumber LitNumInteger _ _) = 100   -- Note [Size of literal integers]
 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
         -- [Sept03: make literal strings a bit bigger to avoid fruitless
         --  duplication of little strings]
index c39e681..aa77592 100644 (file)
@@ -1527,7 +1527,7 @@ expr_ok primop_ok other_expr
   | (expr, args) <- collectArgs other_expr
   = case stripTicksTopE (not . tickishCounts) expr of
         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).
         Lit lit -> ASSERT( lit == rubbishLit ) True
         _       -> False
@@ -1853,7 +1853,7 @@ exprIsTickedString = isJust . exprIsTickedString_maybe
 -- different shape.
 -- Used to "look through" Ticks in places that need to handle literal strings.
 exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
-exprIsTickedString_maybe (Lit (MachStr bs)) = Just bs
+exprIsTickedString_maybe (Lit (LitString bs)) = Just bs
 exprIsTickedString_maybe (Tick t e)
   -- we don't tick literals with CostCentre ticks, compare to mkTick
   | tickishPlace t == PlaceCostCentre = Nothing
@@ -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
     Just e  -> is_static in_arg e
     Nothing -> True
-  is_static _      (Lit (MachLabel {}))   = False
+  is_static _      (Lit (LitLabel {}))    = False
   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
         -- reason is that it might give rise to unresolvable symbols
         -- in the object file: under Linux, references to "weak"
index 8a7d3b4..73c2e7c 100644 (file)
@@ -302,7 +302,7 @@ mkStringExprFSWith lookupM str
   where
     chars = unpackFS str
     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
   = mkApps (Var err_id) [ Type (getRuntimeRep res_ty)
                         , Type res_ty, err_string ]
   where
-    err_string = Lit (mkMachString err_msg)
+    err_string = Lit (mkLitString err_msg)
 
 mkImpossibleExpr :: Type -> CoreExpr
 mkImpossibleExpr res_ty
@@ -896,4 +896,4 @@ mkAbsentErrorApp :: Type         -- The type to instantiate 'a'
 mkAbsentErrorApp res_ty err_msg
   = mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ]
   where
-    err_string = Lit (mkMachString err_msg)
+    err_string = Lit (mkLitString err_msg)
index 7a634ac..7cab8e8 100644 (file)
@@ -327,8 +327,8 @@ resultWrapper result_ty
   = do { dflags <- getDynFlags
        ; let marshal_bool e
                = mkWildCase e intPrimTy boolTy
-                   [ (DEFAULT                    ,[],Var trueDataConId )
-                   , (LitAlt (mkMachInt dflags 0),[],Var falseDataConId)]
+                   [ (DEFAULT                   ,[],Var trueDataConId )
+                   , (LitAlt (mkLitInt dflags 0),[],Var falseDataConId)]
        ; return (Just intPrimTy, marshal_bool) }
 
   -- Newtypes
index 5856ff2..2e20cc7 100644 (file)
@@ -163,7 +163,7 @@ dsCImport id co (CLabel cid) cconv _ _ = do
    (resTy, foRhs) <- resultWrapper ty
    ASSERT(fromJust resTy `eqType` addrPrimTy)    -- typechecker ensures this
     let
-        rhs = foRhs (Lit (MachLabel cid stdcall_info fod))
+        rhs = foRhs (Lit (LitLabel cid stdcall_info fod))
         rhs' = Cast rhs co
         stdcall_info = fun_type_arg_stdcall_info dflags cconv ty
     in
@@ -442,8 +442,8 @@ dsFExportDynamic id co0 cconv = do
          -}
         adj_args      = [ mkIntLitInt dflags (ccallConvToInt cconv)
                         , Var stbl_value
-                        , Lit (MachLabel fe_nm mb_sz_args IsFunction)
-                        , Lit (mkMachString typestring)
+                        , Lit (LitLabel fe_nm mb_sz_args IsFunction)
+                        , Lit (mkLitString typestring)
                         ]
           -- name of external entry point providing these services.
           -- (probably in the RTS.)
index 921276e..e93b2c3 100644 (file)
@@ -82,7 +82,7 @@ import ErrUtils
 import FastString
 import Var (EvVar)
 import UniqFM ( lookupWithDefaultUFM )
-import Literal ( mkMachString )
+import Literal ( mkLitString )
 import CostCentreState
 
 import Data.IORef
@@ -609,5 +609,5 @@ pprRuntimeTrace str doc expr = do
   dflags <- getDynFlags
   let message :: CoreExpr
       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]
index 001b361..ca22387 100644 (file)
@@ -403,8 +403,8 @@ mkErrorAppDs err_id ty msg = do
     dflags <- getDynFlags
     let
         full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
-        core_msg = Lit (mkMachString full_msg)
-        -- mkMachString returns a result of type String#
+        core_msg = Lit (mkLitString full_msg)
+        -- mkLitString returns a result of type String#
     return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])
 
 {-
index e4a8bad..f207d60 100644 (file)
@@ -848,8 +848,8 @@ Previously we had, as PatGroup constructors
 
 But Literal is really supposed to represent an *unboxed* literal, like Int#.
 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
-the invariant that value in a MachInt must be in the range of the target
+into a LitInt constructor. This didn't really make sense; and we now have
+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.
 
 Solution: For pattern grouping purposes, just store the literal directly in
index ca7ef0a..b91f44d 100644 (file)
@@ -80,14 +80,14 @@ dsLit :: HsLit GhcRn -> DsM CoreExpr
 dsLit l = do
   dflags <- getDynFlags
   case l of
-    HsStringPrim _ s -> return (Lit (MachStr s))
-    HsCharPrim   _ c -> return (Lit (MachChar c))
-    HsIntPrim    _ i -> return (Lit (mkMachIntWrap dflags i))
-    HsWordPrim   _ w -> return (Lit (mkMachWordWrap dflags w))
-    HsInt64Prim  _ i -> return (Lit (mkMachInt64Wrap dflags i))
-    HsWord64Prim _ w -> return (Lit (mkMachWord64Wrap dflags w))
-    HsFloatPrim  _ f -> return (Lit (MachFloat (fl_value f)))
-    HsDoublePrim _ d -> return (Lit (MachDouble (fl_value d)))
+    HsStringPrim _ s -> return (Lit (LitString s))
+    HsCharPrim   _ c -> return (Lit (LitChar c))
+    HsIntPrim    _ i -> return (Lit (mkLitIntWrap dflags i))
+    HsWordPrim   _ w -> return (Lit (mkLitWordWrap dflags w))
+    HsInt64Prim  _ i -> return (Lit (mkLitInt64Wrap dflags i))
+    HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap dflags w))
+    HsFloatPrim  _ f -> return (Lit (LitFloat (fl_value f)))
+    HsDoublePrim _ d -> return (Lit (LitDouble (fl_value d)))
     HsChar _ c       -> return (mkCharExpr c)
     HsString _ str   -> mkStringExprFS str
     HsInteger _ i _  -> mkIntegerExpr i
@@ -375,9 +375,9 @@ matchLiterals (var:vars) ty sub_groups
 
     wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
         -- 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
-               -- should be separate MachBytes and MachStr constructors?
+               -- should be separate LitBytes and LitString constructors?
                let s'  = mkFastStringByteString s
              ; lit    <- mkStringExprFS s'
              ; let pred = mkApps (Var eq_str) [Var var, lit]
@@ -391,20 +391,20 @@ hsLitKey :: DynFlags -> HsLit GhcTc -> Literal
 -- Get the Core literal corresponding to a HsLit.
 -- It only works for primitive types and strings;
 -- 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
 -- produces a primitive Literal of type matching the original HsLit.
 -- 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
 -- HsLit does not.
-hsLitKey dflags (HsIntPrim    _ i) = mkMachIntWrap  dflags i
-hsLitKey dflags (HsWordPrim   _ w) = mkMachWordWrap dflags w
-hsLitKey dflags (HsInt64Prim  _ i) = mkMachInt64Wrap  dflags i
-hsLitKey dflags (HsWord64Prim _ w) = mkMachWord64Wrap dflags w
-hsLitKey _      (HsCharPrim   _ c) = mkMachChar            c
-hsLitKey _      (HsFloatPrim  _ f) = mkMachFloat           (fl_value f)
-hsLitKey _      (HsDoublePrim _ d) = mkMachDouble          (fl_value d)
-hsLitKey _      (HsString _ s)     = MachStr (fastStringToByteString s)
+hsLitKey dflags (HsIntPrim    _ i) = mkLitIntWrap  dflags i
+hsLitKey dflags (HsWordPrim   _ w) = mkLitWordWrap dflags w
+hsLitKey dflags (HsInt64Prim  _ i) = mkLitInt64Wrap  dflags i
+hsLitKey dflags (HsWord64Prim _ w) = mkLitWord64Wrap dflags w
+hsLitKey _      (HsCharPrim   _ c) = mkLitChar            c
+hsLitKey _      (HsFloatPrim  _ f) = mkLitFloat           (fl_value f)
+hsLitKey _      (HsDoublePrim _ d) = mkLitDouble          (fl_value d)
+hsLitKey _      (HsString _ s)     = LitString (fastStringToByteString s)
 hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
 {-
index 4473a9e..0776e40 100644 (file)
@@ -441,18 +441,18 @@ assembleI dflags i = case i of
                                                    Op q, Op np]
 
   where
-    literal (MachLabel fs (Just sz) _)
+    literal (LitLabel fs (Just sz) _)
      | platformOS (targetPlatform dflags) == OSMinGW32
          = litlabel (appendFS fs (mkFastString ('@':show sz)))
      -- On Windows, stdcall labels have a suffix indicating the no. of
      -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
-    literal (MachLabel fs _ _) = litlabel fs
-    literal MachNullAddr       = int 0
-    literal (MachFloat r)      = float (fromRational r)
-    literal (MachDouble r)     = double (fromRational r)
-    literal (MachChar c)       = int (ord c)
-    literal (MachStr bs)       = lit [BCONPtrStr bs]
-       -- MachStr requires a zero-terminator when emitted
+    literal (LitLabel fs _ _) = litlabel fs
+    literal LitNullAddr       = int 0
+    literal (LitFloat r)      = float (fromRational r)
+    literal (LitDouble r)     = double (fromRational r)
+    literal (LitChar c)       = int (ord c)
+    literal (LitString bs)    = lit [BCONPtrStr bs]
+       -- LitString requires a zero-terminator when emitted
     literal (LitNumber nt i _) = case nt of
       LitNumInt     -> int (fromIntegral i)
       LitNumWord    -> int (fromIntegral i)
@@ -460,10 +460,10 @@ assembleI dflags i = case i of
       LitNumWord64  -> int64 (fromIntegral i)
       LitNumInteger -> panic "ByteCodeAsm.literal: LitNumInteger"
       LitNumNatural -> panic "ByteCodeAsm.literal: LitNumNatural"
-    -- We can lower 'RubbishLit' to an arbitrary constant, but @NULL@ is most
+    -- We can lower 'LitRubbish' to an arbitrary constant, but @NULL@ is most
     -- likely to elicit a crash (rather than corrupt memory) in case absence
     -- analysis messed up.
-    literal RubbishLit         = int 0
+    literal LitRubbish         = int 0
 
     litlabel fs = lit [BCONPtrLbl fs]
     addr (RemotePtr a) = words [fromIntegral a]
index e723258..1136907 100644 (file)
@@ -998,9 +998,9 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
         my_discr (LitAlt l, _, _)
            = case l of LitNumber LitNumInt i  _  -> DiscrI (fromInteger i)
                        LitNumber LitNumWord w _  -> DiscrW (fromInteger w)
-                       MachFloat r   -> DiscrF (fromRational r)
-                       MachDouble r  -> DiscrD (fromRational r)
-                       MachChar i    -> DiscrI (ord i)
+                       LitFloat r   -> DiscrF (fromRational r)
+                       LitDouble r  -> DiscrD (fromRational r)
+                       LitChar i    -> DiscrI (ord i)
                        _ -> pprPanic "schemeE(AnnCase).my_discr" (ppr l)
 
         maybe_ncons
@@ -1200,7 +1200,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                  StaticTarget _ _ _ False ->
                    panic "generateCCall: unexpected FFI value import"
                  StaticTarget _ target _ True ->
-                   Just (MachLabel target mb_size IsFunction)
+                   Just (LitLabel target mb_size IsFunction)
                    where
                       mb_size
                           | OSMinGW32 <- platformOS (targetPlatform dflags)
@@ -1300,13 +1300,13 @@ primRepToFFIType dflags r
 mkDummyLiteral :: DynFlags -> PrimRep -> Literal
 mkDummyLiteral dflags pr
    = case pr of
-        IntRep    -> mkMachInt dflags 0
-        WordRep   -> mkMachWord dflags 0
-        Int64Rep  -> mkMachInt64 0
-        Word64Rep -> mkMachWord64 0
-        AddrRep   -> MachNullAddr
-        DoubleRep -> MachDouble 0
-        FloatRep  -> MachFloat 0
+        IntRep    -> mkLitInt dflags 0
+        WordRep   -> mkLitWord dflags 0
+        Int64Rep  -> mkLitInt64 0
+        Word64Rep -> mkLitWord64 0
+        AddrRep   -> LitNullAddr
+        DoubleRep -> LitDouble 0
+        FloatRep  -> LitFloat 0
         _         -> pprPanic "mkDummyLiteral" (ppr pr)
 
 
@@ -1423,7 +1423,7 @@ implement_tagToId d s p arg names
            slide_ws = bytesToWords dflags (d - s + arg_bytes)
 
        return (push_arg
-               `appOL` unitOL (PUSH_UBX MachNullAddr 1)
+               `appOL` unitOL (PUSH_UBX LitNullAddr 1)
                    -- Push bogus word (see Note [Implementing tagToEnum#])
                `appOL` concatOL steps
                `appOL` toOL [ LABEL label_fail, CASEFAIL,
@@ -1507,7 +1507,7 @@ pushAtom d p (AnnVar var)
    = do topStrings <- getTopStrings
         dflags <- getDynFlags
         case lookupVarEnv topStrings var of
-            Just ptr -> pushAtom d p $ AnnLit $ mkMachWord dflags $
+            Just ptr -> pushAtom d p $ AnnLit $ mkLitWord dflags $
               fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr
             Nothing -> do
                 let sz = idSizeCon dflags var
@@ -1523,12 +1523,13 @@ pushAtom _ _ (AnnLit lit) = do
                            wordsToBytes dflags size_words)
 
      case lit of
-        MachLabel _ _ _ -> code N
-        MachFloat _   -> code F
-        MachDouble _  -> code D
-        MachChar _    -> code N
-        MachNullAddr  -> code N
-        MachStr _     -> code N
+        LitLabel _ _ _   -> code N
+        LitFloat _       -> code F
+        LitDouble _      -> code D
+        LitChar _        -> code N
+        LitNullAddr      -> code N
+        LitString _      -> code N
+        LitRubbish       -> code N
         LitNumber nt _ _ -> case nt of
           LitNumInt     -> code N
           LitNumWord    -> code N
@@ -1539,7 +1540,6 @@ pushAtom _ _ (AnnLit lit) = do
           -- representation.
           LitNumInteger -> panic "pushAtom: LitInteger"
           LitNumNatural -> panic "pushAtom: LitNatural"
-        RubbishLit    -> code N
 
 pushAtom _ _ expr
    = pprPanic "ByteCodeGen.pushAtom"
@@ -1552,7 +1552,7 @@ pushAtom _ _ expr
 pushConstrAtom
     :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff)
 
-pushConstrAtom _ _ (AnnLit lit@(MachFloat _)) =
+pushConstrAtom _ _ (AnnLit lit@(LitFloat _)) =
     return (unitOL (PUSH_UBX32 lit), 4)
 
 pushConstrAtom d p (AnnVar v)
index bc7bbaa..975c361 100644 (file)
@@ -188,7 +188,8 @@ pprSpecialStatic (LMBitc v t) =
 pprSpecialStatic stat = ppr stat
 
 
-pprStaticArith :: LlvmStatic -> LlvmStatic -> LitString -> LitString -> String -> SDoc
+pprStaticArith :: LlvmStatic -> LlvmStatic -> PtrString -> PtrString
+                  -> String -> SDoc
 pprStaticArith s1 s2 int_op float_op op_name =
   let ty1 = getStatType s1
       op  = if isFloat ty1 then float_op else int_op
index 9a3cb60..3e2c963 100644 (file)
@@ -604,7 +604,7 @@ cannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
 cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
                                            (sLit "Ambiguous interface for")
 
-cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
+cantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult
             -> SDoc
 cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
   | Just pkgs <- unambiguousPackages
@@ -751,8 +751,8 @@ cantFindErr cannot_find _ dflags mod_name find_result
                     <+> ppr (packageConfigId pkg))
               | otherwise = Outputable.empty
 
-cantFindInstalledErr :: LitString -> LitString -> DynFlags -> ModuleName -> InstalledFindResult
-            -> SDoc
+cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName
+                     -> InstalledFindResult -> SDoc
 cantFindInstalledErr cannot_find _ dflags mod_name find_result
   = ptext cannot_find <+> quotes (ppr mod_name)
     $$ more_info
index db5395a..687a4f8 100644 (file)
@@ -164,7 +164,7 @@ dwarfSection name = sdocWithPlatform $ \plat ->
        -> text "\t.section .debug_" <> text name <> text ",\"dr\""
 
 -- * Dwarf section labels
-dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: LitString
+dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: PtrString
 dwarfInfoLabel   = sLit ".Lsection_info"
 dwarfAbbrevLabel = sLit ".Lsection_abbrev"
 dwarfLineLabel   = sLit ".Lsection_line"
index 2562944..05b5b7f 100644 (file)
@@ -56,7 +56,7 @@ data DwarfInfo
                      , dwCompDir :: String
                      , dwLowLabel :: CLabel
                      , dwHighLabel :: CLabel
-                     , dwLineLabel :: LitString }
+                     , dwLineLabel :: PtrString }
   | DwarfSubprogram { dwChildren :: [DwarfInfo]
                     , dwName :: String
                     , dwLabel :: CLabel
index 2f64d82..3d9077d 100644 (file)
@@ -986,7 +986,7 @@ pprInstr (UPDATE_SP fmt amount)
 -- pprInstr _ = panic "pprInstr (ppc)"
 
 
-pprLogic :: LitString -> Reg -> Reg -> RI -> SDoc
+pprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc
 pprLogic op reg1 reg2 ri = hcat [
         char '\t',
         ptext op,
@@ -1039,7 +1039,7 @@ pprDiv fmt sgn reg1 reg2 reg3 = hcat [
     ]
 
 
-pprUnary :: LitString -> Reg -> Reg -> SDoc
+pprUnary :: PtrString -> Reg -> Reg -> SDoc
 pprUnary op reg1 reg2 = hcat [
         char '\t',
         ptext op,
@@ -1050,7 +1050,7 @@ pprUnary op reg1 reg2 = hcat [
     ]
 
 
-pprBinaryF :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
 pprBinaryF op fmt reg1 reg2 reg3 = hcat [
         char '\t',
         ptext op,
index eb401ff..b4cdbda 100644 (file)
@@ -572,7 +572,7 @@ pprRI (RIImm r) = pprImm r
 
 
 -- | Pretty print a two reg instruction.
-pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc
+pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
 pprFormatRegReg name format reg1 reg2
   = hcat [
         char '\t',
@@ -589,7 +589,7 @@ pprFormatRegReg name format reg1 reg2
 
 
 -- | Pretty print a three reg instruction.
-pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
 pprFormatRegRegReg name format reg1 reg2 reg3
   = hcat [
         char '\t',
@@ -607,7 +607,7 @@ pprFormatRegRegReg name format reg1 reg2 reg3
 
 
 -- | Pretty print an instruction of two regs and a ri.
-pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> SDoc
+pprRegRIReg :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
 pprRegRIReg name b reg1 ri reg2
   = hcat [
         char '\t',
@@ -621,7 +621,7 @@ pprRegRIReg name b reg1 ri reg2
     ]
 
 {-
-pprRIReg :: LitString -> Bool -> RI -> Reg -> SDoc
+pprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc
 pprRIReg name b ri reg1
   = hcat [
         char '\t',
index acfae71..141e781 100644 (file)
@@ -407,7 +407,7 @@ pprReg f r
         _  -> ppr_reg_float i
       })
 
-ppr_reg_float :: Int -> LitString
+ppr_reg_float :: Int -> PtrString
 ppr_reg_float i = case i of
         16 -> sLit "%fake0";  17 -> sLit "%fake1"
         18 -> sLit "%fake2";  19 -> sLit "%fake3"
@@ -1202,17 +1202,17 @@ pprOperand _ (OpImm i)   = pprDollImm i
 pprOperand _ (OpAddr ea) = pprAddr ea
 
 
-pprMnemonic_  :: LitString -> SDoc
+pprMnemonic_  :: PtrString -> SDoc
 pprMnemonic_ name =
    char '\t' <> ptext name <> space
 
 
-pprMnemonic  :: LitString -> Format -> SDoc
+pprMnemonic  :: PtrString -> Format -> SDoc
 pprMnemonic name format =
    char '\t' <> ptext name <> pprFormat format <> space
 
 
-pprFormatImmOp :: LitString -> Format -> Imm -> Operand -> SDoc
+pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
 pprFormatImmOp name format imm op1
   = hcat [
         pprMnemonic name format,
@@ -1223,14 +1223,14 @@ pprFormatImmOp name format imm op1
     ]
 
 
-pprFormatOp_ :: LitString -> Format -> Operand -> SDoc
+pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
 pprFormatOp_ name format op1
   = hcat [
         pprMnemonic_ name ,
         pprOperand format op1
     ]
 
-pprFormatOp :: LitString -> Format -> Operand -> SDoc
+pprFormatOp :: PtrString -> Format -> Operand -> SDoc
 pprFormatOp name format op1
   = hcat [
         pprMnemonic name format,
@@ -1238,7 +1238,7 @@ pprFormatOp name format op1
     ]
 
 
-pprFormatOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
+pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
 pprFormatOpOp name format op1 op2
   = hcat [
         pprMnemonic name format,
@@ -1248,7 +1248,7 @@ pprFormatOpOp name format op1 op2
     ]
 
 
-pprOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
+pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
 pprOpOp name format op1 op2
   = hcat [
         pprMnemonic_ name,
@@ -1258,7 +1258,7 @@ pprOpOp name format op1 op2
     ]
 
 
-pprFormatReg :: LitString -> Format -> Reg -> SDoc
+pprFormatReg :: PtrString -> Format -> Reg -> SDoc
 pprFormatReg name format reg1
   = hcat [
         pprMnemonic name format,
@@ -1266,7 +1266,7 @@ pprFormatReg name format reg1
     ]
 
 
-pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc
+pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
 pprFormatRegReg name format reg1 reg2
   = hcat [
         pprMnemonic name format,
@@ -1276,7 +1276,7 @@ pprFormatRegReg name format reg1 reg2
     ]
 
 
-pprRegReg :: LitString -> Reg -> Reg -> SDoc
+pprRegReg :: PtrString -> Reg -> Reg -> SDoc
 pprRegReg name reg1 reg2
   = sdocWithPlatform $ \platform ->
     hcat [
@@ -1287,7 +1287,7 @@ pprRegReg name reg1 reg2
     ]
 
 
-pprFormatOpReg :: LitString -> Format -> Operand -> Reg -> SDoc
+pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
 pprFormatOpReg name format op1 reg2
   = sdocWithPlatform $ \platform ->
     hcat [
@@ -1297,7 +1297,7 @@ pprFormatOpReg name format op1 reg2
         pprReg (archWordFormat (target32Bit platform)) reg2
     ]
 
-pprCondOpReg :: LitString -> Format -> Cond -> Operand -> Reg -> SDoc
+pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
 pprCondOpReg name format cond op1 reg2
   = hcat [
         char '\t',
@@ -1309,7 +1309,7 @@ pprCondOpReg name format cond op1 reg2
         pprReg format reg2
     ]
 
-pprCondRegReg :: LitString -> Format -> Cond -> Reg -> Reg -> SDoc
+pprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
 pprCondRegReg name format cond reg1 reg2
   = hcat [
         char '\t',
@@ -1321,7 +1321,7 @@ pprCondRegReg name format cond reg1 reg2
         pprReg format reg2
     ]
 
-pprFormatFormatRegReg :: LitString -> Format -> Format -> Reg -> Reg -> SDoc
+pprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc
 pprFormatFormatRegReg name format1 format2 reg1 reg2
   = hcat [
         char '\t',
@@ -1334,7 +1334,7 @@ pprFormatFormatRegReg name format1 format2 reg1 reg2
         pprReg format2 reg2
     ]
 
-pprFormatFormatOpReg :: LitString -> Format -> Format -> Operand -> Reg -> SDoc
+pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
 pprFormatFormatOpReg name format1 format2 op1 reg2
   = hcat [
         pprMnemonic name format2,
@@ -1343,7 +1343,7 @@ pprFormatFormatOpReg name format1 format2 op1 reg2
         pprReg format2 reg2
     ]
 
-pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
 pprFormatRegRegReg name format reg1 reg2 reg3
   = hcat [
         pprMnemonic name format,
@@ -1354,7 +1354,7 @@ pprFormatRegRegReg name format reg1 reg2 reg3
         pprReg format reg3
     ]
 
-pprFormatOpOpReg :: LitString -> Format -> Operand -> Operand -> Reg -> SDoc
+pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
 pprFormatOpOpReg name format op1 op2 reg3
   = hcat [
         pprMnemonic name format,
@@ -1365,7 +1365,7 @@ pprFormatOpOpReg name format op1 op2 reg3
         pprReg format reg3
     ]
 
-pprFormatAddrReg :: LitString -> Format -> AddrMode -> Reg -> SDoc
+pprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc
 pprFormatAddrReg name format op dst
   = hcat [
         pprMnemonic name format,
@@ -1375,7 +1375,7 @@ pprFormatAddrReg name format op dst
     ]
 
 
-pprFormatRegAddr :: LitString -> Format -> Reg -> AddrMode -> SDoc
+pprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc
 pprFormatRegAddr name format src op
   = hcat [
         pprMnemonic name format,
@@ -1385,7 +1385,7 @@ pprFormatRegAddr name format src op
     ]
 
 
-pprShift :: LitString -> Format -> Operand -> Operand -> SDoc
+pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
 pprShift name format src dest
   = hcat [
         pprMnemonic name format,
@@ -1395,7 +1395,7 @@ pprShift name format src dest
     ]
 
 
-pprFormatOpOpCoerce :: LitString -> Format -> Format -> Operand -> Operand -> SDoc
+pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
 pprFormatOpOpCoerce name format1 format2 op1 op2
   = hcat [ char '\t', ptext name, pprFormat format1, pprFormat format2, space,
         pprOperand format1 op1,
@@ -1404,6 +1404,6 @@ pprFormatOpOpCoerce name format1 format2 op1 op2
     ]
 
 
-pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
+pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
index 3d419ba..ce269e3 100644 (file)
@@ -362,18 +362,18 @@ mkFloatingRelOpRule nm cmp
 
 -- common constants
 zeroi, onei, zerow, onew :: DynFlags -> Literal
-zeroi dflags = mkMachInt  dflags 0
-onei  dflags = mkMachInt  dflags 1
-zerow dflags = mkMachWord dflags 0
-onew  dflags = mkMachWord dflags 1
+zeroi dflags = mkLitInt  dflags 0
+onei  dflags = mkLitInt  dflags 1
+zerow dflags = mkLitWord dflags 0
+onew  dflags = mkLitWord dflags 1
 
 zerof, onef, twof, zerod, oned, twod :: Literal
-zerof = mkMachFloat 0.0
-onef  = mkMachFloat 1.0
-twof  = mkMachFloat 2.0
-zerod = mkMachDouble 0.0
-oned  = mkMachDouble 1.0
-twod  = mkMachDouble 2.0
+zerof = mkLitFloat 0.0
+onef  = mkLitFloat 1.0
+twof  = mkLitFloat 2.0
+zerod = mkLitDouble 0.0
+oned  = mkLitDouble 1.0
+twod  = mkLitDouble 2.0
 
 cmpOp :: DynFlags -> (forall a . Ord a => a -> a -> Bool)
       -> Literal -> Literal -> Maybe CoreExpr
@@ -383,9 +383,9 @@ cmpOp dflags cmp = go
     done False = Just $ falseValInt dflags
 
     -- These compares are at different types
-    go (MachChar i1)   (MachChar i2)   = done (i1 `cmp` i2)
-    go (MachFloat i1)  (MachFloat i2)  = done (i1 `cmp` i2)
-    go (MachDouble i1) (MachDouble i2) = done (i1 `cmp` i2)
+    go (LitChar i1)   (LitChar i2)   = done (i1 `cmp` i2)
+    go (LitFloat i1)  (LitFloat i2)  = done (i1 `cmp` i2)
+    go (LitDouble i1) (LitDouble i2) = done (i1 `cmp` i2)
     go (LitNumber nt1 i1 _) (LitNumber nt2 i2 _)
       | nt1 /= nt2 = Nothing
       | otherwise  = done (i1 `cmp` i2)
@@ -394,10 +394,10 @@ cmpOp dflags cmp = go
 --------------------------
 
 negOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Negate
-negOp _      (MachFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational
-negOp dflags (MachFloat f)    = Just (mkFloatVal dflags (-f))
-negOp _      (MachDouble 0.0) = Nothing
-negOp dflags (MachDouble d)   = Just (mkDoubleVal dflags (-d))
+negOp _      (LitFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational
+negOp dflags (LitFloat f)    = Just (mkFloatVal dflags (-f))
+negOp _      (LitDouble 0.0) = Nothing
+negOp dflags (LitDouble d)   = Just (mkDoubleVal dflags (-d))
 negOp dflags (LitNumber nt i t)
    | litNumIsSigned nt = Just (Lit (mkLitNumberWrap dflags nt (-i) t))
 negOp _      _                = Nothing
@@ -493,7 +493,7 @@ wordSizeInBits dflags = toInteger (platformWordSize (targetPlatform dflags) `shi
 floatOp2 :: (Rational -> Rational -> Rational)
          -> DynFlags -> Literal -> Literal
          -> Maybe (Expr CoreBndr)
-floatOp2 op dflags (MachFloat f1) (MachFloat f2)
+floatOp2 op dflags (LitFloat f1) (LitFloat f2)
   = Just (mkFloatVal dflags (f1 `op` f2))
 floatOp2 _ _ _ _ = Nothing
 
@@ -501,7 +501,7 @@ floatOp2 _ _ _ _ = Nothing
 doubleOp2 :: (Rational -> Rational -> Rational)
           -> DynFlags -> Literal -> Literal
           -> Maybe (Expr CoreBndr)
-doubleOp2 op dflags (MachDouble f1) (MachDouble f2)
+doubleOp2 op dflags (LitDouble f1) (LitDouble f2)
   = Just (mkDoubleVal dflags (f1 `op` f2))
 doubleOp2 _ _ _ _ = Nothing
 
@@ -573,7 +573,7 @@ mkRuleFn dflags Le _ (Lit lit) | isMaxBound dflags lit = Just $ trueValInt  dfla
 mkRuleFn _ _ _ _                                       = Nothing
 
 isMinBound :: DynFlags -> Literal -> Bool
-isMinBound _      (MachChar c)       = c == minBound
+isMinBound _      (LitChar c)        = c == minBound
 isMinBound dflags (LitNumber nt i _) = case nt of
    LitNumInt     -> i == tARGET_MIN_INT dflags
    LitNumInt64   -> i == toInteger (minBound :: Int64)
@@ -584,7 +584,7 @@ isMinBound dflags (LitNumber nt i _) = case nt of
 isMinBound _      _                  = False
 
 isMaxBound :: DynFlags -> Literal -> Bool
-isMaxBound _      (MachChar c)       = c == maxBound
+isMaxBound _      (LitChar c)       = c == maxBound
 isMaxBound dflags (LitNumber nt i _) = case nt of
    LitNumInt     -> i == tARGET_MAX_INT dflags
    LitNumInt64   -> i == toInteger (maxBound :: Int64)
@@ -600,7 +600,7 @@ intResult :: DynFlags -> Integer -> Maybe CoreExpr
 intResult dflags result = Just (intResult' dflags result)
 
 intResult' :: DynFlags -> Integer -> CoreExpr
-intResult' dflags result = Lit (mkMachIntWrap dflags result)
+intResult' dflags result = Lit (mkLitIntWrap dflags result)
 
 -- | Create an unboxed pair of an Int literal expression, ensuring the given
 -- Integer is in the target Int range and the corresponding overflow flag
@@ -609,7 +609,7 @@ intCResult :: DynFlags -> Integer -> Maybe CoreExpr
 intCResult dflags result = Just (mkPair [Lit lit, Lit c])
   where
     mkPair = mkCoreUbxTup [intPrimTy, intPrimTy]
-    (lit, b) = mkMachIntWrapC dflags result
+    (lit, b) = mkLitIntWrapC dflags result
     c = if b then onei dflags else zeroi dflags
 
 -- | Create a Word literal expression while ensuring the given Integer is in the
@@ -618,7 +618,7 @@ wordResult :: DynFlags -> Integer -> Maybe CoreExpr
 wordResult dflags result = Just (wordResult' dflags result)
 
 wordResult' :: DynFlags -> Integer -> CoreExpr
-wordResult' dflags result = Lit (mkMachWordWrap dflags result)
+wordResult' dflags result = Lit (mkLitWordWrap dflags result)
 
 -- | Create an unboxed pair of a Word literal expression, ensuring the given
 -- Integer is in the target Word range and the corresponding carry flag
@@ -627,7 +627,7 @@ wordCResult :: DynFlags -> Integer -> Maybe CoreExpr
 wordCResult dflags result = Just (mkPair [Lit lit, Lit c])
   where
     mkPair = mkCoreUbxTup [wordPrimTy, intPrimTy]
-    (lit, b) = mkMachWordWrapC dflags result
+    (lit, b) = mkLitWordWrapC dflags result
     c = if b then onei dflags else zeroi dflags
 
 inversePrimOp :: PrimOp -> RuleM CoreExpr
@@ -898,21 +898,21 @@ nonZeroLit n = getLiteral n >>= guard . not . isZeroLit
 -- Rational value to that of Float/Double. We confuse host architecture
 -- and target architecture here, but it's convenient (and wrong :-).
 convFloating :: DynFlags -> Literal -> Literal
-convFloating dflags (MachFloat  f) | not (gopt Opt_ExcessPrecision dflags) =
-   MachFloat  (toRational (fromRational f :: Float ))
-convFloating dflags (MachDouble d) | not (gopt Opt_ExcessPrecision dflags) =
-   MachDouble (toRational (fromRational d :: Double))
+convFloating dflags (LitFloat  f) | not (gopt Opt_ExcessPrecision dflags) =
+   LitFloat  (toRational (fromRational f :: Float ))
+convFloating dflags (LitDouble d) | not (gopt Opt_ExcessPrecision dflags) =
+   LitDouble (toRational (fromRational d :: Double))
 convFloating _ l = l
 
 guardFloatDiv :: RuleM ()
 guardFloatDiv = do
-  [Lit (MachFloat f1), Lit (MachFloat f2)] <- getArgs
+  [Lit (LitFloat f1), Lit (LitFloat f2)] <- getArgs
   guard $ (f1 /=0 || f2 > 0) -- see Note [negative zero]
        && f2 /= 0            -- avoid NaN and Infinity/-Infinity
 
 guardDoubleDiv :: RuleM ()
 guardDoubleDiv = do
-  [Lit (MachDouble d1), Lit (MachDouble d2)] <- getArgs
+  [Lit (LitDouble d1), Lit (LitDouble d2)] <- getArgs
   guard $ (d1 /=0 || d2 > 0) -- see Note [negative zero]
        && d2 /= 0            -- avoid NaN and Infinity/-Infinity
 -- Note [negative zero] Avoid (0 / -d), otherwise 0/(-1) reduces to
@@ -961,11 +961,11 @@ eqVal = Var ordEQDataConId
 gtVal = Var ordGTDataConId
 
 mkIntVal :: DynFlags -> Integer -> Expr CoreBndr
-mkIntVal dflags i = Lit (mkMachInt dflags i)
+mkIntVal dflags i = Lit (mkLitInt dflags i)
 mkFloatVal :: DynFlags -> Rational -> Expr CoreBndr
-mkFloatVal dflags f = Lit (convFloating dflags (MachFloat  f))
+mkFloatVal dflags f = Lit (convFloating dflags (LitFloat  f))
 mkDoubleVal :: DynFlags -> Rational -> Expr CoreBndr
-mkDoubleVal dflags d = Lit (convFloating dflags (MachDouble d))
+mkDoubleVal dflags d = Lit (convFloating dflags (LitDouble d))
 
 matchPrimOpId :: PrimOp -> Id -> RuleM ()
 matchPrimOpId op id = do
@@ -1342,11 +1342,11 @@ match_append_lit _ id_unf _
         ]
   | unpk `hasKey` unpackCStringFoldrIdKey &&
     c1 `cheapEqExpr` c2
-  , Just (MachStr s1) <- exprIsLiteral_maybe id_unf lit1
-  , Just (MachStr s2) <- exprIsLiteral_maybe id_unf lit2
+  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1
+  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2
   = ASSERT( ty1 `eqType` ty2 )
     Just (Var unpk `App` Type ty1
-                   `App` Lit (MachStr (s1 `BS.append` s2))
+                   `App` Lit (LitString (s1 `BS.append` s2))
                    `App` c1
                    `App` n)
 
@@ -1361,8 +1361,8 @@ match_eq_string _ id_unf _
         [Var unpk1 `App` lit1, Var unpk2 `App` lit2]
   | unpk1 `hasKey` unpackCStringIdKey
   , unpk2 `hasKey` unpackCStringIdKey
-  , Just (MachStr s1) <- exprIsLiteral_maybe id_unf lit1
-  , Just (MachStr s2) <- exprIsLiteral_maybe id_unf lit2
+  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1
+  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2
   = Just (if s1 == s2 then trueValBool else falseValBool)
 
 match_eq_string _ _ _ _ = Nothing
@@ -1639,7 +1639,7 @@ match_rationalTo _ _ _ _ _ = Nothing
 
 match_decodeDouble :: RuleFun
 match_decodeDouble dflags id_unf fn [xl]
-  | Just (MachDouble x) <- exprIsLiteral_maybe id_unf xl
+  | Just (LitDouble x) <- exprIsLiteral_maybe id_unf xl
   = case splitFunTy_maybe (idType fn) of
     Just (_, res)
       | Just [_lev1, _lev2, integerTy, intHashTy] <- tyConAppArgs_maybe res
@@ -1647,7 +1647,7 @@ match_decodeDouble dflags id_unf fn [xl]
            (y, z) ->
              Just $ mkCoreUbxTup [integerTy, intHashTy]
                                  [Lit (mkLitInteger y integerTy),
-                                  Lit (mkMachInt dflags (toInteger z))]
+                                  Lit (mkLitInt dflags (toInteger z))]
     _ ->
         pprPanic "match_decodeDouble: Id has the wrong type"
           (ppr fn <+> dcolon <+> ppr (idType fn))
@@ -2004,7 +2004,7 @@ tx_lit_con :: DynFlags -> (Integer -> Integer) -> AltCon -> Maybe AltCon
 tx_lit_con _      _      DEFAULT    = Just DEFAULT
 tx_lit_con dflags adjust (LitAlt l) = Just $ LitAlt (mapLitValue dflags adjust l)
 tx_lit_con _      _      alt        = pprPanic "caseRules" (ppr alt)
-   -- NB: mapLitValue uses mkMachIntWrap etc, to ensure that the
+   -- NB: mapLitValue uses mkLitIntWrap etc, to ensure that the
    -- literal alternatives remain in Word/Int target ranges
    -- (See Note [Word/Int underflow/overflow] in Literal and #13172).
 
@@ -2046,7 +2046,7 @@ tx_con_tte :: DynFlags -> AltCon -> Maybe AltCon
 tx_con_tte _      DEFAULT         = Just DEFAULT
 tx_con_tte _      alt@(LitAlt {}) = pprPanic "caseRules" (ppr alt)
 tx_con_tte dflags (DataAlt dc)  -- See Note [caseRules for tagToEnum]
-  = Just $ LitAlt $ mkMachInt dflags $ toInteger $ dataConTagZ dc
+  = Just $ LitAlt $ mkLitInt dflags $ toInteger $ dataConTagZ dc
 
 tx_con_dtt :: Type -> AltCon -> Maybe AltCon
 tx_con_dtt _  DEFAULT = Just DEFAULT
index aeb4755..a63ed27 100644 (file)
@@ -980,7 +980,7 @@ It's important to float Integer literals, so that they get shared,
 rather than being allocated every time round the loop.
 Hence the litIsTrivial.
 
-Ditto literal strings (MachStr), which we'd like to float to top
+Ditto literal strings (LitString), which we'd like to float to top
 level, which is now possible.
 
 
index 8729739..fca9904 100644 (file)
@@ -19,7 +19,7 @@ import SimplEnv
 import SimplUtils
 import OccurAnal        ( occurAnalyseExpr )
 import FamInstEnv       ( FamInstEnv )
-import Literal          ( litIsLifted ) --, mkMachInt ) -- temporalily commented out. See #8326
+import Literal          ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
 import Id
 import MkId             ( seqId )
 import MkCore           ( mkImpossibleExpr, castBottomExpr )
@@ -1963,7 +1963,7 @@ tryRules env rules fn args call_cont
                = ASSERT( isEnumerationTyCon (dataConTyCon con) )
                 (LitAlt tag, [], rhs)
               where
-                tag = mkMachInt dflags (toInteger (dataConTag con - fIRST_TAG))
+                tag = mkLitInt dflags (toInteger (dataConTag con - fIRST_TAG))
              enum_to_tag alt = pprPanic "tryRules: tagToEnum" (ppr alt)
 
              new_alts = (DEFAULT, [], rhs1) : map enum_to_tag rest_alts
index c3a8bc7..e87fd85 100644 (file)
@@ -580,8 +580,8 @@ mkUbxSum dc ty_args args0
                          -- See Note [aBSENT_SUM_FIELD_ERROR_ID] in MkCore
       slotRubbishArg WordSlot   = StgLitArg (LitNumber LitNumWord 0 wordPrimTy)
       slotRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0 word64PrimTy)
-      slotRubbishArg FloatSlot  = StgLitArg (MachFloat 0)
-      slotRubbishArg DoubleSlot = StgLitArg (MachDouble 0)
+      slotRubbishArg FloatSlot  = StgLitArg (LitFloat 0)
+      slotRubbishArg DoubleSlot = StgLitArg (LitDouble 0)
     in
       tag_arg : mkTupArgs 0 sum_slots arg_idxs
 
index 1b1d463..74bb7b6 100644 (file)
@@ -371,8 +371,8 @@ coreToStgExpr
 coreToStgExpr (Lit (LitNumber LitNumInteger _ _)) = panic "coreToStgExpr: LitInteger"
 coreToStgExpr (Lit (LitNumber LitNumNatural _ _)) = panic "coreToStgExpr: LitNatural"
 coreToStgExpr (Lit l)      = return (StgLit l)
-coreToStgExpr (App (Lit RubbishLit) _some_unlifted_type)
-  -- We lower 'RubbishLit' to @()@ here, which is much easier than doing it in
+coreToStgExpr (App (Lit LitRubbish) _some_unlifted_type)
+  -- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in
   -- a STG to Cmm pass.
   = coreToStgExpr (Var unitDataConId)
 coreToStgExpr (Var v)      = coreToStgApp Nothing v               [] []
index 8a2ecc2..f01dc6c 100644 (file)
@@ -922,7 +922,7 @@ buggily is used we'll get a runtime error message.
 
 Coping with absence for *unlifted* types is important; see, for
 example, Trac #4306 and Trac #15627.  In the UnliftedRep case, we can
-use RubbishLit, which we need to apply to the required type.
+use LitRubbish, which we need to apply to the required type.
 For the unlifted types of singleton kind like Float#, Addr#, etc. we
 also find a suitable literal, using Literal.absentLiteralOf.  We don't
 have literals for every primitive type, so the function is partial.
index 8d8aa9b..7ccd018 100644 (file)
@@ -29,7 +29,7 @@ evDelayedError ty msg
     Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg]
   where
     errorId = tYPE_ERROR_ID
-    litMsg  = Lit (MachStr (fastStringToByteString msg))
+    litMsg  = Lit (LitString (fastStringToByteString msg))
 
 -- Dictionary for CallStack implicit parameters
 evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) =>
index 31ac55f..5fd91c6 100644 (file)
@@ -2080,7 +2080,7 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
 mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type
 mkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys
 
-noTH :: LitString -> SDoc -> TcM a
+noTH :: PtrString -> SDoc -> TcM a
 noTH s d = failWithTc (hsep [text "Can't represent" <+> ptext s <+>
                                 text "in Template Haskell:",
                              nest 2 d])
index 99c043c..f4b406f 100644 (file)
@@ -19,7 +19,7 @@ module BufWrite (
         bPutStr,
         bPutFS,
         bPutFZS,
-        bPutLitString,
+        bPutPtrString,
         bPutReplicate,
         bFlush,
   ) where
@@ -98,15 +98,15 @@ bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do
                 copyBytes (buf `plusPtr` i) ptr len
                 writeFastMutInt r (i + len)
 
-bPutLitString :: BufHandle -> LitString -> IO ()
-bPutLitString b@(BufHandle buf r hdl) l@(LitString a len) = l `seq` do
+bPutPtrString :: BufHandle -> PtrString -> IO ()
+bPutPtrString b@(BufHandle buf r hdl) l@(PtrString a len) = l `seq` do
   i <- readFastMutInt r
   if (i+len) >= buf_size
         then do hPutBuf hdl buf i
                 writeFastMutInt r 0
                 if (len >= buf_size)
                     then hPutBuf hdl a len
-                    else bPutLitString b l
+                    else bPutPtrString b l
         else do
                 copyBytes (buf `plusPtr` i) a len
                 writeFastMutInt r (i+len)
index 5869449..c53eff1 100644 (file)
@@ -16,7 +16,7 @@
 --   * Generated by 'fsLit'.
 --   * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
 --
--- ['LitString']
+-- ['PtrString']
 --
 --   * Pointer and size of a Latin-1 encoded string.
 --   * Practically no operations.
@@ -28,7 +28,7 @@
 --   * It assumes Latin-1 as the encoding, therefore it cannot represent
 --     arbitrary Unicode strings.
 --
--- Use 'LitString' unless you want the facilities of 'FastString'.
+-- Use 'PtrString' unless you want the facilities of 'FastString'.
 module FastString
        (
         -- * ByteString
@@ -79,19 +79,19 @@ module FastString
         getFastStringTable,
         hasZEncoding,
 
-        -- * LitStrings
-        LitString (..),
+        -- * PtrStrings
+        PtrString (..),
 
         -- ** Construction
         sLit,
-        mkLitString#,
-        mkLitString,
+        mkPtrString#,
+        mkPtrString,
 
         -- ** Deconstruction
-        unpackLitString,
+        unpackPtrString,
 
         -- ** Operations
-        lengthLS
+        lengthPS
        ) where
 
 #include "HsVersions.h"
@@ -627,21 +627,21 @@ hPutFS handle fs = BS.hPut handle $ fastStringToByteString fs
 -- in the current locale's encoding (for error messages and suchlike).
 
 -- -----------------------------------------------------------------------------
--- LitStrings, here for convenience only.
+-- PtrStrings, here for convenience only.
 
--- | A 'LitString' is a pointer to some array of Latin-1 encoded chars.
-data LitString = LitString !(Ptr Word8) !Int
+-- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.
+data PtrString = PtrString !(Ptr Word8) !Int
 
--- | Wrap an unboxed address into a 'LitString'.
-mkLitString# :: Addr# -> LitString
-mkLitString# a# = LitString (Ptr a#) (ptrStrLength (Ptr a#))
+-- | Wrap an unboxed address into a 'PtrString'.
+mkPtrString# :: Addr# -> PtrString
+mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#))
 
--- | Encode a 'String' into a newly allocated 'LitString' using Latin-1
+-- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1
 -- encoding.  The original string must not contain non-Latin-1 characters
 -- (above codepoint @0xff@).
-{-# INLINE mkLitString #-}
-mkLitString :: String -> LitString
-mkLitString s =
+{-# INLINE mkPtrString #-}
+mkPtrString :: String -> PtrString
+mkPtrString s =
  -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks
  -- and because someone might be using `eqAddr#` to check for string equality.
  unsafePerformIO (do
@@ -654,17 +654,17 @@ mkLitString s =
         pokeByteOff p n (fromIntegral (ord c) :: Word8)
         loop (1+n) cs
    loop 0 s
-   return (LitString p len)
+   return (PtrString p len)
  )
 
--- | Decode a 'LitString' back into a 'String' using Latin-1 encoding.
--- This does not free the memory associated with 'LitString'.
-unpackLitString :: LitString -> String
-unpackLitString (LitString (Ptr p#) (I# n#)) = unpackNBytes# p# n#
+-- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding.
+-- This does not free the memory associated with 'PtrString'.
+unpackPtrString :: PtrString -> String
+unpackPtrString (PtrString (Ptr p#) (I# n#)) = unpackNBytes# p# n#
 
--- | Return the length of a 'LitString'
-lengthLS :: LitString -> Int
-lengthLS (LitString _ n) = n
+-- | Return the length of a 'PtrString'
+lengthPS :: PtrString -> Int
+lengthPS (PtrString _ n) = n
 
 -- -----------------------------------------------------------------------------
 -- under the carpet
@@ -673,14 +673,14 @@ foreign import ccall unsafe "strlen"
   ptrStrLength :: Ptr Word8 -> Int
 
 {-# NOINLINE sLit #-}
-sLit :: String -> LitString
-sLit x  = mkLitString x
+sLit :: String -> PtrString
+sLit x  = mkPtrString x
 
 {-# NOINLINE fsLit #-}
 fsLit :: String -> FastString
 fsLit x = mkFastString x
 
 {-# RULES "slit"
-    forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
+    forall x . sLit  (unpackCString# x) = mkPtrString#  x #-}
 {-# RULES "fslit"
     forall x . fsLit (unpackCString# x) = mkFastString# x #-}
index 929c7f3..28fd487 100644 (file)
@@ -553,7 +553,7 @@ empty    :: SDoc
 char     :: Char       -> SDoc
 text     :: String     -> SDoc
 ftext    :: FastString -> SDoc
-ptext    :: LitString  -> SDoc
+ptext    :: PtrString  -> SDoc
 ztext    :: FastZString -> SDoc
 int      :: Int        -> SDoc
 integer  :: Integer    -> SDoc
index 1a8bc23..32b9828 100644 (file)
@@ -270,7 +270,7 @@ data TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment
                  | Str  String -- ^ A whole String fragment
                  | PStr FastString                      -- a hashed string
                  | ZStr FastZString                     -- a z-encoded string
-                 | LStr {-# UNPACK #-} !LitString
+                 | LStr {-# UNPACK #-} !PtrString
                    -- a '\0'-terminated array of bytes
                  | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char
                    -- a repeated character (e.g., ' ')
@@ -306,17 +306,17 @@ text s = textBeside_ (Str s) (length s) Empty
 -- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
 -- intermediate packing/unpacking of the string.
 {-# RULES "text/str"
-    forall a. text (unpackCString# a)  = ptext (mkLitString# a)
+    forall a. text (unpackCString# a)  = ptext (mkPtrString# a)
   #-}
 {-# RULES "text/unpackNBytes#"
-    forall p n. text (unpackNBytes# p n) = ptext (LitString (Ptr p) (I# n))
+    forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n))
   #-}
 
 ftext :: FastString -> Doc
 ftext s = textBeside_ (PStr s) (lengthFS s) Empty
 
-ptext :: LitString -> Doc
-ptext s = textBeside_ (LStr s) (lengthLS s) Empty
+ptext :: PtrString -> Doc
+ptext s = textBeside_ (LStr s) (lengthPS s) Empty
 
 ztext :: FastZString -> Doc
 ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty
@@ -941,7 +941,7 @@ txtPrinter (Chr c)    s  = c:s
 txtPrinter (Str s1)   s2 = s1 ++ s2
 txtPrinter (PStr s1)  s2 = unpackFS s1 ++ s2
 txtPrinter (ZStr s1)  s2 = zString s1 ++ s2
-txtPrinter (LStr s1)  s2 = unpackLitString s1 ++ s2
+txtPrinter (LStr s1)  s2 = unpackPtrString s1 ++ s2
 txtPrinter (RStr n c) s2 = replicate n c ++ s2
 
 -- | The general rendering interface.
@@ -1053,15 +1053,15 @@ printDoc_ mode pprCols hdl doc
                           -- NB. not hPutFS, we want this to go through
                           -- the I/O library's encoding layer. (#3398)
     put (ZStr s)   next = hPutFZS  hdl s >> next
-    put (LStr s)   next = hPutLitString hdl s >> next
+    put (LStr s)   next = hPutPtrString hdl s >> next
     put (RStr n c) next = hPutStr hdl (replicate n c) >> next
 
     done = return () -- hPutChar hdl '\n'
 
   -- some versions of hPutBuf will barf if the length is zero
-hPutLitString :: Handle -> LitString -> IO ()
-hPutLitString _handle (LitString _ 0) = return ()
-hPutLitString handle  (LitString a l) = hPutBuf handle a l
+hPutPtrString :: Handle -> PtrString -> IO ()
+hPutPtrString _handle (PtrString _ 0) = return ()
+hPutPtrString handle  (PtrString a l) = hPutBuf handle a l
 
 -- Printing output in LeftMode is performance critical: it's used when
 -- dumping C and assembly output, so we allow ourselves a few dirty
@@ -1099,7 +1099,7 @@ layLeft b (TextBeside s _ p) = s `seq` (put b s >> layLeft b p)
     put b (Str s)    = bPutStr  b s
     put b (PStr s)   = bPutFS   b s
     put b (ZStr s)   = bPutFZS  b s
-    put b (LStr s)   = bPutLitString b s
+    put b (LStr s)   = bPutPtrString b s
     put b (RStr n c) = bPutReplicate b n c
 layLeft _ _                  = panic "layLeft: Unhandled case"
 
index 7a6942b..7c979c3 100644 (file)
@@ -20,7 +20,7 @@ replaceInBind (Rec bes) = Rec [(b, replaceInExpr e) | (b, e) <- bes]
 
 replaceInExpr :: CoreExpr -> CoreExpr
 replaceInExpr (Var x) = Var x
-replaceInExpr (Lit (MachStr _)) = mkStringLit "Hello From The Plugin" -- The payload
+replaceInExpr (Lit (LitString _)) = mkStringLit "Hello From The Plugin" -- The payload
 replaceInExpr (Lit l) = Lit l
 replaceInExpr (Lam b e) = Lam b (replaceInExpr e)
 replaceInExpr (App e1 e2) = App (replaceInExpr e1) (replaceInExpr e2)
index 94cb74b..9c0fdcb 100644 (file)
@@ -67,11 +67,11 @@ changeBindPr anns mb_replacement b e = do
 
 changeExpr :: UniqFM [ReplaceWith] -> Maybe String -> CoreExpr -> CoreM CoreExpr
 changeExpr anns mb_replacement e = let go = changeExpr anns mb_replacement in case e of
-        Lit (MachStr _) -> case mb_replacement of
+        Lit (LitString _) -> case mb_replacement of
                 Nothing -> return e
                 Just replacement -> do
                         putMsgS "Performing Replacement"
-                        return $ Lit (MachStr (fastStringToByteString (mkFastString replacement)))
+                        return $ Lit (LitString (fastStringToByteString (mkFastString replacement)))
         App e1 e2 -> liftM2 App (go e1) (go e2)
         Lam b e -> liftM (Lam b) (go e)
         Let bind e -> liftM2 Let (changeBind anns mb_replacement bind) (go e)