From 3a1babd6243edd96073ed3e3a5fb6e0aaf11350e Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 15 Jan 2016 00:03:58 +0200
Subject: Work SourceText in for all integer literals

Summary:
Certain syntactic elements have integers in them, such as fixity
specifications, SPECIALISE pragmas and so on.

The lexer will accept mult-radix literals, with arbitrary leading zeros
in these.

Bring in a SourceText field to each affected AST element to capture the
original literal text for use with API Annotations.

Affected hsSyn elements are

```
     -- See note [Pragma source text]
     data Activation = NeverActive
                     | AlwaysActive
                     | ActiveBefore SourceText PhaseNum
                          -- Active only *strictly before* this phase
                     | ActiveAfter SourceText PhaseNum
                           -- Active in this phase and later
                     deriving( Eq, Data, Typeable )
                               -- Eq used in comparing rules in HsDecls

     data Fixity = Fixity SourceText Int FixityDirection
       -- Note [Pragma source text]
       deriving (Data, Typeable)
 ```

and

```
      | HsTickPragma         -- A pragma introduced tick
         SourceText           -- Note [Pragma source text] in BasicTypes
         (StringLiteral,(Int,Int),(Int,Int))
                                          -- external span for this tick
         ((SourceText,SourceText),(SourceText,SourceText))
            -- Source text for the four integers used in the span.
            -- See note [Pragma source text] in BasicTypes
         (LHsExpr id)
```

Updates haddock submodule

Test Plan: ./validate

Reviewers: goldfire, bgamari, austin

Reviewed By: bgamari

Subscribers: thomie, mpickering

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

GHC Trac Issues: #11430
---
 testsuite/tests/ghc-api/annotations/t11430.hs | 127 ++++++++++++++++++++++++++
 1 file changed, 127 insertions(+)
 create mode 100644 testsuite/tests/ghc-api/annotations/t11430.hs

(limited to 'testsuite/tests/ghc-api/annotations/t11430.hs')

diff --git a/testsuite/tests/ghc-api/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs
new file mode 100644
index 0000000000..1f00d1d5d2
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/t11430.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- This program must be called with GHC's libdir as the single command line
+-- argument.
+module Main where
+
+-- import Data.Generics
+import Data.Data hiding (Fixity)
+import Data.List
+import System.IO
+import GHC
+import BasicTypes
+import DynFlags
+import FastString
+import ForeignCall
+import MonadUtils
+import Outputable
+import HsDecls
+import Bag (filterBag,isEmptyBag)
+import System.Directory (removeFile)
+import System.Environment( getArgs )
+import qualified Data.Map as Map
+import Data.Dynamic ( fromDynamic,Dynamic )
+
+main::IO()
+main = do
+        [libdir,fileName] <- getArgs
+        testOneFile libdir fileName
+
+testOneFile libdir fileName = do
+       ((anns,cs),p) <- runGhc (Just libdir) $ do
+                        dflags <- getSessionDynFlags
+                        setSessionDynFlags dflags
+                        let mn =mkModuleName fileName
+                        addTarget Target { targetId = TargetModule mn
+                                         , targetAllowObjCode = True
+                                         , targetContents = Nothing }
+                        load LoadAllTargets
+                        modSum <- getModSummary mn
+                        p <- parseModule modSum
+                        return (pm_annotations p,p)
+
+       let tupArgs = gq (pm_parsed_source p)
+
+       putStrLn (intercalate "\n" $ map show tupArgs)
+       -- putStrLn (pp tupArgs)
+       -- putStrLn (intercalate "\n" [showAnns anns])
+
+    where
+     gq ast = everything (++) ([] `mkQ` doFixity
+                               `extQ` doRuleDecl
+                               `extQ` doHsExpr
+                               `extQ` doInline
+                              ) ast
+
+     doFixity :: Fixity -> [(String,[String])]
+     doFixity (Fixity ss _ _) = [("f",[ss])]
+
+     doRuleDecl :: RuleDecl RdrName
+                -> [(String,[String])]
+     doRuleDecl (HsRule _ (ActiveBefore ss _) _ _ _ _ _) = [("rb",[ss])]
+     doRuleDecl (HsRule _ (ActiveAfter ss _) _ _ _ _ _) = [("ra",[ss])]
+     doRuleDecl (HsRule _ _ _ _ _ _ _) = []
+
+     doHsExpr :: HsExpr RdrName -> [(String,[String])]
+     doHsExpr (HsTickPragma src (_,_,_) ss _) = [("tp",[show ss])]
+     doHsExpr _ = []
+
+     doInline (InlinePragma _ _ _ (ActiveBefore ss _) _) = [("ib",[ss])]
+     doInline (InlinePragma _ _ _ (ActiveAfter ss _) _) = [("ia",[ss])]
+     doInline (InlinePragma _ _ _ _ _ ) = []
+
+showAnns anns = "[\n" ++ (intercalate "\n"
+   $ map (\((s,k),v)
+              -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
+   $ Map.toList anns)
+    ++ "]\n"
+
+pp a = showPpr unsafeGlobalDynFlags a
+
+-- ---------------------------------------------------------------------
+
+-- Copied from syb for the test
+
+
+-- | Generic queries of type \"r\",
+--   i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Make a generic query;
+--   start from a type-specific case;
+--   return a constant otherwise
+--
+mkQ :: ( Typeable a
+       , Typeable b
+       )
+    => r
+    -> (b -> r)
+    -> a
+    -> r
+(r `mkQ` br) a = case cast a of
+                        Just b  -> br b
+                        Nothing -> r
+
+-- | Extend a generic query by a type-specific case
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
+extQ f g a = maybe (f a) g (cast a)
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
-- 
cgit v1.2.1