Commit 998444dc authored by simonmar's avatar simonmar
Browse files

[project @ 2001-04-26 12:16:57 by simonmar]

Allow out-of-range character literals to appear in interface-file
unfoldings.  They occasionally pop up in Core.
parent 55411b4b
......@@ -12,7 +12,7 @@ module Literal
, literalType, literalPrimRep
, hashLiteral
, inIntRange, inWordRange, tARGET_MAX_INT
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, word2IntLit, int2WordLit, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
......@@ -61,6 +61,9 @@ tARGET_MIN_INT = -2147483648
tARGET_MAX_INT = 2147483647
#endif
tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
tARGET_MAX_CHAR :: Int
tARGET_MAX_CHAR = 0x10ffff
\end{code}
......@@ -145,6 +148,9 @@ mkMachWord64 x = MachWord64 x -- Ditto?
inIntRange, inWordRange :: Integer -> Bool
inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
inCharRange :: Int -> Bool
inCharRange c = c >= 0 && c <= tARGET_MAX_CHAR
\end{code}
Coercions
......
......@@ -27,7 +27,7 @@ import RnMonad
import RnEnv
import RnHiFiles ( lookupFixityRn )
import CmdLineOpts ( DynFlag(..), opt_IgnoreAsserts )
import Literal ( inIntRange )
import Literal ( inIntRange, inCharRange )
import BasicTypes ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
import PrelNames ( hasKey, assertIdKey, minusName, negateName, fromIntegerName,
eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
......@@ -799,7 +799,10 @@ that the types and classes they involve
are made available.
\begin{code}
litFVs (HsChar c) = returnRn (unitFV charTyCon_name)
litFVs (HsChar c)
= checkRn (inCharRange c) (bogusCharError c) `thenRn_`
returnRn (unitFV charTyCon_name)
litFVs (HsCharPrim c) = returnRn (unitFV (getName charPrimTyCon))
litFVs (HsString s) = returnRn (mkFVs [listTyCon_name, charTyCon_name])
litFVs (HsStringPrim s) = returnRn (unitFV (getName addrPrimTyCon))
......@@ -916,4 +919,7 @@ patSynErr e
doStmtListErr e
= sep [ptext SLIT("`do' statements must end in expression:"),
nest 4 (ppr e)]
bogusCharError c
= ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
\end{code}
......@@ -49,12 +49,14 @@ module Outputable (
import {-# SOURCE #-} Name( Name )
import IO ( Handle, hPutChar, hPutStr, stderr, stdout )
import CmdLineOpts ( opt_PprStyle_Debug, opt_PprUserLength )
import FastString
import qualified Pretty
import Pretty ( Doc, Mode(..), TextDetails(..), fullRender )
import Panic
import Word ( Word32 )
import IO ( Handle, hPutChar, hPutStr, stderr, stdout )
import Char ( chr, ord, isDigit )
\end{code}
......@@ -360,7 +362,7 @@ showCharLit c rest
| c == ord '\r' = "\\r" ++ rest
| c == ord '\t' = "\\t" ++ rest
| c == ord '\v' = "\\v" ++ rest
| otherwise = ('\\':) $ shows c $ case rest of
| otherwise = ('\\':) $ shows (fromIntegral c :: Word32) $ case rest of
d:_ | isDigit d -> "\\&" ++ rest
_ -> rest
......@@ -369,7 +371,8 @@ showCharLit c rest
-- of Char and String.
pprHsChar :: Int -> SDoc
pprHsChar c = text (show (chr c))
pprHsChar c | not (inCharRange c) = char '\\' <> show (fromIntegral c :: Word32)
| otherwise = text (show (chr c))
pprHsString :: FastString -> SDoc
pprHsString fs = text (show (unpackFS fs))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment