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

33 files changed, 285 insertions, 92 deletions

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index f8d4e8fe3e..5db992de51 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -312,14 +312,15 @@ pprRuleName rn = doubleQuotes (ftext rn)
 -}
 
 ------------------------
-data Fixity = Fixity Int FixityDirection
+data Fixity = Fixity SourceText Int FixityDirection
+  -- Note [Pragma source text]
   deriving (Data, Typeable)
 
 instance Outputable Fixity where
-    ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
+    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
 
 instance Eq Fixity where -- Used to determine if two fixities conflict
-  (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
+  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
 
 ------------------------
 data FixityDirection = InfixL | InfixR | InfixN
@@ -336,12 +337,12 @@ maxPrecedence = 9
 minPrecedence = 0
 
 defaultFixity :: Fixity
-defaultFixity = Fixity maxPrecedence InfixL
+defaultFixity = Fixity (show maxPrecedence) maxPrecedence InfixL
 
 negateFixity, funTyFixity :: Fixity
 -- Wired-in fixities
-negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
-funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
+negateFixity = Fixity "6" 6 InfixL  -- Fixity of unary negate
+funTyFixity  = Fixity "0" 0 InfixR  -- Fixity of '->'
 
 {-
 Consider
@@ -356,7 +357,7 @@ whether there's an error.
 compareFixity :: Fixity -> Fixity
               -> (Bool,         -- Error please
                   Bool)         -- Associate to the right: a op1 (b op2 c)
-compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
+compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
   = case prec1 `compare` prec2 of
         GT -> left
         LT -> right
@@ -889,11 +890,15 @@ instance Outputable CompilerPhase where
    ppr (Phase n)    = int n
    ppr InitialPhase = ptext (sLit "InitialPhase")
 
+-- See note [Pragma source text]
 data Activation = NeverActive
                 | AlwaysActive
-                | ActiveBefore PhaseNum -- Active only *strictly before* this phase
-                | ActiveAfter PhaseNum  -- Active in this phase and later
-                deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
+                | 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 RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
                    | FunLike
@@ -1051,10 +1056,10 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
 
 instance Outputable Activation where
-   ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
-   ppr NeverActive      = brackets (ptext (sLit "NEVER"))
-   ppr (ActiveBefore n) = brackets (char '~' <> int n)
-   ppr (ActiveAfter n)  = brackets (int n)
+   ppr AlwaysActive       = brackets (ptext (sLit "ALWAYS"))
+   ppr NeverActive        = brackets (ptext (sLit "NEVER"))
+   ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
+   ppr (ActiveAfter  _ n) = brackets (int n)
 
 instance Outputable RuleMatchInfo where
    ppr ConLike = ptext (sLit "CONLIKE")
@@ -1087,10 +1092,10 @@ isActive InitialPhase _                 = False
 isActive (Phase p)    act               = isActiveIn p act
 
 isActiveIn :: PhaseNum -> Activation -> Bool
-isActiveIn _ NeverActive      = False
-isActiveIn _ AlwaysActive     = True
-isActiveIn p (ActiveAfter n)  = p <= n
-isActiveIn p (ActiveBefore n) = p >  n
+isActiveIn _ NeverActive        = False
+isActiveIn _ AlwaysActive       = True
+isActiveIn p (ActiveAfter _ n)  = p <= n
+isActiveIn p (ActiveBefore _ n) = p >  n
 
 competesWith :: Activation -> Activation -> Bool
 -- See Note [Activation competition]
@@ -1098,13 +1103,13 @@ competesWith NeverActive       _                = False
 competesWith _                 NeverActive      = False
 competesWith AlwaysActive      _                = True
 
-competesWith (ActiveBefore {}) AlwaysActive      = True
-competesWith (ActiveBefore {}) (ActiveBefore {}) = True
-competesWith (ActiveBefore a)  (ActiveAfter b)   = a < b
+competesWith (ActiveBefore {})  AlwaysActive      = True
+competesWith (ActiveBefore {})  (ActiveBefore {}) = True
+competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
 
 competesWith (ActiveAfter {})  AlwaysActive      = False
 competesWith (ActiveAfter {})  (ActiveBefore {}) = False
-competesWith (ActiveAfter a)   (ActiveAfter b)   = a >= b
+competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
 
 {- Note [Competing activations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index f796d76853..27e9dc1d17 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -1119,7 +1119,8 @@ seqId = pcMiscPrelId seqName ty info
                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                        `setRuleInfo`       mkRuleInfo [seq_cast_rule]
 
-    inline_prag = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0
+    inline_prag
+         = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter "0" 0
                   -- Make 'seq' not inline-always, so that simpleOptExpr
                   -- (see CoreSubst.simple_app) won't inline 'seq' on the
                   -- LHS of rules.  That way we can have rules for 'seq';
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 6dc7383d8b..762883b4d1 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -622,7 +622,7 @@ addTickHsExpr (HsTick t e) =
 addTickHsExpr (HsBinTick t0 t1 e) =
         liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
 
-addTickHsExpr (HsTickPragma _ _ (L pos e0)) = do
+addTickHsExpr (HsTickPragma _ _ _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
     return $ unLoc e2
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 357d2fd38f..cfa68338ea 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -717,7 +717,7 @@ dsExpr (HsBinTick ixT ixF e) = do
        mkBinaryTickBox ixT ixF e2
      }
 
-dsExpr (HsTickPragma _ _ expr) = do
+dsExpr (HsTickPragma _ _ _ expr) = do
   dflags <- getDynFlags
   if gopt Opt_Hpc dflags
     then panic "dsExpr:HsTickPragma"
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index eadd243a11..acd32ba15b 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -531,7 +531,7 @@ repSafety PlayInterruptible = rep2 interruptibleName []
 repSafety PlaySafe = rep2 safeName []
 
 repFixD :: LFixitySig Name -> DsM [(SrcSpan, Core TH.DecQ)]
-repFixD (L loc (FixitySig names (Fixity prec dir)))
+repFixD (L loc (FixitySig names (Fixity _ prec dir)))
   = do { MkC prec' <- coreIntLit prec
        ; let rep_fn = case dir of
                         InfixL -> infixLDName
@@ -778,11 +778,11 @@ repRuleMatch ConLike = dataCon conLikeDataConName
 repRuleMatch FunLike = dataCon funLikeDataConName
 
 repPhases :: Activation -> DsM (Core TH.Phases)
-repPhases (ActiveBefore i) = do { MkC arg <- coreIntLit i
-                                ; dataCon' beforePhaseDataConName [arg] }
-repPhases (ActiveAfter i)  = do { MkC arg <- coreIntLit i
-                                ; dataCon' fromPhaseDataConName [arg] }
-repPhases _                = dataCon allPhasesDataConName
+repPhases (ActiveBefore _ i) = do { MkC arg <- coreIntLit i
+                                  ; dataCon' beforePhaseDataConName [arg] }
+repPhases (ActiveAfter _ i)  = do { MkC arg <- coreIntLit i
+                                  ; dataCon' fromPhaseDataConName [arg] }
+repPhases _                  = dataCon allPhasesDataConName
 
 -------------------------------------------------------
 --                      Types
diff --git a/compiler/deSugar/PmExpr.hs b/compiler/deSugar/PmExpr.hs
index 56e7eb8eb7..4ca9461a5d 100644
--- a/compiler/deSugar/PmExpr.hs
+++ b/compiler/deSugar/PmExpr.hs
@@ -263,7 +263,7 @@ hsExprToPmExpr e@(RecordCon   _ _ _ _) = PmExprOther e
 
 hsExprToPmExpr (HsTick            _ e) = lhsExprToPmExpr e
 hsExprToPmExpr (HsBinTick       _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsTickPragma    _ _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (HsTickPragma  _ _ _ e) = lhsExprToPmExpr e
 hsExprToPmExpr (HsSCC           _ _ e) = lhsExprToPmExpr e
 hsExprToPmExpr (HsCoreAnn       _ _ e) = lhsExprToPmExpr e
 hsExprToPmExpr (ExprWithTySig     e _) = lhsExprToPmExpr e
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 251fa19d99..c76fc3a5c5 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -664,8 +664,8 @@ cvtRuleMatch TH.FunLike = Hs.FunLike
 
 cvtPhases :: TH.Phases -> Activation -> Activation
 cvtPhases AllPhases       dflt = dflt
-cvtPhases (FromPhase i)   _    = ActiveAfter i
-cvtPhases (BeforePhase i) _    = ActiveBefore i
+cvtPhases (FromPhase i)   _    = ActiveAfter (show i) i
+cvtPhases (BeforePhase i) _    = ActiveBefore (show i) i
 
 cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr RdrName)
 cvtRuleBndr (RuleVar n)
@@ -1267,7 +1267,7 @@ cvtInjectivityAnnotation (TH.InjectivityAnn annLHS annRHS)
 
 -----------------------------------------------------------
 cvtFixity :: TH.Fixity -> Hs.Fixity
-cvtFixity (TH.Fixity prec dir) = Hs.Fixity prec (cvt_dir dir)
+cvtFixity (TH.Fixity prec dir) = Hs.Fixity (show prec) prec (cvt_dir dir)
    where
      cvt_dir TH.InfixL = Hs.InfixL
      cvt_dir TH.InfixR = Hs.InfixR
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 158993eb2e..6b395a318a 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -477,6 +477,9 @@ data HsExpr id
      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)
 
   ---------------------------------------
@@ -798,7 +801,7 @@ ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
           ppr tickIdFalse,
           ptext (sLit ">("),
           ppr exp,ptext (sLit ")")]
-ppr_expr (HsTickPragma _ externalSrcLoc exp)
+ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
   = pprTicks (ppr exp) $
     hcat [ptext (sLit "tickpragma<"),
           pprExternalSrcLoc externalSrcLoc,
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index b0da64c7da..35c6b22027 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -817,7 +817,7 @@ ghcPrimIface
         mi_fix_fn  = mkIfaceFixCache fixities
     }
   where
-    fixities = (getOccName seqId, Fixity 0 InfixR)  -- seq is infixr 0
+    fixities = (getOccName seqId, Fixity "0" 0 InfixR)  -- seq is infixr 0
              : (occName funTyConName, funTyFixity)  -- trac #10145
              : mapMaybe mkFixity allThePrimOps
     mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 5f6f12cabe..7d903f64d8 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -757,10 +757,10 @@ impspec :: { Located (Bool, Located [LIE RdrName]) }
 -----------------------------------------------------------------------------
 -- Fixity Declarations
 
-prec    :: { Located Int }
-        : {- empty -}           { noLoc 9 }
+prec    :: { Located (SourceText,Int) }
+        : {- empty -}           { noLoc ("",9) }
         | INTEGER
-                 {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
+                 {% checkPrecP (sL1 $1 (getINTEGERs $1,fromInteger (getINTEGER $1))) }
 
 infix   :: { Located FixityDirection }
         : 'infix'                               { sL1 $1 InfixN  }
@@ -1362,9 +1362,9 @@ rule_activation :: { ([AddAnn],Maybe Activation) }
 rule_explicit_activation :: { ([AddAnn]
                               ,Activation) }  -- In brackets
         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
-                                  ,ActiveAfter  (fromInteger (getINTEGER $2))) }
+                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (getINTEGER $2))) }
         | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
-                                  ,ActiveBefore (fromInteger (getINTEGER $3))) }
+                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (getINTEGER $3))) }
         | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
                                   ,NeverActive) }
 
@@ -2055,7 +2055,7 @@ sigdecl :: { LHsDecl RdrName }
         | infix prec ops
               {% ams (sLL $1 $> $ SigD
                         (FixSig (FixitySig (fromOL $ unLoc $3)
-                                (Fixity (unLoc $2) (unLoc $1)))))
+                                (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
                      [mj AnnInfix $1,mj AnnVal $2] }
 
         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
@@ -2095,10 +2095,10 @@ activation :: { ([AddAnn],Maybe Activation) }
 
 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
-                                  ,ActiveAfter  (fromInteger (getINTEGER $2))) }
+                                  ,ActiveAfter  (getINTEGERs $2) (fromInteger (getINTEGER $2))) }
         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
                                                  ,mj AnnCloseS $4]
-                                  ,ActiveBefore (fromInteger (getINTEGER $3))) }
+                                  ,ActiveBefore (getINTEGERs $3) (fromInteger (getINTEGER $3))) }
 
 -----------------------------------------------------------------------------
 -- Expressions
@@ -2183,8 +2183,9 @@ exp10 :: { LHsExpr RdrName }
         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ unLoc $1) }
 
-        | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
-                                      (fst $ fst $ unLoc $1) }
+        | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1)
+                                                                (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+                                      (fst $ fst $ fst $ unLoc $1) }
 
         | 'proc' aexp '->' exp
                        {% checkPattern empty $2 >>= \ p ->
@@ -2213,9 +2214,11 @@ scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
                                          ,mc $3],getSCC_PRAGs $1)
                                         ,(StringLiteral (unpackFS $ getVARID $2) (getVARID $2))) }
 
-hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))) }
+hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))),
+                         ((SourceText,SourceText),(SourceText,SourceText))
+                       ) }
       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
-                                      { sLL $1 $> $ (([mo $1,mj AnnVal $2
+                                      { sLL $1 $> $ ((([mo $1,mj AnnVal $2
                                               ,mj AnnVal $3,mj AnnColon $4
                                               ,mj AnnVal $5,mj AnnMinus $6
                                               ,mj AnnVal $7,mj AnnColon $8
@@ -2229,6 +2232,12 @@ hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int)
                                                 , fromInteger $ getINTEGER $9
                                                 )
                                                ))
+                                             , (( getINTEGERs $3
+                                                , getINTEGERs $5
+                                                )
+                                               ,( getINTEGERs $7
+                                                , getINTEGERs $9
+                                                )))
                                          }
 
 fexp    :: { LHsExpr RdrName }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index ada9bf25eb..11ec70c27d 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -1203,9 +1203,9 @@ cmdStmtFail loc e = parseErrorSDoc loc
 ---------------------------------------------------------------------------
 -- Miscellaneous utilities
 
-checkPrecP :: Located Int -> P (Located Int)
-checkPrecP (L l i)
- | 0 <= i && i <= maxPrecedence = return (L l i)
+checkPrecP :: Located (SourceText,Int) -> P (Located (SourceText,Int))
+checkPrecP (L l (src,i))
+ | 0 <= i && i <= maxPrecedence = return (L l (src,i))
  | otherwise
     = parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
 
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 6b71abfd45..252cce6e86 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1420,7 +1420,7 @@ lookupFixityRn_help' :: Name
                      -> RnM (Bool, Fixity)
 lookupFixityRn_help' name occ
   | isUnboundName name
-  = return (False, Fixity minPrecedence InfixL)
+  = return (False, Fixity (show minPrecedence) minPrecedence InfixL)
     -- Minimise errors from ubound names; eg
     --    a>0 `foo` b>0
     -- where 'foo' is not in scope, should not give an error (Trac #7937)
@@ -1499,7 +1499,7 @@ lookupFieldFixityRn (Ambiguous   (L _ rdr) _) = get_ambiguous_fixity rdr
         [] -> panic "get_ambiguous_fixity: no candidates for a given RdrName"
         [ (_, fix):_ ] -> return fix
         ambigs -> addErr (ambiguous_fixity_err rdr_name ambigs)
-                  >> return (Fixity minPrecedence InfixL)
+                  >> return (Fixity(show minPrecedence) minPrecedence InfixL)
 
     lookup_gre_fixity gre = lookupFixityRn' (gre_name gre) (greOccName gre)
 
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 03f4b62043..c4f4bca35f 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -152,10 +152,10 @@ rnExpr (OpApp e1 op  _ e2)
         -- more, so I've removed the test.  Adding HsPars in TcGenDeriv
         -- should prevent bad things happening.
         ; fixity <- case op' of
-                      L _ (HsVar (L _ n)) -> lookupFixityRn n
-                      L _ (HsRecFld f)    -> lookupFieldFixityRn f
-                      _ -> return (Fixity minPrecedence InfixL)
-                           -- c.f. lookupFixity for unbound
+              L _ (HsVar (L _ n)) -> lookupFixityRn n
+              L _ (HsRecFld f)    -> lookupFieldFixityRn f
+              _ -> return (Fixity (show minPrecedence) minPrecedence InfixL)
+                   -- c.f. lookupFixity for unbound
 
         ; final_e <- mkOpAppRn e1' op' fixity e2'
         ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
@@ -202,9 +202,9 @@ rnExpr (HsCoreAnn src ann expr)
 rnExpr (HsSCC src lbl expr)
   = do { (expr', fvs_expr) <- rnLExpr expr
        ; return (HsSCC src lbl expr', fvs_expr) }
-rnExpr (HsTickPragma src info expr)
+rnExpr (HsTickPragma src info srcInfo expr)
   = do { (expr', fvs_expr) <- rnLExpr expr
-       ; return (HsTickPragma src info expr', fvs_expr) }
+       ; return (HsTickPragma src info srcInfo expr', fvs_expr) }
 
 rnExpr (HsLam matches)
   = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 137b918f22..9a3dba216e 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1303,8 +1303,8 @@ checkPrecMatch op (MG { mg_alts = L _ ms })
 
 checkPrec :: Name -> Pat Name -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
-    op_fix@(Fixity op_prec  op_dir) <- lookupFixityRn op
-    op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
+    op_fix@(Fixity _ op_prec  op_dir) <- lookupFixityRn op
+    op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
     let
         inf_ok = op1_prec > op_prec ||
                  (op1_prec == op_prec &&
@@ -1332,8 +1332,8 @@ checkSectionPrec direction section op arg
         _                -> return ()
   where
     op_name = get_op op
-    go_for_it arg_op arg_fix@(Fixity arg_prec assoc) = do
-          op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
+    go_for_it arg_op arg_fix@(Fixity _ arg_prec assoc) = do
+          op_fix@(Fixity _ op_prec _) <- lookupFixityRn op_name
           unless (op_prec < arg_prec
                   || (op_prec == arg_prec && direction == assoc))
                  (sectionPrecErr (op_name, op_fix)
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 846d1cc838..43c8cb65df 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -700,8 +700,8 @@ updModeForStableUnfoldings inline_rule_act current_mode
                  -- For sm_rules, just inherit; sm_rules might be "off"
                  -- because of -fno-enable-rewrite-rules
   where
-    phaseFromActivation (ActiveAfter n) = Phase n
-    phaseFromActivation _               = InitialPhase
+    phaseFromActivation (ActiveAfter _ n) = Phase n
+    phaseFromActivation _                 = InitialPhase
 
 updModeForRules :: SimplifierMode -> SimplifierMode
 -- See Note [Simplifying rules]
diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs
index c0a31c9b92..8a5ed67513 100644
--- a/compiler/stranal/WorkWrap.hs
+++ b/compiler/stranal/WorkWrap.hs
@@ -364,7 +364,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs
                                 -- Set the arity so that the Core Lint check that the
                                 -- arity is consistent with the demand type goes through
 
-            wrap_act  = ActiveAfter 0
+            wrap_act  = ActiveAfter "0" 0
             wrap_rhs  = wrap_fn work_id
             wrap_prag = InlinePragma { inl_src = "{-# INLINE"
                                      , inl_inline = Inline
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index d5a001666f..592b0bfbf7 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -172,9 +172,9 @@ tcExpr (HsSCC src lbl expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
        ; return (HsSCC src lbl expr') }
 
-tcExpr (HsTickPragma src info expr) res_ty
+tcExpr (HsTickPragma src info srcInfo expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
-       ; return (HsTickPragma src info expr') }
+       ; return (HsTickPragma src info srcInfo expr') }
 
 tcExpr (HsCoreAnn src lbl expr) res_ty
   = do  { expr' <- tcMonoExpr expr res_ty
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 330415522a..2990e18f10 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1226,7 +1226,7 @@ appPrecedence = fromIntegral maxPrecedence + 1
 getPrecedence :: (Name -> Fixity) -> Name -> Integer
 getPrecedence get_fixity nm
    = case get_fixity nm of
-        Fixity x _assoc -> fromIntegral x
+        Fixity _ x _assoc -> fromIntegral x
           -- NB: the Report says that associativity is not taken
           --     into account for either Read or Show; hence we
           --     ignore associativity here
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index 43433da2bc..2ebf3fda15 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -576,9 +576,9 @@ tc_mkRepTy gk_ tycon =
         ctFix c
             | dataConIsInfix c
             = case lookupFixity fix_env (dataConName c) of
-                   Fixity n InfixL -> buildFix n pLA
-                   Fixity n InfixR -> buildFix n pRA
-                   Fixity n InfixN -> buildFix n pNA
+                   Fixity _ n InfixL -> buildFix n pLA
+                   Fixity _ n InfixR -> buildFix n pRA
+                   Fixity _ n InfixN -> buildFix n pNA
             | otherwise = mkTyConTy pPrefix
         buildFix n assoc = mkTyConApp pInfix [ mkTyConTy assoc
                                              , mkNumLitTy (fromIntegral n)]
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index d8703a07e5..f055197ede 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -725,9 +725,9 @@ zonkExpr env (HsSCC src lbl expr)
   = do new_expr <- zonkLExpr env expr
        return (HsSCC src lbl new_expr)
 
-zonkExpr env (HsTickPragma src info expr)
+zonkExpr env (HsTickPragma src info srcInfo expr)
   = do new_expr <- zonkLExpr env expr
-       return (HsTickPragma src info new_expr)
+       return (HsTickPragma src info srcInfo new_expr)
 
 -- hdaume: core annotations
 zonkExpr env (HsCoreAnn src lbl expr)
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 9465456bac..cdda69666e 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -2755,7 +2755,7 @@ exprCtOrigin (HsArrApp {})      = panic "exprCtOrigin HsArrApp"
 exprCtOrigin (HsArrForm {})     = panic "exprCtOrigin HsArrForm"
 exprCtOrigin (HsTick _ (L _ e)) = exprCtOrigin e
 exprCtOrigin (HsBinTick _ _ (L _ e)) = exprCtOrigin e
-exprCtOrigin (HsTickPragma _ _ (L _ e)) = exprCtOrigin e
+exprCtOrigin (HsTickPragma _ _ _ (L _ e)) = exprCtOrigin e
 exprCtOrigin EWildPat           = panic "exprCtOrigin EWildPat"
 exprCtOrigin (EAsPat {})        = panic "exprCtOrigin EAsPat"
 exprCtOrigin (EViewPat {})      = panic "exprCtOrigin EViewPat"
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 985798b381..ab2e30cb31 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1812,7 +1812,7 @@ reifyFixity name
   = do { (found, fix) <- lookupFixityRn_help name
        ; return (if found then Just (conv_fix fix) else Nothing) }
     where
-      conv_fix (BasicTypes.Fixity i d) = TH.Fixity i (conv_dir d)
+      conv_fix (BasicTypes.Fixity _ i d) = TH.Fixity i (conv_dir d)
       conv_dir BasicTypes.InfixR = TH.InfixR
       conv_dir BasicTypes.InfixL = TH.InfixL
       conv_dir BasicTypes.InfixN = TH.InfixN
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index b70304d785..8800d98f9c 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -755,21 +755,25 @@ instance Binary Activation where
             putByte bh 0
     put_ bh AlwaysActive = do
             putByte bh 1
-    put_ bh (ActiveBefore aa) = do
+    put_ bh (ActiveBefore src aa) = do
             putByte bh 2
+            put_ bh src
             put_ bh aa
-    put_ bh (ActiveAfter ab) = do
+    put_ bh (ActiveAfter src ab) = do
             putByte bh 3
+            put_ bh src
             put_ bh ab
     get bh = do
             h <- getByte bh
             case h of
               0 -> do return NeverActive
               1 -> do return AlwaysActive
-              2 -> do aa <- get bh
-                      return (ActiveBefore aa)
-              _ -> do ab <- get bh
-                      return (ActiveAfter ab)
+              2 -> do src <- get bh
+                      aa <- get bh
+                      return (ActiveBefore src aa)
+              _ -> do src <- get bh
+                      ab <- get bh
+                      return (ActiveAfter src ab)
 
 instance Binary InlinePragma where
     put_ bh (InlinePragma s a b c d) = do
@@ -859,13 +863,15 @@ instance Binary FixityDirection where
               _ -> do return InfixN
 
 instance Binary Fixity where
-    put_ bh (Fixity aa ab) = do
+    put_ bh (Fixity src aa ab) = do
+            put_ bh src
             put_ bh aa
             put_ bh ab
     get bh = do
+          src <- get bh
           aa <- get bh
           ab <- get bh
-          return (Fixity aa ab)
+          return (Fixity src aa ab)
 
 instance Binary WarningTxt where
     put_ bh (WarningTxt s w) = do
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 212f7b0706..045cd4084d 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -7,6 +7,7 @@ clean:
 	rm -f annotations comments parseTree
 	rm -f listcomps
 	rm -f stringSource
+	rm -f t11430
 
 .PHONY: annotations
 annotations:
@@ -118,3 +119,9 @@ T11321:
 .PHONY: T11332
 T11332:
 	$(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11332
+
+.PHONY: T11430
+T11430:
+	rm -f t11430.o t11430.hi t11430
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t11430
+	./t11430 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11430
diff --git a/testsuite/tests/ghc-api/annotations/T11430.stdout b/testsuite/tests/ghc-api/annotations/T11430.stdout
new file mode 100644
index 0000000000..32d7ff1b24
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T11430.stdout
@@ -0,0 +1,6 @@
+("f",["0x1"])
+("ib",["001"])
+("ia",["1"])
+("ia",["0x999"])
+("ia",["1"])
+("tp",["((\"0x1\",\"0x2\"),(\"0x3\",\"0x4\"))"])
diff --git a/testsuite/tests/ghc-api/annotations/Test11430.hs b/testsuite/tests/ghc-api/annotations/Test11430.hs
new file mode 100644
index 0000000000..4b124e478c
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test11430.hs
@@ -0,0 +1,25 @@
+module Test11430 where
+
+
+infixl 0x1 `f`
+
+x `f` y = x
+
+
+{-# SPECIALISE [~ 001] x ::
+        Integer -> Integer -> Integer,
+        Integer -> Int -> Integer,
+        Int -> Int -> Int #-}
+{-# INLINABLE [1] x #-}
+x :: (Num a, Integral b) => a -> b -> a
+x = undefined
+
+{-# SPECIALISE INLINE [0x999] y ::
+        Integer -> Integer -> Integer,
+        Integer -> Int -> Integer,
+        Int -> Int -> Int #-}
+{-# INLINABLE [1] y #-}
+y :: (Num a, Integral b) => a -> b -> a
+y = undefined
+
+c = {-# GENERATED "foob\x61r" 0x1 : 0x2  -  0x3 :   0x4 #-} 0.00
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index a2750ff08a..64f69e20f0 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -23,3 +23,4 @@ test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundl
 test('T10276',      normal, run_command, ['$MAKE -s --no-print-directory T10276'])
 test('T11321',      normal, run_command, ['$MAKE -s --no-print-directory T11321'])
 test('T11332',      normal, run_command, ['$MAKE -s --no-print-directory T11332'])
+test('T11430',      normal, run_command, ['$MAKE -s --no-print-directory T11430'])
diff --git a/testsuite/tests/ghc-api/annotations/stringSource.hs b/testsuite/tests/ghc-api/annotations/stringSource.hs
index 1e8af17072..bf691ae8ea 100644
--- a/testsuite/tests/ghc-api/annotations/stringSource.hs
+++ b/testsuite/tests/ghc-api/annotations/stringSource.hs
@@ -82,7 +82,7 @@ testOneFile libdir fileName = do
      doHsExpr :: HsExpr RdrName -> [(String,[Located (SourceText,FastString)])]
      doHsExpr (HsCoreAnn src ss _) = [("co",[conv (noLoc ss)])]
      doHsExpr (HsSCC     src ss _) = [("sc",[conv (noLoc ss)])]
-     doHsExpr (HsTickPragma src (ss,_,_) _) = [("tp",[conv (noLoc ss)])]
+     doHsExpr (HsTickPragma src (ss,_,_) _ss2 _) = [("tp",[conv (noLoc ss)])]
      doHsExpr _ = []
 
      conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs)
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)
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 781317ab11..e6af0f200e 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -350,7 +350,8 @@ gen_hs_source (Info defaults entries) =
            escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
                 where special = "/'`\"@<"
 
-           pprFixity (Fixity i d) n = pprFixityDir d ++ " " ++ show i ++ " " ++ n
+           pprFixity (Fixity _ i d) n
+             = pprFixityDir d ++ " " ++ show i ++ " " ++ n
 
 {- Note [Placeholder declarations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -495,7 +496,7 @@ gen_latex_doc (Info defaults entries)
                Nothing -> "" 
 
            mk_fixity o = case lookup_attrib "fixity" o of
-             Just (OptionFixity (Just (Fixity i d)))
+             Just (OptionFixity (Just (Fixity _ i d)))
                -> pprFixityDir d ++ " " ++ show i
              _ -> ""
 
diff --git a/utils/genprimopcode/Parser.y b/utils/genprimopcode/Parser.y
index 6a3c0d0043..51ca9ad6eb 100644
--- a/utils/genprimopcode/Parser.y
+++ b/utils/genprimopcode/Parser.y
@@ -77,9 +77,9 @@ pOption : lowerName '=' false               { OptionFalse  $1 }
         | fixity    '=' pInfix              { OptionFixity $3 }
 
 pInfix :: { Maybe Fixity }
-pInfix : infix  integer { Just $ Fixity $2 InfixN }
-       | infixl integer { Just $ Fixity $2 InfixL }
-       | infixr integer { Just $ Fixity $2 InfixR }
+pInfix : infix  integer { Just $ Fixity (show $2) $2 InfixN }
+       | infixl integer { Just $ Fixity (show $2) $2 InfixL }
+       | infixr integer { Just $ Fixity (show $2) $2 InfixR }
        | nothing        { Nothing }
 
 
diff --git a/utils/genprimopcode/Syntax.hs b/utils/genprimopcode/Syntax.hs
index 68b20adbdd..17c264d44a 100644
--- a/utils/genprimopcode/Syntax.hs
+++ b/utils/genprimopcode/Syntax.hs
@@ -96,7 +96,9 @@ instance Show TyCon where
 
 -- Follow definitions of Fixity and FixityDirection in GHC
 
-data Fixity = Fixity Int FixityDirection
+-- The String exists so that it matches the SourceText field in
+-- BasicTypes.Fixity
+data Fixity = Fixity String Int FixityDirection
   deriving (Eq, Show)
 
 data FixityDirection = InfixN | InfixL | InfixR
diff --git a/utils/haddock b/utils/haddock
-Subproject a13d21c688cae176be4505a5a6e9d64739845ea
+Subproject c2e89153c0aaf2dc4e3908701f19d739eb0d8b9