[commit: ghc] master: Add COLUMN pragma (e61b4a4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e61b4a4169da17cd7b77f9dc09e3627eff1ff559/ghc

>---------------------------------------------------------------

commit e61b4a4169da17cd7b77f9dc09e3627eff1ff559
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon Mar 13 15:18:22 2017 -0400

    Add COLUMN pragma
    
    Test Plan: validate
    
    Reviewers: bgamari, austin
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3313


>---------------------------------------------------------------

e61b4a4169da17cd7b77f9dc09e3627eff1ff559
 compiler/parser/Lexer.x                            | 18 ++++++++++++++++-
 docs/users_guide/glasgow_exts.rst                  | 23 ++++++++++++++++++++++
 .../tests/parser/should_compile/ColumnPragma.hs    |  6 ++++++
 .../parser/should_compile/ColumnPragma.stderr      |  3 +++
 testsuite/tests/parser/should_compile/all.T        |  1 +
 5 files changed, 50 insertions(+), 1 deletion(-)

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 6f91f44..3d6fa16 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -318,6 +318,10 @@ $tab          { warnTab }
    -- NOTE: accept -} at the end of a LINE pragma, for compatibility
    -- with older versions of GHC which generated these.
 
+-- Haskell-style column pragmas, of the form
+--    {-# COLUMN <column> #-}
+<column_prag> @decimal $whitechar* "#-}" { setColumn }
+
 <0,option_prags> {
   "{-#" $whitechar* $pragmachar+
         $whitechar+ $pragmachar+ / { known_pragma twoWordPrags }
@@ -1390,6 +1394,17 @@ setLine code span buf len = do
   pushLexState code
   lexToken
 
+setColumn :: Action
+setColumn span buf len = do
+  let column =
+        case reads (lexemeToString buf len) of
+          [(column, _)] -> column
+          _ -> error "setColumn: expected integer" -- shouldn't happen
+  setSrcLoc (mkRealSrcLoc (srcSpanFile span) (srcSpanEndLine span)
+                          (fromIntegral (column :: Integer)))
+  _ <- popLexState
+  lexToken
+
 setFile :: Int -> Action
 setFile code span buf len = do
   let file = mkFastString (go (lexemeToString (stepOn buf) (len-2)))
@@ -2751,7 +2766,8 @@ oneWordPrags = Map.fromList [
      ("overlapping", strtoken (\s -> IToverlapping_prag (SourceText s))),
      ("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))),
      ("ctype", strtoken (\s -> ITctype (SourceText s))),
-     ("complete", strtoken (\s -> ITcomplete_prag (SourceText s)))
+     ("complete", strtoken (\s -> ITcomplete_prag (SourceText s))),
+     ("column", begin column_prag)
      ]
 
 twoWordPrags = Map.fromList([
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 3366705..43175ba 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -12771,6 +12771,29 @@ position for the duration of the splice and are limited to the splice.
 Note that because Template Haskell splices abstract syntax, the file
 positions are not automatically advanced.
 
+.. _column-pragma:
+
+``COLUMN`` pragma
+---------------
+
+.. index::
+   single: COLUMN; pragma
+   single: pragma; COLUMN
+
+This is the analogue of the ``LINE`` pragma and is likewise intended for
+use in automatically generated Haskell code. It lets you specify the
+column number of the original code; for example
+
+::
+
+    foo = do
+      {-# COLUMN 42 #-}pure ()
+      pure ()
+
+This adjusts all column numbers immediately after the pragma to start
+at 42.  The presence of this pragma only affects the quality of the
+diagnostics and does not change the syntax of the code itself.
+
 .. _rules:
 
 ``RULES`` pragma
diff --git a/testsuite/tests/parser/should_compile/ColumnPragma.hs b/testsuite/tests/parser/should_compile/ColumnPragma.hs
new file mode 100644
index 0000000..8044d1b
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/ColumnPragma.hs
@@ -0,0 +1,6 @@
+main :: IO ()
+main = do
+  -- force an "unrecognized pragma" warning
+  -- to check if the column number is correct
+  {-# COLUMN 1000 #-}print "Hello"  {-# NONEXISTENTPRAGMA #-}
+  print "world"
diff --git a/testsuite/tests/parser/should_compile/ColumnPragma.stderr b/testsuite/tests/parser/should_compile/ColumnPragma.stderr
new file mode 100644
index 0000000..4dcfbd1
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/ColumnPragma.stderr
@@ -0,0 +1,3 @@
+
+ColumnPragma.hs:5:1015: warning: [-Wunrecognised-pragmas (in -Wdefault)]
+    Unrecognised pragma
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 512836d..2059979 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -91,6 +91,7 @@ test('mc16', normal, compile, [''])
 test('EmptyDecls', normal, compile, [''])
 test('ParserLambdaCase', [], compile, [''])
 
+test('ColumnPragma', normal, compile, [''])
 test('T5243', [], multimod_compile, ['T5243', ''])
 test('T7118', normal, compile, [''])
 test('T7776', normal, compile, [''])