Capture original source for literals

Summary:
Make HsLit and OverLitVal have original source strings, for source to
source conversions using the GHC API

This is part of the ongoing AST Annotations work, as captured in
https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations and
https://ghc.haskell.org/trac/ghc/ticket/9628#comment:28

The motivations for the literals is as follows

```lang=haskell
x,y :: Int
x = 0003
y = 0x04

s :: String
s = "\x20"

c :: Char
c = '\x20'

d :: Double
d = 0.00

blah = x
  where
    charH = '\x41'#
    intH = 0004#
    wordH = 005##
    floatH = 3.20#
    doubleH = 04.16##
    x = 1
```

Test Plan: ./sh validate

Reviewers: simonpj, austin

Reviewed By: simonpj, austin

Subscribers: thomie, goldfire, carter, simonmar

Differential Revision: https://phabricator.haskell.org/D412

GHC Trac Issues: #9628

31 files changed, 687 insertions, 248 deletions

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 52d81ed6ed..b5b9544cb4 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -175,8 +175,8 @@ pars True p = ParPat p
 pars _    p = unLoc p
 
 untidy_lit :: HsLit -> HsLit
-untidy_lit (HsCharPrim c) = HsChar c
-untidy_lit lit            = lit
+untidy_lit (HsCharPrim src c) = HsChar src c
+untidy_lit lit                = lit
 \end{code}
 
 This equation is the same that check, the only difference is that the
@@ -459,9 +459,12 @@ get_lit :: Pat id -> Maybe HsLit
 -- It doesn't matter which one, because they will only be compared
 -- with other HsLits gotten in the same way
 get_lit (LitPat lit)                                      = Just lit
-get_lit (NPat (OverLit { ol_val = HsIntegral i})    mb _) = Just (HsIntPrim   (mb_neg negate              mb i))
-get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
-get_lit (NPat (OverLit { ol_val = HsIsString s })   _  _) = Just (HsStringPrim (fastStringToByteString s))
+get_lit (NPat (OverLit { ol_val = HsIntegral src i})    mb _)
+                        = Just (HsIntPrim src (mb_neg negate              mb i))
+get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _)
+                        = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
+get_lit (NPat (OverLit { ol_val = HsIsString src s })   _  _)
+                        = Just (HsStringPrim src (fastStringToByteString s))
 get_lit _                                                 = Nothing
 
 mb_neg :: (a -> a) -> Maybe b -> a -> a
@@ -743,8 +746,9 @@ tidy_lit_pat :: HsLit -> Pat Id
 -- Unpack string patterns fully, so we can see when they
 -- overlap with each other, or even explicit lists of Chars.
 tidy_lit_pat lit
-  | HsString s <- lit
-  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy])
+  | HsString src s <- lit
+  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon
+                                             [mkCharLitPat src c, pat] [charTy])
                   (mkPrefixConPat nilDataCon [] [charTy]) (unpackFS s)
   | otherwise
   = tidyLitPat lit
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 5bb933a115..515d3528bf 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1973,11 +1973,11 @@ repKConstraint = rep2 constraintKName []
 repLiteral :: HsLit -> DsM (Core TH.Lit)
 repLiteral lit
   = do lit' <- case lit of
-                   HsIntPrim i    -> mk_integer i
-                   HsWordPrim w   -> mk_integer w
-                   HsInt i        -> mk_integer i
-                   HsFloatPrim r  -> mk_rational r
-                   HsDoublePrim r -> mk_rational r
+                   HsIntPrim _ i    -> mk_integer i
+                   HsWordPrim _ w   -> mk_integer w
+                   HsInt _ i        -> mk_integer i
+                   HsFloatPrim r    -> mk_rational r
+                   HsDoublePrim r   -> mk_rational r
                    _ -> return lit
        lit_expr <- dsLit lit'
        case mb_lit_name of
@@ -1985,25 +1985,25 @@ repLiteral lit
           Nothing -> notHandled "Exotic literal" (ppr lit)
   where
     mb_lit_name = case lit of
-                 HsInteger _ _  -> Just integerLName
-                 HsInt     _    -> Just integerLName
-                 HsIntPrim _    -> Just intPrimLName
-                 HsWordPrim _   -> Just wordPrimLName
-                 HsFloatPrim _  -> Just floatPrimLName
-                 HsDoublePrim _ -> Just doublePrimLName
-                 HsChar _       -> Just charLName
-                 HsString _     -> Just stringLName
-                 HsRat _ _      -> Just rationalLName
-                 _              -> Nothing
+                 HsInteger _ _ _  -> Just integerLName
+                 HsInt     _ _    -> Just integerLName
+                 HsIntPrim _ _    -> Just intPrimLName
+                 HsWordPrim _ _   -> Just wordPrimLName
+                 HsFloatPrim _    -> Just floatPrimLName
+                 HsDoublePrim _   -> Just doublePrimLName
+                 HsChar _ _       -> Just charLName
+                 HsString _ _     -> Just stringLName
+                 HsRat _ _        -> Just rationalLName
+                 _                -> Nothing
 
 mk_integer :: Integer -> DsM HsLit
 mk_integer  i = do integer_ty <- lookupType integerTyConName
-                   return $ HsInteger i integer_ty
+                   return $ HsInteger "" i integer_ty
 mk_rational :: FractionalLit -> DsM HsLit
 mk_rational r = do rat_ty <- lookupType rationalTyConName
                    return $ HsRat r rat_ty
 mk_string :: FastString -> DsM HsLit
-mk_string s = return $ HsString s
+mk_string s = return $ HsString "" s
 
 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
 repOverloadedLiteral (OverLit { ol_val = val})
@@ -2013,9 +2013,9 @@ repOverloadedLiteral (OverLit { ol_val = val})
         -- and rationalL is sucked in when any TH stuff is used
 
 mk_lit :: OverLitVal -> DsM HsLit
-mk_lit (HsIntegral i)   = mk_integer  i
-mk_lit (HsFractional f) = mk_rational f
-mk_lit (HsIsString s)   = mk_string   s
+mk_lit (HsIntegral _ i)   = mk_integer  i
+mk_lit (HsFractional f)   = mk_rational f
+mk_lit (HsIsString _ s)   = mk_string   s
 
 --------------- Miscellaneous -------------------
 
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 61db408066..acf0b776f3 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -75,20 +75,20 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc.
 
 \begin{code}
 dsLit :: HsLit -> DsM CoreExpr
-dsLit (HsStringPrim s) = return (Lit (MachStr s))
-dsLit (HsCharPrim   c) = return (Lit (MachChar c))
-dsLit (HsIntPrim    i) = return (Lit (MachInt i))
-dsLit (HsWordPrim   w) = return (Lit (MachWord w))
-dsLit (HsInt64Prim  i) = return (Lit (MachInt64 i))
-dsLit (HsWord64Prim w) = return (Lit (MachWord64 w))
-dsLit (HsFloatPrim  f) = return (Lit (MachFloat (fl_value f)))
-dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d)))
-
-dsLit (HsChar c)       = return (mkCharExpr c)
-dsLit (HsString str)   = mkStringExprFS str
-dsLit (HsInteger i _)  = mkIntegerExpr i
-dsLit (HsInt i)        = do dflags <- getDynFlags
-                            return (mkIntExpr dflags i)
+dsLit (HsStringPrim _ s) = return (Lit (MachStr s))
+dsLit (HsCharPrim   _ c) = return (Lit (MachChar c))
+dsLit (HsIntPrim    _ i) = return (Lit (MachInt i))
+dsLit (HsWordPrim   _ w) = return (Lit (MachWord w))
+dsLit (HsInt64Prim  _ i) = return (Lit (MachInt64 i))
+dsLit (HsWord64Prim _ w) = return (Lit (MachWord64 w))
+dsLit (HsFloatPrim    f) = return (Lit (MachFloat (fl_value f)))
+dsLit (HsDoublePrim   d) = return (Lit (MachDouble (fl_value d)))
+
+dsLit (HsChar _ c)       = return (mkCharExpr c)
+dsLit (HsString _ str)   = mkStringExprFS str
+dsLit (HsInteger _ i _)  = mkIntegerExpr i
+dsLit (HsInt _ i)        = do dflags <- getDynFlags
+                              return (mkIntExpr dflags i)
 
 dsLit (HsRat r ty) = do
    num   <- mkIntegerExpr (numerator (fl_value r))
@@ -244,7 +244,7 @@ getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit
 getLHsIntegralLit _ = Nothing
 
 getIntegralLit :: HsOverLit Id -> Maybe (Integer, Name)
-getIntegralLit (OverLit { ol_val = HsIntegral i, ol_type = ty })
+getIntegralLit (OverLit { ol_val = HsIntegral _ i, ol_type = ty })
   | Just tc <- tyConAppTyCon_maybe ty
   = Just (i, tyConName tc)
 getIntegralLit _ = Nothing
@@ -264,10 +264,11 @@ tidyLitPat :: HsLit -> Pat Id
 --      HsDoublePrim, HsStringPrim, HsString
 --  * HsInteger, HsRat, HsInt can't show up in LitPats
 --  * We get rid of HsChar right here
-tidyLitPat (HsChar c) = unLoc (mkCharLitPat c)
-tidyLitPat (HsString s)
+tidyLitPat (HsChar src c) = unLoc (mkCharLitPat src c)
+tidyLitPat (HsString src s)
   | lengthFS s <= 1     -- Short string literals only
-  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy])
+  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon
+                                             [mkCharLitPat src c, pat] [charTy])
                   (mkNilPat charTy) (unpackFS s)
         -- The stringTy is the type of the whole pattern, not
         -- the type to instantiate (:) or [] with!
@@ -293,32 +294,36 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
         --     which might be ok if we hvae 'instance IsString Int'
         --
 
-  | isIntTy ty,    Just int_lit <- mb_int_lit = mk_con_pat intDataCon    (HsIntPrim    int_lit)
-  | isWordTy ty,   Just int_lit <- mb_int_lit = mk_con_pat wordDataCon   (HsWordPrim   int_lit)
+  | isIntTy ty,    Just int_lit <- mb_int_lit
+                            = mk_con_pat intDataCon    (HsIntPrim    "" int_lit)
+  | isWordTy ty,   Just int_lit <- mb_int_lit
+                            = mk_con_pat wordDataCon   (HsWordPrim   "" int_lit)
   | isFloatTy ty,  Just rat_lit <- mb_rat_lit = mk_con_pat floatDataCon  (HsFloatPrim  rat_lit)
   | isDoubleTy ty, Just rat_lit <- mb_rat_lit = mk_con_pat doubleDataCon (HsDoublePrim rat_lit)
-  | isStringTy ty, Just str_lit <- mb_str_lit = tidy_lit_pat (HsString str_lit)
+  | isStringTy ty, Just str_lit <- mb_str_lit
+                            = tidy_lit_pat (HsString "" str_lit)
   where
     mk_con_pat :: DataCon -> HsLit -> Pat Id
     mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] [])
 
     mb_int_lit :: Maybe Integer
     mb_int_lit = case (mb_neg, val) of
-                   (Nothing, HsIntegral i) -> Just i
-                   (Just _,  HsIntegral i) -> Just (-i)
+                   (Nothing, HsIntegral _ i) -> Just i
+                   (Just _,  HsIntegral _ i) -> Just (-i)
                    _ -> Nothing
 
     mb_rat_lit :: Maybe FractionalLit
     mb_rat_lit = case (mb_neg, val) of
-                   (Nothing, HsIntegral   i) -> Just (integralFractionalLit (fromInteger i))
-                   (Just _,  HsIntegral   i) -> Just (integralFractionalLit (fromInteger (-i)))
-                   (Nothing, HsFractional f) -> Just f
-                   (Just _, HsFractional f)  -> Just (negateFractionalLit f)
-                   _ -> Nothing
+       (Nothing, HsIntegral _ i) -> Just (integralFractionalLit (fromInteger i))
+       (Just _,  HsIntegral _ i) -> Just (integralFractionalLit
+                                                             (fromInteger (-i)))
+       (Nothing, HsFractional f) -> Just f
+       (Just _, HsFractional f)  -> Just (negateFractionalLit f)
+       _ -> Nothing
 
     mb_str_lit :: Maybe FastString
     mb_str_lit = case (mb_neg, val) of
-                   (Nothing, HsIsString s) -> Just s
+                   (Nothing, HsIsString _ s) -> Just s
                    _ -> Nothing
 
 tidyNPat _ over_lit mb_neg eq
@@ -381,16 +386,16 @@ hsLitKey :: DynFlags -> HsLit -> Literal
 --      (and doesn't for strings)
 -- It only works for primitive types and strings;
 -- others have been removed by tidy
-hsLitKey dflags (HsIntPrim     i) = mkMachInt  dflags i
-hsLitKey dflags (HsWordPrim    w) = mkMachWord dflags w
-hsLitKey _      (HsInt64Prim   i) = mkMachInt64  i
-hsLitKey _      (HsWord64Prim  w) = mkMachWord64 w
-hsLitKey _      (HsCharPrim    c) = MachChar   c
-hsLitKey _      (HsStringPrim  s) = MachStr    s
-hsLitKey _      (HsFloatPrim   f) = MachFloat  (fl_value f)
-hsLitKey _      (HsDoublePrim  d) = MachDouble (fl_value d)
-hsLitKey _      (HsString s)      = MachStr    (fastStringToByteString s)
-hsLitKey _      l                 = pprPanic "hsLitKey" (ppr l)
+hsLitKey dflags (HsIntPrim    _ i) = mkMachInt  dflags i
+hsLitKey dflags (HsWordPrim   _ w) = mkMachWord dflags w
+hsLitKey _      (HsInt64Prim  _ i) = mkMachInt64  i
+hsLitKey _      (HsWord64Prim _ w) = mkMachWord64 w
+hsLitKey _      (HsCharPrim   _ c) = MachChar   c
+hsLitKey _      (HsStringPrim _ s) = MachStr    s
+hsLitKey _      (HsFloatPrim    f) = MachFloat  (fl_value f)
+hsLitKey _      (HsDoublePrim   d) = MachDouble (fl_value d)
+hsLitKey _      (HsString _ s)     = MachStr    (fastStringToByteString s)
+hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
 ---------------------------
 hsOverLitKey :: OutputableBndr a => HsOverLit a -> Bool -> Literal
@@ -399,11 +404,12 @@ hsOverLitKey (OverLit { ol_val = l }) neg = litValKey l neg
 
 ---------------------------
 litValKey :: OverLitVal -> Bool -> Literal
-litValKey (HsIntegral i)   False = MachInt i
-litValKey (HsIntegral i)   True  = MachInt (-i)
+litValKey (HsIntegral _ i) False = MachInt i
+litValKey (HsIntegral _ i) True  = MachInt (-i)
 litValKey (HsFractional r) False = MachFloat (fl_value r)
 litValKey (HsFractional r) True  = MachFloat (negate (fl_value r))
-litValKey (HsIsString s)   neg   = ASSERT( not neg) MachStr (fastStringToByteString s)
+litValKey (HsIsString _ s) neg   = ASSERT( not neg) MachStr
+                                                      (fastStringToByteString s)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index b0bc1a8ed8..ffa91a574a 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -623,11 +623,13 @@ compiler_stage2_dll0_MODULES += \
 	CodeGen.Platform.SPARC \
 	CodeGen.Platform.X86 \
 	CodeGen.Platform.X86_64 \
+	Ctype \
 	FastBool \
 	Hoopl \
 	Hoopl.Dataflow \
 	InteractiveEvalTypes \
 	MkGraph \
+	Lexer \
 	PprCmm \
 	PprCmmDecl \
 	PprCmmExpr \
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index c7c31f3d8d..1a6f2cf110 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -830,13 +830,13 @@ cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
 
 cvtOverLit :: Lit -> CvtM (HsOverLit RdrName)
 cvtOverLit (IntegerL i)
-  = do { force i; return $ mkHsIntegral i placeHolderType}
+  = do { force i; return $ mkHsIntegral "" i placeHolderType}
 cvtOverLit (RationalL r)
   = do { force r; return $ mkHsFractional (cvtFractionalLit r) placeHolderType}
 cvtOverLit (StringL s)
   = do { let { s' = mkFastString s }
        ; force s'
-       ; return $ mkHsIsString s' placeHolderType
+       ; return $ mkHsIsString "" s' placeHolderType
        }
 cvtOverLit _ = panic "Convert.cvtOverLit: Unexpected overloaded literal"
 -- An Integer is like an (overloaded) '3' in a Haskell source program
@@ -864,17 +864,17 @@ allCharLs xs
     go _  _                     = Nothing
 
 cvtLit :: Lit -> CvtM HsLit
-cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim i }
-cvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim w }
+cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim "" i }
+cvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim "" w }
 cvtLit (FloatPrimL f)  = do { force f; return $ HsFloatPrim (cvtFractionalLit f) }
 cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim (cvtFractionalLit f) }
-cvtLit (CharL c)       = do { force c; return $ HsChar c }
+cvtLit (CharL c)       = do { force c; return $ HsChar "" c }
 cvtLit (StringL s)     = do { let { s' = mkFastString s }
                             ; force s'
-                            ; return $ HsString s' }
+                            ; return $ HsString s s' }
 cvtLit (StringPrimL s) = do { let { s' = BS.pack s }
                             ; force s'
-                            ; return $ HsStringPrim s' }
+                            ; return $ HsStringPrim "" s' }
 cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
         -- cvtLit should not be called on IntegerL, RationalL
         -- That precondition is established right here in
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index e7c23ebae2..0833c3c66d 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -64,7 +64,7 @@ type PostTcExpr  = HsExpr Id
 type PostTcTable = [(Name, PostTcExpr)]
 
 noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
+noPostTcExpr = HsLit (HsString "" (fsLit "noPostTcExpr"))
 
 noPostTcTable :: PostTcTable
 noPostTcTable = []
@@ -81,7 +81,7 @@ type SyntaxExpr id = HsExpr id
 
 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                               -- (if the syntax slot makes no sense)
-noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
+noSyntaxExpr = HsLit (HsString "" (fsLit "noSyntaxExpr"))
 
 
 type CmdSyntaxTable id = [(Name, SyntaxExpr id)]
diff --git a/compiler/hsSyn/HsLit.lhs b/compiler/hsSyn/HsLit.lhs
index db6e126594..2bde0cdc29 100644
--- a/compiler/hsSyn/HsLit.lhs
+++ b/compiler/hsSyn/HsLit.lhs
@@ -24,6 +24,7 @@ import Type       ( Type )
 import Outputable
 import FastString
 import PlaceHolder ( PostTc,PostRn,DataId )
+import Lexer       ( SourceText )
 
 import Data.ByteString (ByteString)
 import Data.Data hiding ( Fixity )
@@ -41,20 +42,21 @@ import Data.Data hiding ( Fixity )
 
 
 \begin{code}
+-- Note [literal source text] for SourceText fields in the following
 data HsLit
-  = HsChar          Char               -- Character
-  | HsCharPrim      Char               -- Unboxed character
-  | HsString        FastString         -- String
-  | HsStringPrim    ByteString         -- Packed bytes
-  | HsInt           Integer            -- Genuinely an Int; arises from
+  = HsChar          SourceText Char        -- Character
+  | HsCharPrim      SourceText Char        -- Unboxed character
+  | HsString        SourceText FastString  -- String
+  | HsStringPrim    SourceText ByteString  -- Packed bytes
+  | HsInt           SourceText Integer     -- Genuinely an Int; arises from
                                        --     TcGenDeriv, and from TRANSLATION
-  | HsIntPrim       Integer            -- literal Int#
-  | HsWordPrim      Integer            -- literal Word#
-  | HsInt64Prim     Integer            -- literal Int64#
-  | HsWord64Prim    Integer            -- literal Word64#
-  | HsInteger       Integer  Type      -- Genuinely an integer; arises only from
-                                       --   TRANSLATION (overloaded literals are
-                                       --   done with HsOverLit)
+  | HsIntPrim       SourceText Integer     -- literal Int#
+  | HsWordPrim      SourceText Integer     -- literal Word#
+  | HsInt64Prim     SourceText Integer     -- literal Int64#
+  | HsWord64Prim    SourceText Integer     -- literal Word64#
+  | HsInteger       SourceText Integer Type -- Genuinely an integer; arises only
+                                          --   from TRANSLATION (overloaded
+                                          --   literals are done with HsOverLit)
   | HsRat           FractionalLit Type -- Genuinely a rational; arises only from
                                        --   TRANSLATION (overloaded literals are
                                        --   done with HsOverLit)
@@ -63,20 +65,20 @@ data HsLit
   deriving (Data, Typeable)
 
 instance Eq HsLit where
-  (HsChar x1)       == (HsChar x2)       = x1==x2
-  (HsCharPrim x1)   == (HsCharPrim x2)   = x1==x2
-  (HsString x1)     == (HsString x2)     = x1==x2
-  (HsStringPrim x1) == (HsStringPrim x2) = x1==x2
-  (HsInt x1)        == (HsInt x2)        = x1==x2
-  (HsIntPrim x1)    == (HsIntPrim x2)    = x1==x2
-  (HsWordPrim x1)   == (HsWordPrim x2)   = x1==x2
-  (HsInt64Prim x1)  == (HsInt64Prim x2)  = x1==x2
-  (HsWord64Prim x1) == (HsWord64Prim x2) = x1==x2
-  (HsInteger x1 _)  == (HsInteger x2 _)  = x1==x2
-  (HsRat x1 _)      == (HsRat x2 _)      = x1==x2
-  (HsFloatPrim x1)  == (HsFloatPrim x2)  = x1==x2
-  (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
-  _                 == _                 = False
+  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
+  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2
+  (HsString _ x1)     == (HsString _ x2)     = x1==x2
+  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
+  (HsInt _ x1)        == (HsInt _ x2)        = x1==x2
+  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2
+  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2
+  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2
+  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
+  (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2
+  (HsRat x1 _)        == (HsRat x2 _)        = x1==x2
+  (HsFloatPrim x1)    == (HsFloatPrim x2)    = x1==x2
+  (HsDoublePrim x1)   == (HsDoublePrim x2)   = x1==x2
+  _                   == _                   = False
 
 data HsOverLit id       -- An overloaded literal
   = OverLit {
@@ -87,16 +89,47 @@ data HsOverLit id       -- An overloaded literal
   deriving (Typeable)
 deriving instance (DataId id) => Data (HsOverLit id)
 
+-- Note [literal source text] for SourceText fields in the following
 data OverLitVal
-  = HsIntegral   !Integer       -- Integer-looking literals;
-  | HsFractional !FractionalLit -- Frac-looking literals
-  | HsIsString   !FastString    -- String-looking literals
+  = HsIntegral   !SourceText !Integer    -- Integer-looking literals;
+  | HsFractional !FractionalLit          -- Frac-looking literals
+  | HsIsString   !SourceText !FastString -- String-looking literals
   deriving (Data, Typeable)
 
 overLitType :: HsOverLit a -> PostTc a Type
 overLitType = ol_type
 \end{code}
 
+Note [literal source text]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The lexer/parser converts literals from their original source text
+versions to an appropriate internal representation. This is a problem
+for tools doing source to source conversions, so the original source
+text is stored in literals where this can occur.
+
+Motivating examples for HsLit
+
+  HsChar          '\n', '\x20`
+  HsCharPrim      '\x41`#
+  HsString        "\x20\x41" == " A"
+  HsStringPrim    "\x20"#
+  HsInt           001
+  HsIntPrim       002#
+  HsWordPrim      003##
+  HsInt64Prim     004##
+  HsWord64Prim    005##
+  HsInteger       006
+
+For OverLitVal
+
+  HsIntegral      003,0x001
+  HsIsString      "\x41nd"
+
+
+
+
+
 Note [ol_rebindable]
 ~~~~~~~~~~~~~~~~~~~~
 The ol_rebindable field is True if this literal is actually
@@ -132,42 +165,42 @@ instance Eq (HsOverLit id) where
   (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
 
 instance Eq OverLitVal where
-  (HsIntegral i1)   == (HsIntegral i2)   = i1 == i2
-  (HsFractional f1) == (HsFractional f2) = f1 == f2
-  (HsIsString s1)   == (HsIsString s2)   = s1 == s2
-  _                 == _                 = False
+  (HsIntegral _ i1)   == (HsIntegral _ i2)   = i1 == i2
+  (HsFractional f1)   == (HsFractional f2)   = f1 == f2
+  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2
+  _                   == _                   = False
 
 instance Ord (HsOverLit id) where
   compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
 
 instance Ord OverLitVal where
-  compare (HsIntegral i1)   (HsIntegral i2)   = i1 `compare` i2
-  compare (HsIntegral _)    (HsFractional _)  = LT
-  compare (HsIntegral _)    (HsIsString _)    = LT
-  compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
-  compare (HsFractional _)  (HsIntegral _)    = GT
-  compare (HsFractional _)  (HsIsString _)    = LT
-  compare (HsIsString s1)   (HsIsString s2)   = s1 `compare` s2
-  compare (HsIsString _)    (HsIntegral _)    = GT
-  compare (HsIsString _)    (HsFractional _)  = GT
+  compare (HsIntegral _ i1)   (HsIntegral _ i2)   = i1 `compare` i2
+  compare (HsIntegral _ _)    (HsFractional _)    = LT
+  compare (HsIntegral _ _)    (HsIsString _ _)    = LT
+  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2
+  compare (HsFractional _)    (HsIntegral _ _)    = GT
+  compare (HsFractional _)    (HsIsString _ _)    = LT
+  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `compare` s2
+  compare (HsIsString _ _)    (HsIntegral _ _)    = GT
+  compare (HsIsString _ _)    (HsFractional _)    = GT
 \end{code}
 
 \begin{code}
 instance Outputable HsLit where
         -- Use "show" because it puts in appropriate escapes
-    ppr (HsChar c)       = pprHsChar c
-    ppr (HsCharPrim c)   = pprHsChar c <> char '#'
-    ppr (HsString s)     = pprHsString s
-    ppr (HsStringPrim s) = pprHsBytes s <> char '#'
-    ppr (HsInt i)        = integer i
-    ppr (HsInteger i _)  = integer i
-    ppr (HsRat f _)      = ppr f
-    ppr (HsFloatPrim f)  = ppr f <> char '#'
-    ppr (HsDoublePrim d) = ppr d <> text "##"
-    ppr (HsIntPrim i)    = integer i  <> char '#'
-    ppr (HsWordPrim w)   = integer w  <> text "##"
-    ppr (HsInt64Prim i)  = integer i  <> text "L#"
-    ppr (HsWord64Prim w) = integer w  <> text "L##"
+    ppr (HsChar _ c)       = pprHsChar c
+    ppr (HsCharPrim _ c)   = pprHsChar c <> char '#'
+    ppr (HsString _ s)     = pprHsString s
+    ppr (HsStringPrim _ s) = pprHsBytes s <> char '#'
+    ppr (HsInt _ i)        = integer i
+    ppr (HsInteger _ i _)  = integer i
+    ppr (HsRat f _)        = ppr f
+    ppr (HsFloatPrim f)    = ppr f <> char '#'
+    ppr (HsDoublePrim d)   = ppr d <> text "##"
+    ppr (HsIntPrim _ i)    = integer i  <> char '#'
+    ppr (HsWordPrim _ w)   = integer w  <> text "##"
+    ppr (HsInt64Prim _ i)  = integer i  <> text "L#"
+    ppr (HsWord64Prim _ w) = integer w  <> text "L##"
 
 -- in debug mode, print the expression that it's resolved to, too
 instance OutputableBndr id => Outputable (HsOverLit id) where
@@ -175,7 +208,7 @@ instance OutputableBndr id => Outputable (HsOverLit id) where
         = ppr val <+> (ifPprDebug (parens (pprExpr witness)))
 
 instance Outputable OverLitVal where
-  ppr (HsIntegral i)   = integer i
-  ppr (HsFractional f) = ppr f
-  ppr (HsIsString s)   = pprHsString s
+  ppr (HsIntegral _ i)   = integer i
+  ppr (HsFractional f)   = ppr f
+  ppr (HsIsString _ s)   = pprHsString s
 \end{code}
diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 3f4526c0dc..32a03391db 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -344,8 +344,9 @@ mkPrefixConPat dc pats tys
 mkNilPat :: Type -> OutPat id
 mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
 
-mkCharLitPat :: Char -> OutPat id
-mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] []
+mkCharLitPat :: String -> Char -> OutPat id
+mkCharLitPat src c = mkPrefixConPat charDataCon
+                                    [noLoc $ LitPat (HsCharPrim src c)] []
 \end{code}
 
 
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 9828c402fa..02e0503969 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -196,9 +196,9 @@ mkParPat lp@(L loc p) | hsPatNeedsParens p = L loc (ParPat lp)
 -- These are the bits of syntax that contain rebindable names
 -- See RnEnv.lookupSyntaxName
 
-mkHsIntegral   :: Integer -> PostTc RdrName Type -> HsOverLit RdrName
+mkHsIntegral   :: String -> Integer -> PostTc RdrName Type -> HsOverLit RdrName
 mkHsFractional :: FractionalLit -> PostTc RdrName Type -> HsOverLit RdrName
-mkHsIsString   :: FastString -> PostTc RdrName Type -> HsOverLit RdrName
+mkHsIsString :: String -> FastString -> PostTc RdrName Type -> HsOverLit RdrName
 mkHsDo         :: HsStmtContext Name -> [ExprLStmt RdrName] -> HsExpr RdrName
 mkHsComp       :: HsStmtContext Name -> [ExprLStmt RdrName] -> LHsExpr RdrName
                -> HsExpr RdrName
@@ -217,9 +217,9 @@ emptyRecStmtId   :: StmtLR Id   Id      bodyR
 mkRecStmt    :: [LStmtLR idL RdrName bodyR] -> StmtLR idL RdrName bodyR
 
 
-mkHsIntegral   i       = OverLit (HsIntegral   i)  noRebindableInfo noSyntaxExpr
-mkHsFractional f       = OverLit (HsFractional f)  noRebindableInfo noSyntaxExpr
-mkHsIsString   s       = OverLit (HsIsString   s)  noRebindableInfo noSyntaxExpr
+mkHsIntegral src i  = OverLit (HsIntegral   src i) noRebindableInfo noSyntaxExpr
+mkHsFractional   f  = OverLit (HsFractional     f) noRebindableInfo noSyntaxExpr
+mkHsIsString src s  = OverLit (HsIsString   src s) noRebindableInfo noSyntaxExpr
 
 noRebindableInfo :: PlaceHolder
 noRebindableInfo = PlaceHolder -- Just another placeholder;
@@ -306,7 +306,7 @@ unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
                 -- identify the quasi-quote
 
 mkHsString :: String -> HsLit
-mkHsString s = HsString (mkFastString s)
+mkHsString s = HsString s (mkFastString s)
 
 -------------
 userHsTyVarBndrs :: SrcSpan -> [name] -> [Located (HsTyVarBndr name)]
@@ -338,7 +338,7 @@ nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
 nlHsApp f x = noLoc (HsApp f x)
 
 nlHsIntLit :: Integer -> LHsExpr id
-nlHsIntLit n = noLoc (HsLit (HsInt n))
+nlHsIntLit n = noLoc (HsLit (HsInt (show n) n))
 
 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 6669250cc3..d7ee0b6d77 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -56,7 +56,7 @@
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 
 module Lexer (
-   Token(..), lexer, pragState, mkPState, PState(..),
+   Token(..), SourceText, lexer, pragState, mkPState, PState(..),
    P(..), ParseResult(..), getSrcLoc,
    getPState, getDynFlags, withThisPackage,
    failLocMsgP, failSpanMsgP, srcParseFail,
@@ -506,6 +506,9 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 -- Alex "Haskell code fragment bottom"
 
 {
+
+type SourceText = String -- Note [literal source text] in HsLit
+
 -- -----------------------------------------------------------------------------
 -- The token type
 
@@ -636,15 +639,15 @@ data Token
 
   | ITdupipvarid   FastString   -- GHC extension: implicit param: ?x
 
-  | ITchar       Char
-  | ITstring     FastString
-  | ITinteger    Integer
+  | ITchar       SourceText Char        -- Note [literal source text] in HsLit
+  | ITstring     SourceText FastString  -- Note [literal source text] in HsLit
+  | ITinteger    SourceText Integer     -- Note [literal source text] in HsLit
   | ITrational   FractionalLit
 
-  | ITprimchar   Char
-  | ITprimstring ByteString
-  | ITprimint    Integer
-  | ITprimword   Integer
+  | ITprimchar   SourceText Char        -- Note [literal source text] in HsLit
+  | ITprimstring SourceText ByteString  -- Note [literal source text] in HsLit
+  | ITprimint    SourceText Integer     -- Note [literal source text] in HsLit
+  | ITprimword   SourceText Integer     -- Note [literal source text] in HsLit
   | ITprimfloat  FractionalLit
   | ITprimdouble FractionalLit
 
@@ -1157,13 +1160,14 @@ sym con span buf len =
     !fs = lexemeToFastString buf len
 
 -- Variations on the integral numeric literal.
-tok_integral :: (Integer -> Token)
+tok_integral :: (String -> Integer -> Token)
              -> (Integer -> Integer)
              -> Int -> Int
              -> (Integer, (Char -> Int))
              -> Action
 tok_integral itint transint transbuf translen (radix,char_to_int) span buf len
- = return $ L span $ itint $! transint $ parseUnsignedInteger
+ = return $ L span $ itint (lexemeToString buf len)
+       $! transint $ parseUnsignedInteger
        (offsetBytes transbuf buf) (subtract translen len) radix char_to_int
 
 -- some conveniences for use with tok_integral
@@ -1345,10 +1349,16 @@ lex_string_prag mkTok span _buf _len
 -- This stuff is horrible.  I hates it.
 
 lex_string_tok :: Action
-lex_string_tok span _buf _len = do
+lex_string_tok span buf _len = do
   tok <- lex_string ""
   end <- getSrcLoc
-  return (L (mkRealSrcSpan (realSrcSpanStart span) end) tok)
+  (AI end bufEnd) <- getInput
+  let
+    tok' = case tok of
+            ITprimstring _ bs -> ITprimstring src bs
+            ITstring _ s -> ITstring src s
+    src = lexemeToString buf (cur bufEnd - cur buf)
+  return (L (mkRealSrcSpan (realSrcSpanStart span) end) tok')
 
 lex_string :: String -> P Token
 lex_string s = do
@@ -1368,11 +1378,11 @@ lex_string s = do
                    if any (> '\xFF') s
                     then failMsgP "primitive string literal must contain only characters <= \'\\xFF\'"
                     else let bs = unsafeMkByteString (reverse s)
-                         in return (ITprimstring bs)
+                         in return (ITprimstring "" bs)
               _other ->
-                return (ITstring (mkFastString (reverse s)))
+                return (ITstring "" (mkFastString (reverse s)))
           else
-                return (ITstring (mkFastString (reverse s)))
+                return (ITstring "" (mkFastString (reverse s)))
 
     Just ('\\',i)
         | Just ('&',i) <- next -> do
@@ -1406,7 +1416,7 @@ lex_char_tok :: Action
 -- but WITHOUT CONSUMING the x or T part  (the parser does that).
 -- So we have to do two characters of lookahead: when we see 'x we need to
 -- see if there's a trailing quote
-lex_char_tok span _buf _len = do        -- We've seen '
+lex_char_tok span buf _len = do        -- We've seen '
    i1 <- getInput       -- Look ahead to first character
    let loc = realSrcSpanStart span
    case alexGetChar' i1 of
@@ -1421,7 +1431,7 @@ lex_char_tok span _buf _len = do        -- We've seen '
                   lit_ch <- lex_escape
                   i3 <- getInput
                   mc <- getCharOrFail i3 -- Trailing quote
-                  if mc == '\'' then finish_char_tok loc lit_ch
+                  if mc == '\'' then finish_char_tok buf loc lit_ch
                                 else lit_error i3
 
         Just (c, i2@(AI _end2 _))
@@ -1433,27 +1443,28 @@ lex_char_tok span _buf _len = do        -- We've seen '
            case alexGetChar' i2 of      -- Look ahead one more character
                 Just ('\'', i3) -> do   -- We've seen 'x'
                         setInput i3
-                        finish_char_tok loc c
+                        finish_char_tok buf loc c
                 _other -> do            -- We've seen 'x not followed by quote
                                         -- (including the possibility of EOF)
                                         -- If TH is on, just parse the quote only
                         let (AI end _) = i1
                         return (L (mkRealSrcSpan loc end) ITsimpleQuote)
 
-finish_char_tok :: RealSrcLoc -> Char -> P (RealLocated Token)
-finish_char_tok loc ch  -- We've already seen the closing quote
+finish_char_tok :: StringBuffer -> RealSrcLoc -> Char -> P (RealLocated Token)
+finish_char_tok buf loc ch  -- We've already seen the closing quote
                         -- Just need to check for trailing #
   = do  magicHash <- extension magicHashEnabled
-        i@(AI end _) <- getInput
+        i@(AI end bufEnd) <- getInput
+        let src = lexemeToString buf (cur bufEnd - cur buf)
         if magicHash then do
                 case alexGetChar' i of
                         Just ('#',i@(AI end _)) -> do
-                                setInput i
-                                return (L (mkRealSrcSpan loc end) (ITprimchar ch))
+                          setInput i
+                          return (L (mkRealSrcSpan loc end) (ITprimchar src ch))
                         _other ->
-                                return (L (mkRealSrcSpan loc end) (ITchar ch))
+                          return (L (mkRealSrcSpan loc end) (ITchar src ch))
             else do
-                   return (L (mkRealSrcSpan loc end) (ITchar ch))
+                   return (L (mkRealSrcSpan loc end) (ITchar src ch))
 
 isAny :: Char -> Bool
 isAny c | c > '\x7f' = isPrint c
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 36baf1d615..d9c0991dad 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -366,15 +366,15 @@ incorrect.
 
  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
 
- CHAR           { L _ (ITchar     _) }
- STRING         { L _ (ITstring   _) }
- INTEGER        { L _ (ITinteger  _) }
+ CHAR           { L _ (ITchar   _ _) }
+ STRING         { L _ (ITstring _ _) }
+ INTEGER        { L _ (ITinteger _ _) }
  RATIONAL       { L _ (ITrational _) }
 
- PRIMCHAR       { L _ (ITprimchar   _) }
- PRIMSTRING     { L _ (ITprimstring _) }
- PRIMINTEGER    { L _ (ITprimint    _) }
- PRIMWORD       { L _ (ITprimword  _) }
+ PRIMCHAR       { L _ (ITprimchar   _ _) }
+ PRIMSTRING     { L _ (ITprimstring _ _) }
+ PRIMINTEGER    { L _ (ITprimint    _ _) }
+ PRIMWORD       { L _ (ITprimword   _ _) }
  PRIMFLOAT      { L _ (ITprimfloat  _) }
  PRIMDOUBLE     { L _ (ITprimdouble _) }
 
@@ -2014,11 +2014,11 @@ aexp2   :: { LHsExpr RdrName }
         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
---      | STRING     { sL (getLoc $1) (HsOverLit $! mkHsIsString
---                                        (getSTRING $1) placeHolderType) }
-        | INTEGER    { sL (getLoc $1) (HsOverLit $! mkHsIntegral
-                                          (getINTEGER $1) placeHolderType) }
-        | RATIONAL   { sL (getLoc $1) (HsOverLit $! mkHsFractional
+--      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
+--                                       (getSTRING $1) placeHolderType) }
+        | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
+                                         (getINTEGER $1) placeHolderType) }
+        | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
                                           (getRATIONAL $1) placeHolderType) }
 
         -- N.B.: sections get parsed by these next two productions.
@@ -2729,14 +2729,19 @@ consym :: { Located RdrName }
 -- Literals
 
 literal :: { Located HsLit }
-        : CHAR                  { sL1 $1 $ HsChar       $ getCHAR $1 }
-        | STRING                { sL1 $1 $ HsString     $ getSTRING $1 }
-        | PRIMINTEGER           { sL1 $1 $ HsIntPrim    $ getPRIMINTEGER $1 }
-        | PRIMWORD              { sL1 $1 $ HsWordPrim    $ getPRIMWORD $1 }
-        | PRIMCHAR              { sL1 $1 $ HsCharPrim   $ getPRIMCHAR $1 }
-        | PRIMSTRING            { sL1 $1 $ HsStringPrim $ getPRIMSTRING $1 }
-        | PRIMFLOAT             { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
-        | PRIMDOUBLE            { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
+        : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
+        | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
+                                                   $ getSTRING $1 }
+        | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
+                                                   $ getPRIMINTEGER $1 }
+        | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
+                                                   $ getPRIMWORD $1 }
+        | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
+                                                   $ getPRIMCHAR $1 }
+        | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
+                                                   $ getPRIMSTRING $1 }
+        | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
+        | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
 
 -----------------------------------------------------------------------------
 -- Layout
@@ -2806,15 +2811,15 @@ getQCONSYM      (L _ (ITqconsym  x)) = x
 getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
 getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
-getCHAR         (L _ (ITchar     x)) = x
-getSTRING       (L _ (ITstring   x)) = x
-getINTEGER      (L _ (ITinteger  x)) = x
+getCHAR         (L _ (ITchar   _ x)) = x
+getSTRING       (L _ (ITstring _ x)) = x
+getINTEGER      (L _ (ITinteger _ x)) = x
 getRATIONAL     (L _ (ITrational x)) = x
-getPRIMCHAR     (L _ (ITprimchar   x)) = x
-getPRIMSTRING   (L _ (ITprimstring x)) = x
-getPRIMINTEGER  (L _ (ITprimint    x)) = x
-getPRIMWORD     (L _ (ITprimword x)) = x
-getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
+getPRIMCHAR     (L _ (ITprimchar _ x)) = x
+getPRIMSTRING   (L _ (ITprimstring _ x)) = x
+getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
+getPRIMWORD     (L _ (ITprimword _ x)) = x
+getPRIMFLOAT    (L _ (ITprimfloat x)) = x
 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
@@ -2827,6 +2832,16 @@ getDOCPREV (L _ (ITdocCommentPrev x)) = x
 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
 
+getCHARs        (L _ (ITchar       src _)) = src
+getSTRINGs      (L _ (ITstring     src _)) = src
+getINTEGERs     (L _ (ITinteger    src _)) = src
+getPRIMCHARs    (L _ (ITprimchar   src _)) = src
+getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
+getPRIMINTEGERs (L _ (ITprimint    src _)) = src
+getPRIMWORDs    (L _ (ITprimword   src _)) = src
+
+
+
 getSCC :: Located Token -> P FastString
 getSCC lt = do let s = getSTRING lt
                    err = "Spaces are not allowed in SCCs"
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 1b30b710c0..a928470181 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -125,8 +125,8 @@ mkClassDecl :: SrcSpan
             -> P (LTyClDecl RdrName)
 
 mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
-  = do { let (binds, sigs, ats, at_insts, _, docs) = cvBindsAndSigs where_cls
-             cxt = fromMaybe (noLoc []) mcxt
+  = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls
+       ; let cxt = fromMaybe (noLoc []) mcxt
        ; (cls, tparams) <- checkTyClHdr tycl_hdr
        ; tyvars <- checkTyVarsP (ptext (sLit "class")) whereDots cls tparams
        ; at_defs <- mapM (eitherToP . mkATDefault) at_insts
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 98b1358594..30e7112f12 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -103,10 +103,10 @@ rnExpr (HsVar v)
 rnExpr (HsIPVar v)
   = return (HsIPVar v, emptyFVs)
 
-rnExpr (HsLit lit@(HsString s))
+rnExpr (HsLit lit@(HsString src s))
   = do { opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
        ; if opt_OverloadedStrings then
-            rnExpr (HsOverLit (mkHsIsString s placeHolderType))
+            rnExpr (HsOverLit (mkHsIsString src s placeHolderType))
          else do {
             ; rnLit lit
             ; return (HsLit lit, emptyFVs) } }
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 4b9fe62b0a..90002d8b7e 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -374,10 +374,11 @@ rnPatAndThen mk (SigPatIn pat sig)
        ; return (SigPatIn pat' sig') }
        
 rnPatAndThen mk (LitPat lit)
-  | HsString s <- lit
+  | HsString src s <- lit
   = do { ovlStr <- liftCps (xoptM Opt_OverloadedStrings)
        ; if ovlStr 
-         then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing)
+         then rnPatAndThen mk (mkNPat (mkHsIsString src s placeHolderType)
+                                      Nothing)
          else normal_lit }
   | otherwise = normal_lit
   where
@@ -701,14 +702,14 @@ are made available.
 
 \begin{code}
 rnLit :: HsLit -> RnM ()
-rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
+rnLit (HsChar _ c) = checkErr (inCharRange c) (bogusCharError c)
 rnLit _ = return ()
 
 -- Turn a Fractional-looking literal which happens to be an integer into an
 -- Integer-looking literal.
 generalizeOverLitVal :: OverLitVal -> OverLitVal
-generalizeOverLitVal (HsFractional (FL {fl_value=val}))
-    | denominator val == 1 = HsIntegral (numerator val)
+generalizeOverLitVal (HsFractional (FL {fl_text=src,fl_value=val}))
+    | denominator val == 1 = HsIntegral src (numerator val)
 generalizeOverLitVal lit = lit
 
 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 3fd8e647f0..de7668db48 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -289,15 +289,15 @@ newOverloadedLit' dflags orig
 
 ------------
 mkOverLit :: OverLitVal -> TcM HsLit
-mkOverLit (HsIntegral i)
+mkOverLit (HsIntegral src i)
   = do  { integer_ty <- tcMetaTy integerTyConName
-        ; return (HsInteger i integer_ty) }
+        ; return (HsInteger src i integer_ty) }
 
 mkOverLit (HsFractional r)
   = do  { rat_ty <- tcMetaTy rationalTyConName
         ; return (HsRat r rat_ty) }
 
-mkOverLit (HsIsString s) = return (HsString s)
+mkOverLit (HsIsString src s) = return (HsString src s)
 \end{code}
 
 
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index acd469ed15..a95d9c1a04 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -847,7 +847,8 @@ tcSpec poly_id prag@(SpecSig fun_name hs_tys inl)
                  (ptext (sLit "SPECIALISE pragma for non-overloaded function")
                   <+> quotes (ppr fun_name))
                   -- Note [SPECIALISE pragmas]
-        ; wraps <- mapM (tcSubType origin sig_ctxt (idType poly_id)) spec_tys
+        -- ; wraps <- mapM (tcSubType origin sig_ctxt (idType poly_id)) spec_tys
+        ; wraps <- mapM (tcSubType sig_ctxt (idType poly_id)) spec_tys
         ; return [ (SpecPrag poly_id wrap inl) | wrap <- wraps ] }
   where
     name      = idName poly_id
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index d8db986c8b..d7af47cb2a 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -1120,7 +1120,8 @@ tc_infer_id orig id_name
 
 srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr TcId
 srcSpanPrimLit dflags span
-    = HsLit (HsStringPrim (unsafeMkByteString (showSDocOneLine dflags (ppr span))))
+    = HsLit (HsStringPrim "" (unsafeMkByteString
+                             (showSDocOneLine dflags (ppr span))))
 \end{code}
 
 Note [Adding the implicit parameter to 'assert']
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 0779e67363..f911d16565 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -467,7 +467,7 @@ gen_Ord_binds loc tycon
                                  , mkSimpleHsAlt nlWildPat (gtResult op) ]
       where
         tag     = get_tag data_con
-        tag_lit = noLoc (HsLit (HsIntPrim (toInteger tag)))
+        tag_lit = noLoc (HsLit (HsIntPrim "" (toInteger tag)))
 
     mkInnerEqAlt :: OrdOp -> DataCon -> LMatch RdrName (LHsExpr RdrName)
     -- First argument 'a' known to be built with K
@@ -630,7 +630,7 @@ gen_Enum_binds loc tycon
              (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
              (nlHsApp (nlHsVar (tag2con_RDR tycon))
                            (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
-                                               nlHsLit (HsInt (-1))]))
+                                               nlHsLit (HsInt "-1" (-1))]))
 
     to_enum
       = mk_easy_FunBind loc toEnum_RDR [a_Pat] $
@@ -1138,7 +1138,8 @@ gen_Show_binds get_fixity loc tycon
          ([nlWildPat, con_pat], mk_showString_app op_con_str)
       | otherwise   =
          ([a_Pat, con_pat],
-          showParen_Expr (nlHsPar (genOpApp a_Expr ge_RDR (nlHsLit (HsInt con_prec_plus_one))))
+          showParen_Expr (nlHsPar (genOpApp a_Expr ge_RDR
+                                        (nlHsLit (HsInt "" con_prec_plus_one))))
                          (nlHsPar (nested_compose_Expr show_thingies)))
         where
              data_con_RDR  = getRdrName data_con
@@ -1188,8 +1189,9 @@ gen_Show_binds get_fixity loc tycon
                 -- Generates (showsPrec p x) for argument x, but it also boxes
                 -- the argument first if necessary.  Note that this prints unboxed
                 -- things without any '#' decorations; could change that if need be
-             show_arg b arg_ty = nlHsApps showsPrec_RDR [nlHsLit (HsInt arg_prec),
-                                                         box_if_necy "Show" tycon (nlHsVar b) arg_ty]
+             show_arg b arg_ty = nlHsApps showsPrec_RDR
+                                    [nlHsLit (HsInt "" arg_prec),
+                                    box_if_necy "Show" tycon (nlHsVar b) arg_ty]
 
                 -- Fixity stuff
              is_infix = dataConIsInfix data_con
@@ -1271,16 +1273,16 @@ gen_Typeable_binds dflags loc tycon
     tycon_rep = nlHsApps mkTyCon_RDR
                     (map nlHsLit [int64 high,
                                   int64 low,
-                                  HsString pkg_fs,
-                                  HsString modl_fs,
-                                  HsString name_fs])
+                                  HsString "" pkg_fs,
+                                  HsString "" modl_fs,
+                                  HsString "" name_fs])
 
     hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, name_fs]
     Fingerprint high low = fingerprintString hashThis
 
     int64
-      | wORD_SIZE dflags == 4 = HsWord64Prim . fromIntegral
-      | otherwise             = HsWordPrim . fromIntegral
+      | wORD_SIZE dflags == 4 = HsWord64Prim "" . fromIntegral
+      | otherwise             = HsWordPrim "" . fromIntegral
 \end{code}
 
 
@@ -1403,7 +1405,8 @@ gen_Data_binds dflags loc tycon
     mk_unfold_pat dc    -- Last one is a wild-pat, to avoid
                         -- redundant test, and annoying warning
       | tag-fIRST_TAG == n_cons-1 = nlWildPat   -- Last constructor
-      | otherwise = nlConPat intDataCon_RDR [nlLitPat (HsIntPrim (toInteger tag))]
+      | otherwise = nlConPat intDataCon_RDR
+                             [nlLitPat (HsIntPrim "" (toInteger tag))]
       where
         tag = dataConTag dc
 
@@ -1988,7 +1991,8 @@ genAuxBindSpec loc (DerivCon2Tag tycon)
 
     mk_eqn :: DataCon -> ([LPat RdrName], LHsExpr RdrName)
     mk_eqn con = ([nlWildConPat con],
-                  nlHsLit (HsIntPrim (toInteger ((dataConTag con) - fIRST_TAG))))
+                  nlHsLit (HsIntPrim ""
+                                    (toInteger ((dataConTag con) - fIRST_TAG))))
 
 genAuxBindSpec loc (DerivTag2Con tycon)
   = (mk_FunBind loc rdr_name
@@ -2007,7 +2011,7 @@ genAuxBindSpec loc (DerivMaxTag tycon)
   where
     rdr_name = maxtag_RDR tycon
     sig_ty = HsCoreTy intTy
-    rhs = nlHsApp (nlHsVar intDataCon_RDR) (nlHsLit (HsIntPrim max_tag))
+    rhs = nlHsApp (nlHsVar intDataCon_RDR) (nlHsLit (HsIntPrim "" max_tag))
     max_tag =  case (tyConDataCons tycon) of
                  data_cons -> toInteger ((length data_cons) - fIRST_TAG)
 
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 0265dec38d..5ff622b3dc 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -101,29 +101,30 @@ conLikeResTy (RealDataCon con) tys = mkTyConApp (dataConTyCon con) tys
 conLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys
 
 hsLitType :: HsLit -> TcType
-hsLitType (HsChar _)       = charTy
-hsLitType (HsCharPrim _)   = charPrimTy
-hsLitType (HsString _)     = stringTy
-hsLitType (HsStringPrim _) = addrPrimTy
-hsLitType (HsInt _)        = intTy
-hsLitType (HsIntPrim _)    = intPrimTy
-hsLitType (HsWordPrim _)   = wordPrimTy
-hsLitType (HsInt64Prim _)  = int64PrimTy
-hsLitType (HsWord64Prim _) = word64PrimTy
-hsLitType (HsInteger _ ty) = ty
-hsLitType (HsRat _ ty)     = ty
-hsLitType (HsFloatPrim _)  = floatPrimTy
-hsLitType (HsDoublePrim _) = doublePrimTy
+hsLitType (HsChar _ _)       = charTy
+hsLitType (HsCharPrim _ _)   = charPrimTy
+hsLitType (HsString _ _)     = stringTy
+hsLitType (HsStringPrim _ _) = addrPrimTy
+hsLitType (HsInt _ _)        = intTy
+hsLitType (HsIntPrim _ _)    = intPrimTy
+hsLitType (HsWordPrim _ _)   = wordPrimTy
+hsLitType (HsInt64Prim _ _)  = int64PrimTy
+hsLitType (HsWord64Prim _ _) = word64PrimTy
+hsLitType (HsInteger _ _ ty) = ty
+hsLitType (HsRat _ ty)       = ty
+hsLitType (HsFloatPrim _)    = floatPrimTy
+hsLitType (HsDoublePrim _)   = doublePrimTy
 \end{code}
 
 Overloaded literals. Here mainly because it uses isIntTy etc
 
 \begin{code}
 shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr TcId)
-shortCutLit dflags (HsIntegral i) ty
-  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt i))
-  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim i))
-  | isIntegerTy ty = Just (HsLit (HsInteger i ty))
+shortCutLit dflags (HsIntegral src i) ty
+  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt src i))
+  | isWordTy ty && inWordRange dflags i
+                                   = Just (mkLit wordDataCon (HsWordPrim src i))
+  | isIntegerTy ty = Just (HsLit (HsInteger src i ty))
   | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit i)) ty
         -- The 'otherwise' case is important
         -- Consider (3 :: Float).  Syntactically it looks like an IntLit,
@@ -136,8 +137,8 @@ shortCutLit _ (HsFractional f) ty
   | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
   | otherwise     = Nothing
 
-shortCutLit _ (HsIsString s) ty
-  | isStringTy ty = Just (HsLit (HsString s))
+shortCutLit _ (HsIsString src s) ty
+  | isStringTy ty = Just (HsLit (HsString src s))
   | otherwise     = Nothing
 
 mkLit :: DataCon -> HsLit -> HsExpr Id
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 033ee0ef6c..53411ce696 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -1242,7 +1242,8 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
       where
         error_rhs dflags = L inst_loc $ HsApp error_fun (error_msg dflags)
         error_fun    = L inst_loc $ wrapId (WpTyApp meth_tau) nO_METHOD_BINDING_ERROR_ID
-        error_msg dflags = L inst_loc (HsLit (HsStringPrim (unsafeMkByteString (error_string dflags))))
+        error_msg dflags = L inst_loc (HsLit (HsStringPrim ""
+                                    (unsafeMkByteString (error_string dflags))))
         meth_tau     = funResultTy (applyTys (idType sel_id) inst_tys)
         error_string dflags = showSDoc dflags (hcat [ppr inst_loc, text "|", ppr sel_id ])
         lam_wrapper  = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index c2eabbf67d..d2e9115d07 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -311,7 +311,8 @@ tcRnModuleTcRnM hsc_env hsc_src
         boot_iface <- tcHiBootIface hsc_src this_mod ;
 
         let { exports_occs =
-                 maybe emptyBag (listToBag . map (rdrNameOcc . ieName . unLoc))
+                 maybe emptyBag
+                       (listToBag . map (rdrNameOcc . ieName . unLoc) . unLoc)
                        export_ies
             } ;
 
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 7c8085ebe2..4b651ba4a7 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -648,7 +648,7 @@ runQuasiQuote (HsQuasiQuote quoter q_span quote) quote_selector meta_ty meta_ops
 
           -- Build the expression
         ; let quoterExpr = L q_span $! HsVar $! quoter''
-        ; let quoteExpr = L q_span $! HsLit $! HsString quote'
+        ; let quoteExpr = L q_span $! HsLit $! HsString "" quote'
         ; let expr = L q_span $
                      HsApp (L q_span $
                             HsApp (L q_span (HsVar quote_selector)) quoterExpr) quoteExpr
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 1cffcf04a1..300b18cf4c 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -1983,7 +1983,7 @@ mkRecSelBind (tycon, sel_name)
     inst_tys = substTyVars (mkTopTvSubst (dataConEqSpec con1)) (dataConUnivTyVars con1)
 
     unit_rhs = mkLHsTupleExpr []
-    msg_lit = HsStringPrim $ unsafeMkByteString $
+    msg_lit = HsStringPrim "" $ unsafeMkByteString $
               occNameString (getOccName sel_name)
 
 ---------------
diff --git a/testsuite/tests/ghc-api/annotations-literals/.gitignore b/testsuite/tests/ghc-api/annotations-literals/.gitignore
new file mode 100644
index 0000000000..7a7e523f6d
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/.gitignore
@@ -0,0 +1,6 @@
+parsed
+literals
+*.hi
+*.o
+*.run.*
+*.normalised
diff --git a/testsuite/tests/ghc-api/annotations-literals/LiteralsTest.hs b/testsuite/tests/ghc-api/annotations-literals/LiteralsTest.hs
new file mode 100644
index 0000000000..9081adf74e
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/LiteralsTest.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE MagicHash #-}
+module LiteralsTest where
+
+x,y :: Int
+x = 0003
+y = 0x04
+
+s :: String
+s = "\x20"
+
+c :: Char
+c = '\x20'
+
+d :: Double
+d = 0.00
+
+blah = x
+  where
+    charH = '\x41'#
+    intH = 0004#
+    wordH = 005##
+    floatH = 3.20#
+    doubleH = 04.16##
+    x = 1
diff --git a/testsuite/tests/ghc-api/annotations-literals/Makefile b/testsuite/tests/ghc-api/annotations-literals/Makefile
new file mode 100644
index 0000000000..0a65083ee7
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/Makefile
@@ -0,0 +1,16 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+	rm -f *.o *.hi
+
+literals: clean
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc literals
+	./literals "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+parsed: clean
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc parsed
+	./parsed "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+.PHONY: clean
diff --git a/testsuite/tests/ghc-api/annotations-literals/all.T b/testsuite/tests/ghc-api/annotations-literals/all.T
new file mode 100644
index 0000000000..999c5a4ed0
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/all.T
@@ -0,0 +1,2 @@
+test('literals', normal, run_command, ['$MAKE -s --no-print-directory literals'])
+test('parsed',   normal, run_command, ['$MAKE -s --no-print-directory parsed'])
\ No newline at end of file
diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.hs b/testsuite/tests/ghc-api/annotations-literals/literals.hs
new file mode 100644
index 0000000000..df0f1edf50
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/literals.hs
@@ -0,0 +1,43 @@
+-- This program must be called with GHC's libdir as the single command line
+-- argument.
+module Main where
+
+-- import Data.Generics
+import Data.Data
+import Data.List
+import System.IO
+import GHC
+import DynFlags
+import MonadUtils
+import Outputable
+import Bag (filterBag,isEmptyBag)
+import System.Directory (removeFile)
+import System.Environment( getArgs )
+import qualified Data.Map as Map
+import Data.Dynamic ( fromDynamic,Dynamic )
+
+main::IO()
+main = do
+        [libdir] <- getArgs
+        testOneFile libdir "LiteralsTest"
+
+testOneFile libdir fileName = do
+    t <- runGhc (Just libdir) $ do
+        dflags <- getSessionDynFlags
+        setSessionDynFlags dflags
+        let mn =mkModuleName fileName
+        addTarget Target { targetId = TargetModule mn
+                         , targetAllowObjCode = True
+                         , targetContents = Nothing }
+        load LoadAllTargets
+        modSum <- getModSummary mn
+        toks <- getRichTokenStream (ms_mod modSum)
+        return toks
+
+    putStrLn (intercalate "\n" [showToks t])
+
+showToks ts = intercalate ",\n\n"
+            $ map (\((L p t),s) ->
+                         "(" ++ pp p ++ "," ++ show t ++ ",[" ++ s ++ "])") ts
+
+pp a = showPpr unsafeGlobalDynFlags a
diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
new file mode 100644
index 0000000000..2d3b6b1adf
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
@@ -0,0 +1,145 @@
+(LiteralsTest.hs:1:1-26,ITblockComment "# LANGUAGE MagicHash #",[{-# LANGUAGE MagicHash #-}]),
+
+(LiteralsTest.hs:2:1-6,ITmodule,[module]),
+
+(LiteralsTest.hs:2:8-19,ITconid "LiteralsTest",[LiteralsTest]),
+
+(LiteralsTest.hs:2:21-25,ITwhere,[where]),
+
+(LiteralsTest.hs:4:1,ITvocurly,[]),
+
+(LiteralsTest.hs:4:1,ITvarid "x",[x]),
+
+(LiteralsTest.hs:4:2,ITcomma,[,]),
+
+(LiteralsTest.hs:4:3,ITvarid "y",[y]),
+
+(LiteralsTest.hs:4:5-6,ITdcolon,[::]),
+
+(LiteralsTest.hs:4:8-10,ITconid "Int",[Int]),
+
+(LiteralsTest.hs:5:1,ITsemi,[]),
+
+(LiteralsTest.hs:5:1,ITvarid "x",[x]),
+
+(LiteralsTest.hs:5:3,ITequal,[=]),
+
+(LiteralsTest.hs:5:5-8,ITinteger "0003" 3,[0003]),
+
+(LiteralsTest.hs:6:1,ITsemi,[]),
+
+(LiteralsTest.hs:6:1,ITvarid "y",[y]),
+
+(LiteralsTest.hs:6:3,ITequal,[=]),
+
+(LiteralsTest.hs:6:5-8,ITinteger "0x04" 4,[0x04]),
+
+(LiteralsTest.hs:8:1,ITsemi,[]),
+
+(LiteralsTest.hs:8:1,ITvarid "s",[s]),
+
+(LiteralsTest.hs:8:3-4,ITdcolon,[::]),
+
+(LiteralsTest.hs:8:6-11,ITconid "String",[String]),
+
+(LiteralsTest.hs:9:1,ITsemi,[]),
+
+(LiteralsTest.hs:9:1,ITvarid "s",[s]),
+
+(LiteralsTest.hs:9:3,ITequal,[=]),
+
+(LiteralsTest.hs:9:5-10,ITstring "\"\\x20\"" " ",["\x20"]),
+
+(LiteralsTest.hs:11:1,ITsemi,[]),
+
+(LiteralsTest.hs:11:1,ITvarid "c",[c]),
+
+(LiteralsTest.hs:11:3-4,ITdcolon,[::]),
+
+(LiteralsTest.hs:11:6-9,ITconid "Char",[Char]),
+
+(LiteralsTest.hs:12:1,ITsemi,[]),
+
+(LiteralsTest.hs:12:1,ITvarid "c",[c]),
+
+(LiteralsTest.hs:12:3,ITequal,[=]),
+
+(LiteralsTest.hs:12:5-10,ITchar "'\\x20'" ' ',['\x20']),
+
+(LiteralsTest.hs:14:1,ITsemi,[]),
+
+(LiteralsTest.hs:14:1,ITvarid "d",[d]),
+
+(LiteralsTest.hs:14:3-4,ITdcolon,[::]),
+
+(LiteralsTest.hs:14:6-11,ITconid "Double",[Double]),
+
+(LiteralsTest.hs:15:1,ITsemi,[]),
+
+(LiteralsTest.hs:15:1,ITvarid "d",[d]),
+
+(LiteralsTest.hs:15:3,ITequal,[=]),
+
+(LiteralsTest.hs:15:5-8,ITrational (FL {fl_text = "0.00", fl_value = 0 % 1}),[0.00]),
+
+(LiteralsTest.hs:17:1,ITsemi,[]),
+
+(LiteralsTest.hs:17:1-4,ITvarid "blah",[blah]),
+
+(LiteralsTest.hs:17:6,ITequal,[=]),
+
+(LiteralsTest.hs:17:8,ITvarid "x",[x]),
+
+(LiteralsTest.hs:18:3-7,ITwhere,[where]),
+
+(LiteralsTest.hs:19:5,ITvocurly,[]),
+
+(LiteralsTest.hs:19:5-9,ITvarid "charH",[charH]),
+
+(LiteralsTest.hs:19:11,ITequal,[=]),
+
+(LiteralsTest.hs:19:13-19,ITprimchar "'\\x41'" 'A',['\x41'#]),
+
+(LiteralsTest.hs:20:5,ITsemi,[]),
+
+(LiteralsTest.hs:20:5-8,ITvarid "intH",[intH]),
+
+(LiteralsTest.hs:20:10,ITequal,[=]),
+
+(LiteralsTest.hs:20:12-16,ITprimint "0004#" 4,[0004#]),
+
+(LiteralsTest.hs:21:5,ITsemi,[]),
+
+(LiteralsTest.hs:21:5-9,ITvarid "wordH",[wordH]),
+
+(LiteralsTest.hs:21:11,ITequal,[=]),
+
+(LiteralsTest.hs:21:13-17,ITprimword "005##" 5,[005##]),
+
+(LiteralsTest.hs:22:5,ITsemi,[]),
+
+(LiteralsTest.hs:22:5-10,ITvarid "floatH",[floatH]),
+
+(LiteralsTest.hs:22:12,ITequal,[=]),
+
+(LiteralsTest.hs:22:14-18,ITprimfloat (FL {fl_text = "3.20", fl_value = 16 % 5}),[3.20#]),
+
+(LiteralsTest.hs:23:5,ITsemi,[]),
+
+(LiteralsTest.hs:23:5-11,ITvarid "doubleH",[doubleH]),
+
+(LiteralsTest.hs:23:13,ITequal,[=]),
+
+(LiteralsTest.hs:23:15-21,ITprimdouble (FL {fl_text = "04.16", fl_value = 104 % 25}),[04.16##]),
+
+(LiteralsTest.hs:24:5,ITsemi,[]),
+
+(LiteralsTest.hs:24:5,ITvarid "x",[x]),
+
+(LiteralsTest.hs:24:7,ITequal,[=]),
+
+(LiteralsTest.hs:24:9,ITinteger "1" 1,[1]),
+
+(LiteralsTest.hs:25:1,ITvccurly,[]),
+
+(LiteralsTest.hs:25:1,ITsemi,[])
diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.hs b/testsuite/tests/ghc-api/annotations-literals/parsed.hs
new file mode 100644
index 0000000000..063e6bca77
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/parsed.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE RankNTypes #-}
+-- This program must be called with GHC's libdir as the single command line
+-- argument.
+module Main where
+
+-- import Data.Generics
+import Data.Data
+import Data.List
+import System.IO
+import GHC
+import DynFlags
+import MonadUtils
+import Outputable
+import Bag (filterBag,isEmptyBag)
+import System.Directory (removeFile)
+import System.Environment( getArgs )
+import qualified Data.Map as Map
+import Data.Dynamic ( fromDynamic,Dynamic )
+
+main::IO()
+main = do
+        [libdir] <- getArgs
+        testOneFile libdir "LiteralsTest"
+
+testOneFile libdir fileName = do
+    p <- runGhc (Just libdir) $ do
+        dflags <- getSessionDynFlags
+        setSessionDynFlags dflags
+        let mn =mkModuleName fileName
+        addTarget Target { targetId = TargetModule mn
+                         , targetAllowObjCode = True
+                         , targetContents = Nothing }
+        load LoadAllTargets
+        modSum <- getModSummary mn
+        p <- GHC.parseModule modSum
+        return p
+
+    let res = gq (pm_parsed_source p)
+    putStrLn (intercalate "\n" res)
+
+    where
+     gq ast = everything (++) ([] `mkQ` doHsLit `extQ` doOverLit) ast
+
+     doHsLit :: HsLit -> [String]
+     doHsLit (HsChar       src c) = ["HsChar [" ++ src ++ "] " ++ show c]
+     doHsLit (HsCharPrim   src c) = ["HsCharPrim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsString     src c) = ["HsString [" ++ src ++ "] " ++ show c]
+     doHsLit (HsStringPrim src c) = ["HsStringPrim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsInt        src c) = ["HsInt [" ++ src ++ "] " ++ show c]
+     doHsLit (HsIntPrim    src c) = ["HsIntPrim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsWordPrim   src c) = ["HsWordPrim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsInt64Prim  src c) = ["HsInt64Prim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsWord64Prim src c) = ["HsWord64Prim [" ++ src ++ "] " ++ show c]
+     doHsLit (HsInteger  src c _) = ["HsInteger [" ++ src ++ "] " ++ show c]
+     doHsLit _ = []
+
+     doOverLit :: OverLitVal -> [String]
+     doOverLit (HsIntegral  src c) = ["HsIntegral [" ++ src ++ "] " ++ show c]
+     doOverLit (HsIsString  src c) = ["HsIsString [" ++ src ++ "] " ++ show c]
+     doOverLit _ = []
+
+pp a = showPpr unsafeGlobalDynFlags a
+
+-- ---------------------------------------------------------------------
+
+-- Copied from syb for the test
+
+
+-- | Generic queries of type \"r\",
+--   i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Make a generic query;
+--   start from a type-specific case;
+--   return a constant otherwise
+--
+mkQ :: ( Typeable a
+       , Typeable b
+       )
+    => r
+    -> (b -> r)
+    -> a
+    -> r
+(r `mkQ` br) a = case cast a of
+                        Just b  -> br b
+                        Nothing -> r
+
+-- | Extend a generic query by a type-specific case
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
+extQ f g a = maybe (f a) g (cast a)
+
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.stdout b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout
new file mode 100644
index 0000000000..fdf2bfc739
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout
@@ -0,0 +1,12 @@
+HsIntegral [0003] 3
+HsString [] "noSyntaxExpr"
+HsIntegral [0x04] 4
+HsString [] "noSyntaxExpr"
+HsString ["\x20"] " "
+HsChar ['\x20'] ' '
+HsString [] "noSyntaxExpr"
+HsCharPrim ['\x41'] 'A'
+HsIntPrim [0004#] 4
+HsWordPrim [005##] 5
+HsIntegral [1] 1
+HsString [] "noSyntaxExpr"