Expose enabled language extensions to TH
[ghc.git] / compiler / parser / Parser.y
index 7b40574..6606e3f 100644 (file)
@@ -59,7 +59,7 @@ import BasicTypes
 
 -- compiler/types
 import Type             ( funTyCon )
-import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
+import Kind             ( Kind )
 import Class            ( FunDep )
 
 -- compiler/parser
@@ -73,20 +73,22 @@ import TcEvidence       ( emptyTcEvBinds )
 
 -- compiler/prelude
 import ForeignCall
-import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
+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: 31 Jul 2015
+{- Last updated: 18 Nov 2015
 
-Conflicts: 47 shift/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:
@@ -127,35 +129,26 @@ state 46 contains 2 shift/reduce conflicts.
 
 -------------------------------------------------------------------------------
 
-state 50 contains 11 shift/reduce conflicts.
+state 50 contains 1 shift/reduce conflict.
 
-        context -> btype .                                  (rule 282)
-    *** type -> btype .                                     (rule 283)
-        type -> btype . qtyconop type                       (rule 284)
-        type -> btype . tyvarop type                        (rule 285)
-        type -> btype . '->' ctype                          (rule 286)
-        type -> btype . SIMPLEQUOTE qconop type             (rule 287)
-        type -> btype . SIMPLEQUOTE varop type              (rule 288)
-        btype -> btype . atype                              (rule 299)
+        context -> btype .                                  (rule 295)
+    *** type -> btype .                                     (rule 297)
+        type -> btype . '->' ctype                          (rule 298)
 
-    Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
+    Conflicts: '->'
 
-Example of ambiguity: 'e :: a `b` c';  does this mean
-    (e::a) `b` c, or
-    (e :: (a `b` c))
+-------------------------------------------------------------------------------
+
+state 51 contains 9 shift/reduce conflicts.
+
+    *** btype -> tyapps .                                   (rule 303)
+        tyapps -> tyapps . tyapp                            (rule 307)
 
-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 ...
+    Conflicts: ':' '-' '!' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
 
 -------------------------------------------------------------------------------
 
-state 119 contains 15 shift/reduce conflicts.
+state 132 contains 14 shift/reduce conflicts.
 
         exp -> infixexp . '::' sigtype                      (rule 416)
         exp -> infixexp . '-<' exp                          (rule 417)
@@ -165,7 +158,7 @@ state 119 contains 15 shift/reduce conflicts.
     *** exp -> infixexp .                                   (rule 421)
         infixexp -> infixexp . qop exp10                    (rule 423)
 
-    Conflicts: ':' '::' '-' '!' '*' '-<' '>-' '-<<' '>>-'
+    Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-'
                '.' '`' VARSYM CONSYM QVARSYM QCONSYM
 
 Examples of ambiguity:
@@ -180,7 +173,7 @@ Shift parses as (per longest-parse rule):
 
 -------------------------------------------------------------------------------
 
-state 279 contains 1 shift/reduce conflicts.
+state 292 contains 1 shift/reduce conflicts.
 
         rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 215)
 
@@ -198,23 +191,18 @@ a rule instructing how to rewrite the expression '[0] f'.
 
 -------------------------------------------------------------------------------
 
-state 288 contains 11 shift/reduce conflicts.
+state 301 contains 1 shift/reduce conflict.
 
-    *** type -> btype .                                     (rule 283)
-        type -> btype . qtyconop type                       (rule 284)
-        type -> btype . tyvarop type                        (rule 285)
-        type -> btype . '->' ctype                          (rule 286)
-        type -> btype . SIMPLEQUOTE qconop type             (rule 287)
-        type -> btype . SIMPLEQUOTE varop type              (rule 288)
-        btype -> btype . atype                              (rule 299)
+    *** type -> btype .                                     (rule 297)
+        type -> btype . '->' ctype                          (rule 298)
 
-    Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
+    Conflict: '->'
 
-Same as State 50, but minus the context productions.
+Same as state 50 but without contexts.
 
 -------------------------------------------------------------------------------
 
-state 324 contains 1 shift/reduce conflicts.
+state 337 contains 1 shift/reduce conflicts.
 
         tup_exprs -> commas . tup_tail                      (rule 505)
         sysdcon_nolist -> '(' commas . ')'                  (rule 616)
@@ -229,7 +217,7 @@ if -XTupleSections is not specified.
 
 -------------------------------------------------------------------------------
 
-state 376 contains 1 shift/reduce conflicts.
+state 388 contains 1 shift/reduce conflicts.
 
         tup_exprs -> commas . tup_tail                      (rule 505)
         sysdcon_nolist -> '(#' commas . '#)'                (rule 618)
@@ -241,20 +229,18 @@ Same as State 324 for unboxed tuples.
 
 -------------------------------------------------------------------------------
 
-state 404 contains 1 shift/reduce conflicts.
+state 460 contains 1 shift/reduce conflict.
 
-        exp10 -> 'let' binds . 'in' exp                     (rule 425)
-        exp10 -> 'let' binds . 'in' error                   (rule 440)
-        exp10 -> 'let' binds . error                        (rule 441)
-    *** qual -> 'let' binds .                               (rule 579)
+        oqtycon -> '(' qtyconsym . ')'                      (rule 621)
+    *** qtyconop -> qtyconsym .                             (rule 628)
 
-    Conflict: error
+    Conflict: ')'
 
 TODO: Why?
 
 -------------------------------------------------------------------------------
 
-state 633 contains 1 shift/reduce conflicts.
+state 635 contains 1 shift/reduce conflicts.
 
     *** aexp2 -> ipvar .                                    (rule 466)
         dbind -> ipvar . '=' exp                            (rule 590)
@@ -269,7 +255,7 @@ sensible meaning, namely the lhs of an implicit binding.
 
 -------------------------------------------------------------------------------
 
-state 699 contains 1 shift/reduce conflicts.
+state 702 contains 1 shift/reduce conflicts.
 
         rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 215)
 
@@ -286,7 +272,7 @@ doesn't include 'forall'.
 
 -------------------------------------------------------------------------------
 
-state 950 contains 1 shift/reduce conflicts.
+state 930 contains 1 shift/reduce conflicts.
 
         transformqual -> 'then' 'group' . 'using' exp       (rule 528)
         transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 529)
@@ -294,6 +280,16 @@ state 950 contains 1 shift/reduce conflicts.
 
     Conflict: 'by'
 
+-------------------------------------------------------------------------------
+
+state 1270 contains 1 shift/reduce conflict.
+
+    *** atype -> tyvar .                                    (rule 314)
+        tv_bndr -> '(' tyvar . '::' kind ')'                (rule 346)
+
+    Conflict: '::'
+
+TODO: Why?
 
 -------------------------------------------------------------------------------
 -- API Annotations
@@ -413,7 +409,6 @@ output it generates.
  '=>'           { L _ (ITdarrow _) }
  '-'            { L _ ITminus }
  '!'            { L _ ITbang }
- '*'            { L _ (ITstar _) }
  '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
  '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
  '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
@@ -900,10 +895,11 @@ 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 }
-             ; 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
@@ -1122,11 +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)
-                               ; 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
@@ -1160,10 +1155,12 @@ pattern_synonym_decl :: { LHsDecl RdrName }
                                                     ImplicitBidirectional)
                (as ++ [mj AnnPattern $1, mj AnnEqual $3])
          }
+
         | 'pattern' pattern_synonym_lhs '<-' pat
          {%    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, as) = $2
                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
@@ -1192,29 +1189,30 @@ where_decls :: { Located ([AddAnn]
                                            :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, req, prov, ty) = snd $ unLoc $4
-                  ; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) req prov ty
-                  ; ams (sLL $1 $> $ sig)
-                        (mj AnnPattern $1:mu 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 $>
-                                ((mu 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 $> ([mu AnnDarrow $2,mu 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 $> ([mu 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
@@ -1227,10 +1225,10 @@ decl_cls  : at_decl_cls                 { $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)
-                          ; ams (sLL $1 $> $ SigD (GenericSig l ty))
+                                      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
@@ -1399,7 +1397,7 @@ rule_var_list :: { [LRuleBndr RdrName] }
 rule_var :: { LRuleBndr RdrName }
         : varid                         { sLL $1 $> (RuleBndr $1) }
         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleBndrSig $2
-                                                       (mkHsWithBndrs $4)))
+                                                       (mkLHsSigWcType $4)))
                                                [mop $1,mu AnnDcolon $3,mcp $5] }
 
 -----------------------------------------------------------------------------
@@ -1491,12 +1489,12 @@ safety :: { Located Safety }
         | 'interruptible'               { sLL $1 $> PlayInterruptible }
 
 fspec :: { Located ([AddAnn]
-                    ,(Located StringLiteral, Located RdrName, LHsType RdrName)) }
+                    ,(Located StringLiteral, Located RdrName, LHsSigType RdrName)) }
        : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
                                              ,(L (getLoc $1)
-                                                    (getStringLiteral $1), $2, $4)) }
+                                                    (getStringLiteral $1), $2, mkLHsSigType $4)) }
        |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
-                                             ,(noLoc (StringLiteral "" nilFS), $1, $3)) }
+                                             ,(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
@@ -1504,7 +1502,7 @@ fspec :: { Located ([AddAnn]
 -----------------------------------------------------------------------------
 -- Type signatures
 
-opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
+opt_sig :: { ([AddAnn], Maybe (LHsType RdrName)) }
         : {- empty -}                   { ([],Nothing) }
         | '::' sigtype                  { ([mu AnnDcolon $1],Just $2) }
 
@@ -1512,14 +1510,12 @@ opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
         : {- empty -}                   { ([],Nothing) }
         | '::' atype                    { ([mu AnnDcolon $1],Just $2) }
 
-sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
-                                        -- to tell the renamer where to generalise
-        : ctype                         { sL1 $1 (mkImplicitHsForAllTy $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 $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)
@@ -1527,10 +1523,10 @@ 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
@@ -1555,12 +1551,14 @@ unpackedness :: { Located ([AddAnn], Maybe SourceText, SrcUnpackedness) }
 -- A ctype is a for-all type
 ctype   :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
-                                           ams (sLL $1 $> $ mkExplicitHsForAllTy $2
-                                                                 (noLoc []) $4)
-                                               [mu AnnForall $1,mj AnnDot $3] }
+                                           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,mu AnnDcolon $2] }
         | type                        { $1 }
@@ -1578,12 +1576,14 @@ ctype   :: { LHsType RdrName }
 
 ctypedoc :: { LHsType RdrName }
         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
-                                            ams (sLL $1 $> $ mkExplicitHsForAllTy $2
-                                                                  (noLoc []) $4)
+                                            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 AnnVal $1,mu AnnDcolon $2] }
         | typedoc                     { $1 }
@@ -1601,50 +1601,85 @@ ctypedoc :: { LHsType RdrName }
 -- but not                          f :: ?x::Int => blah
 -- See Note [Parsing ~]
 context :: { LHsContext RdrName }
-        :  btype                        {% do { (anns,ctx) <- checkContext (splitTilde $1)
+        :  btype                        {% do { (anns,ctx) <- checkContext $1
                                                 ; if null (unLoc ctx)
                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
                                                    else return ()
                                                 ; ams ctx anns
                                                 } }
--- See Note [Parsing ~]
+
+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                         { splitTilde $1 }
-        | btype qtyconop type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype tyvarop  type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
-        | btype '->'     ctype          {% ams $1 [mu AnnRarrow $2]
-                                        >> ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
-                                               [mu AnnRarrow $2] }
-        | 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] }
--- See Note [Parsing ~]
+        : 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                          { splitTilde $1 }
-        | btype docprev                  { sLL $1 $> $ HsDocTy (splitTilde $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 (splitTilde $1) $3)
+        : btype                          { $1 }
+        | btype docprev                  { sLL $1 $> $ HsDocTy $1 $2 }
+        | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy $1 $3)
                                                 [mu AnnRarrow $2] }
-        | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $ HsFunTy (L (comb2 (splitTilde $1) $2)
-                                                            (HsDocTy $1 $2)) $4)
+        | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $
+                                                 HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2))
+                                                         $4)
                                                 [mu AnnRarrow $3] }
-        | 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] }
 
+-- 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
+        : ntgtycon                       { sL1 $1 (HsTyVar $1) }      -- Not including unit tuples
         | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
-                                               ; let tv@(Unqual name) = unLoc $1
+                                               ; let tv@(L _ (Unqual name)) = $1
                                                ; return $ if (startsWithUnderscore name && nwc)
                                                           then (sL1 $1 (mkNamedWildCardTy tv))
                                                           else (sL1 $1 (HsTyVar tv)) } }
@@ -1676,10 +1711,10 @@ atype :: { LHsType RdrName }
         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
         | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
-                                             mkUnqual varName (getTH_ID_SPLICE $1))
+                                             (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))
@@ -1687,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
@@ -1707,16 +1742,15 @@ atype :: { LHsType RdrName }
 
 -- 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 }
@@ -1732,7 +1766,7 @@ 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,mu AnnDcolon $3
                                                ,mcp $5] }
@@ -1777,37 +1811,7 @@ turn them into HsEqTy's.
 -- Kinds
 
 kind :: { LHsKind RdrName }
-        : bkind                  { $1 }
-        | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
-                                        [mu AnnRarrow $2] }
-
-bkind :: { LHsKind RdrName }
-        : akind                  { $1 }
-        | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
-
-akind :: { LHsKind RdrName }
-        : '*'                    {% ams (sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName))
-                                        [mu AnnStar $1] }
-        | '(' 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]
    ~~~~~~~~~~~~~~~~
@@ -1820,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
@@ -1876,9 +1874,8 @@ gadt_constr :: { LConDecl RdrName }
     -- see Note [Difference in parsing GADT and data constructors]
     -- Returns a list because of:   C,D :: ty
         : con_list '::' sigtype
-                {% do { let { (anns, gadtDecl) = mkGadtDecl (unLoc $1) $3 }
-                      ; ams (sLL $1 $> gadtDecl)
-                            (mu AnnDcolon $2:anns) } }
+                {% ams (sLL $1 $> (mkGadtDecl (unLoc $1) (mkLHsSigType $3)))
+                       [mu AnnDcolon $2] }
 
 {- Note [Difference in parsing GADT and data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1903,35 +1900,36 @@ 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))
                         (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 $> ([mu 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) }
     -- see Note [Parsing data constructors is hard]
-        : btype                         {% splitCon $1 >>= return.sLL $1 $> }
-        | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
+        : 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 (treating C as a type constructor) and then convert C to be
+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
+     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)
 -}
@@ -1953,21 +1951,23 @@ fielddecl :: { LConDeclField RdrName }
                       (ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
                    [mu 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])) }
+-- 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
 
@@ -2008,7 +2008,7 @@ docdecld :: { LDocDecl }
 decl_no_th :: { LHsDecl RdrName }
         : sigdecl               { $1 }
 
-        | '!' aexp rhs          {% do { let { e = sLL $1 $2 (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 $> ())
                                                (fst $ unLoc $3);
@@ -2061,12 +2061,14 @@ sigdecl :: { LHsDecl RdrName }
         :
         -- See Note [Declaration/signature overlap] for why we need infixexp here
           infixexp '::' sigtypedoc
-                        {% do s <- checkValSig $1 $3
+                        {% do v <- checkValSigLhs $1
                         ; _ <- ams (sLL $1 $> ()) [mu AnnDcolon $2]
-                        ; return (sLL $1 $> $ SigD s) }
+                        ; return (sLL $1 $> $ SigD $
+                                  TypeSig [v] (mkLHsSigWcType $3)) }
 
         | var ',' sig_vars '::' sigtypedoc
-           {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
+           {% do { let sig = TypeSig ($1 : reverse (unLoc $3))
+                                     (mkLHsSigWcType $5)
                  ; addAnnotation (gl $1) AnnComma (gl $2)
                  ; ams ( sLL $1 $> $ SigD sig )
                        [mu AnnDcolon $4] } }
@@ -2133,7 +2135,7 @@ 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)
+        : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
                                        [mu AnnDcolon $2] }
         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
                                                         HsFirstOrderApp True)
@@ -2160,8 +2162,12 @@ infixexp :: { LHsExpr RdrName }
 exp10 :: { LHsExpr RdrName }
         : '\\' apat apats opt_asig '->' exp
                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
-                            [sLL $1 $> $ Match NonFunBindMatch ($2:$3) (snd $4) (unguardedGRHSs $6)]))
+                            [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)) }
@@ -2265,8 +2271,8 @@ aexp1   :: { LHsExpr RdrName }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr RdrName }
-        : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
-        | qcon                          { 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) }
@@ -2323,14 +2329,14 @@ 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)
                                        [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)
                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
@@ -2561,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 NonFunBindMatch [$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,
@@ -2605,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 }
@@ -2613,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] }
@@ -2641,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)
@@ -2903,8 +2910,6 @@ tyconsym :: { Located RdrName }
         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
         | ':'                   { sL1 $1 $! consDataCon_RDR }
-        | '*'                   {% ams (sL1 $1 $! mkUnqual tcClsName (fsLit "*"))
-                                       [mu AnnStar $1] }
         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
 
 
@@ -2922,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 }
@@ -3042,7 +3047,6 @@ special_id
 special_sym :: { Located FastString }
 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
             | '.'       { sL1 $1 (fsLit ".") }
-            | '*'       {% ams (sL1 $1 (fsLit "*")) [mu AnnStar $1] }
 
 -----------------------------------------------------------------------------
 -- Data constructors
@@ -3212,7 +3216,6 @@ 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 _ (ITstar       iu)) = iu == UnicodeSyntax
 isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax
 isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax
 isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
@@ -3313,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
@@ -3337,7 +3340,7 @@ hintExplicitForall span = do
       ]
 
 namedWildCardsEnabled :: P Bool
-namedWildCardsEnabled = liftM ((Opt_NamedWildCards `xopt`) . dflags) getPState
+namedWildCardsEnabled = liftM ((LangExt.NamedWildCards `xopt`) . dflags) getPState
 
 {-
 %************************************************************************
@@ -3351,10 +3354,13 @@ 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
@@ -3383,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
 
@@ -3420,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 =