Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
GHC
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alexander Kaznacheev
GHC
Commits
1d6124de
Commit
1d6124de
authored
10 years ago
by
Simon Peyton Jones
Browse files
Options
Downloads
Patches
Plain Diff
Tidy up pretty-printing of SrcLoc and SrcSpan
parent
c7fa0ba6
Loading
Loading
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
compiler/basicTypes/SrcLoc.lhs
+55
-46
55 additions, 46 deletions
compiler/basicTypes/SrcLoc.lhs
with
55 additions
and
46 deletions
compiler/basicTypes/SrcLoc.lhs
+
55
−
46
View file @
1d6124de
...
@@ -83,7 +83,6 @@ import Data.Bits
...
@@ -83,7 +83,6 @@ import Data.Bits
import Data.Data
import Data.Data
import Data.List
import Data.List
import Data.Ord
import Data.Ord
import System.FilePath
\end{code}
\end{code}
%************************************************************************
%************************************************************************
...
@@ -191,15 +190,19 @@ cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
...
@@ -191,15 +190,19 @@ cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
instance Outputable RealSrcLoc where
instance Outputable RealSrcLoc where
ppr (SrcLoc src_path src_line src_col)
ppr (SrcLoc src_path src_line src_col)
= getPprStyle $ \ sty ->
= hcat [ pprFastFilePath src_path <> colon
if userStyle sty || debugStyle sty then
, int src_line <> colon
hcat [ pprFastFilePath src_path, char ':',
, int src_col ]
int src_line,
char ':', int src_col
-- I don't know why there is this style-based difference
]
-- if userStyle sty || debugStyle sty then
else
-- hcat [ pprFastFilePath src_path, char ':',
hcat [text "{-# LINE ", int src_line, space,
-- int src_line,
char '\"', pprFastFilePath src_path, text " #-}"]
-- char ':', int src_col
-- ]
-- else
-- hcat [text "{-# LINE ", int src_line, space,
-- char '\"', pprFastFilePath src_path, text " #-}"]
instance Outputable SrcLoc where
instance Outputable SrcLoc where
ppr (RealSrcLoc l) = ppr l
ppr (RealSrcLoc l) = ppr l
...
@@ -432,50 +435,56 @@ instance Ord SrcSpan where
...
@@ -432,50 +435,56 @@ instance Ord SrcSpan where
instance Outputable RealSrcSpan where
instance Outputable RealSrcSpan where
ppr span
ppr span = pprUserRealSpan True span
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
-- I don't know why there is this style-based difference
text (showUserRealSpan True span)
-- = getPprStyle $ \ sty ->
else
-- if userStyle sty || debugStyle sty then
hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
-- text (showUserRealSpan True span)
char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
-- else
-- hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
-- char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
instance Outputable SrcSpan where
instance Outputable SrcSpan where
ppr span
ppr span = pprUserSpan True span
= getPprStyle $ \ sty ->
if userStyle sty || debugStyle sty then
pprUserSpan True span
else
case span of
UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
RealSrcSpan s -> ppr s
pprUserSpan :: Bool -> SrcSpan -> SDoc
-- I don't know why there is this style-based difference
pprUserSpan _ (UnhelpfulSpan s) = ftext s
-- = getPprStyle $ \ sty ->
pprUserSpan show_path (RealSrcSpan s) = text (showUserRealSpan show_path s)
-- if userStyle sty || debugStyle sty then
-- pprUserSpan True span
-- else
-- case span of
-- UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
-- RealSrcSpan s -> ppr s
showUserSpan :: Bool -> SrcSpan -> String
showUserSpan :: Bool -> SrcSpan -> String
showUserSpan _ (UnhelpfulSpan s) = unpackFS s
showUserSpan show_path span = showSDocSimple (pprUserSpan show_path span)
showUserSpan show_path (RealSrcSpan s) = showUserRealSpan show_path s
pprUserSpan :: Bool -> SrcSpan -> SDoc
showUserRealSpan :: Bool -> RealSrcSpan -> String
pprUserSpan _ (UnhelpfulSpan s) = ftext s
showUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
++ show line ++ ":" ++ show start_col
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
++ (if end_col - start_col <= 1 then "" else '-' : show (end_col - 1))
pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, int line <> colon
, int start_col
, ppUnless (end_col - start_col <= 1) (char '-' <> int (end_col - 1)) ]
-- For single-character or point spans, we just
-- For single-character or point spans, we just
-- output the starting column number
-- output the starting column number
showUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
++ "(" ++ show sline ++ "," ++ show scol ++ ")"
, parens (int sline <> comma <> int scol)
++ "-"
, char '-'
++ "(" ++ show eline ++ "," ++ show ecol' ++ ")"
, parens (int eline <> comma <> int ecol') ]
where ecol' = if ecol == 0 then ecol else ecol - 1
where
ecol' = if ecol == 0 then ecol else ecol - 1
showUserRealSpan show_path (SrcSpanPoint src_path line col)
= (if show_path then normalise (unpackFS src_path) ++ ":" else "")
pprUserRealSpan show_path (SrcSpanPoint src_path line col)
++ show line ++ ":" ++ show col
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, int line <> colon
, int col ]
\end{code}
\end{code}
%************************************************************************
%************************************************************************
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment