Add COLUMN pragma

Test Plan: validate

Reviewers: bgamari, austin

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3313

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([

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

testsuite/tests/parser/should_compile/ColumnPragma.hs

+main :: IO ()
+main = do
+  -- force an "unrecognized pragma" warning
+  -- to check if the column number is correct
+  {-# COLUMN 1000 #-}print "Hello"  {-# NONEXISTENTPRAGMA #-}
+  print "world"

testsuite/tests/parser/should_compile/ColumnPragma.stderr

+
+ColumnPragma.hs:5:1015: warning: [-Wunrecognised-pragmas (in -Wdefault)]
+    Unrecognised pragma

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, [''])