Commit 55042138 authored by simonmar's avatar simonmar

[project @ 2003-12-10 14:15:16 by simonmar]

Add accurate source location annotations to HsSyn
-------------------------------------------------

Every syntactic entity in HsSyn is now annotated with a SrcSpan, which
details the exact beginning and end points of that entity in the
original source file.  All honest compilers should do this, and it was
about time GHC did the right thing.

The most obvious benefit is that we now have much more accurate error
messages; when running GHC inside emacs for example, the cursor will
jump to the exact location of an error, not just a line somewhere
nearby.  We haven't put a huge amount of effort into making sure all
the error messages are accurate yet, so there could be some tweaking
still needed, although the majority of messages I've seen have been
spot-on.

Error messages now contain a column number in addition to the line
number, eg.

   read001.hs:25:10: Variable not in scope: `+#'

To get the full text span info, use the new option -ferror-spans.  eg.

   read001.hs:25:10-11: Variable not in scope: `+#'

I'm not sure whether we should do this by default.  Emacs won't
understand the new error format, for one thing.

In a more elaborate editor setting (eg. Visual Studio), we can arrange
to actually highlight the subexpression containing an error.  Eventually
this information will be used so we can find elements in the abstract
syntax corresponding to text locations, for performing high-level editor
functions (eg. "tell me the type of this expression I just highlighted").

Performance of the compiler doesn't seem to be adversely affected.
Parsing is still quicker than in 6.0.1, for example.

Implementation:

This was an excrutiatingly painful change to make: both Simon P.J. and
myself have been working on it for the last three weeks or so.  The
basic changes are:

 - a new datatype SrcSpan, which represents a beginning and end position
   in a source file.

 - To reduce the pain as much as possible, we also defined:

      data Located e = L SrcSpan e

 - Every datatype in HsSyn has an equivalent Located version.  eg.

      type LHsExpr id = Located (HsExpr id)

   and pretty much everywhere we used to use HsExpr we now use
   LHsExpr.  Believe me, we thought about this long and hard, and
   all the other options were worse :-)


Additional changes/cleanups we made at the same time:

  - The abstract syntax for bindings is now less arcane.  MonoBinds
    and HsBinds with their built-in list constructors have gone away,
    replaced by HsBindGroup and HsBind (see HsSyn/HsBinds.lhs).

  - The various HsSyn type synonyms have now gone away (eg. RdrNameHsExpr,
    RenamedHsExpr, and TypecheckedHsExpr are now HsExpr RdrName,
    HsExpr Name, and HsExpr Id respectively).

  - Utilities over HsSyn are now collected in a new module HsUtils.
    More stuff still needs to be moved in here.

  - MachChar now has a real Char instead of an Int.  All GHC versions that
    can compile GHC now support 32-bit Chars, so this was a simplification.
parent 60ea58ab
...@@ -52,6 +52,12 @@ name = Util.global (value) :: IORef (ty); \ ...@@ -52,6 +52,12 @@ name = Util.global (value) :: IORef (ty); \
{-# NOINLINE name #-} {-# NOINLINE name #-}
#endif #endif
#if __GLASGOW_HASKELL__ >= 620
#define UNBOX_FIELD !!
#else
#define UNBOX_FIELD !
#endif
#define COMMA , #define COMMA ,
#ifdef DEBUG #ifdef DEBUG
......
...@@ -354,13 +354,13 @@ prelude/PrelRules_HC_OPTS = -fvia-C ...@@ -354,13 +354,13 @@ prelude/PrelRules_HC_OPTS = -fvia-C
main/ParsePkgConf_HC_OPTS += -fno-warn-incomplete-patterns main/ParsePkgConf_HC_OPTS += -fno-warn-incomplete-patterns
# Use -fvia-C since the NCG can't handle the narrow16Int# (and intToInt16#?) # Use -fvia-C since the NCG can't handle the narrow16Int# (and intToInt16#?)
# primops on all platforms. # primops on all platforms.
parser/Parser_HC_OPTS += -Onot -fno-warn-incomplete-patterns -fvia-C parser/Parser_HC_OPTS += -fno-warn-incomplete-patterns -fvia-C
# The latest GHC version doesn't have a -K option yet, and it doesn't # Careful optimisation of the parser: we don't want to throw everything
# seem to be necessary anymore for the modules below. # at it, because that takes too long and doesn't buy much, but we do want
ifeq "$(compiling_with_4xx)" "YES" # to inline certain key external functions, so we instruct GHC not to
parser/Parser_HC_OPTS += -K2m # throw away inlinings as it would normally do in -Onot mode:
endif parser/Parser_HC_OPTS += -Onot -fno-ignore-interface-pragmas
ifeq "$(HOSTPLATFORM)" "hppa1.1-hp-hpux9" ifeq "$(HOSTPLATFORM)" "hppa1.1-hp-hpux9"
rename/RnMonad_HC_OPTS = -O2 -O2-for-C rename/RnMonad_HC_OPTS = -O2 -O2-for-C
...@@ -368,6 +368,8 @@ endif ...@@ -368,6 +368,8 @@ endif
utils/Digraph_HC_OPTS = -fglasgow-exts utils/Digraph_HC_OPTS = -fglasgow-exts
basicTypes/SrcLoc_HC_OPTS = -funbox-strict-fields
ifeq "$(bootstrapped)" "YES" ifeq "$(bootstrapped)" "YES"
utils/Binary_HC_OPTS = -funbox-strict-fields utils/Binary_HC_OPTS = -funbox-strict-fields
endif endif
...@@ -569,6 +571,9 @@ MAINTAINER_CLEAN_FILES += parser/Parser.info main/ParsePkgConf.info ...@@ -569,6 +571,9 @@ MAINTAINER_CLEAN_FILES += parser/Parser.info main/ParsePkgConf.info
MKDEPENDHS_SRCS = MKDEPENDHS_SRCS =
MKDEPENDC_SRCS = MKDEPENDC_SRCS =
# Make doesn't work this out for itself, it seems
parser/Parser.y : parser/Parser.y.pp
include $(TOP)/mk/target.mk include $(TOP)/mk/target.mk
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
......
...@@ -96,7 +96,7 @@ function applications, etc., etc., has not yet been done. ...@@ -96,7 +96,7 @@ function applications, etc., etc., has not yet been done.
data Literal data Literal
= ------------------ = ------------------
-- First the primitive guys -- First the primitive guys
MachChar Int -- Char# At least 31 bits MachChar Char -- Char# At least 31 bits
| MachStr FastString | MachStr FastString
| MachNullAddr -- the NULL pointer, the only pointer value | MachNullAddr -- the NULL pointer, the only pointer value
...@@ -211,8 +211,8 @@ inIntRange, inWordRange :: Integer -> Bool ...@@ -211,8 +211,8 @@ inIntRange, inWordRange :: Integer -> Bool
inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
inWordRange x = x >= 0 && x <= tARGET_MAX_WORD inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
inCharRange :: Int -> Bool inCharRange :: Char -> Bool
inCharRange c = c >= 0 && c <= tARGET_MAX_CHAR inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
isZeroLit :: Literal -> Bool isZeroLit :: Literal -> Bool
isZeroLit (MachInt 0) = True isZeroLit (MachInt 0) = True
...@@ -250,8 +250,8 @@ narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8)) ...@@ -250,8 +250,8 @@ narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16)) narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32)) narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
char2IntLit (MachChar c) = MachInt (toInteger c) char2IntLit (MachChar c) = MachInt (toInteger (ord c))
int2CharLit (MachInt i) = MachChar (fromInteger i) int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
float2IntLit (MachFloat f) = MachInt (truncate f) float2IntLit (MachFloat f) = MachInt (truncate f)
int2FloatLit (MachInt i) = MachFloat (fromInteger i) int2FloatLit (MachInt i) = MachFloat (fromInteger i)
...@@ -366,7 +366,7 @@ pprLit lit ...@@ -366,7 +366,7 @@ pprLit lit
code_style = codeStyle sty code_style = codeStyle sty
in in
case lit of case lit of
MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)] MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show (ord ch))]
| otherwise -> pprHsChar ch | otherwise -> pprHsChar ch
MachStr s | code_style -> pprFSInCStyle s MachStr s | code_style -> pprFSInCStyle s
...@@ -439,7 +439,7 @@ Hash values should be zero or a positive integer. No negatives please. ...@@ -439,7 +439,7 @@ Hash values should be zero or a positive integer. No negatives please.
\begin{code} \begin{code}
hashLiteral :: Literal -> Int hashLiteral :: Literal -> Int
hashLiteral (MachChar c) = c + 1000 -- Keep it out of range of common ints hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
hashLiteral (MachStr s) = hashFS s hashLiteral (MachStr s) = hashFS s
hashLiteral (MachNullAddr) = 0 hashLiteral (MachNullAddr) = 0
hashLiteral (MachInt i) = hashInteger i hashLiteral (MachInt i) = hashInteger i
......
...@@ -51,7 +51,7 @@ import Module ( ModuleName, mkSysModuleNameFS, mkModuleNameFS ) ...@@ -51,7 +51,7 @@ import Module ( ModuleName, mkSysModuleNameFS, mkModuleNameFS )
import Name ( Name, NamedThing(getName), nameModuleName, nameParent_maybe, import Name ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
nameOccName, isExternalName, nameSrcLoc ) nameOccName, isExternalName, nameSrcLoc )
import Maybes ( seqMaybe ) import Maybes ( seqMaybe )
import SrcLoc ( SrcLoc, isGoodSrcLoc ) import SrcLoc ( SrcLoc, isGoodSrcLoc, SrcSpan )
import BasicTypes( DeprecTxt ) import BasicTypes( DeprecTxt )
import Outputable import Outputable
import Util ( thenCmp ) import Util ( thenCmp )
...@@ -433,7 +433,7 @@ data ImportSpec -- Describes a particular import declaration ...@@ -433,7 +433,7 @@ data ImportSpec -- Describes a particular import declaration
-- the defining module for this thing! -- the defining module for this thing!
is_as :: ModuleName, -- 'as M' (or 'Muggle' if there is no 'as' clause) is_as :: ModuleName, -- 'as M' (or 'Muggle' if there is no 'as' clause)
is_qual :: Bool, -- True <=> qualified (only) is_qual :: Bool, -- True <=> qualified (only)
is_loc :: SrcLoc } -- Location of import statment is_loc :: SrcSpan } -- Location of import statment
-- Comparison of provenance is just used for grouping -- Comparison of provenance is just used for grouping
-- error messages (in RnEnv.warnUnusedBinds) -- error messages (in RnEnv.warnUnusedBinds)
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The University of Glasgow, 1992-2003
% %
%************************************************************************ %************************************************************************
%* * %* *
...@@ -23,16 +23,27 @@ module SrcLoc ( ...@@ -23,16 +23,27 @@ module SrcLoc (
srcLocFile, -- return the file name part srcLocFile, -- return the file name part
srcLocLine, -- return the line part srcLocLine, -- return the line part
srcLocCol, -- return the column part srcLocCol, -- return the column part
SrcSpan, -- Abstract
noSrcSpan,
mkGeneralSrcSpan,
isGoodSrcSpan,
mkSrcSpan, srcLocSpan,
combineSrcSpans,
srcSpanFile,
srcSpanStartLine, srcSpanEndLine,
srcSpanStartCol, srcSpanEndCol,
srcSpanStart, srcSpanEnd,
Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
import Util ( thenCmp ) import Util ( thenCmp )
import Outputable import Outputable
import FastTypes
import FastString import FastString
import GLAEXTS ( (+#), quotInt# )
\end{code} \end{code}
%************************************************************************ %************************************************************************
...@@ -46,8 +57,10 @@ this is the obvious stuff: ...@@ -46,8 +57,10 @@ this is the obvious stuff:
\begin{code} \begin{code}
data SrcLoc data SrcLoc
= SrcLoc FastString -- A precise location (file name) = SrcLoc FastString -- A precise location (file name)
FastInt -- line !Int -- line number, begins at 1
FastInt -- column !Int -- column number, begins at 0
-- Don't ask me why lines start at 1 and columns start at
-- zero. That's just the way it is, so there. --SDM
| ImportedLoc String -- Module name | ImportedLoc String -- Module name
...@@ -81,8 +94,8 @@ rare case. ...@@ -81,8 +94,8 @@ rare case.
Things to make 'em: Things to make 'em:
\begin{code} \begin{code}
mkSrcLoc x line col = SrcLoc x (iUnbox line) (iUnbox col) mkSrcLoc x line col = SrcLoc x line col
noSrcLoc = UnhelpfulLoc FSLIT("<no locn>") noSrcLoc = UnhelpfulLoc FSLIT("<no location info>")
generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>") generatedSrcLoc = UnhelpfulLoc FSLIT("<compiler-generated code>")
wiredInSrcLoc = UnhelpfulLoc FSLIT("<wired into compiler>") wiredInSrcLoc = UnhelpfulLoc FSLIT("<wired into compiler>")
interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>") interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
...@@ -101,22 +114,22 @@ srcLocFile (SrcLoc fname _ _) = fname ...@@ -101,22 +114,22 @@ srcLocFile (SrcLoc fname _ _) = fname
srcLocFile other = FSLIT("<unknown file") srcLocFile other = FSLIT("<unknown file")
srcLocLine :: SrcLoc -> Int srcLocLine :: SrcLoc -> Int
srcLocLine (SrcLoc _ l c) = iBox l srcLocLine (SrcLoc _ l c) = l
srcLocLine other = panic "srcLocLine: unknown line" srcLocLine other = panic "srcLocLine: unknown line"
srcLocCol :: SrcLoc -> Int srcLocCol :: SrcLoc -> Int
srcLocCol (SrcLoc _ l c) = iBox c srcLocCol (SrcLoc _ l c) = c
srcLocCol other = panic "srcLocCol: unknown col" srcLocCol other = panic "srcLocCol: unknown col"
advanceSrcLoc :: SrcLoc -> Char -> SrcLoc advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (tab c) advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (tab c)
advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f (l +# 1#) 0# advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f (l + 1) 0
advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c +# 1#) advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
advanceSrcLoc loc _ = loc -- Better than nothing advanceSrcLoc loc _ = loc -- Better than nothing
-- Advance to the next tab stop. Tabs are at column positions 0, 8, 16, etc. -- Advance to the next tab stop. Tabs are at column positions 0, 8, 16, etc.
tab :: FastInt -> FastInt tab :: Int -> Int
tab c = (c `quotInt#` 8# +# 1#) *# 8# tab c = (c `quot` 8 + 1) * 8
\end{code} \end{code}
%************************************************************************ %************************************************************************
...@@ -145,8 +158,8 @@ cmpSrcLoc (ImportedLoc _) other = LT ...@@ -145,8 +158,8 @@ cmpSrcLoc (ImportedLoc _) other = LT
cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2) cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
= (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2) = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
where where
l1 `cmpline` l2 | l1 <# l2 = LT l1 `cmpline` l2 | l1 < l2 = LT
| l1 ==# l2 = EQ | l1 == l2 = EQ
| otherwise = GT | otherwise = GT
cmpSrcLoc (SrcLoc _ _ _) other = GT cmpSrcLoc (SrcLoc _ _ _) other = GT
...@@ -155,13 +168,228 @@ instance Outputable SrcLoc where ...@@ -155,13 +168,228 @@ instance Outputable SrcLoc where
= getPprStyle $ \ sty -> = getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then if userStyle sty || debugStyle sty then
hcat [ ftext src_path, char ':', hcat [ ftext src_path, char ':',
int (iBox src_line) int src_line,
{- TODO: char ':', int (iBox src_col) -} char ':', int src_col
] ]
else else
hcat [text "{-# LINE ", int (iBox src_line), space, hcat [text "{-# LINE ", int src_line, space,
char '\"', ftext src_path, text " #-}"] char '\"', ftext src_path, text " #-}"]
ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> quotes (text mod) ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> quotes (text mod)
ppr (UnhelpfulLoc s) = ftext s ppr (UnhelpfulLoc s) = ftext s
\end{code} \end{code}
%************************************************************************
%* *
\subsection[SrcSpan]{Source Spans}
%* *
%************************************************************************
\begin{code}
{- |
A SrcSpan delimits a portion of a text file. It could be represented
by a pair of (line,column) coordinates, but in fact we optimise
slightly by using more compact representations for single-line and
zero-length spans, both of which are quite common.
The end position is defined to be the column *after* the end of the
span. That is, a span of (1,1)-(1,2) is one character long, and a
span of (1,1)-(1,1) is zero characters long.
-}
data SrcSpan
= SrcSpanOneLine -- a common case: a single line
{ srcSpanFile :: FastString,
srcSpanLine :: !Int,
srcSpanSCol :: !Int,
srcSpanECol :: !Int
}
| SrcSpanMultiLine
{ srcSpanFile :: FastString,
srcSpanSLine :: !Int,
srcSpanSCol :: !Int,
srcSpanELine :: !Int,
srcSpanECol :: !Int
}
| SrcSpanPoint
{ srcSpanFile :: FastString,
srcSpanLine :: !Int,
srcSpanCol :: !Int
}
| ImportedSpan String -- Module name
| UnhelpfulSpan FastString -- Just a general indication
-- also used to indicate an empty span
deriving Eq
-- We want to order SrcSpans first by the start point, then by the end point.
instance Ord SrcSpan where
a `compare` b =
(srcSpanStart a `compare` srcSpanStart b) `thenCmp`
(srcSpanEnd a `compare` srcSpanEnd b)
noSrcSpan = UnhelpfulSpan FSLIT("<no location info>")
mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan = UnhelpfulSpan
isGoodSrcSpan SrcSpanOneLine{} = True
isGoodSrcSpan SrcSpanMultiLine{} = True
isGoodSrcSpan SrcSpanPoint{} = True
isGoodSrcSpan _ = False
srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
srcSpanStart (ImportedSpan str) = ImportedLoc str
srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanStart s =
mkSrcLoc (srcSpanFile s)
(srcSpanStartLine s)
(srcSpanStartCol s)
srcSpanEnd (ImportedSpan str) = ImportedLoc str
srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanEnd s =
mkSrcLoc (srcSpanFile s)
(srcSpanEndLine s)
(srcSpanEndCol s)
srcLocSpan :: SrcLoc -> SrcSpan
srcLocSpan (ImportedLoc str) = ImportedSpan str
srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (ImportedLoc str) _ = ImportedSpan str
mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
mkSrcSpan _ (ImportedLoc str) = ImportedSpan str
mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
mkSrcSpan loc1 loc2
| line1 == line2 = if col1 == col2
then SrcSpanPoint file line1 col1
else SrcSpanOneLine file line1 col1 col2
| otherwise = SrcSpanMultiLine file line1 col1 line2 col2
where
line1 = srcLocLine loc1
line2 = srcLocLine loc2
col1 = srcLocCol loc1
col2 = srcLocCol loc2
file = srcLocFile loc1
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (ImportedSpan str) _ = ImportedSpan str
combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful
combineSrcSpans _ (ImportedSpan str) = ImportedSpan str
combineSrcSpans l (UnhelpfulSpan str) = l
combineSrcSpans start end
| line1 == line2 = if col1 == col2
then SrcSpanPoint file line1 col1
else SrcSpanOneLine file line1 col1 col2
| otherwise = SrcSpanMultiLine file line1 col1 line2 col2
where
line1 = srcSpanStartLine start
line2 = srcSpanEndLine end
col1 = srcSpanStartCol start
col2 = srcSpanEndCol end
file = srcSpanFile start
instance Outputable SrcSpan where
ppr span
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
pprUserSpan span
else
hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
char '\"', ftext (srcSpanFile span), text " #-}"]
pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
= hcat [ ftext src_path, char ':',
int line,
char ':', int start_col
]
<> if end_col - start_col <= 1
then empty
-- for single-character or point spans, we just output the starting
-- column number
else char '-' <> int (end_col-1)
pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
= hcat [ ftext src_path, char ':',
parens (int sline <> char ',' <> int scol),
char '-',
parens (int eline <> char ',' <>
if ecol == 0 then int ecol else int (ecol-1))
]
pprUserSpan (SrcSpanPoint src_path line col)
= hcat [ ftext src_path, char ':',
int line,
char ':', int col
]
pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod)
pprUserSpan (UnhelpfulSpan s) = ftext s
\end{code}
%************************************************************************
%* *
\subsection[Located]{Attaching SrcSpans to things}
%* *
%************************************************************************
\begin{code}
-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data Located e = L SrcSpan e
unLoc :: Located e -> e
unLoc (L _ e) = e
getLoc :: Located e -> SrcSpan
getLoc (L l _) = l
noLoc :: e -> Located e
noLoc e = L noSrcSpan e
combineLocs :: Located a -> Located b -> SrcSpan
combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
addCLoc :: Located a -> Located b -> c -> Located c
addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
-- not clear whether to add a general Eq instance, but this is useful sometimes:
eqLocated :: Eq a => Located a -> Located a -> Bool
eqLocated a b = unLoc a == unLoc b
-- not clear whether to add a general Eq instance, but this is useful sometimes:
cmpLocated :: Ord a => Located a -> Located a -> Ordering
cmpLocated a b = unLoc a `compare` unLoc b
instance Functor Located where
fmap f (L l e) = L l (f e)
instance Outputable e => Outputable (Located e) where
ppr (L span e) = ppr e
-- do we want to dump the span in debugSty mode?
\end{code}
...@@ -51,6 +51,7 @@ import Util ...@@ -51,6 +51,7 @@ import Util
import Outputable import Outputable
import List ( partition ) import List ( partition )
import Char ( ord )
\end{code} \end{code}
%************************************************************************ %************************************************************************
...@@ -172,7 +173,8 @@ buildDynCon binder cc con [arg_amode] ...@@ -172,7 +173,8 @@ buildDynCon binder cc con [arg_amode]
| maybeCharLikeCon con && in_range_char_lit arg_amode | maybeCharLikeCon con && in_range_char_lit arg_amode
= returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con)) = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
where where
in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE in_range_char_lit (CLit (MachChar val)) =
ord val <= mAX_CHARLIKE && ord val >= mIN_CHARLIKE
in_range_char_lit _other_amode = False in_range_char_lit _other_amode = False
\end{code} \end{code}
......
...@@ -25,8 +25,8 @@ import Subst ( substTyWith ) ...@@ -25,8 +25,8 @@ import Subst ( substTyWith )
import Name ( getSrcLoc ) import Name ( getSrcLoc )
import PprCore import PprCore
import ErrUtils ( dumpIfSet_core, ghcExit, Message, showPass, import ErrUtils ( dumpIfSet_core, ghcExit, Message, showPass,
addErrLocHdrLine ) mkLocMessage )
import SrcLoc ( SrcLoc, noSrcLoc ) import SrcLoc ( SrcLoc, noSrcLoc, mkSrcSpan )
import Type ( Type, tyVarsOfType, eqType, import Type ( Type, tyVarsOfType, eqType,
splitFunTy_maybe, mkTyVarTy, splitFunTy_maybe, mkTyVarTy,
splitForAllTy_maybe, splitTyConApp_maybe, splitTyConApp, splitForAllTy_maybe, splitTyConApp_maybe, splitTyConApp,
...@@ -521,7 +521,7 @@ addErr errs_so_far msg locs ...@@ -521,7 +521,7 @@ addErr errs_so_far msg locs
context | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1 context | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1
| otherwise = cxt1 | otherwise = cxt1
mk_msg msg = addErrLocHdrLine loc context msg mk_msg msg = mkLocMessage (mkSrcSpan loc loc) (context $$ msg)
addLoc :: LintLocInfo -> LintM a -> LintM a addLoc :: LintLocInfo -> LintM a -> LintM a
addLoc extra_loc m loc scope errs addLoc extra_loc m loc scope errs
......
...@@ -164,9 +164,7 @@ make_alt (DEFAULT,[],e) = C.Adefault (make_exp e) ...@@ -164,9 +164,7 @@ make_alt (DEFAULT,[],e) = C.Adefault (make_exp e)
make_lit :: Literal -> C.Lit make_lit :: Literal -> C.Lit
make_lit l = make_lit l =
case l of case l of
MachChar i | i <= 0xff -> C.Lchar (chr i) t MachChar i -> C.Lchar i t
MachChar i | otherwise -> C.Lint (toEnum i) t
-- For big characters, use an integer literal with a character type sig
MachStr s -> C.Lstring (unpackFS s) t MachStr s -> C.Lstring (unpackFS s) t
MachNullAddr -> C.Lint 0 t MachNullAddr -> C.Lint 0 t
MachInt i -> C.Lint i t MachInt i -> C.Lint i t
......
...@@ -11,19 +11,19 @@ module Check ( check , ExhaustivePat ) where ...@@ -11,19 +11,19 @@ module Check ( check , ExhaustivePat ) where
import HsSyn import HsSyn