diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 33 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 8 |
2 files changed, 21 insertions, 20 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 815c8cb798..b1863856a3 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -807,10 +807,10 @@ maybe_safe :: { ([AddAnn],Bool) } : 'safe' { ([mj AnnSafe $1],True) } | {- empty -} { ([],False) } -maybe_pkg :: { ([AddAnn],Maybe (SourceText,FastString)) } +maybe_pkg :: { ([AddAnn],Maybe StringLiteral) } : STRING {% let pkgFS = getSTRING $1 in if looksLikePackageName (unpackFS pkgFS) - then return ([mj AnnPackageName $1], Just (getSTRINGs $1,pkgFS)) + then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) else parseErrorSDoc (getLoc $1) $ vcat [ text "parse error" <> colon <+> quotes (ppr pkgFS), text "Version number or non-alphanumeric" <+> @@ -1465,15 +1465,15 @@ deprecation :: { OrdList (LWarnDecl RdrName) } {% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc "") $ snd $ unLoc $2))) (fst $ unLoc $2) } -strings :: { Located ([AddAnn],[Located (SourceText,FastString)]) } - : STRING { sL1 $1 ([],[L (gl $1) (getSTRINGs $1,getSTRING $1)]) } +strings :: { Located ([AddAnn],[Located StringLiteral]) } + : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) } | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) } -stringlist :: { Located (OrdList (Located (SourceText,FastString))) } +stringlist :: { Located (OrdList (Located StringLiteral)) } : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >> return (sLL $1 $> (unLoc $1 `snocOL` - (L (gl $3) (getSTRINGs $3,getSTRING $3)))) } - | STRING { sLL $1 $> (unitOL (L (gl $1) (getSTRINGs $1,getSTRING $1))) } + (L (gl $3) (getStringLiteral $3)))) } + | STRING { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) } ----------------------------------------------------------------------------- -- Annotations @@ -1521,12 +1521,12 @@ safety :: { Located Safety } | 'interruptible' { sLL $1 $> PlayInterruptible } fspec :: { Located ([AddAnn] - ,(Located (SourceText,FastString), Located RdrName, LHsType RdrName)) } + ,(Located StringLiteral, Located RdrName, LHsType RdrName)) } : STRING var '::' sigtypedoc { sLL $1 $> ([mj AnnDcolon $3] ,(L (getLoc $1) - (getSTRINGs $1,getSTRING $1), $2, $4)) } + (getStringLiteral $1), $2, $4)) } | var '::' sigtypedoc { sLL $1 $> ([mj AnnDcolon $2] - ,(noLoc ("",nilFS), $1, $3)) } + ,(noLoc (StringLiteral "" nilFS), $1, $3)) } -- if the entity string is missing, it defaults to the empty string; -- the meaning of an empty entity string depends on the calling -- convention @@ -2228,7 +2228,7 @@ exp10 :: { LHsExpr RdrName } -- TODO: is LL right here? [mj AnnProc $1,mj AnnRarrow $3] } - | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getSTRINGs $2,getSTRING $2) $4) + | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4) [mo $1,mj AnnVal $2 ,mc $3] } -- hdaume: core annotation @@ -2269,16 +2269,16 @@ optSemi :: { ([Located a],Bool) } : ';' { ([$1],True) } | {- empty -} { ([],False) } -scc_annot :: { Located (([AddAnn],SourceText),(SourceText,FastString)) } +scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) } : '{-# SCC' STRING '#-}' {% do scc <- getSCC $2 ; return $ sLL $1 $> (([mo $1,mj AnnValStr $2 - ,mc $3],getSCC_PRAGs $1),(getSTRINGs $2,scc)) } + ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) } | '{-# SCC' VARID '#-}' { sLL $1 $> (([mo $1,mj AnnVal $2 ,mc $3],getSCC_PRAGs $1) - ,(unpackFS $ getVARID $2,getVARID $2)) } + ,(StringLiteral (unpackFS $ getVARID $2) (getVARID $2))) } -hpc_annot :: { Located (([AddAnn],SourceText),((SourceText,FastString),(Int,Int),(Int,Int))) } +hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))) } : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}' { sLL $1 $> $ (([mo $1,mj AnnVal $2 ,mj AnnVal $3,mj AnnColon $4 @@ -2286,7 +2286,7 @@ hpc_annot :: { Located (([AddAnn],SourceText),((SourceText,FastString),(Int,Int) ,mj AnnVal $7,mj AnnColon $8 ,mj AnnVal $9,mc $10], getGENERATED_PRAGs $1) - ,((getSTRINGs $2,getSTRING $2) + ,((getStringLiteral $2) ,( fromInteger $ getINTEGER $3 , fromInteger $ getINTEGER $5 ) @@ -3214,6 +3214,7 @@ getOVERLAPS_PRAGs (L _ (IToverlaps_prag src)) = src getINCOHERENT_PRAGs (L _ (ITincoherent_prag src)) = src getCTYPEs (L _ (ITctype src)) = src +getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) getSCC :: Located Token -> P FastString getSCC lt = do let s = getSTRING lt diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 357512be33..ab3f17d182 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -1226,9 +1226,9 @@ mkInlinePragma src (inl, match_info) mb_act -- mkImport :: Located CCallConv -> Located Safety - -> (Located (SourceText,FastString), Located RdrName, LHsType RdrName) + -> (Located StringLiteral, Located RdrName, LHsType RdrName) -> P (HsDecl RdrName) -mkImport (L lc cconv) (L ls safety) (L loc (esrc,entity), v, ty) +mkImport (L lc cconv) (L ls safety) (L loc (StringLiteral esrc entity), v, ty) | cconv == PrimCallConv = do let funcTarget = CFunction (StaticTarget esrc entity Nothing True) importSpec = CImport (L lc PrimCallConv) (L ls safety) Nothing funcTarget @@ -1305,9 +1305,9 @@ parseCImport cconv safety nm str sourceText = -- construct a foreign export declaration -- mkExport :: Located CCallConv - -> (Located (SourceText,FastString), Located RdrName, LHsType RdrName) + -> (Located StringLiteral, Located RdrName, LHsType RdrName) -> P (HsDecl RdrName) -mkExport (L lc cconv) (L le (esrc,entity), v, ty) = do +mkExport (L lc cconv) (L le (StringLiteral esrc entity), v, ty) = do return $ ForD (ForeignExport v ty noForeignExportCoercionYet (CExport (L lc (CExportStatic esrc entity' cconv)) (L le (unpackFS entity)))) |