Merge branch 'master' into type-nats
[ghc.git] / compiler / parser / Parser.y.pp
index d5314e4..d45e380 100644 (file)
@@ -8,7 +8,8 @@
 -- ---------------------------------------------------------------------------
 
 {
-{-# OPTIONS -Wwarn #-}
+{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
+{-# OPTIONS -Wwarn -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
@@ -40,18 +41,15 @@ import ForeignCall  ( Safety(..), CExportSpec(..), CLabelString,
                        )
 import OccName         ( varName, dataName, tcClsName, tvName )
 import DataCon         ( DataCon, dataConName )
-import SrcLoc          ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
-                         SrcSpan, combineLocs, srcLocFile, 
-                         mkSrcLoc, mkSrcSpan )
+import SrcLoc
 import Module
 import StaticFlags     ( opt_SccProfilingOn, opt_Hpc )
-import Type            ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
-import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-                         Activation(..), RuleMatchInfo(..), defaultInlineSpec )
+import Type            ( Kind, liftedTypeKind, unliftedTypeKind )
+import Coercion                ( mkArrowKind )
+import Class           ( FunDep )
+import BasicTypes
 import DynFlags
 import OrdList
-import HaddockParse
-import {-# SOURCE #-} HaddockLex hiding ( Token )
 import HaddockUtils
 
 import FastString
@@ -240,33 +238,36 @@ incorrect.
  'label'       { L _ ITlabel } 
  'dynamic'     { L _ ITdynamic }
  'safe'                { L _ ITsafe }
- 'threadsafe'  { L _ ITthreadsafe }
+ 'threadsafe'  { L _ ITthreadsafe }  -- ToDo: remove deprecated alias
+ 'interruptible' { L _ ITinterruptible }
  'unsafe'      { L _ ITunsafe }
  'mdo'         { L _ ITmdo }
  'family'      { L _ ITfamily }
  'stdcall'      { L _ ITstdcallconv }
  'ccall'        { L _ ITccallconv }
- 'dotnet'       { L _ ITdotnet }
+ 'prim'         { L _ ITprimcallconv }
  'proc'                { L _ ITproc }          -- for arrow notation extension
  'rec'         { L _ ITrec }           -- for arrow notation extension
  'group'    { L _ ITgroup }     -- for list transform extension
  'by'       { L _ ITby }        -- for list transform extension
  'using'    { L _ ITusing }     -- for list transform extension
 
- '{-# INLINE'            { L _ (ITinline_prag _) }
- '{-# INLINE_CONLIKE'     { L _ (ITinline_conlike_prag _) }
- '{-# SPECIALISE'        { L _ ITspec_prag }
+ '{-# INLINE'             { L _ (ITinline_prag _ _) }
+ '{-# SPECIALISE'         { L _ ITspec_prag }
  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
- '{-# SOURCE'     { L _ ITsource_prag }
- '{-# RULES'      { L _ ITrules_prag }
- '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
- '{-# SCC'        { L _ ITscc_prag }
- '{-# GENERATED'   { L _ ITgenerated_prag }
- '{-# DEPRECATED'  { L _ ITdeprecated_prag }
- '{-# WARNING'  { L _ ITwarning_prag }
- '{-# UNPACK'      { L _ ITunpack_prag }
- '{-# ANN'      { L _ ITann_prag }
- '#-}'            { L _ ITclose_prag }
+ '{-# SOURCE'                                  { L _ ITsource_prag }
+ '{-# RULES'                                   { L _ ITrules_prag }
+ '{-# CORE'                                    { L _ ITcore_prag }              -- hdaume: annotated core
+ '{-# SCC'                { L _ ITscc_prag }
+ '{-# GENERATED'          { L _ ITgenerated_prag }
+ '{-# DEPRECATED'         { L _ ITdeprecated_prag }
+ '{-# WARNING'            { L _ ITwarning_prag }
+ '{-# UNPACK'             { L _ ITunpack_prag }
+ '{-# ANN'                { L _ ITann_prag }
+ '{-# VECTORISE'          { L _ ITvect_prag }
+ '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
+ '{-# NOVECTORISE'        { L _ ITnovect_prag }
+ '#-}'                                         { L _ ITclose_prag }
 
  '..'          { L _ ITdotdot }                        -- reserved symbols
  ':'           { L _ ITcolon }
@@ -381,25 +382,25 @@ identifier :: { Located RdrName }
 
 module         :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
-               {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
-                  return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
-                          info doc) )}}
+               {% fileSrcSpan >>= \ loc ->
+                  return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
+                          ) )}
         | body2
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing
-                          (fst $1) (snd $1) Nothing emptyHaddockModInfo
-                          Nothing)) }
+                          (fst $1) (snd $1) Nothing Nothing
+                          )) }
 
-maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
+maybedocheader :: { Maybe LHsDocString }
         : moduleheader            { $1 }
-        | {- empty -}             { (emptyHaddockModInfo, Nothing) }
+        | {- empty -}             { Nothing }
 
 missing_module_keyword :: { () }
        : {- empty -}                           {% pushCurrentContext }
 
 maybemodwarning :: { Maybe WarningTxt }
-    : '{-# DEPRECATED' STRING '#-}' { Just (DeprecatedTxt (getSTRING $2)) }
-    | '{-# WARNING' STRING '#-}'    { Just (WarningTxt (getSTRING $2)) }
+    : '{-# DEPRECATED' strings '#-}' { Just (DeprecatedTxt $ unLoc $2) }
+    | '{-# WARNING' strings '#-}'    { Just (WarningTxt $ unLoc $2) }
     |  {- empty -}                  { Nothing }
 
 body   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
@@ -423,13 +424,13 @@ cvtopdecls :: { [LHsDecl RdrName] }
 
 header         :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
-               {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
-                  return (L loc (HsModule (Just $3) $5 $7 [] $4
-                   info doc))}}
+               {% fileSrcSpan >>= \ loc ->
+                  return (L loc (HsModule (Just $3) $5 $7 [] $4 $1
+                          ))}
        | missing_module_keyword importdecls
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing $2 [] Nothing
-                   emptyHaddockModInfo Nothing)) }
+                          Nothing)) }
 
 header_body :: { [LImportDecl RdrName] }
        :  '{'            importdecls           { $2 }
@@ -447,8 +448,8 @@ exportlist :: { [LIE RdrName] }
        | exportlist1                           { $1 }
 
 exportlist1 :: { [LIE RdrName] }
-        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 : $3) ++ $5 }
-       | expdoclist export expdoclist                 { $1 ++ ($2 : $3) }
+        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 ++ $3) ++ $5 }
+       | expdoclist export expdoclist                 { $1 ++ ($2 ++ $3) }
        | expdoclist                                   { $1 }
 
 expdoclist :: { [LIE RdrName] }
@@ -460,15 +461,22 @@ exp_doc :: { LIE RdrName }
         | docnamed      { L1 (IEDocNamed ((fst . unLoc) $1)) } 
         | docnext       { L1 (IEDoc (unLoc $1)) }       
                        
-   -- No longer allow things like [] and (,,,) to be exported
+   -- NOTE 1: No longer allow things like [] and (,,,) to be exported
    -- They are built in syntax, always available
-export         :: { LIE RdrName }
-       :  qvar                         { L1 (IEVar (unLoc $1)) }
-       |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
-       |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
-       |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
-       |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
-       |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
+   -- NOTE 2: There is a lot of overlap between value and type names,
+   -- so, in the general case, we parse everything as values,
+   -- and post-process the declaration to determine what is being exported.
+export         :: { [LIE RdrName] }
+       : qcname opt_subordinates { [L (comb3 $1 $1 $2)
+                                       (mkExportSpec (unLoc $1) (unLoc $2))] }
+        | 'type' oqtycons1        { map (fmap IEThingAbs) $2 }
+       | 'module' modid          { [LL (IEModuleContents (unLoc $2))] }
+
+opt_subordinates :: { Located (Maybe Subordinates) }
+        : {- empty -}             { L0 Nothing }
+        | '(' '..' ')'            { LL (Just SubordinateAll) }
+        | '(' ')'                { LL (Just (SubordinateList [])) }
+        | '(' qcnames ')'         { LL (Just (SubordinateList (reverse $2))) }
 
 qcnames :: { [RdrName] }
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
@@ -499,13 +507,17 @@ importdecls :: { [LImportDecl RdrName] }
        | {- empty -}                           { [] }
 
 importdecl :: { LImportDecl RdrName }
-       : 'import' maybe_src optqualified maybe_pkg modid maybeas maybeimpspec 
-               { L (comb4 $1 $5 $6 $7) (ImportDecl $5 $4 $2 $3 (unLoc $6) (unLoc $7)) }
+       : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec 
+               { L (comb4 $1 $6 $7 $8) (ImportDecl $6 $5 $2 $3 $4 (unLoc $7) (unLoc $8)) }
 
 maybe_src :: { IsBootInterface }
        : '{-# SOURCE' '#-}'                    { True }
        | {- empty -}                           { False }
 
+maybe_safe :: { Bool }
+       : 'safe'                                { True }
+       | {- empty -}                           { False }
+
 maybe_pkg :: { Maybe FastString }
         : STRING                                { Just (getSTRING $1) }
         | {- empty -}                           { Nothing }
@@ -546,44 +558,39 @@ ops       :: { Located [Located RdrName] }
 -- Top-Level Declarations
 
 topdecls :: { OrdList (LHsDecl RdrName) }
-        : topdecls ';' topdecl                 { $1 `appOL` $3 }
-        | topdecls ';'                         { $1 }
-       | topdecl                               { $1 }
+        : topdecls ';' topdecl                  { $1 `appOL` $3 }
+        | topdecls ';'                          { $1 }
+        | topdecl                               { $1 }
 
 topdecl :: { OrdList (LHsDecl RdrName) }
-       : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
-       | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
-       | 'instance' inst_type where_inst
-           { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
-             in 
-             unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
+        : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
+        | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
+        | 'instance' inst_type where_inst
+            { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
+              in 
+              unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
-       | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
-       | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
-    | '{-# DEPRECATED' deprecations '#-}' { $2 }
-    | '{-# WARNING' warnings '#-}'        { $2 }
-       | '{-# RULES' rules '#-}'               { $2 }
-       | annotation { unitOL $1 }
-       | decl                                  { unLoc $1 }
-
-       -- Template Haskell Extension
-       | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
-       | TH_ID_SPLICE                          { unitOL (LL $ SpliceD (SpliceDecl $
-                                                       L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
-                                                 )) }
+        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
+        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
+        | '{-# DEPRECATED' deprecations '#-}'   { $2 }
+        | '{-# WARNING' warnings '#-}'          { $2 }
+        | '{-# RULES' rules '#-}'               { $2 }
+        | '{-# VECTORISE_SCALAR' qvar '#-}'     { unitOL $ LL $ VectD (HsVect   $2 Nothing) }
+        | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect   $2 (Just $4)) }
+        | '{-# NOVECTORISE' qvar '#-}'                         { unitOL $ LL $ VectD (HsNoVect $2) }
+        | annotation { unitOL $1 }
+        | decl                                  { unLoc $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 (LL $ mkTopSpliceDecl $1) } 
 
 -- Type classes
 --
 cl_decl :: { LTyClDecl RdrName }
-       : 'class' tycl_hdr fds where_cls
-               {% do { let { (binds, sigs, ats, docs)           = 
-                               cvBindsAndSigs (unLoc $4)
-                           ; (ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; checkTyVars tparms      -- only type vars allowed
-                     ; checkKindSigs ats
-                     ; return $ L (comb4 $1 $2 $3 $4) 
-                                  (mkClassDecl (ctxt, tc, tvs) 
-                                               (unLoc $3) sigs binds ats docs) } }
+       : 'class' tycl_hdr fds where_cls        {% mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 $4 }
 
 -- Type declarations (toplevel)
 --
@@ -597,87 +604,53 @@ ty_decl :: { LTyClDecl RdrName }
                --
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared 
-               {% do { (tc, tvs, _) <- checkSynHdr $2 False
-                     ; return (L (comb2 $1 $4) 
-                                 (TySynonym tc tvs Nothing $4))
-                      } }
+               {% mkTySynonym (comb2 $1 $4) False $2 $4 }
 
            -- type family declarations
         | 'type' 'family' type opt_kind_sig 
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
-               --
-               {% do { (tc, tvs, _) <- checkSynHdr $3 False
-                     ; return (L (comb3 $1 $3 $4) 
-                                 (TyFamily TypeFamily tc tvs (unLoc $4)))
-                     } }
+               {% mkTyFamily (comb3 $1 $3 $4) TypeFamily $3 (unLoc $4) }
 
            -- type instance declarations
         | 'type' 'instance' type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
-               --
-               {% do { (tc, tvs, typats) <- checkSynHdr $3 True
-                     ; return (L (comb2 $1 $5) 
-                                 (TySynonym tc tvs (Just typats) $5)) 
-                      } }
+               {% mkTySynonym (comb2 $1 $5) True $3 $5 }
 
           -- ordinary data type or newtype declaration
        | data_or_newtype tycl_hdr constrs deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; checkTyVars tparms    -- no type pattern
-                     ; return $!
-                         sL (comb4 $1 $2 $3 $4)
+               {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) False $2 
+                            Nothing (reverse (unLoc $3)) (unLoc $4) }
                                   -- We need the location on tycl_hdr in case 
                                   -- constrs and deriving are both empty
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) 
-                              Nothing (reverse (unLoc $3)) (unLoc $4)) } }
 
           -- ordinary GADT declaration
         | data_or_newtype tycl_hdr opt_kind_sig 
-                'where' gadt_constrlist
+                gadt_constrlist
                 deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; checkTyVars tparms    -- can have type pats
-                     ; return $!
-                         sL (comb4 $1 $2 $4 $5)
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) 
-                             (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
+               {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) False $2 
+                            (unLoc $3) (unLoc $4) (unLoc $5) }
+                                  -- We need the location on tycl_hdr in case 
+                                  -- constrs and deriving are both empty
 
           -- data/newtype family
-        | 'data' 'family' tycl_hdr opt_kind_sig
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
-                      ; checkTyVars tparms            -- no type pattern
-                     ; unless (null (unLoc ctxt)) $  -- and no context
-                         parseError (getLoc ctxt) 
-                           "A family declaration cannot have a context"
-                     ; return $
-                         L (comb3 $1 $2 $4)
-                           (TyFamily DataFamily tc tvs (unLoc $4)) } }
+        | 'data' 'family' type opt_kind_sig
+               {% mkTyFamily (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
 
           -- data/newtype instance declaration
        | data_or_newtype 'instance' tycl_hdr constrs deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
-                                             -- can have type pats
-                     ; return $
-                         L (comb4 $1 $3 $4 $5)
-                                  -- We need the location on tycl_hdr in case 
-                                  -- constrs and deriving are both empty
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) 
-                             Nothing (reverse (unLoc $4)) (unLoc $5)) } }
+               {% mkTyData (comb4 $1 $3 $4 $5) (unLoc $1) True $3
+                           Nothing (reverse (unLoc $4)) (unLoc $5) }
 
           -- GADT instance declaration
         | data_or_newtype 'instance' tycl_hdr opt_kind_sig 
-                'where' gadt_constrlist
+                gadt_constrlist
                 deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
-                                             -- can have type pats
-                     ; return $
-                         L (comb4 $1 $3 $6 $7)
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) 
-                              (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
-
--- Associate type family declarations
+               {% mkTyData (comb4 $1 $3 $5 $6) (unLoc $1) True $3
+                           (unLoc $4) (unLoc $5) (unLoc $6) }
+
+-- Associated type family declarations
 --
 -- * They have a different syntax than on the toplevel (no family special
 --   identifier).
@@ -691,68 +664,38 @@ at_decl_cls :: { LTyClDecl RdrName }
         : 'type' type opt_kind_sig
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
-               --
-               {% do { (tc, tvs, _) <- checkSynHdr $2 False
-                     ; return (L (comb3 $1 $2 $3) 
-                                 (TyFamily TypeFamily tc tvs (unLoc $3)))
-                     } }
+               {% mkTyFamily (comb3 $1 $2 $3) TypeFamily $2 (unLoc $3) }
 
            -- default type instance
         | 'type' type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
-               --
-               {% do { (tc, tvs, typats) <- checkSynHdr $2 True
-                     ; return (L (comb2 $1 $4) 
-                                 (TySynonym tc tvs (Just typats) $4)) 
-                      } }
+               {% mkTySynonym (comb2 $1 $4) True $2 $4 }
 
           -- data/newtype family declaration
-        | 'data' tycl_hdr opt_kind_sig
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                      ; checkTyVars tparms            -- no type pattern
-                     ; unless (null (unLoc ctxt)) $  -- and no context
-                         parseError (getLoc ctxt) 
-                           "A family declaration cannot have a context"
-                     ; return $
-                         L (comb3 $1 $2 $3)
-                           (TyFamily DataFamily tc tvs (unLoc $3)) 
-                      } }
-
--- Associate type instances
+        | 'data' type opt_kind_sig
+               {% mkTyFamily (comb3 $1 $2 $3) DataFamily $2 (unLoc $3) }
+
+-- Associated type instances
 --
 at_decl_inst :: { LTyClDecl RdrName }
            -- type instance declarations
         : 'type' type '=' ctype
                -- Note the use of type for the head; this allows
                -- infix type constructors and type patterns
-               --
-               {% do { (tc, tvs, typats) <- checkSynHdr $2 True
-                     ; return (L (comb2 $1 $4) 
-                                 (TySynonym tc tvs (Just typats) $4)) 
-                      } }
+               {% mkTySynonym (comb2 $1 $4) True $2 $4 }
 
         -- data/newtype instance declaration
        | data_or_newtype tycl_hdr constrs deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                                             -- can have type pats
-                     ; return $
-                         L (comb4 $1 $2 $3 $4)
-                                  -- We need the location on tycl_hdr in case 
-                                  -- constrs and deriving are both empty
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) 
-                             Nothing (reverse (unLoc $3)) (unLoc $4)) } }
+               {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) True $2 
+                            Nothing (reverse (unLoc $3)) (unLoc $4) }
 
         -- GADT instance declaration
         | data_or_newtype tycl_hdr opt_kind_sig 
-                'where' gadt_constrlist
+                gadt_constrlist
                 deriving
-               {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
-                                             -- can have type pats
-                     ; return $
-                         L (comb4 $1 $2 $5 $6)
-                           (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) 
-                            (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
+               {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) True $2 
+                           (unLoc $3) (unLoc $4) (unLoc $5) }
 
 data_or_newtype :: { Located NewOrData }
        : 'data'        { L1 DataType }
@@ -769,19 +712,16 @@ opt_kind_sig :: { Located (Maybe Kind) }
 --     (Eq a, Ord b) => T a b
 --      T Int [a]                      -- for associated types
 -- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (LHsContext RdrName, 
-                      Located RdrName, 
-                      [LHsTyVarBndr RdrName],
-                      [LHsType RdrName]) }
-       : context '=>' type             {% checkTyClHdr $1         $3 >>= return.LL }
-       | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
+tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
+       : context '=>' type             { LL (Just $1, $3) }
+       | type                          { L1 (Nothing, $1) }
 
 -----------------------------------------------------------------------------
 -- Stand-alone deriving
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-       : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+       : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
@@ -792,6 +732,11 @@ decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
 decl_cls  : at_decl_cls                        { LL (unitOL (L1 (TyClD (unLoc $1)))) }
          | decl                        { $1 }
 
+         -- A 'default' signature used with the generic-programming extension
+          | 'default' infixexp '::' sigtypedoc
+                    {% do { (TypeSig l ty) <- checkValSig $2 $4
+                          ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) } }
+
 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
          : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
          | decls_cls ';'               { LL (unLoc $1) }
@@ -858,8 +803,8 @@ decllist :: { Located (OrdList (LHsDecl RdrName)) }
 binds  ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
                                                -- No type declarations
        : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
-       | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
-       |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
+       | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
+       |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
 
 wherebinds :: { Located (HsLocalBinds RdrName) }       -- May have implicit parameters
                                                -- No type declarations
@@ -913,8 +858,8 @@ warnings :: { OrdList (LHsDecl RdrName) }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 warning :: { OrdList (LHsDecl RdrName) }
-       : namelist STRING
-               { toOL [ LL $ WarningD (Warning n (WarningTxt (getSTRING $2)))
+       : namelist strings
+               { toOL [ LL $ WarningD (Warning n (WarningTxt $ unLoc $2))
                       | n <- unLoc $1 ] }
 
 deprecations :: { OrdList (LHsDecl RdrName) }
@@ -925,10 +870,18 @@ deprecations :: { OrdList (LHsDecl RdrName) }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 deprecation :: { OrdList (LHsDecl RdrName) }
-       : namelist STRING
-               { toOL [ LL $ WarningD (Warning n (DeprecatedTxt (getSTRING $2)))
+       : namelist strings
+               { toOL [ LL $ WarningD (Warning n (DeprecatedTxt $ unLoc $2))
                       | n <- unLoc $1 ] }
 
+strings :: { Located [FastString] }
+    : STRING { L1 [getSTRING $1] }
+    | '[' stringlist ']' { LL $ fromOL (unLoc $2) }
+
+stringlist :: { Located (OrdList FastString) }
+    : stringlist ',' STRING { LL (unLoc $1 `snocOL` getSTRING $3) }
+    | STRING                { LL (unitOL (getSTRING $1)) }
+
 -----------------------------------------------------------------------------
 -- Annotations
 annotation :: { LHsDecl RdrName }
@@ -949,15 +902,16 @@ fdecl : 'import' callconv safety fspec
       | 'export' callconv fspec
                {% mkExport $2 (unLoc $3) >>= return.LL }
 
-callconv :: { CallConv }
-         : 'stdcall'                   { CCall  StdCallConv }
-         | 'ccall'                     { CCall  CCallConv   }
-         | 'dotnet'                    { DNCall             }
+callconv :: { CCallConv }
+         : 'stdcall'                   { StdCallConv }
+         | 'ccall'                     { CCallConv   }
+         | 'prim'                      { PrimCallConv}
 
 safety :: { Safety }
        : 'unsafe'                      { PlayRisky }
        | 'safe'                        { PlaySafe  False }
-       | 'threadsafe'                  { PlaySafe  True }
+       | 'interruptible'               { PlayInterruptible }
+       | 'threadsafe'                  { PlaySafe  True } -- deprecated alias
 
 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
        : STRING var '::' sigtypedoc     { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
@@ -977,15 +931,12 @@ opt_asig :: { Maybe (LHsType RdrName) }
        : {- empty -}                   { Nothing }
        | '::' atype                    { Just $2 }
 
-sigtypes1 :: { [LHsType RdrName] }
-       : sigtype                       { [ $1 ] }
-       | sigtype ',' sigtypes1         { $1 : $3 }
-
-sigtype :: { LHsType RdrName }
+sigtype :: { LHsType RdrName }         -- Always a HsForAllTy,
+                                        -- to tell the renamer where to generalise
        : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
        -- Wrap an Implicit forall if there isn't one there already
 
-sigtypedoc :: { LHsType RdrName }
+sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
        : ctypedoc                      { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
        -- Wrap an Implicit forall if there isn't one there already
 
@@ -993,6 +944,10 @@ sig_vars :: { Located [Located RdrName] }
         : sig_vars ',' var             { LL ($3 : unLoc $1) }
         | var                          { L1 [$1] }
 
+sigtypes1 :: { [LHsType RdrName] }     -- Always HsForAllTys
+       : sigtype                       { [ $1 ] }
+       | sigtype ',' sigtypes1         { $1 : $3 }
+
 -----------------------------------------------------------------------------
 -- Types
 
@@ -1002,7 +957,7 @@ infixtype :: { LHsType RdrName }
 
 strict_mark :: { Located HsBang }
        : '!'                           { L1 HsStrict }
-       | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
+       | '{-# UNPACK' '#-}' '!'        { LL HsUnpack }
 
 -- A ctype is a for-all type
 ctype  :: { LHsType RdrName }
@@ -1048,7 +1003,7 @@ context :: { LHsContext RdrName }
 
 type :: { LHsType RdrName }
         : btype                         { $1 }
-        | btype qtyconop type        { LL $ HsOpTy $1 $2 $3 }
+        | btype qtyconop type           { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  type          { LL $ HsOpTy $1 $2 $3 }
        | btype '->'     ctype          { LL $ HsFunTy $1 $3 }
         | btype '~'      btype         { LL $ HsPredTy (HsEqualP $1 $3) }
@@ -1071,15 +1026,19 @@ btype :: { LHsType RdrName }
 atype :: { LHsType RdrName }
        : gtycon                        { L1 (HsTyVar (unLoc $1)) }
        | tyvar                         { L1 (HsTyVar (unLoc $1)) }
-       | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }
+       | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }  -- Constructor sigs only
+       | '{' fielddecls '}'            { LL $ HsRecTy $2 }              -- Constructor sigs only
        | '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
        | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
        | '[' ctype ']'                 { LL $ HsListTy  $2 }
        | '[:' ctype ':]'               { LL $ HsPArrTy  $2 }
        | '(' ctype ')'                 { LL $ HsParTy   $2 }
        | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 (unLoc $4) }
--- Generics
-        | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
+       | quasiquote                    { L1 (HsQuasiQuoteTy (unLoc $1)) }
+       | '$(' exp ')'                  { LL $ mkHsSpliceTy $2 }
+       | TH_ID_SPLICE                  { LL $ mkHsSpliceTy $ L1 $ HsVar $ 
+                                         mkUnqual varName (getTH_ID_SPLICE $1) }
+        | INTEGER                       {% mkNumberType (L1 (getINTEGER $1)) }
 
 -- An inst_type is what occurs in the head of an instance decl
 --     e.g.  (Foo a, Gaz b) => Wibble a b
@@ -1105,19 +1064,19 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
         | {- empty -}                  { [] }
 
 tv_bndr :: { LHsTyVarBndr RdrName }
-       : tyvar                         { L1 (UserTyVar (unLoc $1)) }
+       : tyvar                         { L1 (UserTyVar (unLoc $1) placeHolderKind) }
        | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) 
                                                          (unLoc $4)) }
 
-fds :: { Located [Located ([RdrName], [RdrName])] }
+fds :: { Located [Located (FunDep RdrName)] }
        : {- empty -}                   { noLoc [] }
        | '|' fds1                      { LL (reverse (unLoc $2)) }
 
-fds1 :: { Located [Located ([RdrName], [RdrName])] }
+fds1 :: { Located [Located (FunDep RdrName)] }
        : fds1 ',' fd                   { LL ($3 : unLoc $1) }
        | fd                            { L1 [$1] }
 
-fd :: { Located ([RdrName], [RdrName]) }
+fd :: { Located (FunDep RdrName) }
        : varids0 '->' varids0          { L (comb3 $1 $2 $3)
                                           (reverse (unLoc $1), reverse (unLoc $3)) }
 
@@ -1135,20 +1094,22 @@ kind    :: { Located Kind }
 akind  :: { Located Kind }
        : '*'                   { L1 liftedTypeKind }
        | '!'                   { L1 unliftedTypeKind }
+       | tycon                 {% checkKindCon $1 }
        | '(' kind ')'          { LL (unLoc $2) }
 
 
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
-gadt_constrlist :: { Located [LConDecl RdrName] }
-       : '{'            gadt_constrs '}'       { LL (unLoc $2) }
-       |     vocurly    gadt_constrs close     { $2 }
+gadt_constrlist :: { Located [LConDecl RdrName] }      -- Returned in order
+       : 'where' '{'        gadt_constrs '}'      { L (comb2 $1 $3) (unLoc $3) }
+       | 'where' vocurly    gadt_constrs close    { L (comb2 $1 $3) (unLoc $3) }
+       | {- empty -}                              { noLoc [] }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
-        : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
-        | gadt_constrs ';'             { $1 }
-        | gadt_constr                   { L1 [$1] } 
+        : gadt_constr ';' gadt_constrs  { L (comb2 (head $1) $3) ($1 ++ unLoc $3) }
+        | gadt_constr                   { L (getLoc (head $1)) $1 }
+        | {- empty -}                  { noLoc [] }
 
 -- We allow the following forms:
 --     C :: Eq a => a -> T a
@@ -1156,28 +1117,17 @@ gadt_constrs :: { Located [LConDecl RdrName] }
 --     D { x,y :: a } :: T a
 --     forall a. Eq a => D { x,y :: a } :: T a
 
-gadt_constr :: { LConDecl RdrName }
-        : con '::' sigtype
-              { LL (mkGadtDecl $1 $3) } 
-        -- Syntax: Maybe merge the record stuff with the single-case above?
-        --         (to kill the mostly harmless reduce/reduce error)
-        -- XXX revisit audreyt
-       | constr_stuff_record '::' sigtype
-               { let (con,details) = unLoc $1 in 
-                 LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
-{-
-       | forall context '=>' constr_stuff_record '::' sigtype
-               { let (con,details) = unLoc $4 in 
-                 LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
-       | forall constr_stuff_record '::' sigtype
-               { let (con,details) = unLoc $2 in 
-                 LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
--}
+gadt_constr :: { [LConDecl RdrName] }  -- Returns a list because of:   C,D :: ty
+        : con_list '::' sigtype
+                { map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $1) $3) } 
 
+               -- Deprecated syntax for GADT record declarations
+       | oqtycon '{' fielddecls '}' '::' sigtype
+               {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 $3 $6
+                      ; return [cd] } }
 
 constrs :: { Located [LConDecl RdrName] }
-        : {- empty; a GHC extension -}  { noLoc [] }
-        | maybe_docnext '=' constrs1    { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
+        : maybe_docnext '=' constrs1    { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
 
 constrs1 :: { Located [LConDecl RdrName] }
        : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
@@ -1186,10 +1136,12 @@ constrs1 :: { Located [LConDecl RdrName] }
 constr :: { LConDecl RdrName }
        : maybe_docnext forall context '=>' constr_stuff maybe_docprev  
                { let (con,details) = unLoc $5 in 
-                 L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
+                 addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con (unLoc $2) $3 details))
+                            ($1 `mplus` $6) }
        | maybe_docnext forall constr_stuff maybe_docprev
                { let (con,details) = unLoc $3 in 
-                 L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
+                 addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con (unLoc $2) (noLoc []) details))
+                            ($1 `mplus` $4) }
 
 forall :: { Located [LHsTyVarBndr RdrName] }
        : 'forall' tv_bndrs '.'         { LL $2 }
@@ -1203,21 +1155,22 @@ constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
 --     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                         {% mkPrefixCon $1 [] >>= return.LL }
-       | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
-       | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
-       | btype conop btype             { LL ($2, InfixCon $1 $3) }
+       : btype                         {% splitCon $1 >>= return.LL }
+       | btype conop btype             {  LL ($2, InfixCon $1 $3) }
 
-constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
-       : oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
-       | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
+fielddecls :: { [ConDeclField RdrName] }
+        : {- empty -}     { [] }
+        | fielddecls1     { $1 }
 
-fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
-       : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
-       | fielddecl                                            { [unLoc $1] }
+fielddecls1 :: { [ConDeclField RdrName] }
+       : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
+                      { [ addFieldDoc f $4 | f <- $1 ] ++ addFieldDocs $5 $2 }
+                             -- This adds the doc $4 to each field separately
+       | fielddecl   { $1 }
 
-fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
-       : maybe_docnext sig_vars '::' ctype maybe_docprev      { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
+fielddecl :: { [ConDeclField RdrName] }    -- A list because of   f,g :: Int
+       : maybe_docnext sig_vars '::' ctype maybe_docprev      { [ ConDeclField fld $4 ($1 `mplus` $5) 
+                                                                 | fld <- reverse (unLoc $2) ] }
 
 -- 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).
@@ -1236,7 +1189,9 @@ deriving :: { Located (Maybe [LHsType RdrName]) }
 -----------------------------------------------------------------------------
 -- Value definitions
 
-{- There's an awkward overlap with a type signature.  Consider
+{- Note [Declaration/signature overlap]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's an awkward overlap with a type signature.  Consider
        f :: Int -> Int = ...rhs...
    Then we can't tell whether it's a type signature or a value
    definition with a result signature until we see the '='.
@@ -1259,22 +1214,27 @@ deriving :: { Located (Maybe [LHsType RdrName]) }
 docdecl :: { LHsDecl RdrName }
         : docdecld { L1 (DocD (unLoc $1)) }
 
-docdecld :: { LDocDecl RdrName }
+docdecld :: { LDocDecl }
         : docnext                               { L1 (DocCommentNext (unLoc $1)) }
         | docprev                               { L1 (DocCommentPrev (unLoc $1)) }
         | docnamed                              { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
         | docsection                            { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
 
 decl   :: { Located (OrdList (LHsDecl RdrName)) }
-       : sigdecl                       { $1 }
-       | '!' aexp rhs                  {% do { pat <- checkPattern $2;
-                                               return (LL $ unitOL $ LL $ ValD ( 
-                                                       PatBind (LL $ BangPat pat) (unLoc $3)
-                                                               placeHolderType placeHolderNames)) } }
-        | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 $3;
-                                                let { l = comb2 $1 $> };
-                                                return $! (sL l (unitOL $! (sL l $ ValD r))) } }
-        | docdecl                       { LL $ unitOL $1 }
+       : sigdecl               { $1 }
+
+        | '!' aexp rhs          {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) };
+                                        pat <- checkPattern e;
+                                        return $ LL $ unitOL $ LL $ ValD $
+                                               PatBind pat (unLoc $3)
+                                                       placeHolderType placeHolderNames } }
+                                -- Turn it all into an expression so that
+                                -- checkPattern can check that bangs are enabled
+
+        | infixexp opt_sig rhs  {% do { r <- checkValDef $1 $2 $3;
+                                        let { l = comb2 $1 $> };
+                                        return $! (sL l (unitOL $! (sL l $ ValD r))) } }
+        | docdecl               { LL $ unitOL $1 }
 
 rhs    :: { Located (GRHSs RdrName) }
        : '=' exp wherebinds    { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
@@ -1288,30 +1248,35 @@ gdrh :: { LGRHS RdrName }
        : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
-       : infixexp '::' sigtypedoc
-                               {% do s <- checkValSig $1 $3; 
-                                     return (LL $ unitOL (LL $ SigD s)) }
-               -- See the above notes for why we need infixexp here
+        : 
+       -- See Note [Declaration/signature overlap] for why we need infixexp here
+         infixexp '::' sigtypedoc
+                        {% do s <- checkValSig $1 $3 
+                        ; return (LL $ unitOL (LL $ SigD s)) }
        | var ',' sig_vars '::' sigtypedoc
-                               { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
+                               { LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] }
        | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
                                             | n <- unLoc $3 ] }
        | '{-# INLINE'   activation qvar '#-}'        
-                               { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 FunLike (getINLINE $1)))) }
-        | '{-# INLINE_CONLIKE' activation qvar '#-}'
-                                { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 ConLike (getINLINE_CONLIKE $1)))) }
+               { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) }
        | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
-                               { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec
+               { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlinePragma
                                            | t <- $4] }
        | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-                               { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 FunLike (getSPEC_INLINE $1)))
+               { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlinePragma (getSPEC_INLINE $1) $2))
                                            | t <- $5] }
        | '{-# SPECIALISE' 'instance' inst_type '#-}'
-                               { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
+               { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 
 -----------------------------------------------------------------------------
 -- Expressions
 
+quasiquote :: { Located (HsQuasiQuote RdrName) }
+       : TH_QUASIQUOTE   { let { loc = getLoc $1
+                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
+                                ; quoterId = mkUnqual varName quoter }
+                            in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
+
 exp   :: { LHsExpr RdrName }
        : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
        | infixexp '-<' exp             { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
@@ -1330,16 +1295,15 @@ exp10 :: { LHsExpr RdrName }
                                                                (unguardedGRHSs $6)
                                                            ]) }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
-       | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
+       | 'if' exp optSemi 'then' exp optSemi 'else' exp
+                                        {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
+                                           return (LL $ mkHsIf $2 $5 $8) }
        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
        | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
 
-       | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
-                                          checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-                                          return (L loc (mkHsDo DoExpr stmts body)) }
-       | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
-                                          checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-                                          return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
+       | 'do' stmtlist                 { L (comb2 $1 $2) (mkHsDo DoExpr  (unLoc $2)) }
+       | 'mdo' stmtlist                { L (comb2 $1 $2) (mkHsDo MDoExpr (unLoc $2)) }
+
         | scc_annot exp                                { LL $ if opt_SccProfilingOn
                                                        then HsSCC (unLoc $1) $2
                                                        else HsPar $2 }
@@ -1357,6 +1321,10 @@ exp10 :: { LHsExpr RdrName }
                                                    -- hdaume: core annotation
        | fexp                                  { $1 }
 
+optSemi :: { Bool }
+       : ';'         { True }
+       | {- empty -} { False }
+
 scc_annot :: { Located FastString }
        : '_scc_' STRING                        {% (addWarning Opt_WarnWarningsDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
                                    ( do scc <- getSCC $2; return $ LL scc ) }
@@ -1405,13 +1373,17 @@ aexp2   :: { LHsExpr RdrName }
 --     | STRING                        { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
        | INTEGER                       { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
        | RATIONAL                      { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
+
         -- N.B.: sections get parsed by these next two productions.
-        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
-        -- (you'd have to write '((+ 3), (4 -))')
+        -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
+        -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
        | '(' texp ')'                  { LL (HsPar $2) }
-       | '(' texp ',' texps ')'        { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
-       | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
+       | '(' tup_exprs ')'             { LL (ExplicitTuple $2 Boxed) }
+
+       | '(#' texp '#)'                { LL (ExplicitTuple [Present $2] Unboxed) }
+       | '(#' tup_exprs '#)'           { LL (ExplicitTuple $2 Unboxed) }
+
        | '[' list ']'                  { LL (unLoc $2) }
        | '[:' parr ':]'                { LL (unLoc $2) }
        | '_'                           { L1 EWildPat }
@@ -1419,14 +1391,10 @@ aexp2   :: { LHsExpr RdrName }
        -- Template Haskell Extension
        | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice 
                                        (L1 $ HsVar (mkUnqual varName 
-                                                       (getTH_ID_SPLICE $1)))) } -- $x
-       | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
-
-       | TH_QUASIQUOTE         { let { loc = getLoc $1
-                                      ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
-                                      ; quoterId = mkUnqual varName quoter
-                                      }
-                                  in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
+                                                       (getTH_ID_SPLICE $1)))) } 
+       | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               
+
+
        | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
@@ -1435,8 +1403,8 @@ aexp2     :: { LHsExpr RdrName }
        | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }                       
        | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
                                        return (LL $ HsBracket (PatBr p)) }
-       | '[d|' cvtopbody '|]'  {% checkDecBrGroup $2 >>= \g -> 
-                                       return (LL $ HsBracket (DecBr g)) }
+       | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBrL $2) }
+       | quasiquote            { L1 (HsQuasiQuoteE (unLoc $1)) }
 
        -- arrow notation extension
        | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
@@ -1456,6 +1424,9 @@ cvtopdecls0 :: { [LHsDecl RdrName] }
        : {- empty -}           { [] }
        | cvtopdecls            { $1 }
 
+-----------------------------------------------------------------------------
+-- Tuple expressions
+
 -- "texp" is short for tuple expressions: 
 -- things that can appear unparenthesized as long as they're
 -- inside parens or delimitted by commas
@@ -1465,8 +1436,8 @@ texp :: { LHsExpr RdrName }
        -- Note [Parsing sections]
        -- ~~~~~~~~~~~~~~~~~~~~~~~
        -- We include left and right sections here, which isn't
-       -- technically right according to Haskell 98.  For example
-       --      (3 +, True) isn't legal
+       -- technically right according to the Haskell standard.
+        -- For example (3 +, True) isn't legal.
        -- However, we want to parse bang patterns like
        --      (!x, !y)
        -- and it's convenient to do so here as a section
@@ -1477,12 +1448,22 @@ texp :: { LHsExpr RdrName }
        | qopm infixexp       { LL $ SectionR $1 $2 }
 
        -- View patterns get parenthesized above
-       | exp '->' exp   { LL $ EViewPat $1 $3 }
+       | exp '->' texp   { LL $ EViewPat $1 $3 }
+
+-- Always at least one comma
+tup_exprs :: { [HsTupArg RdrName] }
+           : texp commas_tup_tail  { Present $1 : $2 }
+           | commas tup_tail      { replicate $1 missingTupArg ++ $2 }
 
-texps :: { [LHsExpr RdrName] }
-       : texps ',' texp                { $3 : $1 }
-       | texp                          { [$1] }
+-- Always starts with commas; always follows an expr
+commas_tup_tail :: { [HsTupArg RdrName] }
+commas_tup_tail : commas tup_tail  { replicate ($1-1) missingTupArg ++ $2 }
 
+-- Always follows a comma
+tup_tail :: { [HsTupArg RdrName] }
+          : texp commas_tup_tail       { Present $1 : $2 }
+         | texp                        { [Present $1] }
+          | {- empty -}                        { [missingTupArg] }
 
 -----------------------------------------------------------------------------
 -- List expressions
@@ -1497,7 +1478,10 @@ list :: { LHsExpr RdrName }
        | texp ',' exp '..'     { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
        | texp '..' exp         { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
        | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-       | texp '|' flattenedpquals      { sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 }
+       | texp '|' flattenedpquals      
+             {% checkMonadComp >>= \ ctxt ->
+               return (sL (comb2 $1 $>) $ 
+                        mkHsComp ctxt (unLoc $3) $1) }
 
 lexps :: { Located [LHsExpr RdrName] }
        : lexps ',' texp                { LL (((:) $! $3) $! unLoc $1) }
@@ -1508,48 +1492,50 @@ lexps :: { Located [LHsExpr RdrName] }
 
 flattenedpquals :: { Located [LStmt RdrName] }
     : pquals   { case (unLoc $1) of
-                    ParStmt [(qs, _)] -> L1 qs
+                    [qs] -> L1 qs
                     -- We just had one thing in our "parallel" list so 
                     -- we simply return that thing directly
                     
-                    _ -> L1 [$1]
+                    qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss] noSyntaxExpr noSyntaxExpr noSyntaxExpr]
                     -- We actually found some actual parallel lists so
-                    -- we leave them into as a ParStmt
+                    -- we wrap them into as a ParStmt
                 }
 
-pquals :: { LStmt RdrName }
-    : pquals1   { L1 (ParStmt [(qs, undefined) | qs <- (reverse (unLoc $1))]) }
-
-pquals1 :: { Located [[LStmt RdrName]] }
-    : pquals1 '|' squals    { LL (unLoc $3 : unLoc $1) }
-    | squals                { L (getLoc $1) [unLoc $1] }
+pquals :: { Located [[LStmt RdrName]] }
+    : squals '|' pquals     { L (getLoc $2) (reverse (unLoc $1) : unLoc $3) }
+    | squals                { L (getLoc $1) [reverse (unLoc $1)] }
 
-squals :: { Located [LStmt RdrName] }
-    : squals1               { L (getLoc $1) (reverse (unLoc $1)) }
-
-squals1 :: { Located [LStmt RdrName] }
-    : transformquals1       { LL (unLoc $1) }
-
-transformquals1 :: { Located [LStmt RdrName] }
-    : transformquals1 ',' transformqual         { LL $ [LL ((unLoc $3) (unLoc $1))] }
-    | transformquals1 ',' qual                  { LL ($3 : unLoc $1) }
---  | transformquals1 ',' '{|' pquals '|}'      { LL ($4 : unLoc $1) }
-    | transformqual                             { LL $ [LL ((unLoc $1) [])] }
-    | qual                                      { L1 [$1] }
---  | '{|' pquals '|}'                          { L1 [$2] }
+squals :: { Located [LStmt RdrName] }  -- In reverse order, because the last 
+                                       -- one can "grab" the earlier ones
+    : squals ',' transformqual                      { LL [L (getLoc $3) ((unLoc $3) (reverse (unLoc $1)))] }
+    | squals ',' qual                               { LL ($3 : unLoc $1) }
+    | transformqual                          { LL [L (getLoc $1) ((unLoc $1) [])] }
+    | qual                                   { L1 [$1] }
+--  | transformquals1 ',' '{|' pquals '|}'   { LL ($4 : unLoc $1) }
+--  | '{|' pquals '|}'                       { L1 [$2] }
 
 
 -- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
 -- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user
--- demand. Note that the {| |} symbols are reused from -XGenerics and hence if you want to compile
--- a program that makes use of this temporary syntax you must supply that flag to GHC
+-- demand.
 
 transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
-    : 'then' exp                { LL $ \leftStmts -> (mkTransformStmt (reverse leftStmts) $2) }
-    | 'then' exp 'by' exp       { LL $ \leftStmts -> (mkTransformByStmt (reverse leftStmts) $2 $4) }
-    | 'then' 'group' 'by' exp              { LL $ \leftStmts -> (mkGroupByStmt (reverse leftStmts) $4) }
-    | 'then' 'group' 'using' exp           { LL $ \leftStmts -> (mkGroupUsingStmt (reverse leftStmts) $4) }
-    | 'then' 'group' 'by' exp 'using' exp  { LL $ \leftStmts -> (mkGroupByUsingStmt (reverse leftStmts) $4 $6) }
+                       -- Function is applied to a list of stmts *in order*
+    : 'then' exp                { LL $ \leftStmts -> (mkTransformStmt leftStmts $2) }
+    -- >>>
+    | 'then' exp 'by' exp       { LL $ \leftStmts -> (mkTransformByStmt leftStmts $2 $4) }
+    | 'then' 'group' 'by' exp   { LL $ \leftStmts -> (mkGroupByStmt leftStmts $4) }
+    -- <<<
+    -- These two productions deliberately have a shift-reduce conflict. I have made 'group' into a special_id,
+    -- which means you can enable TransformListComp while still using Data.List.group. However, this makes the two
+    -- productions ambiguous. I've set things up so that Happy chooses to resolve the conflict in that case by
+    -- choosing the "group by" variant, which is what we want.
+    --
+    -- This is rather dubious: the user might be confused as to how to parse this statement. However, it is a good
+    -- practical choice. NB: Data.List.group :: [a] -> [[a]], so using the first production would not even type check
+    -- if /that/ is the group function we conflict with.
+    | 'then' 'group' 'using' exp           { LL $ \leftStmts -> (mkGroupUsingStmt leftStmts $4) }
+    | 'then' 'group' 'by' exp 'using' exp  { LL $ \leftStmts -> (mkGroupByUsingStmt leftStmts $4 $6) }
 
 -----------------------------------------------------------------------------
 -- Parallel array expressions
@@ -1566,7 +1552,7 @@ parr :: { LHsExpr RdrName }
                                                       (reverse (unLoc $1)) }
        | texp '..' exp                 { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
        | texp ',' exp '..' exp         { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-       | texp '|' flattenedpquals      { LL $ mkHsDo PArrComp (unLoc $3) $1 }
+       | texp '|' flattenedpquals      { LL $ mkHsComp PArrComp (unLoc $3) $1 }
 
 -- We are reusing `lexps' and `flattenedpquals' from the list case.
 
@@ -1678,11 +1664,10 @@ fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
        | '..'                          { ([],   True) }
   
 fbind  :: { HsRecField RdrName (LHsExpr RdrName) }
-       : qvar '=' exp  { HsRecField $1 $3 False }
-       | qvar          { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) True }
-                       -- Here's where we say that plain 'x'
-                       -- means exactly 'x = x'.  The pun-flag boolean is
-                       -- there so we can still print it right
+       : qvar '=' exp  { HsRecField $1 $3                False }
+        | qvar          { HsRecField $1 placeHolderPunRhs True }
+                       -- In the punning case, use a place-holder
+                        -- The renamer fills in the final value
 
 -----------------------------------------------------------------------------
 -- Implicit Parameter Bindings
@@ -1724,11 +1709,15 @@ con     :: { Located RdrName }
        | '(' consym ')'        { LL (unLoc $2) }
        | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
 
+con_list :: { Located [Located RdrName] }
+con_list : con                  { L1 [$1] }
+         | con ',' con_list     { LL ($1 : unLoc $3) }
+
 sysdcon        :: { Located DataCon }  -- Wired in data constructors
        : '(' ')'               { LL unitDataCon }
-       | '(' commas ')'        { LL $ tupleCon Boxed $2 }
+       | '(' commas ')'        { LL $ tupleCon Boxed ($2 + 1) }
        | '(#' '#)'             { LL $ unboxedSingletonDataCon }
-       | '(#' commas '#)'      { LL $ tupleCon Unboxed $2 }
+       | '(#' commas '#)'      { LL $ tupleCon Unboxed ($2 + 1) }
        | '[' ']'               { LL nilDataCon }
 
 conop :: { Located RdrName }
@@ -1745,13 +1734,17 @@ qconop :: { Located RdrName }
 gtycon         :: { Located RdrName }  -- A "general" qualified tycon
        : oqtycon                       { $1 }
        | '(' ')'                       { LL $ getRdrName unitTyCon }
-       | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
+       | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed ($2 + 1)) }
        | '(#' '#)'                     { LL $ getRdrName unboxedSingletonTyCon }
-       | '(#' commas '#)'              { LL $ getRdrName (tupleTyCon Unboxed $2) }
+       | '(#' commas '#)'              { LL $ getRdrName (tupleTyCon Unboxed ($2 + 1)) }
        | '(' '->' ')'                  { LL $ getRdrName funTyCon }
        | '[' ']'                       { LL $ listTyCon_RDR }
        | '[:' ':]'                     { LL $ parrTyCon_RDR }
 
+oqtycons1 :: { [Located RdrName] }
+        : oqtycon                       { [$1] }
+        | oqtycons1 oqtycon             { $2 : $1 }
+
 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
        : qtycon                        { $1 }
        | '(' qtyconsym ')'             { LL (unLoc $2) }
@@ -1774,6 +1767,15 @@ qtyconsym :: { Located RdrName }
 
 tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
+        -- Does not include "!", because that is used for strictness marks
+        -- or ".", because that separates the quantified type vars from the rest
+        -- or "*", because that's used for kinds  (XXX: Add this)
+        | VARSYM                       { L1 $! mkUnqual tcClsName (getVARSYM $1) }
+        | '*'                           { L1 $! mkUnqual tcClsName (fsLit "*") }
+    
+
+
+
 
 -----------------------------------------------------------------------------
 -- Operators
@@ -1807,11 +1809,9 @@ qvaropm :: { Located RdrName }
 
 tyvar   :: { Located RdrName }
 tyvar   : tyvarid              { $1 }
-       | '(' tyvarsym ')'      { LL (unLoc $2) }
 
 tyvarop :: { Located RdrName }
 tyvarop : '`' tyvarid '`'      { LL (unLoc $2) }
-       | tyvarsym              { $1 }
        | '.'                   {% parseErrorSDoc (getLoc $1) 
                                      (vcat [ptext (sLit "Illegal symbol '.' in type"), 
                                             ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"),
@@ -1823,14 +1823,9 @@ tyvarid  :: { Located RdrName }
        | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
        | 'unsafe'              { L1 $! mkUnqual tvName (fsLit "unsafe") }
        | 'safe'                { L1 $! mkUnqual tvName (fsLit "safe") }
+       | 'interruptible'       { L1 $! mkUnqual tvName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual tvName (fsLit "threadsafe") }
 
-tyvarsym :: { Located RdrName }
--- Does not include "!", because that is used for strictness marks
---              or ".", because that separates the quantified type vars from the rest
---              or "*", because that's used for kinds
-tyvarsym : VARSYM              { L1 $! mkUnqual tvName (getVARSYM $1) }
-
 -----------------------------------------------------------------------------
 -- Variables 
 
@@ -1856,6 +1851,7 @@ varid :: { Located RdrName }
        | special_id            { L1 $! mkUnqual varName (unLoc $1) }
        | 'unsafe'              { L1 $! mkUnqual varName (fsLit "unsafe") }
        | 'safe'                { L1 $! mkUnqual varName (fsLit "safe") }
+       | 'interruptible'       { L1 $! mkUnqual varName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual varName (fsLit "threadsafe") }
        | 'forall'              { L1 $! mkUnqual varName (fsLit "forall") }
        | 'family'              { L1 $! mkUnqual varName (fsLit "family") }
@@ -1882,7 +1878,7 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe', 'forall', and 'family' whose treatment differs
+-- except 'unsafe', 'interruptible', 'forall', and 'family' whose treatment differs
 -- depending on context 
 special_id :: { Located FastString }
 special_id
@@ -1894,6 +1890,8 @@ special_id
        | 'dynamic'             { L1 (fsLit "dynamic") }
        | 'stdcall'             { L1 (fsLit "stdcall") }
        | 'ccall'               { L1 (fsLit "ccall") }
+       | 'prim'                { L1 (fsLit "prim") }
+       | 'group'               { L1 (fsLit "group") }
 
 special_sym :: { Located FastString }
 special_sym : '!'      { L1 (fsLit "!") }
@@ -1955,51 +1953,36 @@ modid   :: { Located ModuleName }
 
 commas :: { Int }
        : commas ','                    { $1 + 1 }
-       | ','                           { 2 }
+       | ','                           { 1 }
 
 -----------------------------------------------------------------------------
 -- Documentation comments
 
-docnext :: { LHsDoc RdrName }
-  : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 doc) } }
+docnext :: { LHsDocString }
+  : DOCNEXT {% return (L1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
 
-docprev :: { LHsDoc RdrName }
-  : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 doc) } }
+docprev :: { LHsDocString }
+  : DOCPREV {% return (L1 (HsDocString (mkFastString (getDOCPREV $1)))) }
 
-docnamed :: { Located (String, (HsDoc RdrName)) }
+docnamed :: { Located (String, HsDocString) }
   : DOCNAMED {%
       let string = getDOCNAMED $1 
           (name, rest) = break isSpace string
-      in case parseHaddockParagraphs (tokenise rest) of {
-        MyLeft  err -> parseError (getLoc $1) err;
-        MyRight doc -> return (L1 (name, doc)) } }
+      in return (L1 (name, HsDocString (mkFastString rest))) }
 
-docsection :: { Located (Int, HsDoc RdrName) }
+docsection :: { Located (Int, HsDocString) }
   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
-        case parseHaddockString (tokenise doc) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 (n, doc)) } }
+        return (L1 (n, HsDocString (mkFastString doc))) }
 
-moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }                                    
+moduleheader :: { Maybe LHsDocString }
         : DOCNEXT {% let string = getDOCNEXT $1 in
-               case parseModuleHeader string of {                       
-                 Right (str, info) ->                                  
-                   case parseHaddockParagraphs (tokenise str) of {               
-                     MyLeft err -> parseError (getLoc $1) err;                    
-                     MyRight doc -> return (info, Just doc);          
-                   };                                             
-                 Left err -> parseError (getLoc $1) err
-            }  }                                                  
-
-maybe_docprev :: { Maybe (LHsDoc RdrName) }
+                     return (Just (L1 (HsDocString (mkFastString string)))) }
+
+maybe_docprev :: { Maybe LHsDocString }
        : docprev                       { Just $1 }
        | {- empty -}                   { Nothing }
 
-maybe_docnext :: { Maybe (LHsDoc RdrName) }
+maybe_docnext :: { Maybe LHsDocString }
        : docnext                       { Just $1 }
        | {- empty -}                   { Nothing }
 
@@ -2029,9 +2012,9 @@ getPRIMWORD       (L _ (ITprimword x)) = x
 getPRIMFLOAT   (L _ (ITprimfloat  x)) = x
 getPRIMDOUBLE  (L _ (ITprimdouble x)) = x
 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
-getINLINE      (L _ (ITinline_prag b)) = b
-getINLINE_CONLIKE (L _ (ITinline_conlike_prag b)) = b
-getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
+getINLINE      (L _ (ITinline_prag inl conl)) = (inl,conl)
+getSPEC_INLINE (L _ (ITspec_inline_prag True))  = (Inline,  FunLike)
+getSPEC_INLINE (L _ (ITspec_inline_prag False)) = (NoInline,FunLike)
 
 getDOCNEXT (L _ (ITdocCommentNext x)) = x
 getDOCPREV (L _ (ITdocCommentPrev x)) = x
@@ -2070,6 +2053,6 @@ sL span a = span `seq` a `seq` L span a
 fileSrcSpan :: P SrcSpan
 fileSrcSpan = do 
   l <- getSrcLoc; 
-  let loc = mkSrcLoc (srcLocFile l) 1 0;
+  let loc = mkSrcLoc (srcLocFile l) 1 1;
   return (mkSrcSpan loc loc)
 }