Expose enabled language extensions to TH
[ghc.git] / compiler / parser / Parser.y
index 2b57b5a..6606e3f 100644 (file)
@@ -8,14 +8,6 @@
 -- ---------------------------------------------------------------------------
 
 {
-{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
-{-# OPTIONS -Wwarn -w #-}
--- The above warning suppression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 -- | This module provides the generated Happy parser for Haskell. It exports
 -- a number of parsers which may be used in any library that uses the GHC API.
 -- A common usage pattern is to initialize the parser state with a given string
@@ -31,8 +23,9 @@
 --       parseState = mkPState flags buffer location
 -- @
 module Parser (parseModule, parseImport, parseStatement,
-               parseDeclaration, parseExpression, parseTypeSignature,
-               parseFullStmt, parseStmt, parseIdentifier,
+               parseDeclaration, parseExpression, parsePattern,
+               parseTypeSignature,
+               parseStmt, parseIdentifier,
                parseType, parseHeader) where
 
 -- base
@@ -40,6 +33,7 @@ import Control.Monad    ( unless, liftM )
 import GHC.Exts
 import Data.Char
 import Control.Monad    ( mplus )
+import Control.Applicative ((<$))
 
 -- compiler/hsSyn
 import HsSyn
@@ -50,7 +44,7 @@ import DynFlags
 
 -- compiler/utils
 import OrdList
-import BooleanFormula   ( BooleanFormula, mkAnd, mkOr, mkTrue, mkVar )
+import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
 import FastString
 import Maybes           ( orElse )
 import Outputable
@@ -65,7 +59,7 @@ import BasicTypes
 
 -- compiler/types
 import Type             ( funTyCon )
-import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
+import Kind             ( Kind )
 import Class            ( FunDep )
 
 -- compiler/parser
@@ -79,20 +73,22 @@ import TcEvidence       ( emptyTcEvBinds )
 
 -- compiler/prelude
 import ForeignCall
-import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
-import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
+import TysPrim          ( eqPrimTyCon )
+import PrelNames        ( eqTyCon_RDR )
+import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
                           unboxedUnitTyCon, unboxedUnitDataCon,
-                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
+                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
 
 -- compiler/utils
 import Util             ( looksLikePackageName )
+import Prelude
 
+import qualified GHC.LanguageExtensions as LangExt
 }
 
-{- Last updated: 30 Mar 2015
+{- Last updated: 18 Nov 2015
 
-Conflicts: 50 shift/reduce
-           2  reduce/reduce
+Conflicts: 36 shift/reduce
 
 If you modify this parser and add a conflict, please update this comment.
 You can learn more about the conflicts by passing 'happy' the -i flag:
@@ -124,47 +120,45 @@ follows. Shift parses as if the 'module' keyword follows.
 
 -------------------------------------------------------------------------------
 
-state 49 contains 11 shift/reduce conflicts.
-
-        context -> btype . '~' btype                        (rule 279)
-        context -> btype .                                  (rule 280)
-    *** type -> btype .                                     (rule 281)
-        type -> btype . qtyconop type                       (rule 282)
-        type -> btype . tyvarop type                        (rule 283)
-        type -> btype . '->' ctype                          (rule 284)
-        type -> btype . '~' btype                           (rule 285)
-        type -> btype . SIMPLEQUOTE qconop type             (rule 286)
-        type -> btype . SIMPLEQUOTE varop type              (rule 287)
-        btype -> btype . atype                              (rule 299)
-
-    Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
-
-Example of ambiguity: 'e :: a `b` c';  does this mean
-    (e::a) `b` c, or
-    (e :: (a `b` c))
-
-The case for '->' involves view patterns rather than type operators:
-    'case v of { x :: T -> T ... } '
-    Which of these two is intended?
-          case v of
-            (x::T) -> T         -- Rhs is T
-    or
-          case v of
-            (x::T -> T) -> ..   -- Rhs is ...
+state 46 contains 2 shift/reduce conflicts.
+
+    *** strict_mark -> unpackedness .                       (rule 268)
+        strict_mark -> unpackedness . strictness            (rule 269)
+
+    Conflicts: '~' '!'
+
+-------------------------------------------------------------------------------
+
+state 50 contains 1 shift/reduce conflict.
+
+        context -> btype .                                  (rule 295)
+    *** type -> btype .                                     (rule 297)
+        type -> btype . '->' ctype                          (rule 298)
+
+    Conflicts: '->'
+
+-------------------------------------------------------------------------------
+
+state 51 contains 9 shift/reduce conflicts.
+
+    *** btype -> tyapps .                                   (rule 303)
+        tyapps -> tyapps . tyapp                            (rule 307)
+
+    Conflicts: ':' '-' '!' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
 
 -------------------------------------------------------------------------------
 
-state 118 contains 15 shift/reduce conflicts.
+state 132 contains 14 shift/reduce conflicts.
 
-        exp -> infixexp . '::' sigtype                      (rule 414)
-        exp -> infixexp . '-<' exp                          (rule 415)
-        exp -> infixexp . '>-' exp                          (rule 416)
-        exp -> infixexp . '-<<' exp                         (rule 417)
-        exp -> infixexp . '>>-' exp                         (rule 418)
-    *** exp -> infixexp .                                   (rule 419)
-        infixexp -> infixexp . qop exp10                    (rule 421)
+        exp -> infixexp . '::' sigtype                      (rule 416)
+        exp -> infixexp . '-<' exp                          (rule 417)
+        exp -> infixexp . '>-' exp                          (rule 418)
+        exp -> infixexp . '-<<' exp                         (rule 419)
+        exp -> infixexp . '>>-' exp                         (rule 420)
+    *** exp -> infixexp .                                   (rule 421)
+        infixexp -> infixexp . qop exp10                    (rule 423)
 
-    Conflicts: ':' '::' '-' '!' '*' '-<' '>-' '-<<' '>>-'
+    Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-'
                '.' '`' VARSYM CONSYM QVARSYM QCONSYM
 
 Examples of ambiguity:
@@ -179,9 +173,9 @@ Shift parses as (per longest-parse rule):
 
 -------------------------------------------------------------------------------
 
-state 276 contains 1 shift/reduce conflicts.
+state 292 contains 1 shift/reduce conflicts.
 
-        rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 214)
+        rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 215)
 
     Conflict: '[' (empty rule_activation reduces)
 
@@ -197,28 +191,22 @@ a rule instructing how to rewrite the expression '[0] f'.
 
 -------------------------------------------------------------------------------
 
-state 285 contains 11 shift/reduce conflicts.
+state 301 contains 1 shift/reduce conflict.
 
-    *** type -> btype .                                     (rule 281)
-        type -> btype . qtyconop type                       (rule 282)
-        type -> btype . tyvarop type                        (rule 283)
-        type -> btype . '->' ctype                          (rule 284)
-        type -> btype . '~' btype                           (rule 285)
-        type -> btype . SIMPLEQUOTE qconop type             (rule 286)
-        type -> btype . SIMPLEQUOTE varop type              (rule 287)
-        btype -> btype . atype                              (rule 299)
+    *** type -> btype .                                     (rule 297)
+        type -> btype . '->' ctype                          (rule 298)
 
-    Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
+    Conflict: '->'
 
-Same as State 49, but minus the context productions.
+Same as state 50 but without contexts.
 
 -------------------------------------------------------------------------------
 
-state 320 contains 1 shift/reduce conflicts.
+state 337 contains 1 shift/reduce conflicts.
 
-        tup_exprs -> commas . tup_tail                      (rule 502)
-        sysdcon -> '(' commas . ')'                         (rule 610)
-        commas -> commas . ','                              (rule 725)
+        tup_exprs -> commas . tup_tail                      (rule 505)
+        sysdcon_nolist -> '(' commas . ')'                  (rule 616)
+        commas -> commas . ','                              (rule 734)
 
     Conflict: ')' (empty tup_tail reduces)
 
@@ -229,70 +217,33 @@ if -XTupleSections is not specified.
 
 -------------------------------------------------------------------------------
 
-state 372 contains 1 shift/reduce conflicts.
+state 388 contains 1 shift/reduce conflicts.
 
-        tup_exprs -> commas . tup_tail                      (rule 502)
-        sysdcon -> '(#' commas . '#)'                       (rule 612)
-        commas -> commas . ','                              (rule 724)
+        tup_exprs -> commas . tup_tail                      (rule 505)
+        sysdcon_nolist -> '(#' commas . '#)'                (rule 618)
+        commas -> commas . ','                              (rule 734)
 
     Conflict: '#)' (empty tup_tail reduces)
 
-Same as State 320 for unboxed tuples.
-
--------------------------------------------------------------------------------
-
-state 400 contains 1 shift/reduce conflicts.
-
-        exp10 -> 'let' binds . 'in' exp                     (rule 423)
-        exp10 -> 'let' binds . 'in' error                   (rule 438)
-        exp10 -> 'let' binds . error                        (rule 439)
-    *** qual -> 'let' binds .                               (rule 576)
-
-    Conflict: error
-
-TODO: Why?
-
--------------------------------------------------------------------------------
-
-
-state 462 contains 1 shift/reduce conflicts.
-
-    *** strict_mark -> '{-# NOUNPACK' '#-}' .               (rule 268)
-        strict_mark -> '{-# NOUNPACK' '#-}' . '!'           (rule 270)
-
-    Conflict: '!'
-
-TODO: Why?
-
--------------------------------------------------------------------------------
-
-state 463 contains 1 shift/reduce conflicts.
-
-    *** strict_mark -> '{-# UNPACK' '#-}' .                 (rule 267)
-        strict_mark -> '{-# UNPACK' '#-}' . '!'             (rule 269)
-
-    Conflict: '!'
-
-Same as State 462
+Same as State 324 for unboxed tuples.
 
 -------------------------------------------------------------------------------
 
-state 494 contains 1 shift/reduce conflicts.
+state 460 contains 1 shift/reduce conflict.
 
-        context -> btype '~' btype .                        (rule 279)
-    *** type -> btype '~' btype .                           (rule 285)
-        btype -> btype . atype                              (rule 299)
+        oqtycon -> '(' qtyconsym . ')'                      (rule 621)
+    *** qtyconop -> qtyconsym .                             (rule 628)
 
-    Conflict: '!'
+    Conflict: ')'
 
 TODO: Why?
 
 -------------------------------------------------------------------------------
 
-state 629 contains 1 shift/reduce conflicts.
+state 635 contains 1 shift/reduce conflicts.
 
-    *** aexp2 -> ipvar .                                    (rule 462)
-        dbind -> ipvar . '=' exp                            (rule 587)
+    *** aexp2 -> ipvar .                                    (rule 466)
+        dbind -> ipvar . '=' exp                            (rule 590)
 
     Conflict: '='
 
@@ -304,9 +255,9 @@ sensible meaning, namely the lhs of an implicit binding.
 
 -------------------------------------------------------------------------------
 
-state 696 contains 1 shift/reduce conflicts.
+state 702 contains 1 shift/reduce conflicts.
 
-        rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 214)
+        rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 215)
 
     Conflict: 'forall' (empty rule_forall reduces)
 
@@ -321,52 +272,26 @@ doesn't include 'forall'.
 
 -------------------------------------------------------------------------------
 
-state 769 contains 1 shift/reduce conflicts.
-
-    *** type -> btype '~' btype .                           (rule 285)
-        btype -> btype . atype                              (rule 299)
-
-    Conflict: '!'
-
-TODO: Why?
-
--------------------------------------------------------------------------------
-
-state 952 contains 1 shift/reduce conflicts.
+state 930 contains 1 shift/reduce conflicts.
 
-        transformqual -> 'then' 'group' . 'using' exp       (rule 525)
-        transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 526)
-    *** special_id -> 'group' .                             (rule 701)
+        transformqual -> 'then' 'group' . 'using' exp       (rule 528)
+        transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 529)
+    *** special_id -> 'group' .                             (rule 711)
 
     Conflict: 'by'
 
-TODO: Why?
-
 -------------------------------------------------------------------------------
 
-state 1229 contains 1 reduce/reduce conflicts.
+state 1270 contains 1 shift/reduce conflict.
 
-    *** tyconsym -> ':' .                                   (rule 642)
-        consym -> ':' .                                     (rule 712)
+    *** atype -> tyvar .                                    (rule 314)
+        tv_bndr -> '(' tyvar . '::' kind ')'                (rule 346)
 
-    Conflict: ')'
+    Conflict: '::'
 
-TODO: Same as State 1230
+TODO: Why?
 
 -------------------------------------------------------------------------------
-
-state 1230 contains 1 reduce/reduce conflicts.
-
-    *** tyconsym -> CONSYM .                                (rule 640)
-        consym -> CONSYM .                                  (rule 711)
-
-    Conflict: ')'
-
-TODO: Why?  (NB: This one has been around for a while; it's quite puzzling
-    because we really shouldn't get confused between tyconsym and consym.
-    Trace the state machine, maybe?)
-
--- -----------------------------------------------------------------------------
 -- API Annotations
 --
 
@@ -385,6 +310,11 @@ See
   https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
 for some background.
 
+If you modify the parser and want to ensure that the API annotations are processed
+correctly, see the README in (REPO)/utils/check-api-annotations for details on
+how to set up a test using the check-api-annotations utility, and interpret the
+output it generates.
+
 -- -----------------------------------------------------------------------------
 
 -}
@@ -416,7 +346,7 @@ for some background.
  'type'         { L _ ITtype }
  'where'        { L _ ITwhere }
 
- 'forall'       { L _ ITforall }                -- GHC extension keywords
+ 'forall'       { L _ (ITforall _) }                -- GHC extension keywords
  'foreign'      { L _ ITforeign }
  'export'       { L _ ITexport }
  'label'        { L _ ITlabel }
@@ -466,24 +396,23 @@ for some background.
 
  '..'           { L _ ITdotdot }                        -- reserved symbols
  ':'            { L _ ITcolon }
- '::'           { L _ ITdcolon }
+ '::'           { L _ (ITdcolon _) }
  '='            { L _ ITequal }
  '\\'           { L _ ITlam }
  'lcase'        { L _ ITlcase }
  '|'            { L _ ITvbar }
- '<-'           { L _ ITlarrow }
- '->'           { L _ ITrarrow }
+ '<-'           { L _ (ITlarrow _) }
+ '->'           { L _ (ITrarrow _) }
  '@'            { L _ ITat }
  '~'            { L _ ITtilde }
  '~#'           { L _ ITtildehsh }
- '=>'           { L _ ITdarrow }
+ '=>'           { L _ (ITdarrow _) }
  '-'            { L _ ITminus }
  '!'            { L _ ITbang }
- '*'            { L _ ITstar }
- '-<'           { L _ ITlarrowtail }            -- for arrow notation
- '>-'           { L _ ITrarrowtail }            -- for arrow notation
- '-<<'          { L _ ITLarrowtail }            -- for arrow notation
- '>>-'          { L _ ITRarrowtail }            -- for arrow notation
+ '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
+ '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
+ '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
+ '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation
  '.'            { L _ ITdot }
 
  '{'            { L _ ITocurly }                        -- special symbols
@@ -513,10 +442,9 @@ for some background.
  QCONID         { L _ (ITqconid   _) }
  QVARSYM        { L _ (ITqvarsym  _) }
  QCONSYM        { L _ (ITqconsym  _) }
- PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
- PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
 
  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
+ LABELVARID     { L _ (ITlabelvarid   _) }
 
  CHAR           { L _ (ITchar   _ _) }
  STRING         { L _ (ITstring _ _) }
@@ -536,12 +464,12 @@ for some background.
  DOCSECTION     { L _ (ITdocSection _ _) }
 
 -- Template Haskell
-'[|'            { L _ ITopenExpQuote  }
+'[|'            { L _ (ITopenExpQuote _) }
 '[p|'           { L _ ITopenPatQuote  }
 '[t|'           { L _ ITopenTypQuote  }
 '[d|'           { L _ ITopenDecQuote  }
 '|]'            { L _ ITcloseQuote    }
-'[||'           { L _ ITopenTExpQuote   }
+'[||'           { L _ (ITopenTExpQuote _) }
 '||]'           { L _ ITcloseTExpQuote  }
 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
 '$('            { L _ ITparenEscape   }     -- $( exp )
@@ -561,8 +489,8 @@ TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
 %name parseStatement stmt
 %name parseDeclaration topdecl
 %name parseExpression exp
+%name parsePattern pat
 %name parseTypeSignature sigdecl
-%name parseFullStmt   stmt
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
 %name parseType ctype
@@ -577,7 +505,7 @@ identifier :: { Located RdrName }
         | qvarop                        { $1 }
         | qconop                        { $1 }
     | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
-                               [mj AnnOpenP $1,mj AnnRarrow $2,mj AnnCloseP $3] }
+                               [mj AnnOpenP $1,mu AnnRarrow $2,mj AnnCloseP $3] }
 
 -----------------------------------------------------------------------------
 -- Module Header
@@ -702,9 +630,8 @@ exp_doc :: { OrdList (LIE RdrName) }
    -- No longer allow things like [] and (,,,) to be exported
    -- They are built in syntax, always available
 export  :: { OrdList (LIE RdrName) }
-        : qcname_ext export_subspec  {% amsu (sLL $1 $> (mkModuleImpExp $1
-                                                    (snd $ unLoc $2)))
-                                             (fst $ unLoc $2) }
+        : qcname_ext export_subspec  {% mkModuleImpExp $1 (snd $ unLoc $2)
+                                          >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
         |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
                                              [mj AnnModule $1] }
         |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
@@ -712,26 +639,41 @@ export  :: { OrdList (LIE RdrName) }
 
 export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
         : {- empty -}             { sL0 ([],ImpExpAbs) }
-        | '(' '..' ')'            { sLL $1 $> ([mop $1,mcp $3,mj AnnDotdot $2]
-                                       , ImpExpAll) }
-        | '(' ')'                 { sLL $1 $> ([mop $1,mcp $2],ImpExpList []) }
-        | '(' qcnames ')'         { sLL $1 $> ([mop $1,mcp $3],ImpExpList (reverse $2)) }
-
-qcnames :: { [Located RdrName] }     -- A reversed list
-        :  qcnames ',' qcname_ext       {% (aa (head $1) (AnnComma, $2)) >>
-                                           return ($3  : $1) }
-        |  qcname_ext                   { [$1]  }
-
-qcname_ext :: { Located RdrName }       -- Variable or data constructor
-                                        -- or tagged type constructor
+        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse (snd $2))
+                                      >>= \(as,ie) -> return $ sLL $1 $>
+                                            (as ++ [mop $1,mcp $3] ++ fst $2, ie) }
+
+
+qcnames :: { ([AddAnn], [Located (Maybe RdrName)]) }
+  : {- empty -}                   { ([],[]) }
+  | qcnames1                      { $1 }
+
+qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
+        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (last (snd $1)) of
+                                                    l@(L _ Nothing) ->
+                                                      return ([mj AnnComma $2, mj AnnDotdot l]
+                                                              ,($3  : snd $1))
+                                                    l -> (aa l (AnnComma, $2) >>
+                                                          return (fst $1, $3 : snd $1)) }
+
+
+        -- Annotations readded in mkImpExpSubSpec
+        |  qcname_ext_w_wildcard                   { ([],[$1])  }
+
+-- Variable, data constructor or wildcard
+-- or tagged type constructor
+qcname_ext_w_wildcard :: { Located (Maybe RdrName) }
+        :  qcname_ext               { Just `fmap` $1 }
+        |  '..'                     { Nothing <$ $1 }
+
+qcname_ext :: { Located RdrName }
         :  qcname                   { $1 }
-        |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
+        |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                             [mj AnnType $1,mj AnnVal $2] }
 
--- Cannot pull into qcname_ext, as qcname is also used in expression.
-qcname  :: { Located RdrName }  -- Variable or data constructor
-        :  qvar                         { $1 }
-        |  qcon                         { $1 }
+qcname  :: { Located RdrName }  -- Variable or type constructor
+        :  qvar                 { $1 }
+        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -777,10 +719,10 @@ maybe_safe :: { ([AddAnn],Bool) }
         : 'safe'                                { ([mj AnnSafe $1],True) }
         | {- empty -}                           { ([],False) }
 
-maybe_pkg :: { ([AddAnn],Maybe FastString) }
+maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
         : STRING  {% let pkgFS = getSTRING $1 in
                      if looksLikePackageName (unpackFS pkgFS)
-                        then return ([mj AnnPackageName $1], Just pkgFS)
+                        then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS))
                         else parseErrorSDoc (getLoc $1) $ vcat [
                              text "parse error" <> colon <+> quotes (ppr pkgFS),
                              text "Version number or non-alphanumeric" <+>
@@ -797,7 +739,10 @@ maybeas :: { ([AddAnn],Located (Maybe ModuleName)) }
         | {- empty -}                          { ([],noLoc Nothing) }
 
 maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
-        : impspec                  { L (gl $1) (Just (unLoc $1)) }
+        : impspec                  {% let (b, ie) = unLoc $1 in
+                                       checkImportSpec ie
+                                        >>= \checkedIe ->
+                                          return (L (gl $1) (Just (b, checkedIe)))  }
         | {- empty -}              { noLoc Nothing }
 
 impspec :: { Located (Bool, Located [LIE RdrName]) }
@@ -831,64 +776,63 @@ ops     :: { Located (OrdList (Located RdrName)) }
 
 topdecls :: { OrdList (LHsDecl RdrName) }
         : topdecls ';' topdecl        {% addAnnotation (oll $1) AnnSemi (gl $2)
-                                         >> return ($1 `appOL` $3) }
+                                         >> return ($1 `appOL` unitOL $3) }
         | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
                                          >> return $1 }
-        | topdecl                     { $1 }
-
-topdecl :: { OrdList (LHsDecl RdrName) }
-        : cl_decl                               { unitOL (sL1 $1 (TyClD (unLoc $1))) }
-        | ty_decl                               { unitOL (sL1 $1 (TyClD (unLoc $1))) }
-        | inst_decl                             { unitOL (sL1 $1 (InstD (unLoc $1))) }
-        | stand_alone_deriving                  { unitOL (sLL $1 $> (DerivD (unLoc $1))) }
-        | role_annot                            { unitOL (sL1 $1 (RoleAnnotD (unLoc $1))) }
-        | 'default' '(' comma_types0 ')'    {% do { def <- checkValidDefaults $3
-                                                  ; amsu (sLL $1 $> (DefD def))
+        | topdecl                     { unitOL $1 }
+
+topdecl :: { LHsDecl RdrName }
+        : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
+        | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
+        | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
+        | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
+        | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
+        | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
                                                          [mj AnnDefault $1
-                                                         ,mop $2,mcp $4] }}
-        | 'foreign' fdecl          {% amsu (sLL $1 $> (snd $ unLoc $2))
+                                                         ,mop $2,mcp $4] }
+        | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
                                            (mj AnnForeign $1:(fst $ unLoc $2)) }
-        | '{-# DEPRECATED' deprecations '#-}'   {% amsu (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
+        | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
                                                        [mo $1,mc $3] }
-        | '{-# WARNING' warnings '#-}'          {% amsu (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
+        | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
                                                        [mo $1,mc $3] }
-        | '{-# RULES' rules '#-}'               {% amsu (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
+        | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
                                                        [mo $1,mc $3] }
-        | '{-# VECTORISE' qvar '=' exp '#-}' {% amsu (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
+        | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
                                                     [mo $1,mj AnnEqual $3
                                                     ,mc $5] }
-        | '{-# NOVECTORISE' qvar '#-}'       {% amsu (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
+        | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
                                                      [mo $1,mc $3] }
         | '{-# VECTORISE' 'type' gtycon '#-}'
-                                {% amsu (sLL $1 $> $
+                                {% ams (sLL $1 $> $
                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
                                     [mo $1,mj AnnType $2,mc $4] }
 
         | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
-                                {% amsu (sLL $1 $> $
+                                {% ams (sLL $1 $> $
                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
                                     [mo $1,mj AnnType $2,mc $4] }
 
         | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
-                                {% amsu (sLL $1 $> $
+                                {% ams (sLL $1 $> $
                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
         | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
-                                {% amsu (sLL $1 $> $
+                                {% ams (sLL $1 $> $
                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
 
         | '{-# VECTORISE' 'class' gtycon '#-}'
-                                         {% amsu (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
+                                         {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
                                                  [mo $1,mj AnnClass $2,mc $4] }
-        | annotation { unitOL $1 }
-        | decl_no_th                            { unLoc $1 }
+        | annotation { $1 }
+        | decl_no_th                            { $1 }
 
         -- Template Haskell Extension
         -- The $(..) form is one possible form of infixexp
         -- but we treat an arbitrary expression just as if
         -- it had a $(..) wrapped around it
-        | infixexp                              { unitOL (sLL $1 $> $ mkSpliceDecl $1) }
+        | infixexp                              { sLL $1 $> $ mkSpliceDecl $1 }
 
 -- Type classes
 --
@@ -913,12 +857,14 @@ ty_decl :: { LTyClDecl RdrName }
                         [mj AnnType $1,mj AnnEqual $3] }
 
            -- type family declarations
-        | 'type' 'family' type opt_kind_sig where_type_family
+        | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info
+                          where_type_family
                 -- Note the use of type for the head; this allows
                 -- infix type constructors to be declared
-                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $5) $3
-                                   (snd $ unLoc $4))
-                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
+                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
+                                   (snd $ unLoc $4) (snd $ unLoc $5))
+                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
+                           ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
 
           -- ordinary data type or newtype declaration
         | data_or_newtype capi_ctype tycl_hdr constrs deriving
@@ -940,30 +886,27 @@ ty_decl :: { LTyClDecl RdrName }
                     ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
 
           -- data/newtype family
-        | 'data' 'family' type opt_kind_sig
-                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (snd $ unLoc $4))
+        | 'data' 'family' type opt_datafam_kind_sig
+                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
+                                   (snd $ unLoc $4) Nothing)
                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
 
 inst_decl :: { LInstDecl RdrName }
         : 'instance' overlap_pragma inst_type where_inst
        {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
              ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
-                                     , cid_sigs = sigs, cid_tyfam_insts = ats
+                                     , cid_sigs = mkClassOpSigs sigs
+                                     , cid_tyfam_insts = ats
                                      , cid_overlap_mode = $2
                                      , cid_datafam_insts = adts }
-             ; let err = text "In instance head:" <+> ppr $3
-             ; checkNoPartialType err $3
-             ; sequence_ [ checkNoPartialType err ty
-                         | sig@(L _ (TypeSig _ ty _ )) <- sigs
-                         , let err = text "in instance signature" <> colon
-                                     <+> quotes (ppr sig) ]
-             ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }))
+             ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_inst = cid }))
                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
 
            -- type instance declarations
         | 'type' 'instance' ty_fam_inst_eqn
-                {% amms (mkTyFamInst (comb2 $1 $3) $3)
-                    [mj AnnType $1,mj AnnInstance $2] }
+                {% ams $3 (fst $ unLoc $3)
+                >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
+                    (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
 
           -- data/newtype instance declaration
         | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving
@@ -993,6 +936,22 @@ overlap_pragma :: { Maybe (Located OverlapMode) }
   | {- empty -}                 { Nothing }
 
 
+-- Injective type families
+
+opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn RdrName)) }
+        : {- empty -}               { noLoc ([], Nothing) }
+        | '|' injectivity_cond      { sLL $1 $> ( mj AnnVbar $1 : fst (unLoc $2)
+                                                , Just (snd (unLoc $2))) }
+
+injectivity_cond :: { Located ([AddAnn], LInjectivityAnn RdrName) }
+        : tyvarid '->' inj_varids
+           { sLL $1 $> ( [mu AnnRarrow $2]
+                       , (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))) }
+
+inj_varids :: { Located [Located RdrName] }
+        : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }
+        | tyvarid             { sLL $1 $> [$1]            }
+
 -- Closed type families
 
 where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
@@ -1013,19 +972,21 @@ ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
 
 ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
-                                      {% asl (unLoc $1) $2 $3
-                                         >> return (sLL $1 $> ($3 : unLoc $1)) }
+                                      {% asl (unLoc $1) $2 (snd $ unLoc $3)
+                                         >> ams $3 (fst $ unLoc $3)
+                                         >> return (sLL $1 $> ((snd $ unLoc $3) : unLoc $1)) }
         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
                                          >> return (sLL $1 $>  (unLoc $1)) }
-        | ty_fam_inst_eqn             { sLL $1 $> [$1] }
+        | ty_fam_inst_eqn             {% ams $1 (fst $ unLoc $1)
+                                         >> return (sLL $1 $> [snd $ unLoc $1]) }
         | {- empty -}                 { noLoc [] }
 
-ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
+ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
         : type '=' ctype
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
               {% do { (eqn,ann) <- mkTyFamInstEqn $1 $3
-                    ; ams (sLL $1 $> eqn) (mj AnnEqual $2:ann) } }
+                    ; return (sLL $1 $> (mj AnnEqual $2:ann, sLL $1 $> eqn))  } }
 
 -- Associated type family declarations
 --
@@ -1038,29 +999,35 @@ ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
 --
 at_decl_cls :: { LHsDecl RdrName }
         :  -- data family declarations, with optional 'family' keyword
-          'data' opt_family type opt_kind_sig
+          'data' opt_family type opt_datafam_kind_sig
                 {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
-                                                  (snd $ unLoc $4)))
+                                                  (snd $ unLoc $4) Nothing))
                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
 
            -- type family declarations, with optional 'family' keyword
            -- (can't use opt_instance because you get shift/reduce errors
-        | 'type' type opt_kind_sig
-               {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3)
-                                                  OpenTypeFamily $2 (snd $ unLoc $3)))
+        | 'type' type opt_at_kind_inj_sig
+               {% amms (liftM mkTyClD
+                        (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2
+                                   (fst . snd $ unLoc $3)
+                                   (snd . snd $ unLoc $3)))
                        (mj AnnType $1:(fst $ unLoc $3)) }
-        | 'type' 'family' type opt_kind_sig
-               {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4)
-                                                  OpenTypeFamily $3 (snd $ unLoc $4)))
+        | 'type' 'family' type opt_at_kind_inj_sig
+               {% amms (liftM mkTyClD
+                        (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3
+                                   (fst . snd $ unLoc $4)
+                                   (snd . snd $ unLoc $4)))
                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
 
            -- default type instances, with optional 'instance' keyword
         | 'type' ty_fam_inst_eqn
-                {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) $2))
-                        [mj AnnType $1] }
+                {% ams $2 (fst $ unLoc $2) >>
+                   amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
+                        (mj AnnType $1:(fst $ unLoc $2)) }
         | 'type' 'instance' ty_fam_inst_eqn
-                {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) $3))
-                        [mj AnnType $1,mj AnnInstance $2] }
+                {% ams $3 (fst $ unLoc $3) >>
+                   amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
+                        (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
 
 opt_family   :: { [AddAnn] }
               : {- empty -}   { [] }
@@ -1073,8 +1040,9 @@ at_decl_inst :: { LInstDecl RdrName }
         : 'type' ty_fam_inst_eqn
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
-                {% amms (mkTyFamInst (comb2 $1 $2) $2)
-                        [mj AnnType $1] }
+                {% ams $2 (fst $ unLoc $2) >>
+                   amms (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2))
+                        (mj AnnType $1:(fst $ unLoc $2)) }
 
         -- data/newtype instance declaration
         | data_or_newtype capi_ctype tycl_hdr constrs deriving
@@ -1091,13 +1059,33 @@ at_decl_inst :: { LInstDecl RdrName }
                                 $3 (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6))
                         ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
 
-data_or_newtype :: { Located (AddAnn,NewOrData) }
+data_or_newtype :: { Located (AddAnn, NewOrData) }
         : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
         | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
 
-opt_kind_sig :: { Located ([AddAnn],Maybe (LHsKind RdrName)) }
-        :                             { noLoc ([],Nothing) }
-        | '::' kind                   { sLL $1 $> ([mj AnnDcolon $1],Just ($2)) }
+-- Family result/return kind signatures
+
+opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind RdrName)) }
+        :               { noLoc     ([]               , Nothing) }
+        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
+
+opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
+        :               { noLoc     ([]               , noLoc NoSig           )}
+        | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
+
+opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
+        :              { noLoc     ([]               , noLoc      NoSig       )}
+        | '::' kind    { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig  $2))}
+        | '='  tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig $2))}
+
+opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
+                                            , Maybe (LInjectivityAnn RdrName)))}
+        :            { noLoc ([], (noLoc NoSig, Nothing)) }
+        | '::' kind  { sLL $1 $> ( [mu AnnDcolon $1]
+                                 , (sLL $2 $> (KindSig $2), Nothing)) }
+        | '='  tv_bndr '|' injectivity_cond
+                { sLL $1 $> ( mj AnnEqual $1 : mj AnnVbar $3 : fst (unLoc $4)
+                            , (sLL $1 $2 (TyVarSig $2), Just (snd (unLoc $4))))}
 
 -- tycl_hdr parses the header of a class or data type decl,
 -- which takes the form
@@ -1107,19 +1095,19 @@ opt_kind_sig :: { Located ([AddAnn],Maybe (LHsKind RdrName)) }
 --      T Int [a]                       -- for associated types
 -- Rather a lot of inlining here, else we get reduce/reduce errors
 tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
-        : context '=>' type         {% addAnnotation (gl $1) AnnDarrow (gl $2)
+        : context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
                                        >> (return (sLL $1 $> (Just $1, $3)))
                                     }
         | type                      { sL1 $1 (Nothing, $1) }
 
 capi_ctype :: { Maybe (Located CType) }
 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
-                       {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRING $2)))
-                                        (getSTRING $3))))
+                       {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
+                                        (getSTRINGs $3,getSTRING $3))))
                               [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
 
            | '{-# CTYPE'        STRING '#-}'
-                       {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRING $2))))
+                       {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRINGs $2, getSTRING $2))))
                               [mo $1,mj AnnVal $2,mc $3] }
 
            |           { Nothing }
@@ -1130,12 +1118,10 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}'
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
   : 'deriving' 'instance' overlap_pragma inst_type
-                         {% do {
-                                 let err = text "in the stand-alone deriving instance"
-                                            <> colon <+> quotes (ppr $4)
-                               ; checkNoPartialType err $4
-                               ; ams (sLL $1 $> (DerivDecl $4 $3))
-                                     [mj AnnDeriving $1,mj AnnInstance $2] }}
+                         {% do { let { err = text "in the stand-alone deriving instance"
+                                             <> colon <+> quotes (ppr $4) }
+                               ; ams (sLL $1 (hsSigType $>) (DerivDecl $4 $3))
+                                     [mj AnnDeriving $1, mj AnnInstance $2] } }
 
 -----------------------------------------------------------------------------
 -- Role annotations
@@ -1164,93 +1150,100 @@ role : VARID             { sL1 $1 $ Just $ getVARID $1 }
 -- Glasgow extension: pattern synonyms
 pattern_synonym_decl :: { LHsDecl RdrName }
         : 'pattern' pattern_synonym_lhs '=' pat
-         {%ams ( let (name, args) = $2
-                 in sLL $1 $> . ValD $ mkPatSynBind name args $4
+         {%      let (name, args,as ) = $2 in
+                 ams (sLL $1 $> . ValD $ mkPatSynBind name args $4
                                                     ImplicitBidirectional)
-               [mj AnnPattern $1,mj AnnEqual $3]
+               (as ++ [mj AnnPattern $1, mj AnnEqual $3])
          }
+
         | 'pattern' pattern_synonym_lhs '<-' pat
-         {%ams (let (name, args) = $2
-                in sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
-               [mj AnnPattern $1,mj AnnLarrow $3] }
+         {%    let (name, args, as) = $2 in
+               ams (sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
+               (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
+
         | 'pattern' pattern_synonym_lhs '<-' pat where_decls
-            {% do { let (name, args) = $2
+            {% do { let (name, args, as) = $2
                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
                   ; ams (sLL $1 $> . ValD $
                            mkPatSynBind name args $4 (ExplicitBidirectional mg))
-                        (mj AnnPattern $1:mj AnnLarrow $3:(fst $ unLoc $5))
+                       (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
                    }}
 
-pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName)) }
-        : con vars0 { ($1, PrefixPatSyn $2) }
-        | varid consym varid { ($2, InfixPatSyn $1 $3) }
+pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) }
+        : con vars0 { ($1, PrefixPatSyn $2, []) }
+        | varid conop varid { ($2, InfixPatSyn $1 $3, []) }
+        | con '{' cvars1 '}' { ($1, RecordPatSyn $3, [moc $2, mcc $4] ) }
 
 vars0 :: { [Located RdrName] }
         : {- empty -}                 { [] }
         | varid vars0                 { $1 : $2 }
 
+cvars1 :: { [RecordPatSynField (Located RdrName)] }
+       : varid                        { [RecordPatSynField $1 $1] }
+       | varid ',' cvars1             {% addAnnotation (getLoc $1) AnnComma (getLoc $2) >>
+                                         return ((RecordPatSynField $1 $1) : $3 )}
+
 where_decls :: { Located ([AddAnn]
                          , Located (OrdList (LHsDecl RdrName))) }
         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
         | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
                                           ,sL1 $3 (snd $ unLoc $3)) }
+
 pattern_synonym_sig :: { LSig RdrName }
         : 'pattern' con '::' ptype
-            {% do { let (flag, qtvs, prov, req, ty) = snd $ unLoc $4
-                  ; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) prov req ty
-                  ; checkValidPatSynSig sig
-                  ; ams (sLL $1 $> $ sig)
-                        (mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } }
-
-ptype :: { Located ([AddAnn]
-                  ,( HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName
-                   , LHsContext RdrName, LHsType RdrName)) }
+                   {% ams (sLL $1 $> $ PatSynSig $2 (mkLHsSigType $4))
+                          [mj AnnPattern $1, mu AnnDcolon $3] }
+
+ptype   :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ptype
-            {% do { hintExplicitForall (getLoc $1)
-                  ; let (_, qtvs', prov, req, ty) = snd $ unLoc $4
-                  ; return $ sLL $1 $>
-                                ((mj AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
-                                ,(Explicit, $2 ++ qtvs', prov, req ,ty)) }}
+                   {% hintExplicitForall (getLoc $1) >>
+                      ams (sLL $1 $> $
+                           HsForAllTy { hst_bndrs = $2
+                                      , hst_body = $4 })
+                          [mu AnnForall $1, mj AnnDot $3] }
+
         | context '=>' context '=>' type
-            { sLL $1 $> ([mj AnnDarrow $2,mj AnnDarrow $4]
-                        ,(Implicit, [], $1, $3, $5)) }
+                   {% ams (sLL $1 $> $
+                           HsQualTy { hst_ctxt = $1, hst_body = sLL $3 $> $
+                           HsQualTy { hst_ctxt = $3, hst_body = $5 } })
+                           [mu AnnDarrow $2, mu AnnDarrow $4] }
         | context '=>' type
-            { sLL $1 $> ([mj AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
-        | type
-            { sL1 $1 ([],(Implicit, [], noLoc [], noLoc [], $1)) }
+                   {% ams (sLL $1 $> $
+                           HsQualTy { hst_ctxt = $1, hst_body = $3 })
+                           [mu AnnDarrow $2] }
+        | type     { $1 }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
 
 -- Declaration in class bodies
 --
-decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
-decl_cls  : at_decl_cls                 { sLL $1 $> (unitOL $1) }
+decl_cls  :: { LHsDecl RdrName }
+decl_cls  : at_decl_cls                 { $1 }
           | decl                        { $1 }
 
           -- A 'default' signature used with the generic-programming extension
           | 'default' infixexp '::' sigtypedoc
-                    {% do { (TypeSig l ty _) <- checkValSig $2 $4
+                    {% do { v <- checkValSigLhs $2
                           ; let err = text "in default signature" <> colon <+>
-                                      quotes (ppr ty)
-                          ; checkNoPartialType err ty
-                          ; ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (GenericSig l ty)))
-                                [mj AnnDefault $1,mj AnnDcolon $3] } }
+                                      quotes (ppr $2)
+                          ; ams (sLL $1 $> $ SigD $ ClassOpSig True [v] $ mkLHsSigType $4)
+                                [mj AnnDefault $1,mu AnnDcolon $3] } }
 
 decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }  -- Reversed
           : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
-                                                                    , unLoc $3))
+                                                                    , unitOL $3))
                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
                                            >> return (sLL $1 $> (fst $ unLoc $1
-                                                                ,(snd $ unLoc $1) `appOL` unLoc $3)) }
+                                                                ,(snd $ unLoc $1) `appOL` unitOL $3)) }
           | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
                                                                                    ,snd $ unLoc $1))
                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
                                            >> return (sLL $1 $>  (unLoc $1)) }
-          | decl_cls                    { sL1 $1 ([],unLoc $1) }
+          | decl_cls                    { sL1 $1 ([], unitOL $1) }
           | {- empty -}                 { noLoc ([],nilOL) }
 
 decllist_cls
@@ -1274,7 +1267,7 @@ where_cls :: { Located ([AddAnn]
 --
 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
 decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD (unLoc $1)))) }
-           | decl                       { $1 }
+           | decl                       { sLL $1 $> (unitOL $1) }
 
 decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }   -- Reversed
            : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
@@ -1313,10 +1306,10 @@ where_inst :: { Located ([AddAnn]
 decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
                                  then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
-                                                        , unLoc $3))
+                                                        , unitOL $3))
                                  else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
                                            >> return (
-                                          let { this = unLoc $3;
+                                          let { this = unitOL $3;
                                                 rest = snd $ unLoc $1;
                                                 these = rest `appOL` this }
                                           in rest `seq` this `seq` these `seq`
@@ -1326,38 +1319,38 @@ decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
                                                           ,snd $ unLoc $1)))
                                   else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
                                            >> return (sLL $1 $> (unLoc $1)) }
-        | decl                          { sL1 $1 ([],unLoc $1) }
+        | decl                          { sL1 $1 ([], unitOL $1) }
         | {- empty -}                   { noLoc ([],nilOL) }
 
-decllist :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
+decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl RdrName))) }
         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
-                                                   ,snd $ unLoc $2) }
-        |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,snd $ unLoc $2) }
+                                                   ,sL1 $2 $ snd $ unLoc $2) }
+        |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
 
 -- Binding groups other than those of class and instance declarations
 --
-binds   ::  { Located ([AddAnn],HsLocalBinds RdrName) }
+binds   ::  { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
                                          -- May have implicit parameters
                                                 -- No type declarations
-        : decllist          {% do { val_binds <- cvBindGroup (snd $ unLoc $1)
+        : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
                                   ; return (sL1 $1 (fst $ unLoc $1
-                                                    ,HsValBinds val_binds)) } }
+                                                    ,sL1 $1 $ HsValBinds val_binds)) } }
 
         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
-                                             ,HsIPBinds (IPBinds (unLoc $2)
+                                             ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2)
                                                          emptyTcEvBinds)) }
 
         |     vocurly    dbinds close   { L (getLoc $2) ([]
-                                            ,HsIPBinds (IPBinds (unLoc $2)
+                                            ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2)
                                                         emptyTcEvBinds)) }
 
 
-wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) }
+wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
                                                 -- May have implicit parameters
                                                 -- No type declarations
         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
                                              ,snd $ unLoc $2) }
-        | {- empty -}                   { noLoc ([],emptyLocalBinds) }
+        | {- empty -}                   { noLoc ([],noLoc emptyLocalBinds) }
 
 
 -----------------------------------------------------------------------------
@@ -1373,7 +1366,7 @@ rules   :: { OrdList (LRuleDecl RdrName) }
 
 rule    :: { LRuleDecl RdrName }
         : STRING rule_activation rule_forall infixexp '=' exp
-         {%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRING $1))
+         {%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRINGs $1,getSTRING $1))
                                   ((snd $2) `orElse` AlwaysActive)
                                   (snd $3) $4 placeHolderNames $6
                                   placeHolderNames))
@@ -1394,7 +1387,7 @@ rule_explicit_activation :: { ([AddAnn]
                                   ,NeverActive) }
 
 rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
-        : 'forall' rule_var_list '.'     { ([mj AnnForall $1,mj AnnDot $3],$2) }
+        : 'forall' rule_var_list '.'     { ([mu AnnForall $1,mj AnnDot $3],$2) }
         | {- empty -}                    { ([],[]) }
 
 rule_var_list :: { [LRuleBndr RdrName] }
@@ -1404,8 +1397,8 @@ rule_var_list :: { [LRuleBndr RdrName] }
 rule_var :: { LRuleBndr RdrName }
         : varid                         { sLL $1 $> (RuleBndr $1) }
         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleBndrSig $2
-                                                       (mkHsWithBndrs $4)))
-                                               [mop $1,mj AnnDcolon $3,mcp $5] }
+                                                       (mkLHsSigWcType $4)))
+                                               [mop $1,mu AnnDcolon $3,mcp $5] }
 
 -----------------------------------------------------------------------------
 -- Warnings and deprecations (c.f. rules)
@@ -1439,15 +1432,16 @@ deprecation :: { OrdList (LWarnDecl RdrName) }
              {% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc "") $ snd $ unLoc $2)))
                      (fst $ unLoc $2) }
 
-strings :: { Located ([AddAnn],[Located FastString]) }
-    : STRING { sL1 $1 ([],[L (gl $1) (getSTRING $1)]) }
+strings :: { Located ([AddAnn],[Located StringLiteral]) }
+    : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
 
-stringlist :: { Located (OrdList (Located FastString)) }
+stringlist :: { Located (OrdList (Located StringLiteral)) }
     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
                                return (sLL $1 $> (unLoc $1 `snocOL`
-                                                  (L (gl $3) (getSTRING $3)))) }
-    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getSTRING $1))) }
+                                                  (L (gl $3) (getStringLiteral $3)))) }
+    | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }
+    | {- empty -}           { noLoc nilOL }
 
 -----------------------------------------------------------------------------
 -- Annotations
@@ -1495,12 +1489,12 @@ safety :: { Located Safety }
         | 'interruptible'               { sLL $1 $> PlayInterruptible }
 
 fspec :: { Located ([AddAnn]
-                    ,(Located FastString, Located RdrName, LHsType RdrName)) }
-       : STRING var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $3]
+                    ,(Located StringLiteral, Located RdrName, LHsSigType RdrName)) }
+       : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
                                              ,(L (getLoc $1)
-                                                    (getSTRING $1), $2, $4)) }
-       |        var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $2]
-                                             ,(noLoc nilFS, $1, $3)) }
+                                                    (getStringLiteral $1), $2, mkLHsSigType $4)) }
+       |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
+                                             ,(noLoc (StringLiteral "" nilFS), $1, mkLHsSigType $3)) }
          -- if the entity string is missing, it defaults to the empty string;
          -- the meaning of an empty entity string depends on the calling
          -- convention
@@ -1508,22 +1502,20 @@ fspec :: { Located ([AddAnn]
 -----------------------------------------------------------------------------
 -- Type signatures
 
-opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
+opt_sig :: { ([AddAnn], Maybe (LHsType RdrName)) }
         : {- empty -}                   { ([],Nothing) }
-        | '::' sigtype                  { ([mj AnnDcolon $1],Just $2) }
+        | '::' sigtype                  { ([mu AnnDcolon $1],Just $2) }
 
 opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
         : {- empty -}                   { ([],Nothing) }
-        | '::' atype                    { ([mj AnnDcolon $1],Just $2) }
+        | '::' atype                    { ([mu AnnDcolon $1],Just $2) }
 
-sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
-                                        -- to tell the renamer where to generalise
-        : ctype                         { sL1 $1 (mkImplicitHsForAllTy (noLoc []) $1) }
-        -- Wrap an Implicit forall if there isn't one there already
+sigtype :: { LHsType RdrName }
+        : ctype                            { $1 }
+
+sigtypedoc :: { LHsType RdrName }
+        : ctypedoc                         { $1 }
 
-sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
-        : ctypedoc                      { sL1 $1 (mkImplicitHsForAllTy (noLoc []) $1) }
-        -- Wrap an Implicit forall if there isn't one there already
 
 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
@@ -1531,39 +1523,44 @@ sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
          | var                        { sL1 $1 [$1] }
 
-sigtypes1 :: { (OrdList (LHsType RdrName)) }      -- Always HsForAllTys
-        : sigtype                      { unitOL $1 }
-        | sigtype ',' sigtypes1        {% addAnnotation (gl $1) AnnComma (gl $2)
-                                          >> return ((unitOL $1) `appOL` $3) }
+sigtypes1 :: { (OrdList (LHsSigType RdrName)) }
+   : sigtype                 { unitOL (mkLHsSigType $1) }
+   | sigtype ',' sigtypes1   {% addAnnotation (gl $1) AnnComma (gl $2)
+                                >> return (unitOL (mkLHsSigType $1) `appOL` $3) }
 
 -----------------------------------------------------------------------------
 -- Types
 
-strict_mark :: { Located ([AddAnn],HsBang) }
-        : '!'                        { sL1 $1 ([mj AnnBang $1]
-                                              ,HsSrcBang Nothing                       Nothing      True) }
-        | '{-# UNPACK' '#-}'         { sLL $1 $> ([mo $1,mc $2]
-                                              ,HsSrcBang (Just $ getUNPACK_PRAGs $1)   (Just True)  False) }
-        | '{-# NOUNPACK' '#-}'       { sLL $1 $> ([mo $1,mc $2]
-                                              ,HsSrcBang (Just $ getNOUNPACK_PRAGs $1) (Just False) False) }
-        | '{-# UNPACK' '#-}' '!'     { sLL $1 $> ([mo $1,mc $2,mj AnnBang $3]
-                                              ,HsSrcBang (Just $ getUNPACK_PRAGs $1)   (Just True)  True) }
-        | '{-# NOUNPACK' '#-}' '!'   { sLL $1 $> ([mo $1,mc $2,mj AnnBang $3]
-                                              ,HsSrcBang (Just $ getNOUNPACK_PRAGs $1) (Just False) True) }
-        -- Although UNPACK with no '!' is illegal, we get a
-        -- better error message if we parse it here
+strict_mark :: { Located ([AddAnn],HsSrcBang) }
+        : strictness { sL1 $1 (let (a, str) = unLoc $1 in (a, HsSrcBang Nothing NoSrcUnpack str)) }
+        | unpackedness { sL1 $1 (let (a, prag, unpk) = unLoc $1 in (a, HsSrcBang prag unpk NoSrcStrict)) }
+        | unpackedness strictness { sLL $1 $> (let { (a, prag, unpk) = unLoc $1
+                                                   ; (a', str) = unLoc $2 }
+                                                in (a ++ a', HsSrcBang prag unpk str)) }
+        -- Although UNPACK with no '!' without StrictData and UNPACK with '~' are illegal,
+        -- we get a better error message if we parse them here
+
+strictness :: { Located ([AddAnn], SrcStrictness) }
+        : '!' { sL1 $1 ([mj AnnBang $1], SrcStrict) }
+        | '~' { sL1 $1 ([mj AnnTilde $1], SrcLazy) }
+
+unpackedness :: { Located ([AddAnn], Maybe SourceText, SrcUnpackedness) }
+        : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], Just $ getUNPACK_PRAGs $1, SrcUnpack) }
+        | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], Just $ getNOUNPACK_PRAGs $1, SrcNoUnpack) }
 
 -- A ctype is a for-all type
 ctype   :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
-                                           ams (sLL $1 $> $ mkExplicitHsForAllTy $2
-                                                                 (noLoc []) $4)
-                                               [mj AnnForall $1,mj AnnDot $3] }
-        | context '=>' ctype          {% addAnnotation (gl $1) AnnDarrow (gl $2)
+                                           ams (sLL $1 $> $
+                                                HsForAllTy { hst_bndrs = $2
+                                                           , hst_body = $4 })
+                                               [mu AnnForall $1, mj AnnDot $3] }
+        | context '=>' ctype          {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
                                          >> return (sLL $1 $> $
-                                               mkQualifiedHsForAllTy $1 $3) }
+                                            HsQualTy { hst_ctxt = $1
+                                                     , hst_body = $3 }) }
         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
-                                             [mj AnnVal $1,mj AnnDcolon $2] }
+                                             [mj AnnVal $1,mu AnnDcolon $2] }
         | type                        { $1 }
 
 ----------------------
@@ -1579,14 +1576,16 @@ ctype   :: { LHsType RdrName }
 
 ctypedoc :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
-                                            ams (sLL $1 $> $ mkExplicitHsForAllTy $2
-                                                                  (noLoc []) $4)
-                                                [mj AnnForall $1,mj AnnDot $3] }
-        | context '=>' ctypedoc       {% addAnnotation (gl $1) AnnDarrow (gl $2)
+                                            ams (sLL $1 $> $
+                                                 HsForAllTy { hst_bndrs = $2
+                                                            , hst_body = $4 })
+                                                [mu AnnForall $1,mj AnnDot $3] }
+        | context '=>' ctypedoc       {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
                                          >> return (sLL $1 $> $
-                                                  mkQualifiedHsForAllTy $1 $3) }
+                                            HsQualTy { hst_ctxt = $1
+                                                     , hst_body = $3 }) }
         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
-                                             [mj AnnDcolon $2] }
+                                             [mj AnnVal $1,mu AnnDcolon $2] }
         | typedoc                     { $1 }
 
 ----------------------
@@ -1600,61 +1599,89 @@ ctypedoc :: { LHsType RdrName }
 -- to permit an individual equational constraint without parenthesis.
 -- Thus for some reason we allow    f :: a~b => blah
 -- but not                          f :: ?x::Int => blah
+-- See Note [Parsing ~]
 context :: { LHsContext RdrName }
-        : btype '~'      btype          {% amms (checkContext
-                                             (sLL $1 $> $ HsEqTy $1 $3))
-                                             [mj AnnTilde $2] }
-        | btype                         {% do { ctx <- checkContext $1
-                                              ; if null (unLoc ctx)
-                                                 then addAnnotation (gl $1) AnnUnit (gl $1)
-                                                 else return ()
-                                              ; return ctx
-                                              } }
+        :  btype                        {% do { (anns,ctx) <- checkContext $1
+                                                ; if null (unLoc ctx)
+                                                   then addAnnotation (gl $1) AnnUnit (gl $1)
+                                                   else return ()
+                                                ; ams ctx anns
+                                                } }
+
+context_no_ops :: { LHsContext RdrName }
+        : btype_no_ops                 {% do { let { ty = splitTilde $1 }
+                                             ; (anns,ctx) <- checkContext ty
+                                             ; if null (unLoc ctx)
+                                                   then addAnnotation (gl ty) AnnUnit (gl ty)
+                                                   else return ()
+                                             ; ams ctx anns
+                                             } }
+
+{- Note [GADT decl discards annotations]
+~~~~~~~~~~~~~~~~~~~~~
+The type production for
+
+    btype `->` btype
+
+adds the AnnRarrow annotation twice, in different places.
+
+This is because if the type is processed as usual, it belongs on the annotations
+for the type as a whole.
+
+But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and
+the top-level annotation will be disconnected. Hence for this specific case it
+is connected to the first type too.
+-}
 
 type :: { LHsType RdrName }
-        : btype                         { $1 }
-        | btype qtyconop type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype tyvarop  type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype '->'     ctype          {% ams (sLL $1 $> $ HsFunTy $1 $3)
-                                               [mj AnnRarrow $2] }
-        | btype '~'      btype          {% ams (sLL $1 $> $ HsEqTy $1 $3)
-                                               [mj AnnTilde $2] }
-                                        -- see Note [Promotion]
-        | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
-                                                [mj AnnSimpleQuote $2] }
-        | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
-                                                [mj AnnSimpleQuote $2] }
+        : btype                        { $1 }
+        | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy $1 $3)
+                                              [mu AnnRarrow $2] }
+
 
 typedoc :: { LHsType RdrName }
         : btype                          { $1 }
         | btype docprev                  { sLL $1 $> $ HsDocTy $1 $2 }
-        | btype qtyconop type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype qtyconop type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
-        | btype tyvarop  type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype tyvarop  type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
         | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy $1 $3)
-                                                [mj AnnRarrow $2] }
-        | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $ HsFunTy (L (comb2 $1 $2)
-                                                            (HsDocTy $1 $2)) $4)
-                                                [mj AnnRarrow $3] }
-        | btype '~'      btype           {% ams (sLL $1 $> $ HsEqTy $1 $3)
-                                                [mj AnnTilde $2] }
-                                        -- see Note [Promotion]
-        | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
-                                                [mj AnnSimpleQuote $2] }
-        | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
-                                                [mj AnnSimpleQuote $2] }
+                                                [mu AnnRarrow $2] }
+        | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $
+                                                 HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2))
+                                                         $4)
+                                                [mu AnnRarrow $3] }
 
+-- See Note [Parsing ~]
 btype :: { LHsType RdrName }
-        : btype atype                   { sLL $1 $> $ HsAppTy $1 $2 }
+        : tyapps                      { sL1 $1 $ HsAppsTy (splitTildeApps (reverse (unLoc $1))) }
+
+-- Used for parsing Haskell98-style data constructors,
+-- in order to forbid the blasphemous
+-- > data Foo = Int :+ Char :* Bool
+-- See also Note [Parsing data constructors is hard].
+btype_no_ops :: { LHsType RdrName }
+        : btype_no_ops atype            { sLL $1 $> $ HsAppTy $1 $2 }
         | atype                         { $1 }
 
+tyapps :: { Located [HsAppType RdrName] }   -- NB: This list is reversed
+        : tyapp                         { sL1 $1 [unLoc $1] }
+        | tyapps tyapp                  { sLL $1 $> $ (unLoc $2) : (unLoc $1) }
+
+-- See Note [HsAppsTy] in HsTypes
+tyapp :: { Located (HsAppType RdrName) }
+        : atype                         { sL1 $1 $ HsAppPrefix $1 }
+        | qtyconop                      { sL1 $1 $ HsAppInfix $1 }
+        | tyvarop                       { sL1 $1 $ HsAppInfix $1 }
+        | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ HsAppInfix $2)
+                                               [mj AnnSimpleQuote $1] }
+        | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ HsAppInfix $2)
+                                               [mj AnnSimpleQuote $1] }
+
 atype :: { LHsType RdrName }
-        : ntgtycon                       { sL1 $1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
-        | tyvar                          {% do { nwc <- namedWildcardsEnabled -- (See Note [Unit tuples])
-                                               ; let tv@(Unqual name) = unLoc $1
+        : ntgtycon                       { sL1 $1 (HsTyVar $1) }      -- Not including unit tuples
+        | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
+                                               ; let tv@(L _ (Unqual name)) = $1
                                                ; return $ if (startsWithUnderscore name && nwc)
-                                                          then (sL1 $1 (HsNamedWildcardTy tv))
+                                                          then (sL1 $1 (mkNamedWildCardTy tv))
                                                           else (sL1 $1 (HsTyVar tv)) } }
 
         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
@@ -1679,14 +1706,15 @@ atype :: { LHsType RdrName }
         | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy  $2) [mo $1,mc $3] }
         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
-                                             [mop $1,mj AnnDcolon $3,mcp $5] }
+                                             [mop $1,mu AnnDcolon $3,mcp $5] }
         | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
-                                             [mo $1,mc $3] }
-        | TH_ID_SPLICE                { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
-                                        mkUnqual varName (getTH_ID_SPLICE $1) }
+                                             [mj AnnOpenPE $1,mj AnnCloseP $3] }
+        | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
+                                             (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
+                                             [mj AnnThIdSplice $1] }
                                       -- see Note [Promotion] for the followings
-        | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')'
                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
                                 ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
@@ -1694,7 +1722,7 @@ atype :: { LHsType RdrName }
         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy
                                                             placeHolderKind $3)
                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
-        | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar $ unLoc $2)
+        | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar $2)
                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
 
         -- Two or more [ty, ty, ty] must be a promoted list type, just as
@@ -1710,20 +1738,19 @@ atype :: { LHsType RdrName }
                                                                (getINTEGER $1) }
         | STRING               { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
                                                                (getSTRING  $1) }
-        | '_'                  { sL1 $1 $ HsWildcardTy }
+        | '_'                  { sL1 $1 $ mkAnonWildCardTy }
 
 -- An inst_type is what occurs in the head of an instance decl
 --      e.g.  (Foo a, Gaz b) => Wibble a b
--- It's kept as a single type, with a MonoDictTy at the right
--- hand corner, for convenience.
-inst_type :: { LHsType RdrName }
-        : sigtype                       { $1 }
+-- It's kept as a single type for convenience.
+inst_type :: { LHsSigType RdrName }
+        : sigtype                       { mkLHsSigType $1 }
 
-inst_types1 :: { [LHsType RdrName] }
-        : inst_type                     { [$1] }
+deriv_types :: { [LHsSigType RdrName] }
+        : type                          { [mkLHsSigType $1] }
 
-        | inst_type ',' inst_types1    {% addAnnotation (gl $1) AnnComma (gl $2)
-                                          >> return ($1 : $3) }
+        | type ',' deriv_types          {% addAnnotation (gl $1) AnnComma (gl $2)
+                                           >> return (mkLHsSigType $1 : $3) }
 
 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
         : comma_types1                  { $1 }
@@ -1739,9 +1766,9 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
          | {- empty -}                  { [] }
 
 tv_bndr :: { LHsTyVarBndr RdrName }
-        : tyvar                         { sL1 $1 (UserTyVar (unLoc $1)) }
+        : tyvar                         { sL1 $1 (UserTyVar $1) }
         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar $2 $4))
-                                               [mop $1,mj AnnDcolon $3
+                                               [mop $1,mu AnnDcolon $3
                                                ,mcp $5] }
 
 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
@@ -1757,46 +1784,34 @@ fds1 :: { Located [Located (FunDep (Located RdrName))] }
 fd :: { Located (FunDep (Located RdrName)) }
         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
                                        (reverse (unLoc $1), reverse (unLoc $3)))
-                                       [mj AnnRarrow $2] }
+                                       [mu AnnRarrow $2] }
 
 varids0 :: { Located [Located RdrName] }
         : {- empty -}                   { noLoc [] }
         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
 
+{-
+Note [Parsing ~]
+~~~~~~~~~~~~~~~~
+
+Due to parsing conflicts between lazyness annotations in data type
+declarations (see strict_mark) and equality types ~'s are always
+parsed as lazyness annotations, and turned into HsEqTy's in the
+correct places using RdrHsSyn.splitTilde.
+
+Since strict_mark is parsed as part of atype which is part of type,
+typedoc and context (where HsEqTy previously appeared) it made most
+sense and was simplest to parse ~ as part of strict_mark and later
+turn them into HsEqTy's.
+
+-}
+
+
 -----------------------------------------------------------------------------
 -- Kinds
 
 kind :: { LHsKind RdrName }
-        : bkind                  { $1 }
-        | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
-                                        [mj AnnRarrow $2] }
-
-bkind :: { LHsKind RdrName }
-        : akind                  { $1 }
-        | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
-
-akind :: { LHsKind RdrName }
-        : '*'                    { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
-        | '(' kind ')'           {% ams (sLL $1 $>  $ HsParTy $2)
-                                        [mop $1,mcp $3] }
-        | pkind                  { $1 }
-        | tyvar                  { sL1 $1 $ HsTyVar (unLoc $1) }
-
-pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
-        : qtycon                          { sL1 $1 $ HsTyVar $ unLoc $1 }
-        | '(' ')'                   {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon)
-                                           [mop $1,mcp $2] }
-        | '(' kind ',' comma_kinds1 ')'
-                          {% addAnnotation (gl $2) AnnComma (gl $3) >>
-                             ams (sLL $1 $> $ HsTupleTy HsBoxedTuple ( $2 : $4))
-                                 [mop $1,mcp $5] }
-        | '[' kind ']'                    {% ams (sLL $1 $> $ HsListTy $2)
-                                                 [mos $1,mcs $3] }
-
-comma_kinds1 :: { [LHsKind RdrName] }
-        : kind                         { [$1] }
-        | kind  ',' comma_kinds1       {% addAnnotation (gl $1) AnnComma (gl $2)
-                                          >> return ($1 : $3) }
+        : ctype                  { $1 }
 
 {- Note [Promotion]
    ~~~~~~~~~~~~~~~~
@@ -1809,12 +1824,6 @@ few reasons:
   2. if one day we merge types and kinds, tick would mean look in DataName
   3. we don't have a kind namespace anyway
 
-- Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
-Kind abstraction is implicit. We write
-> data SList (s :: k -> *) (as :: [k]) where ...
-because it looks like what we do in terms
-> id (x :: a) = x
-
 - Name resolution
 When the user write Zero instead of 'Zero in types, we parse it a
 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
@@ -1842,10 +1851,10 @@ gadt_constrlist :: { Located ([AddAnn]
         | {- empty -}                            { noLoc ([],[]) }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
-        : gadt_constr ';' gadt_constrs
+        : gadt_constr_with_doc ';' gadt_constrs
                   {% addAnnotation (gl $1) AnnSemi (gl $2)
                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
-        | gadt_constr                   { L (gl $1) [$1] }
+        | gadt_constr_with_doc          { L (gl $1) [$1] }
         | {- empty -}                   { noLoc [] }
 
 -- We allow the following forms:
@@ -1854,19 +1863,31 @@ gadt_constrs :: { Located [LConDecl RdrName] }
 --      D { x,y :: a } :: T a
 --      forall a. Eq a => D { x,y :: a } :: T a
 
+gadt_constr_with_doc :: { LConDecl RdrName }
+gadt_constr_with_doc
+        : maybe_docnext ';' gadt_constr
+                {% return $ addConDoc $3 $1 }
+        | gadt_constr
+                {% return $1 }
+
 gadt_constr :: { LConDecl RdrName }
-                   -- Returns a list because of:   C,D :: ty
+    -- see Note [Difference in parsing GADT and data constructors]
+    -- Returns a list because of:   C,D :: ty
         : con_list '::' sigtype
-                {% do { gadtDecl <- mkGadtDecl (unLoc $1) $3
-                      ; ams (sLL $1 $> $ gadtDecl)
-                            [mj AnnDcolon $2] } }
+                {% ams (sLL $1 $> (mkGadtDecl (unLoc $1) (mkLHsSigType $3)))
+                       [mu AnnDcolon $2] }
 
-                -- Deprecated syntax for GADT record declarations
-        | oqtycon '{' fielddecls '}' '::' sigtype
-                {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 (noLoc $3) $6
-                      ; cd' <- checkRecordSyntax cd
-                      ; ams (L (comb2 $1 $6) (unLoc cd'))
-                            [moc $2,mcc $4,mj AnnDcolon $5] } }
+{- Note [Difference in parsing GADT and data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GADT constructors have simpler syntax than usual data constructors:
+in GADTs, types cannot occur to the left of '::', so they cannot be mixed
+with constructor names (see Note [Parsing data constructors is hard]).
+
+Due to simplified syntax, GADT constructor names (left-hand side of '::')
+use simpler grammar production than usual data constructor names. As a
+consequence, GADT constructor names are resticted (names like '(*)' are
+allowed in usual data constructors, but not in GADTs).
+-}
 
 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
@@ -1879,33 +1900,39 @@ constrs1 :: { Located [LConDecl RdrName] }
         | constr                                          { sL1 $1 [$1] }
 
 constr :: { LConDecl RdrName }
-        : maybe_docnext forall context '=>' constr_stuff maybe_docprev
+        : maybe_docnext forall context_no_ops '=>' constr_stuff maybe_docprev
                 {% ams (let (con,details) = unLoc $5 in
-                  addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
+                  addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
                                                    (snd $ unLoc $2) $3 details))
                             ($1 `mplus` $6))
-                        (mj AnnDarrow $4:(fst $ unLoc $2)) }
+                        (mu AnnDarrow $4:(fst $ unLoc $2)) }
         | maybe_docnext forall constr_stuff maybe_docprev
                 {% ams ( let (con,details) = unLoc $3 in
-                  addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
+                  addConDoc (L (comb2 $2 $3) (mkConDeclH98 con
                                            (snd $ unLoc $2) (noLoc []) details))
                             ($1 `mplus` $4))
                        (fst $ unLoc $2) }
 
-forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
-        : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
-        | {- empty -}                 { noLoc ([],[]) }
+forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr RdrName]) }
+        : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
+        | {- empty -}                 { noLoc ([], Nothing) }
 
 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
--- We parse the constructor declaration
---      C t1 t2
--- as a btype (treating C as a type constructor) and then convert C to be
--- a data constructor.  Reason: it might continue like this:
---      C t1 t2 %: D Int
--- in which case C really would be a type constructor.  We can't resolve this
--- ambiguity till we come across the constructor oprerator :% (or not, more usually)
-        : btype                         {% splitCon $1 >>= return.sLL $1 $> }
-        | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
+    -- see Note [Parsing data constructors is hard]
+        : btype_no_ops                         {% do { c <- splitCon $1
+                                                     ; return $ sLL $1 $> c } }
+        | btype_no_ops conop btype_no_ops      {  sLL $1 $> ($2, InfixCon (splitTilde $1) $3) }
+
+{- Note [Parsing data constructors is hard]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We parse the constructor declaration
+     C t1 t2
+as a btype_no_ops (treating C as a type constructor) and then convert C to be
+a data constructor.  Reason: it might continue like this:
+     C t1 t2 :% D Int
+in which case C really would be a type constructor.  We can't resolve this
+ambiguity till we come across the constructor oprerator :% (or not, more usually)
+-}
 
 fielddecls :: { [LConDeclField RdrName] }
         : {- empty -}     { [] }
@@ -1921,24 +1948,26 @@ fielddecl :: { LConDeclField RdrName }
                                               -- A list because of   f,g :: Int
         : maybe_docnext sig_vars '::' ctype maybe_docprev
             {% ams (L (comb2 $2 $4)
-                      (ConDeclField (reverse (unLoc $2)) $4 ($1 `mplus` $5)))
-                   [mj AnnDcolon $3] }
-
--- We allow the odd-looking 'inst_type' in a deriving clause, so that
--- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
--- The 'C [a]' part is converted to an HsPredTy by checkInstType
--- We don't allow a context, but that's sorted out by the type checker.
-deriving :: { Located (Maybe (Located [LHsType RdrName])) }
+                      (ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
+                   [mu AnnDcolon $3] }
+
+-- The outer Located is just to allow the caller to
+-- know the rightmost extremity of the 'deriving' clause
+deriving :: { Located (HsDeriving RdrName) }
         : {- empty -}             { noLoc Nothing }
-        | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
-                                            in (sLL $1 $> (Just (sLL $1 $>
-                                                       [L loc (HsTyVar tv)]))))
-                                          [mj AnnDeriving $1] }
-        | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
-                                          [mj AnnDeriving $1,mop $2,mcp $3] }
-
-        | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
-                                                 [mj AnnDeriving $1,mop $2,mcp $4] }
+        | 'deriving' qtycon       {% let { L tv_loc tv = $2
+                                         ; full_loc = comb2 $1 $> }
+                                      in ams (L full_loc $ Just $ L full_loc $
+                                                 [mkLHsSigType (L tv_loc (HsTyVar $2))])
+                                             [mj AnnDeriving $1] }
+
+        | 'deriving' '(' ')'      {% let { full_loc = comb2 $1 $> }
+                                     in ams (L full_loc $ Just $ L full_loc [])
+                                            [mj AnnDeriving $1,mop $2,mcp $3] }
+
+        | 'deriving' '(' deriv_types ')'  {% let { full_loc = comb2 $1 $> }
+                                             in ams (L full_loc $ Just $ L full_loc $3)
+                                                    [mj AnnDeriving $1,mop $2,mcp $4] }
              -- Glasgow extension: allow partial
              -- applications in derivings
 
@@ -1976,14 +2005,14 @@ docdecld :: { LDocDecl }
         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
 
-decl_no_th :: { Located (OrdList (LHsDecl RdrName)) }
+decl_no_th :: { LHsDecl RdrName }
         : sigdecl               { $1 }
 
-        | '!' aexp rhs          {% do { let { e = sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2) };
+        | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) };
                                         pat <- checkPattern empty e;
                                         _ <- ams (sLL $1 $> ())
-                                               (mj AnnBang $1:(fst $ unLoc $3));
-                                        return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $
+                                               (fst $ unLoc $3);
+                                        return $ sLL $1 $> $ ValD $
                                             PatBind pat (snd $ unLoc $3)
                                                     placeHolderType
                                                     placeHolderNames
@@ -1994,21 +2023,22 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) }
         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
                                         let { l = comb2 $1 $> };
                                         case r of {
-                                          (FunBind n _ _ _ _ _) ->
+                                          (FunBind n _ _ _ _) ->
                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
-                                          _ -> return () } ;
-                                        _ <- ams (L l ()) (ann ++ (fst $2) ++ (fst $ unLoc $3));
-                                        return $! (sL l (unitOL $! (sL l $ ValD r))) } }
-        | pattern_synonym_decl  { sLL $1 $> $ unitOL $1 }
-        | docdecl               { sLL $1 $> $ unitOL $1 }
-
-decl    :: { Located (OrdList (LHsDecl RdrName)) }
+                                          (PatBind (L lh _lhs) _rhs _ _ _) ->
+                                                ams (L lh ()) (fst $2) >> return () } ;
+                                        _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
+                                        return $! (sL l $ ValD r) } }
+        | pattern_synonym_decl  { $1 }
+        | docdecl               { $1 }
+
+decl    :: { LHsDecl RdrName }
         : decl_no_th            { $1 }
 
         -- Why do we only allow naked declaration splices in top-level
         -- declarations and not here? Short answer: because readFail009
         -- fails terribly with a panic in cvBindsAndSigs otherwise.
-        | splice_exp            { sLL $1 $> $ unitOL (sLL $1 $> $ mkSpliceDecl $1) }
+        | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
 
 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
@@ -2027,32 +2057,32 @@ gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
                                          [mj AnnVbar $1,mj AnnEqual $3] }
 
-sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
+sigdecl :: { LHsDecl RdrName }
         :
         -- See Note [Declaration/signature overlap] for why we need infixexp here
           infixexp '::' sigtypedoc
-                        {% do ty <- checkPartialTypeSignature $3
-                        ; s <- checkValSig $1 ty
-                        ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
-                        ; return (sLL $1 $> $ unitOL (sLL $1 $> $ SigD s)) }
+                        {% do v <- checkValSigLhs $1
+                        ; _ <- ams (sLL $1 $> ()) [mu AnnDcolon $2]
+                        ; return (sLL $1 $> $ SigD $
+                                  TypeSig [v] (mkLHsSigWcType $3)) }
 
         | var ',' sig_vars '::' sigtypedoc
-           {% do { ty <- checkPartialTypeSignature $5
-                 ; let sig = TypeSig ($1 : reverse (unLoc $3)) ty PlaceHolder
+           {% do { let sig = TypeSig ($1 : reverse (unLoc $3))
+                                     (mkLHsSigWcType $5)
                  ; addAnnotation (gl $1) AnnComma (gl $2)
-                 ; ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD sig ])
-                       [mj AnnDcolon $4] } }
+                 ; ams ( sLL $1 $> $ SigD sig )
+                       [mu AnnDcolon $4] } }
 
         | infix prec ops
-              {% ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD
+              {% ams (sLL $1 $> $ SigD
                         (FixSig (FixitySig (fromOL $ unLoc $3)
-                                (Fixity (unLoc $2) (unLoc $1)))) ])
+                                (Fixity (unLoc $2) (unLoc $1)))))
                      [mj AnnInfix $1,mj AnnVal $2] }
 
-        | pattern_synonym_sig   { sLL $1 $> $ unitOL $ sLL $1 $> . SigD . unLoc $ $1 }
+        | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
 
         | '{-# INLINE' activation qvar '#-}'
-                {% ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (InlineSig $3
+                {% ams ((sLL $1 $> $ SigD (InlineSig $3
                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
                                             (snd $2)))))
                        ((mo $1:fst $2) ++ [mc $4]) }
@@ -2061,26 +2091,24 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
              {% ams (
                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
                                              (EmptyInlineSpec, FunLike) (snd $2)
-                  in sLL $1 $> $
-                            toOL [ sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag) ])
-                    (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
+                  in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
+                    (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
 
         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-             {% ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
+             {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
-                                               (getSPEC_INLINE $1) (snd $2))) ])
-                       (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
+                                               (getSPEC_INLINE $1) (snd $2))))
+                       (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
 
         | '{-# SPECIALISE' 'instance' inst_type '#-}'
-                {% ams (sLL $1 $> $ unitOL (sLL $1 $>
-                                  $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3)))
+                {% ams (sLL $1 $>
+                                  $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
                        [mo $1,mj AnnInstance $2,mc $4] }
 
-        -- AZ TODO: Do we need locations in the name_formula_opt?
         -- A minimal complete definition
         | '{-# MINIMAL' name_boolformula_opt '#-}'
-            {% ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) (snd $2))))
-                   (mo $1:mc $3:fst $2) }
+            {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) $2))
+                   [mo $1,mc $3] }
 
 activation :: { ([AddAnn],Maybe Activation) }
         : {- empty -}                           { ([],Nothing) }
@@ -2107,20 +2135,20 @@ quasiquote :: { Located (HsSplice RdrName) }
                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
 exp   :: { LHsExpr RdrName }
-        : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
-                                       [mj AnnDcolon $2] }
+        : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
+                                       [mu AnnDcolon $2] }
         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
                                                         HsFirstOrderApp True)
-                                       [mj Annlarrowtail $2] }
+                                       [mu Annlarrowtail $2] }
         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
                                                       HsFirstOrderApp False)
-                                       [mj Annrarrowtail $2] }
+                                       [mu Annrarrowtail $2] }
         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
                                                       HsHigherOrderApp True)
-                                       [mj AnnLarrowtail $2] }
+                                       [mu AnnLarrowtail $2] }
         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
                                                       HsHigherOrderApp False)
-                                       [mj AnnRarrowtail $2] }
+                                       [mu AnnRarrowtail $2] }
         | infixexp              { $1 }
 
 infixexp :: { LHsExpr RdrName }
@@ -2134,8 +2162,12 @@ infixexp :: { LHsExpr RdrName }
 exp10 :: { LHsExpr RdrName }
         : '\\' apat apats opt_asig '->' exp
                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
-                            [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
-                          (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
+                            [sLL $1 $> $ Match { m_fixity = NonFunBindMatch
+                                               , m_pats = $2:$3
+                                               , m_type = snd $4
+                                               , m_grhss = unguardedGRHSs $6 }]))
+                          (mj AnnLam $1:mu AnnRarrow $5:(fst $4)) }
+
         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
                                                (mj AnnLet $1:mj AnnIn $3
                                                  :(fst $ unLoc $2)) }
@@ -2181,59 +2213,28 @@ exp10 :: { LHsExpr RdrName }
                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
                                                 placeHolderType []))
                                             -- TODO: is LL right here?
-                               [mj AnnProc $1,mj AnnRarrow $3] }
+                               [mj AnnProc $1,mu AnnRarrow $3] }
 
-        | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getSTRING $2) $4)
+        | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
                                               [mo $1,mj AnnVal $2
                                               ,mc $3] }
                                           -- hdaume: core annotation
         | fexp                         { $1 }
 
-        -- parsing error messages go below here
-        | '\\' apat apats opt_asig '->' error        {% parseErrorSDoc (combineLocs $1 $5) $ text
-                                                        "parse error in lambda: no expression after '->'"
-                                                     }
-        | '\\' error                                 {% parseErrorSDoc (getLoc $1) $ text
-                                                        "parse error: naked lambda expression '\'"
-                                                     }
-        | 'let' binds 'in' error                     {% parseErrorSDoc (combineLocs $1 $2) $ text
-                                                        "parse error in let binding: missing expression after 'in'"
-                                                     }
-        | 'let' binds error                          {% parseErrorSDoc (combineLocs $1 $2) $ text
-                                                        "parse error in let binding: missing required 'in'"
-                                                     }
-        | 'let' error                                {% parseErrorSDoc (getLoc $1) $ text
-                                                        "parse error: naked let binding"
-                                                     }
-        | 'if' exp optSemi 'then' exp optSemi
-          'else' error                               {% hintIf (combineLocs $1 $5) "else clause empty" }
-        | 'if' exp optSemi 'then' exp optSemi error  {% hintIf (combineLocs $1 $5) "missing required else clause" }
-        | 'if' exp optSemi 'then' error              {% hintIf (combineLocs $1 $2) "then clause empty" }
-        | 'if' exp optSemi error                     {% hintIf (combineLocs $1 $2) "missing required then and else clauses" }
-        | 'if' error                                 {% hintIf (getLoc $1) "naked if statement" }
-        | 'case' exp 'of' error                      {% parseErrorSDoc (combineLocs $1 $2) $ text
-                                                        "parse error in case statement: missing list after '->'"
-                                                     }
-        | 'case' exp error                           {% parseErrorSDoc (combineLocs $1 $2) $ text
-                                                        "parse error in case statement: missing required 'of'"
-                                                     }
-        | 'case' error                               {% parseErrorSDoc (getLoc $1) $ text
-                                                        "parse error: naked case statement"
-                                                     }
 optSemi :: { ([Located a],Bool) }
         : ';'         { ([$1],True) }
         | {- empty -} { ([],False) }
 
-scc_annot :: { Located (([AddAnn],SourceText),FastString) }
+scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
                                             ; return $ sLL $1 $>
                                                (([mo $1,mj AnnValStr $2
-                                                ,mc $3],getSCC_PRAGs $1),scc) }
+                                                ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
                                          ,mc $3],getSCC_PRAGs $1)
-                                        ,(getVARID $2)) }
+                                        ,(StringLiteral (unpackFS $ getVARID $2) (getVARID $2))) }
 
-hpc_annot :: { Located (([AddAnn],SourceText),(FastString,(Int,Int),(Int,Int))) }
+hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))) }
       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
                                       { sLL $1 $> $ (([mo $1,mj AnnVal $2
                                               ,mj AnnVal $3,mj AnnColon $4
@@ -2241,7 +2242,7 @@ hpc_annot :: { Located (([AddAnn],SourceText),(FastString,(Int,Int),(Int,Int)))
                                               ,mj AnnVal $7,mj AnnColon $8
                                               ,mj AnnVal $9,mc $10],
                                                 getGENERATED_PRAGs $1)
-                                              ,(getSTRING $2
+                                              ,((getStringLiteral $2)
                                                ,( fromInteger $ getINTEGER $3
                                                 , fromInteger $ getINTEGER $5
                                                 )
@@ -2270,8 +2271,10 @@ aexp1   :: { LHsExpr RdrName }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr RdrName }
-        : ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
-        | qcname                        { sL1 $1 (HsVar   $! unLoc $1) }
+        : qvar                          { sL1 $1 (HsVar   $! $1) }
+        | qcon                          { sL1 $1 (HsVar   $! $1) }
+        | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
+        | overloaded_label              { sL1 $1 (HsOverLabel $! unLoc $1) }
         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
@@ -2305,14 +2308,13 @@ aexp2   :: { LHsExpr RdrName }
 
         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
-        | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThIdSplice $1,mj AnnName $2] }
-        | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThIdSplice $1,mj AnnName $2] }
-        | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
-        | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
-        | '[t|' ctype '|]'    {% checkNoPartialType
-                                   (text "in type brackets" <> colon
-                                    <+> quotes (text "[t|" <+> ppr $2 <+> text "|]")) $2 >>
-                                 ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
+        | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2))
+                                      (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
+        | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
+                                      (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
+        | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
                                       ams (sLL $1 $> $ HsBracket (PatBr p))
                                           [mo $1,mc $3] }
@@ -2327,15 +2329,17 @@ aexp2   :: { LHsExpr RdrName }
 
 splice_exp :: { LHsExpr RdrName }
         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE
-                                        (sL1 $1 $ HsVar (mkUnqual varName
-                                                        (getTH_ID_SPLICE $1))))
+                                        (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
+                                                           (getTH_ID_SPLICE $1)))))
                                        [mj AnnThIdSplice $1] }
-        | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2) [mo $1,mc $3] }
+        | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2)
+                                       [mj AnnOpenPE $1,mj AnnCloseP $3] }
         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE
-                                        (sL1 $1 $ HsVar (mkUnqual varName
-                                                     (getTH_ID_TY_SPLICE $1))))
+                                        (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
+                                                        (getTH_ID_TY_SPLICE $1)))))
                                        [mj AnnThIdTySplice $1] }
-        | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mo $1,mc $3] }
+        | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2)
+                                       [mj AnnOpenPTE $1,mj AnnCloseP $3] }
 
 cmdargs :: { [LHsCmdTop RdrName] }
         : cmdargs acmd                  { $2 : $1 }
@@ -2379,39 +2383,33 @@ texp :: { LHsExpr RdrName }
         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
 
        -- View patterns get parenthesized above
-        | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
+        | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
 
 -- Always at least one comma
 tup_exprs :: { [LHsTupArg RdrName] }
            : texp commas_tup_tail
                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
-                                ; return ((L (gl $1) (Present $1)) : snd $2) } }
+                                ; return ((sL1 $1 (Present $1)) : snd $2) } }
 
            | commas tup_tail
-                {% do { mapM_ (\ll -> addAnnotation (gl ll) AnnComma (gl ll)) $2
+                {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
                       ; return
-                           (let tt = if null $2
-                                       then [noLoc missingTupArg]
-                                       else $2
-                            in map (\l -> L l missingTupArg) (fst $1) ++ tt) } }
+                           (map (\l -> L l missingTupArg) (fst $1) ++ $2) } }
 
 -- Always starts with commas; always follows an expr
 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
 commas_tup_tail : commas tup_tail
        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
              ; return (
-         let tt = if null $2
-                    then [L (last $ fst $1) missingTupArg]
-                    else $2
-         in (head $ fst $1
-            ,(map (\l -> L l missingTupArg) (init $ fst $1)) ++ tt)) } }
+            (head $ fst $1
+            ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
 
 -- Always follows a comma
 tup_tail :: { [LHsTupArg RdrName] }
           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
                                     return ((L (gl $1) (Present $1)) : snd $2) }
           | texp                 { [L (gl $1) (Present $1)] }
-          | {- empty -}          { [] {- [noLoc missingTupArg] -} }
+          | {- empty -}          { [noLoc missingTupArg] }
 
 -----------------------------------------------------------------------------
 -- List expressions
@@ -2463,14 +2461,14 @@ flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
 
 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
     : squals '|' pquals
-                     {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >>
+                     {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
 
 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
                                         -- one can "grab" the earlier ones
     : squals ',' transformqual
-             {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >>
+             {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
     | squals ',' qual
@@ -2569,9 +2567,11 @@ alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
         | alt                   { sL1 $1 ([],[$1]) }
 
 alt     :: { LMatch RdrName (LHsExpr RdrName) }
-        : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
-                                                              (snd $ unLoc $3)))
-                                         ((fst $2) ++ (fst $ unLoc $3))}
+        : pat opt_asig alt_rhs  {%ams (sLL $1 $> (Match { m_fixity = NonFunBindMatch
+                                                        , m_pats = [$1]
+                                                        , m_type = snd $2
+                                                        , m_grhss = snd $ unLoc $3 }))
+                                      (fst $2 ++ (fst $ unLoc $3))}
 
 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
@@ -2579,7 +2579,7 @@ alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
 
 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
-                                     [mj AnnRarrow $1] }
+                                     [mu AnnRarrow $1] }
         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
 
 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
@@ -2604,7 +2604,7 @@ ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
         : '|' guardquals '->' exp
                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
-                                         [mj AnnVbar $1,mj AnnRarrow $3] }
+                                         [mj AnnVbar $1,mu AnnRarrow $3] }
 
 -- 'pat' recognises a pattern, including one with a bang at the top
 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
@@ -2613,7 +2613,7 @@ gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
 pat     :: { LPat RdrName }
 pat     :  exp          {% checkPattern empty $1 }
         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
-                                                     (sL1 $1 (HsVar bang_RDR)) $2)))
+                                                     (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
                                 [mj AnnBang $1] }
 
 bindpat :: { LPat RdrName }
@@ -2621,14 +2621,14 @@ bindpat :  exp            {% checkPattern
                                 (text "Possibly caused by a missing 'do'?") $1 }
         | '!' aexp        {% amms (checkPattern
                                      (text "Possibly caused by a missing 'do'?")
-                                     (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
+                                     (sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
                                   [mj AnnBang $1] }
 
 apat   :: { LPat RdrName }
 apat    : aexp                  {% checkPattern empty $1 }
         | '!' aexp              {% amms (checkPattern empty
                                             (sLL $1 $> (SectionR
-                                                (sL1 $1 (HsVar bang_RDR)) $2)))
+                                                (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
                                         [mj AnnBang $1] }
 
 apats  :: { [LPat RdrName] }
@@ -2649,7 +2649,6 @@ stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
 -- here, because we need too much lookahead if we see do { e ; }
 -- So we use BodyStmts throughout, and switch the last one over
 -- in ParseUtils.checkDo instead
--- AZ: TODO check that we can retrieve multiple semis.
 
 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
         : stmts ';' stmt  {% if null (snd $ unLoc $1)
@@ -2682,7 +2681,7 @@ stmt  :: { LStmt RdrName (LHsExpr RdrName) }
 
 qual  :: { LStmt RdrName (LHsExpr RdrName) }
     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
-                                               [mj AnnLarrow $2] }
+                                               [mu AnnLarrow $2] }
     | exp                               { sL1 $1 $ mkBodyStmt $1 }
     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
                                                (mj AnnLet $1:(fst $ unLoc $2)) }
@@ -2702,13 +2701,13 @@ fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
 
 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
-        : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
+        : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) $3 False)
                                 [mj AnnEqual $2] }
                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
                         -- and, incidentaly, sections.  Eg
                         -- f (R { x = show -> s }) = ...
 
-        | qvar          { sLL $1 $> $ HsRecField $1 placeHolderPunRhs True }
+        | qvar          { sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) placeHolderPunRhs True }
                         -- In the punning case, use a place-holder
                         -- The renamer fills in the final value
 
@@ -2733,26 +2732,32 @@ ipvar   :: { Located HsIPName }
         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
 
 -----------------------------------------------------------------------------
+-- Overloaded labels
+
+overloaded_label :: { Located FastString }
+        : LABELVARID          { sL1 $1 (getLABELVARID $1) }
+
+-----------------------------------------------------------------------------
 -- Warnings and deprecations
 
-name_boolformula_opt :: { ([AddAnn],BooleanFormula (Located RdrName)) }
+name_boolformula_opt :: { LBooleanFormula (Located RdrName) }
         : name_boolformula          { $1 }
-        | {- empty -}               { ([],mkTrue) }
+        | {- empty -}               { noLoc mkTrue }
 
-name_boolformula :: { ([AddAnn],BooleanFormula (Located RdrName)) }
+name_boolformula :: { LBooleanFormula (Located RdrName) }
         : name_boolformula_and                      { $1 }
         | name_boolformula_and '|' name_boolformula
-                                             { ((mj AnnVbar $2:fst $1)++(fst $3)
-                                                ,mkOr [snd $1,snd $3]) }
+                           {% aa $1 (AnnVbar, $2)
+                              >> return (sLL $1 $> (Or [$1,$3])) }
 
-name_boolformula_and :: { ([AddAnn],BooleanFormula (Located RdrName)) }
+name_boolformula_and :: { LBooleanFormula (Located RdrName) }
         : name_boolformula_atom                             { $1 }
         | name_boolformula_atom ',' name_boolformula_and
-                  { ((mj AnnComma $2:fst $1)++(fst $3), mkAnd [snd $1,snd $3]) }
+                  {% aa $1 (AnnComma,$2) >> return (sLL $1 $> (And [$1,$3])) }
 
-name_boolformula_atom :: { ([AddAnn],BooleanFormula (Located RdrName)) }
-        : '(' name_boolformula ')'  { ([mop $1,mcp $3],snd $2) }
-        | name_var                  { ([],mkVar $1) }
+name_boolformula_atom :: { LBooleanFormula (Located RdrName) }
+        : '(' name_boolformula ')'  {% ams (sLL $1 $> (Parens $2)) [mop $1,mcp $3] }
+        | name_var                  { sL1 $1 (Var $1) }
 
 namelist :: { Located [Located RdrName] }
 namelist : name_var              { sL1 $1 [$1] }
@@ -2796,10 +2801,10 @@ con_list : con                  { sL1 $1 [$1] }
 
 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
-        | '(' commas ')'        {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1))
+        | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1))
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
 
 sysdcon :: { Located DataCon }
@@ -2833,14 +2838,14 @@ gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tu
 
 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
         : oqtycon               { $1 }
-        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple
+        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
                                                         (snd $2 + 1)))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
                                                         (snd $2 + 1)))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
-                                       [mop $1,mj AnnRarrow $2,mcp $3] }
+                                       [mop $1,mu AnnRarrow $2,mcp $3] }
         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
@@ -2854,6 +2859,33 @@ oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
                                                [mop $1,mj AnnTilde $2,mcp $3] }
 
+oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
+                                          -- for variable constructor in export lists
+                                          -- see Note [Type constructors in export list]
+        :  qtycon            { $1 }
+        | '(' QCONSYM ')'    {% let name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2)
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+        | '(' CONSYM ')'     {% let name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2)
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+        | '(' ':' ')'        {% let name = sL1 $2 $! consDataCon_RDR
+                                in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
+        | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
+
+{- Note [Type constructors in export list]
+~~~~~~~~~~~~~~~~~~~~~
+Mixing type constructors and variable constructors in export lists introduces
+ambiguity in grammar: e.g. (*) may be both a type constructor and a function.
+
+-XExplicitNamespaces allows to disambiguate by explicitly prefixing type
+constructors with 'type' keyword.
+
+This ambiguity causes reduce/reduce conflicts in parser, which are always
+resolved in favour of variable constructors. To get rid of conflicts we demand
+that ambigous type constructors (those, which are formed by the same
+productions as variable constructors) are always prefixed with 'type' keyword.
+Unambigous type constructors may occur both with or without 'type' keyword.
+-}
+
 qtyconop :: { Located RdrName } -- Qualified or unqualified
         : qtyconsym                     { $1 }
         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
@@ -2862,7 +2894,6 @@ qtyconop :: { Located RdrName } -- Qualified or unqualified
 
 qtycon :: { Located RdrName }   -- Qualified or unqualified
         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
-        | PREFIXQCONSYM     { sL1 $1 $! mkQual tcClsName (getPREFIXQCONSYM $1) }
         | tycon             { $1 }
 
 tycon   :: { Located RdrName }  -- Unqualified
@@ -2879,7 +2910,6 @@ tyconsym :: { Located RdrName }
         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
         | ':'                   { sL1 $1 $! consDataCon_RDR }
-        | '*'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
 
 
@@ -2897,12 +2927,12 @@ varop   :: { Located RdrName }
                                        ,mj AnnBackquote $3] }
 
 qop     :: { LHsExpr RdrName }   -- used in sections
-        : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
-        | qconop                { sL1 $1 $ HsVar (unLoc $1) }
+        : qvarop                { sL1 $1 $ HsVar $1 }
+        | qconop                { sL1 $1 $ HsVar $1 }
 
 qopm    :: { LHsExpr RdrName }   -- used in sections
-        : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
-        | qconop                { sL1 $1 $ HsVar (unLoc $1) }
+        : qvaropm               { sL1 $1 $ HsVar $1 }
+        | qconop                { sL1 $1 $ HsVar $1 }
 
 qvarop :: { Located RdrName }
         : qvarsym               { $1 }
@@ -2960,11 +2990,11 @@ qvar    :: { Located RdrName }
 qvarid :: { Located RdrName }
         : varid               { $1 }
         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
-        | PREFIXQVARSYM       { sL1 $1 $! mkQual varName (getPREFIXQVARSYM $1) }
 
 -- Note that 'role' and 'family' get lexed separately regardless of
 -- the use of extensions. However, because they are listed here, this
 -- is OK and they can be used as normal varids.
+-- See Note [Lexing type pseudo-keywords] in Lexer.x
 varid :: { Located RdrName }
         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
@@ -3017,7 +3047,6 @@ special_id
 special_sym :: { Located FastString }
 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
             | '.'       { sL1 $1 (fsLit ".") }
-            | '*'       { sL1 $1 (fsLit "*") }
 
 -----------------------------------------------------------------------------
 -- Data constructors
@@ -3025,7 +3054,6 @@ special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
 qconid :: { Located RdrName }   -- Qualified or unqualified
         : conid              { $1 }
         | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
-        | PREFIXQCONSYM      { sL1 $1 $! mkQual dataName (getPREFIXQCONSYM $1) }
 
 conid   :: { Located RdrName }
         : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
@@ -3124,9 +3152,8 @@ getQVARID       (L _ (ITqvarid   x)) = x
 getQCONID       (L _ (ITqconid   x)) = x
 getQVARSYM      (L _ (ITqvarsym  x)) = x
 getQCONSYM      (L _ (ITqconsym  x)) = x
-getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
-getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
+getLABELVARID   (L _ (ITlabelvarid   x)) = x
 getCHAR         (L _ (ITchar   _ x)) = x
 getSTRING       (L _ (ITstring _ x)) = x
 getINTEGER      (L _ (ITinteger _ x)) = x
@@ -3180,6 +3207,25 @@ getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
 getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
 getCTYPEs             (L _ (ITctype             src)) = src
 
+getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
+
+isUnicode :: Located Token -> Bool
+isUnicode (L _ (ITforall     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdarrow     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdcolon     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrow     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow     iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax
+isUnicode _                       = False
+
+hasE :: Located Token -> Bool
+hasE (L _ (ITopenExpQuote HasE))  = True
+hasE (L _ (ITopenTExpQuote HasE)) = True
+hasE _                            = False
 
 getSCC :: Located Token -> P FastString
 getSCC lt = do let s = getSTRING lt
@@ -3211,12 +3257,15 @@ sL span a = span `seq` a `seq` L span a
 
 -- replaced last 3 CPP macros in this file
 {-# INLINE sL0 #-}
+sL0 :: a -> Located a
 sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
 
 {-# INLINE sL1 #-}
+sL1 :: Located a -> b -> Located b
 sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sLL #-}
+sLL :: Located a -> Located b -> c -> Located c
 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {- Note [Adding location info]
@@ -3267,14 +3316,14 @@ fileSrcSpan = do
 -- Hint about the MultiWayIf extension
 hintMultiWayIf :: SrcSpan -> P ()
 hintMultiWayIf span = do
-  mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState
+  mwiEnabled <- liftM ((LangExt.MultiWayIf `xopt`) . dflags) getPState
   unless mwiEnabled $ parseErrorSDoc span $
     text "Multi-way if-expressions need MultiWayIf turned on"
 
 -- Hint about if usage for beginners
 hintIf :: SrcSpan -> String -> P (LHsExpr RdrName)
 hintIf span msg = do
-  mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState
+  mwiEnabled <- liftM ((LangExt.MultiWayIf `xopt`) . dflags) getPState
   if mwiEnabled
     then parseErrorSDoc span $ text $ "parse error in if statement"
     else parseErrorSDoc span $ text $ "parse error in if statement: "++msg
@@ -3290,8 +3339,8 @@ hintExplicitForall span = do
       , text "extension to enable explicit-forall syntax: \x2200 <tvs>. <type>"
       ]
 
-namedWildcardsEnabled :: P Bool
-namedWildcardsEnabled = liftM ((Opt_NamedWildCards `xopt`) . dflags) getPState
+namedWildCardsEnabled :: P Bool
+namedWildCardsEnabled = liftM ((LangExt.NamedWildCards `xopt`) . dflags) getPState
 
 {-
 %************************************************************************
@@ -3305,11 +3354,24 @@ in ApiAnnotation.hs
 
 -}
 
+addAnnsAt :: SrcSpan -> [AddAnn] -> P ()
+addAnnsAt loc anns = mapM_ (\a -> a loc) anns
+
 -- |Construct an AddAnn from the annotation keyword and the location
--- of the keyword
+-- of the keyword itself
 mj :: AnnKeywordId -> Located e -> AddAnn
-mj a l = (\s -> addAnnotation s a (gl l))
+mj a l s = addAnnotation s a (gl l)
 
+-- |Construct an AddAnn from the annotation keyword and the Located Token. If
+-- the token has a unicode equivalent and this has been used, provide the
+-- unicode variant of the annotation.
+mu :: AnnKeywordId -> Located Token -> AddAnn
+mu a lt@(L l t) = (\s -> addAnnotation s (toUnicodeAnn a lt) l)
+
+-- | If the 'Token' is using its unicode variant return the unicode variant of
+--   the annotation
+toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
+toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
 
 gl = getLoc
 
@@ -3327,35 +3389,41 @@ am a (b,s) = do
 
 -- |Add a list of AddAnns to the given AST element
 ams :: Located a -> [AddAnn] -> P (Located a)
-ams a@(L l _) bs = mapM_ (\a -> a l) bs >> return a
+ams a@(L l _) bs = addAnnsAt l bs >> return a
+
+-- |Add all [AddAnn] to an AST element wrapped in a Just
+aljs :: Located (Maybe a) -> [AddAnn] -> P (Located (Maybe a))
+aljs a@(L l _) bs = addAnnsAt l bs >> return a
 
+-- |Add all [AddAnn] to an AST element wrapped in a Just
+ajs a@(Just (L l _)) bs = addAnnsAt l bs >> return a
 
 -- |Add a list of AddAnns to the given AST element, where the AST element is the
 --  result of a monadic action
 amms :: P (Located a) -> [AddAnn] -> P (Located a)
-amms a bs = do
-  av@(L l _) <- a
-  (mapM_ (\a -> a l) bs) >> return av
+amms a bs = do { av@(L l _) <- a
+               ; addAnnsAt l bs
+               ; return av }
 
 -- |Add a list of AddAnns to the AST element, and return the element as a
 --  OrdList
 amsu :: Located a -> [AddAnn] -> P (OrdList (Located a))
-amsu a@(L l _) bs = (mapM_ (\a -> a l) bs) >> return (unitOL a)
+amsu a@(L l _) bs = addAnnsAt l bs >> return (unitOL a)
 
 -- |Synonyms for AddAnn versions of AnnOpen and AnnClose
-mo,mc :: Located Token -> SrcSpan -> P ()
+mo,mc :: Located Token -> AddAnn
 mo ll = mj AnnOpen ll
 mc ll = mj AnnClose ll
 
-moc,mcc :: Located Token -> SrcSpan -> P ()
+moc,mcc :: Located Token -> AddAnn
 moc ll = mj AnnOpenC ll
 mcc ll = mj AnnCloseC ll
 
-mop,mcp :: Located Token -> SrcSpan -> P ()
+mop,mcp :: Located Token -> AddAnn
 mop ll = mj AnnOpenP ll
 mcp ll = mj AnnCloseP ll
 
-mos,mcs :: Located Token -> SrcSpan -> P ()
+mos,mcs :: Located Token -> AddAnn
 mos ll = mj AnnOpenS ll
 mcs ll = mj AnnCloseS ll
 
@@ -3364,19 +3432,6 @@ mcs ll = mj AnnCloseS ll
 mcommas :: [SrcSpan] -> [AddAnn]
 mcommas ss = map (\s -> mj AnnCommaTuple (L s ())) ss
 
--- |Add the annotation to an AST element wrapped in a Just
-ajl :: Located (Maybe (Located a)) -> AnnKeywordId -> SrcSpan
- -> P (Located (Maybe (Located a)))
-ajl a@(L _ (Just (L l _))) b s = addAnnotation l b s >> return a
-
--- |Add all [AddAnn] to an AST element wrapped in a Just
-aljs :: Located (Maybe (Located a)) -> [AddAnn]
-  -> P (Located (Maybe (Located a)))
-aljs a@(L _ (Just (L l _))) bs = (mapM_ (\a -> a l) bs) >> return a
-
--- |Add all [AddAnn] to an AST element wrapped in a Just
-ajs a@(Just (L l _)) bs = (mapM_ (\a -> a l) bs) >> return a
-
 -- |Get the location of the last element of a OrdList, or noSrcSpan
 oll :: OrdList (Located a) -> SrcSpan
 oll l =
@@ -3388,5 +3443,4 @@ oll l =
 asl :: [Located a] -> Located b -> Located a -> P()
 asl [] (L ls _) (L l _) = addAnnotation l          AnnSemi ls
 asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
-
 }