Commit 499e4382 authored by Alan Zimmerman's avatar Alan Zimmerman

Add HsSyn prettyprinter tests

Summary:
Add prettyprinter tests, which take a file, parse it, pretty print it,
re-parse the pretty printed version and then compare the original and
new ASTs (ignoring locations)

Updates haddock submodule to match the AST changes.

There are three issues outstanding

1. Extra parens around a context are not reproduced. This will require an
   AST change and will be done in a separate patch.

2. Currently if an `HsTickPragma` is found, this is not pretty-printed,
   to prevent noise in the output.

   I am not sure what the desired behaviour in this case is, so have left
   it as before. Test Ppr047 is marked as expected fail for this.

3. Apart from in a context, the ParsedSource AST keeps all the parens from
   the original source.  Something is happening in the renamer to remove the
   parens around visible type application, causing T12530 to fail, as the
   dumped splice decl is after the renamer.

   This needs to be fixed by keeping the parens, but I do not know where they
   are being removed.  I have amended the test to pass, by removing the parens
   in the expected output.

Test Plan: ./validate

Reviewers: goldfire, mpickering, simonpj, bgamari, austin

Reviewed By: simonpj, bgamari

Subscribers: simonpj, goldfire, thomie, mpickering

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

GHC Trac Issues: #3384
parent 83d69dca
......@@ -30,7 +30,7 @@ module BasicTypes(
FunctionOrData(..),
WarningTxt(..), StringLiteral(..),
WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),
Fixity(..), FixityDirection(..),
defaultFixity, maxPrecedence, minPrecedence,
......@@ -90,14 +90,17 @@ module BasicTypes(
inlinePragmaSpec, inlinePragmaSat,
inlinePragmaActivation, inlinePragmaRuleMatchInfo,
setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
pprInline, pprInlineDebug,
SuccessFlag(..), succeeded, failed, successIf,
FractionalLit(..), negateFractionalLit, integralFractionalLit,
SourceText,
SourceText(..), pprWithSourceText,
IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit
IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,
SpliceExplicitFlag(..)
) where
import FastString
......@@ -312,6 +315,9 @@ data StringLiteral = StringLiteral
instance Eq StringLiteral where
(StringLiteral _ a) == (StringLiteral _ b) = a == b
instance Outputable StringLiteral where
ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
-- | Warning Text
--
-- reason/explanation from a WARNING or DEPRECATED pragma
......@@ -322,11 +328,30 @@ data WarningTxt = WarningTxt (Located SourceText)
deriving (Eq, Data)
instance Outputable WarningTxt where
ppr (WarningTxt _ ws)
= doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
ppr (DeprecatedTxt _ ds)
= text "Deprecated:" <+>
doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
ppr (WarningTxt lsrc ws)
= case unLoc lsrc of
NoSourceText -> pp_ws ws
SourceText src -> text src <+> pp_ws ws <+> text "#-}"
ppr (DeprecatedTxt lsrc ds)
= case unLoc lsrc of
NoSourceText -> pp_ws ds
SourceText src -> text src <+> pp_ws ds <+> text "#-}"
pp_ws :: [Located StringLiteral] -> SDoc
pp_ws [l] = ppr $ unLoc l
pp_ws ws
= text "["
<+> vcat (punctuate comma (map (ppr . unLoc) ws))
<+> text "]"
pprWarningTxtForMsg :: WarningTxt -> SDoc
pprWarningTxtForMsg (WarningTxt _ ws)
= doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
pprWarningTxtForMsg (DeprecatedTxt _ ds)
= text "Deprecated:" <+>
doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
{-
************************************************************************
......@@ -375,12 +400,12 @@ maxPrecedence = 9
minPrecedence = 0
defaultFixity :: Fixity
defaultFixity = Fixity (show maxPrecedence) maxPrecedence InfixL
defaultFixity = Fixity NoSourceText maxPrecedence InfixL
negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
negateFixity = Fixity "6" 6 InfixL -- Fixity of unary negate
funTyFixity = Fixity "0" 0 InfixR -- Fixity of '->'
negateFixity = Fixity NoSourceText 6 InfixL -- Fixity of unary negate
funTyFixity = Fixity NoSourceText 0 InfixR -- Fixity of '->'
{-
Consider
......@@ -979,8 +1004,21 @@ For OverLitVal
HsIsString "\x41nd" == "And"
-}
type SourceText = String -- Note [Literal source text],[Pragma source text]
-- Note [Literal source text],[Pragma source text]
data SourceText = SourceText String
| NoSourceText -- ^ For when code is generated, e.g. TH,
-- deriving. The pretty printer will then make
-- its own representation of the item.
deriving (Data, Show, Eq )
instance Outputable SourceText where
ppr (SourceText s) = text "SourceText" <+> text s
ppr NoSourceText = text "NoSourceText"
-- | Special combinator for showing string literals.
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText NoSourceText d = d
pprWithSourceText (SourceText src) _ = text src
{-
************************************************************************
......@@ -1117,7 +1155,7 @@ isEmptyInlineSpec _ = False
defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
:: InlinePragma
defaultInlinePragma = InlinePragma { inl_src = "{-# INLINE"
defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"
, inl_act = AlwaysActive
, inl_rule = FunLike
, inl_inline = EmptyInlineSpec
......@@ -1175,8 +1213,8 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where
ppr AlwaysActive = brackets (text "ALWAYS")
ppr NeverActive = brackets (text "NEVER")
ppr AlwaysActive = empty
ppr NeverActive = brackets (text "~")
ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
ppr (ActiveAfter _ n) = brackets (int n)
......@@ -1191,10 +1229,21 @@ instance Outputable InlineSpec where
ppr EmptyInlineSpec = empty
instance Outputable InlinePragma where
ppr (InlinePragma { inl_inline = inline, inl_act = activation
, inl_rule = info, inl_sat = mb_arity })
= ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
ppr = pprInline
pprInline :: InlinePragma -> SDoc
pprInline = pprInline' True
pprInlineDebug :: InlinePragma -> SDoc
pprInlineDebug = pprInline' False
pprInline' :: Bool -> InlinePragma -> SDoc
pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation
, inl_rule = info, inl_sat = mb_arity })
= pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info
where
pp_inl x = if emptyInline then empty else ppr x
pp_act Inline AlwaysActive = empty
pp_act NoInline NeverActive = empty
pp_act _ act = ppr act
......@@ -1356,3 +1405,8 @@ treatZeroAsInf n = Int n
-- | Inject any integer into an 'IntWithInf'
mkIntWithInf :: Int -> IntWithInf
mkIntWithInf = Int
data SpliceExplicitFlag
= ExplicitSplice | -- ^ <=> $(f x y)
ImplicitSplice -- ^ <=> f x y, i.e. a naked top level expression
deriving Data
......@@ -495,7 +495,7 @@ data DataConRep
-- emit a warning (in checkValidDataCon) and treat it like
-- @(HsSrcBang _ NoSrcUnpack SrcLazy)@
data HsSrcBang =
HsSrcBang (Maybe SourceText) -- Note [Pragma source text] in BasicTypes
HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes
SrcUnpackedness
SrcStrictness
deriving Data.Data
......
......@@ -1122,7 +1122,8 @@ seqId = pcMiscPrelId seqName ty info
`setRuleInfo` mkRuleInfo [seq_cast_rule]
inline_prag
= alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter "0" 0
= alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
NoSourceText 0
-- Make 'seq' not inline-always, so that simpleOptExpr
-- (see CoreSubst.simple_app) won't inline 'seq' on the
-- LHS of rules. That way we can have rules for 'seq';
......
......@@ -316,6 +316,9 @@ instance Data Var where
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Var"
instance HasOccName Var where
occName = nameOccName . varName
varUnique :: Var -> Unique
varUnique var = mkUniqueGrimily (realUnique var)
......
......@@ -402,7 +402,7 @@ pprIdBndrInfo info
has_lbv = not (hasNoOneShotInfo lbv_info)
doc = showAttributes
[ (has_prag, text "InlPrag=" <> ppr prag_info)
[ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info)
, (has_occ, text "Occ=" <> ppr occ_info)
, (has_dmd, text "Dmd=" <> ppr dmd_info)
, (has_lbv , text "OS=" <> ppr lbv_info)
......
......@@ -888,9 +888,10 @@ addTickHsCmd (HsCmdArrApp e1 e2 ty1 arr_ty lr) =
(return ty1)
(return arr_ty)
(return lr)
addTickHsCmd (HsCmdArrForm e fix cmdtop) =
liftM3 HsCmdArrForm
addTickHsCmd (HsCmdArrForm e f fix cmdtop) =
liftM4 HsCmdArrForm
(addTickLHsExpr e)
(return f)
(return fix)
(mapM (liftL (addTickHsCmdTop)) cmdtop)
......
......@@ -607,7 +607,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdDo (L _ stmts) _) env_ids = do
-- -----------------------------------
-- D; xs |-a (|e c1 ... cn|) :: stk --> t ---> e [t_xs] c1 ... cn
dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ args) env_ids = do
dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ _ args) env_ids = do
let env_ty = mkBigCoreVarTupTy env_ids
core_op <- dsLExpr op
(core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args
......
......@@ -37,7 +37,6 @@ import TysPrim
import TyCon
import TysWiredIn
import BasicTypes
import FastString ( unpackFS )
import Literal
import PrelNames
import DynFlags
......@@ -95,7 +94,7 @@ dsCCall lbl args may_gc result_ty
uniq <- newUnique
dflags <- getDynFlags
let
target = StaticTarget (unpackFS lbl) lbl Nothing True
target = StaticTarget NoSourceText lbl Nothing True
the_fcall = CCall (CCallSpec target CCallConv may_gc)
the_prim_app = mkFCall dflags uniq the_fcall unboxed_args ccall_result_ty
return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)
......
......@@ -218,7 +218,7 @@ dsFCall fn_id co fcall mDeclHeader = do
CApiConv safety) ->
do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName)
let fcall' = CCall (CCallSpec
(StaticTarget (unpackFS wrapperName)
(StaticTarget NoSourceText
wrapperName mUnitId
True)
CApiConv safety)
......
......@@ -944,7 +944,7 @@ repTy :: HsType Name -> DsM (Core TH.TypeQ)
repTy ty@(HsForAllTy {}) = repForall ty
repTy ty@(HsQualTy {}) = repForall ty
repTy (HsTyVar (L _ n))
repTy (HsTyVar _ (L _ n))
| isTvOcc occ = do tv1 <- lookupOcc n
repTvar tv1
| isDataOcc occ = do tc1 <- lookupOcc n
......@@ -970,7 +970,8 @@ repTy (HsListTy t) = do
repTapp tcon t1
repTy (HsPArrTy t) = do
t1 <- repLTy t
tcon <- repTy (HsTyVar (noLoc (tyConName parrTyCon)))
tcon <- repTy (HsTyVar NotPromoted
(noLoc (tyConName parrTyCon)))
repTapp tcon t1
repTy (HsTupleTy HsUnboxedTuple tys) = do
tys1 <- repLTys tys
......@@ -995,7 +996,7 @@ repTy (HsKindSig t k) = do
k1 <- repLKind k
repTSig t1 k1
repTy (HsSpliceTy splice _) = repSplice splice
repTy (HsExplicitListTy _ tys) = do
repTy (HsExplicitListTy _ _ tys) = do
tys1 <- repLTys tys
repTPromotedList tys1
repTy (HsExplicitTupleTy _ tys) = do
......@@ -1041,7 +1042,7 @@ repNonArrowLKind :: LHsKind Name -> DsM (Core TH.Kind)
repNonArrowLKind (L _ ki) = repNonArrowKind ki
repNonArrowKind :: HsKind Name -> DsM (Core TH.Kind)
repNonArrowKind (HsTyVar (L _ name))
repNonArrowKind (HsTyVar _ (L _ name))
| isLiftedTypeKindTyConName name = repKStar
| name `hasKey` constraintKindTyConKey = repKConstraint
| isTvOcc (nameOccName name) = lookupOcc name >>= repKVar
......@@ -1073,10 +1074,10 @@ repRole (L _ Nothing) = rep2 inferRName []
repSplice :: HsSplice Name -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know
repSplice (HsTypedSplice n _) = rep_splice n
repSplice (HsUntypedSplice n _) = rep_splice n
repSplice (HsQuasiQuote n _ _ _) = rep_splice n
repSplice e@(HsSpliced _ _) = pprPanic "repSplice" (ppr e)
repSplice (HsTypedSplice _ n _) = rep_splice n
repSplice (HsUntypedSplice _ n _) = rep_splice n
repSplice (HsQuasiQuote n _ _ _) = rep_splice n
repSplice e@(HsSpliced _ _) = pprPanic "repSplice" (ppr e)
rep_splice :: Name -> DsM (Core a)
rep_splice splice_name
......@@ -2345,15 +2346,15 @@ repLiteral lit
mk_integer :: Integer -> DsM HsLit
mk_integer i = do integer_ty <- lookupType integerTyConName
return $ HsInteger "" i integer_ty
return $ HsInteger NoSourceText 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 NoSourceText s
mk_char :: Char -> DsM HsLit
mk_char c = return $ HsChar "" c
mk_char c = return $ HsChar NoSourceText c
repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
repOverloadedLiteral (OverLit { ol_val = val})
......
......@@ -291,11 +291,11 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
-- which might be ok if we have 'instance IsString Int'
--
| not type_change, isIntTy ty, Just int_lit <- mb_int_lit
= mk_con_pat intDataCon (HsIntPrim "" int_lit)
= mk_con_pat intDataCon (HsIntPrim NoSourceText int_lit)
| not type_change, isWordTy ty, Just int_lit <- mb_int_lit
= mk_con_pat wordDataCon (HsWordPrim "" int_lit)
= mk_con_pat wordDataCon (HsWordPrim NoSourceText int_lit)
| not type_change, isStringTy ty, Just str_lit <- mb_str_lit
= tidy_lit_pat (HsString "" str_lit)
= tidy_lit_pat (HsString NoSourceText str_lit)
-- NB: do /not/ convert Float or Double literals to F# 3.8 or D# 5.3
-- If we do convert to the constructor form, we'll generate a case
-- expression on a Float# or Double# and that's not allowed in Core; see
......
......@@ -39,8 +39,6 @@ import MonadUtils ( foldrM )
import qualified Data.ByteString as BS
import Control.Monad( unless, liftM, ap )
import Data.Char ( chr )
import Data.Word ( Word8 )
import Data.Maybe( catMaybes, fromMaybe, isNothing )
import Language.Haskell.TH as TH hiding (sigP)
import Language.Haskell.TH.Syntax as TH
......@@ -268,10 +266,10 @@ cvtDec (InstanceD o ctxt ty decs)
where
overlap pragma =
case pragma of
TH.Overlaps -> Hs.Overlaps "OVERLAPS"
TH.Overlappable -> Hs.Overlappable "OVERLAPPABLE"
TH.Overlapping -> Hs.Overlapping "OVERLAPPING"
TH.Incoherent -> Hs.Incoherent "INCOHERENT"
TH.Overlaps -> Hs.Overlaps (SourceText "OVERLAPS")
TH.Overlappable -> Hs.Overlappable (SourceText "OVERLAPPABLE")
TH.Overlapping -> Hs.Overlapping (SourceText "OVERLAPPING")
TH.Incoherent -> Hs.Incoherent (SourceText "INCOHERENT")
......@@ -550,7 +548,7 @@ cvt_arg (Bang su ss, ty)
= do { ty' <- cvtType ty
; let su' = cvtSrcUnpackedness su
; let ss' = cvtSrcStrictness ss
; returnL $ HsBangTy (HsSrcBang Nothing su' ss') ty' }
; returnL $ HsBangTy (HsSrcBang NoSourceText su' ss') ty' }
cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField RdrName)
cvt_id_arg (i, str, ty)
......@@ -582,12 +580,13 @@ cvtForD (ImportF callconv safety from nm ty)
-- and are inserted verbatim, analogous to mkImport in RdrHsSyn
| callconv == TH.Prim || callconv == TH.JavaScript
= mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing
(CFunction (StaticTarget from (mkFastString from) Nothing
(CFunction (StaticTarget (SourceText from)
(mkFastString from) Nothing
True))
(noLoc from))
(noLoc $ quotedSourceText from))
| Just impspec <- parseCImport (noLoc (cvt_conv callconv)) (noLoc safety')
(mkFastString (TH.nameBase nm))
from (noLoc from)
from (noLoc $ quotedSourceText from)
= mk_imp impspec
| otherwise
= failWith $ text (show from) <+> text "is not a valid ccall impent"
......@@ -608,10 +607,10 @@ cvtForD (ImportF callconv safety from nm ty)
cvtForD (ExportF callconv as nm ty)
= do { nm' <- vNameL nm
; ty' <- cvtType ty
; let e = CExport (noLoc (CExportStatic as
; let e = CExport (noLoc (CExportStatic (SourceText as)
(mkFastString as)
(cvt_conv callconv)))
(noLoc as)
(noLoc (SourceText as))
; return $ ForeignExport { fd_name = nm'
, fd_sig_ty = mkLHsSigType ty'
, fd_co = noForeignExportCoercionYet
......@@ -632,7 +631,10 @@ cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl RdrName))
cvtPragmaD (InlineP nm inline rm phases)
= do { nm' <- vNameL nm
; let dflt = dfltActivation inline
; let ip = InlinePragma { inl_src = "{-# INLINE"
; let src TH.NoInline = "{-# NOINLINE"
src TH.Inline = "{-# INLINE"
src TH.Inlinable = "{-# INLINABLE"
; let ip = InlinePragma { inl_src = SourceText $ src inline
, inl_inline = cvtInline inline
, inl_rule = cvtRuleMatch rm
, inl_act = cvtPhases phases dflt
......@@ -642,10 +644,15 @@ cvtPragmaD (InlineP nm inline rm phases)
cvtPragmaD (SpecialiseP nm ty inline phases)
= do { nm' <- vNameL nm
; ty' <- cvtType ty
; let (inline', dflt) = case inline of
Just inline1 -> (cvtInline inline1, dfltActivation inline1)
Nothing -> (EmptyInlineSpec, AlwaysActive)
; let ip = InlinePragma { inl_src = "{-# INLINE"
; let src TH.NoInline = "{-# SPECIALISE NOINLINE"
src TH.Inline = "{-# SPECIALISE INLINE"
src TH.Inlinable = "{-# SPECIALISE INLINE"
; let (inline', dflt,srcText) = case inline of
Just inline1 -> (cvtInline inline1, dfltActivation inline1,
src inline1)
Nothing -> (EmptyInlineSpec, AlwaysActive,
"{-# SPECIALISE")
; let ip = InlinePragma { inl_src = SourceText srcText
, inl_inline = inline'
, inl_rule = Hs.FunLike
, inl_act = cvtPhases phases dflt
......@@ -655,7 +662,7 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
cvtPragmaD (SpecialiseInstP ty)
= do { ty' <- cvtType ty
; returnJustL $ Hs.SigD $
SpecInstSig "{-# SPECIALISE" (mkLHsSigType ty') }
SpecInstSig (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
cvtPragmaD (RuleP nm bndrs lhs rhs phases)
= do { let nm' = mkFastString nm
......@@ -664,7 +671,8 @@ cvtPragmaD (RuleP nm bndrs lhs rhs phases)
; lhs' <- cvtl lhs
; rhs' <- cvtl rhs
; returnJustL $ Hs.RuleD
$ HsRules "{-# RULES" [noLoc $ HsRule (noLoc (nm,nm')) act bndrs'
$ HsRules (SourceText "{-# RULES")
[noLoc $ HsRule (noLoc (SourceText nm,nm')) act bndrs'
lhs' placeHolderNames
rhs' placeHolderNames]
}
......@@ -679,7 +687,8 @@ cvtPragmaD (AnnP target exp)
ValueAnnotation n -> do
n' <- vcName n
return (ValueAnnProvenance (noLoc n'))
; returnJustL $ Hs.AnnD $ HsAnnotation "{-# ANN" target' exp'
; returnJustL $ Hs.AnnD $ HsAnnotation (SourceText "{-# ANN") target'
exp'
}
cvtPragmaD (LineP line file)
......@@ -702,8 +711,8 @@ cvtRuleMatch TH.FunLike = Hs.FunLike
cvtPhases :: TH.Phases -> Activation -> Activation
cvtPhases AllPhases dflt = dflt
cvtPhases (FromPhase i) _ = ActiveAfter (show i) i
cvtPhases (BeforePhase i) _ = ActiveBefore (show i) i
cvtPhases (FromPhase i) _ = ActiveAfter NoSourceText i
cvtPhases (BeforePhase i) _ = ActiveBefore NoSourceText i
cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr RdrName)
cvtRuleBndr (RuleVar n)
......@@ -980,13 +989,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 (show i) i placeHolderType}
= do { force i; return $ mkHsIntegral NoSourceText 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 s' placeHolderType
; return $ mkHsIsString (quotedSourceText s) s' placeHolderType
}
cvtOverLit _ = panic "Convert.cvtOverLit: Unexpected overloaded literal"
-- An Integer is like an (overloaded) '3' in a Haskell source program
......@@ -1014,25 +1023,25 @@ allCharLs xs
go _ _ = Nothing
cvtLit :: Lit -> CvtM HsLit
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim (show i) i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim (show w) w }
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText 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 (show c) c }
cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim (show c) c }
cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c }
cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c }
cvtLit (StringL s) = do { let { s' = mkFastString s }
; force s'
; return $ HsString s s' }
; return $ HsString (quotedSourceText s) s' }
cvtLit (StringPrimL s) = do { let { s' = BS.pack s }
; force s'
; return $ HsStringPrim (w8ToString s) s' }
; return $ HsStringPrim NoSourceText s' }
cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
-- cvtLit should not be called on IntegerL, RationalL
-- That precondition is established right here in
-- Convert.hs, hence panic