projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Simon's big boxy-type commit
[ghc-hetmet.git] / ghc / compiler / parser / Parser.y.pp
diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 4187789..0a423f4 100644 (file)
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -8,14 +8,15 @@
 -- ---------------------------------------------------------------------------
 
 {
 -- ---------------------------------------------------------------------------
 
 {
-module Parser ( parseModule, parseStmt, parseIdentifier, parseIface, parseType ) where
+module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
+               parseHeader ) where
 
 #define INCLUDE #include 
 INCLUDE "HsVersions.h"
 
 import HsSyn
 import RdrHsSyn
 
 #define INCLUDE #include 
 INCLUDE "HsVersions.h"
 
 import HsSyn
 import RdrHsSyn
-import HscTypes                ( ModIface, IsBootInterface, DeprecTxt )
+import HscTypes                ( IsBootInterface, DeprecTxt )
 import Lexer
 import RdrName
 import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
 import Lexer
 import RdrName
 import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
@@ -24,19 +25,17 @@ import Type         ( funTyCon )
 import ForeignCall     ( Safety(..), CExportSpec(..), CLabelString,
                          CCallConv(..), CCallTarget(..), defaultCCallConv
                        )
 import ForeignCall     ( Safety(..), CExportSpec(..), CLabelString,
                          CCallConv(..), CCallTarget(..), defaultCCallConv
                        )
-import OccName         ( UserFS, varName, dataName, tcClsName, tvName )
+import OccName         ( varName, dataName, tcClsName, tvName )
 import DataCon         ( DataCon, dataConName )
 import SrcLoc          ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
                          SrcSpan, combineLocs, srcLocFile, 
                          mkSrcLoc, mkSrcSpan )
 import Module
 import DataCon         ( DataCon, dataConName )
 import SrcLoc          ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
                          SrcSpan, combineLocs, srcLocFile, 
                          mkSrcLoc, mkSrcSpan )
 import Module
-import CmdLineOpts     ( opt_SccProfilingOn )
+import StaticFlags     ( opt_SccProfilingOn )
 import Type            ( Kind, mkArrowKind, liftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
 import Type            ( Kind, mkArrowKind, liftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-                         Activation(..) )
+                         Activation(..), defaultInlineSpec )
 import OrdList
 import OrdList
-import Bag             ( emptyBag )
-import Panic
 
 import FastString
 import Maybes          ( orElse )
 
 import FastString
 import Maybes          ( orElse )
@@ -46,36 +45,49 @@ import GLAEXTS
 
 {-
 -----------------------------------------------------------------------------
 
 {-
 -----------------------------------------------------------------------------
-Conflicts: 33 shift/reduce, [SDM 19/9/2002]
+Conflicts: 36 shift/reduce (1.25)
 
 
-10 for abiguity in 'if x then y else z + 1'            [State 136]
+10 for abiguity in 'if x then y else z + 1'            [State 178]
        (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
        10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
 
        (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
        10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
 
-1 for ambiguity in 'if x then y else z with ?x=3'      [State 136]
-       (shift parses as 'if x then y else (z with ?x=3)'
-
-1 for ambiguity in 'if x then y else z :: T'           [State 136]
+1 for ambiguity in 'if x then y else z :: T'           [State 178]
        (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
 
        (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
 
-4 for ambiguity in 'if x then y else z -< e'
+4 for ambiguity in 'if x then y else z -< e'           [State 178]
        (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
        (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
+       There are four such operators: -<, >-, -<<, >>-
+
+
+2 for ambiguity in 'case v of { x :: T -> T ... } '    [States 11, 253]
+       Which of these two is intended?
+         case v of
+           (x::T) -> T         -- Rhs is T
+    or
+         case v of
+           (x::T -> T) -> ..   -- Rhs is ...
 
 
-8 for ambiguity in 'e :: a `b` c'.  Does this mean     [States 160,246]
+10 for ambiguity in 'e :: a `b` c'.  Does this mean    [States 11, 253]
        (e::a) `b` c, or 
        (e :: (a `b` c))
        (e::a) `b` c, or 
        (e :: (a `b` c))
+    As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
+    Same duplication between states 11 and 253 as the previous case
 
 
-1 for ambiguity in 'let ?x ...'                                [State 268]
+1 for ambiguity in 'let ?x ...'                                [State 329]
        the parser can't tell whether the ?x is the lhs of a normal binding or
        an implicit binding.  Fortunately resolving as shift gives it the only
        sensible meaning, namely the lhs of an implicit binding.
 
        the parser can't tell whether the ?x is the lhs of a normal binding or
        an implicit binding.  Fortunately resolving as shift gives it the only
        sensible meaning, namely the lhs of an implicit binding.
 
-1 for ambiguity in '{-# RULES "name" [ ... #-}         [State 332]
+1 for ambiguity in '{-# RULES "name" [ ... #-}         [State 382]
        we don't know whether the '[' starts the activation or not: it
        might be the start of the declaration with the activation being
        empty.  --SDM 1/4/2002
 
        we don't know whether the '[' starts the activation or not: it
        might be the start of the declaration with the activation being
        empty.  --SDM 1/4/2002
 
-1 for ambiguity in '{-# RULES "name" forall = ... #-}'         [State 394]
+6 for conflicts between `fdecl' and `fdeclDEPRECATED',         [States 393,394]
+       which are resolved correctly, and moreover, 
+       should go away when `fdeclDEPRECATED' is removed.
+
+1 for ambiguity in '{-# RULES "name" forall = ... #-}'         [State 474]
        since 'forall' is a valid variable name, we don't know whether
        to treat a forall on the input as the beginning of a quantifier
        or the beginning of the rule itself.  Resolving to shift means
        since 'forall' is a valid variable name, we don't know whether
        to treat a forall on the input as the beginning of a quantifier
        or the beginning of the rule itself.  Resolving to shift means
@@ -83,10 +95,6 @@ Conflicts: 33 shift/reduce, [SDM 19/9/2002]
        This saves explicitly defining a grammar for the rule lhs that
        doesn't include 'forall'.
 
        This saves explicitly defining a grammar for the rule lhs that
        doesn't include 'forall'.
 
-6 for conflicts between `fdecl' and `fdeclDEPRECATED',         [States 384,385]
-       which are resolved correctly, and moreover, 
-       should go away when `fdeclDEPRECATED' is removed.
-
 -- ---------------------------------------------------------------------------
 -- Adding location info
 
 -- ---------------------------------------------------------------------------
 -- Adding location info
 
@@ -175,10 +183,10 @@ incorrect.
  'proc'                { L _ ITproc }          -- for arrow notation extension
  'rec'         { L _ ITrec }           -- for arrow notation extension
 
  'proc'                { L _ ITproc }          -- for arrow notation extension
  'rec'         { L _ ITrec }           -- for arrow notation extension
 
- '{-# SPECIALISE'  { L _ ITspecialise_prag }
+ '{-# INLINE'            { L _ (ITinline_prag _) }
+ '{-# SPECIALISE'        { L _ ITspec_prag }
+ '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
  '{-# SOURCE'     { L _ ITsource_prag }
  '{-# SOURCE'     { L _ ITsource_prag }
- '{-# INLINE'      { L _ ITinline_prag }
- '{-# NOINLINE'    { L _ ITnoinline_prag }
  '{-# RULES'      { L _ ITrules_prag }
  '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
  '{-# SCC'        { L _ ITscc_prag }
  '{-# RULES'      { L _ ITrules_prag }
  '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
  '{-# SCC'        { L _ ITscc_prag }
@@ -265,12 +273,20 @@ TH_TY_QUOTE       { L _ ITtyQuote       }      -- ''T
 %name parseModule module
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
 %name parseModule module
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
-%name parseIface iface
 %name parseType ctype
 %name parseType ctype
+%partial parseHeader header
 %tokentype { Located Token }
 %%
 
 -----------------------------------------------------------------------------
 %tokentype { Located Token }
 %%
 
 -----------------------------------------------------------------------------
+-- Identifiers; one of the entry points
+identifier :: { Located RdrName }
+       : qvar                          { $1 }
+       | qcon                          { $1 }
+       | qvarop                        { $1 }
+       | qconop                        { $1 }
+
+-----------------------------------------------------------------------------
 -- Module Header
 
 -- The place for module deprecation is really too restrictive, but if it
 -- Module Header
 
 -- The place for module deprecation is really too restrictive, but if it
@@ -283,9 +299,7 @@ TH_TY_QUOTE { L _ ITtyQuote       }      -- ''T
 module         :: { Located (HsModule RdrName) }
        : 'module' modid maybemoddeprec maybeexports 'where' body 
                {% fileSrcSpan >>= \ loc ->
 module         :: { Located (HsModule RdrName) }
        : 'module' modid maybemoddeprec maybeexports 'where' body 
                {% fileSrcSpan >>= \ loc ->
-                  return (L loc (HsModule (Just (L (getLoc $2) 
-                                       (mkHomeModule (unLoc $2))))
-                               $4 (fst $6) (snd $6) $3)) }
+                  return (L loc (HsModule (Just $2) $4 (fst $6) (snd $6) $3)) }
        | missing_module_keyword top close
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing 
        | missing_module_keyword top close
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing 
@@ -311,36 +325,19 @@ cvtopdecls :: { [LHsDecl RdrName] }
        : topdecls                              { cvTopDecls $1 }
 
 -----------------------------------------------------------------------------
        : topdecls                              { cvTopDecls $1 }
 
 -----------------------------------------------------------------------------
--- Interfaces (.hi-boot files)
+-- Module declaration & imports only
 
 
-iface   :: { ModIface }
-       : 'module' modid 'where' ifacebody  { mkBootIface (unLoc $2) $4 }
-
-ifacebody :: { [HsDecl RdrName] }
-       :  '{'            ifacedecls '}'                { $2 }
-       |      vocurly    ifacedecls close              { $2 }
-
-ifacedecls :: { [HsDecl RdrName] }
-       : ifacedecl ';' ifacedecls      { $1 : $3 }
-       | ';' ifacedecls                { $2 }
-       | ifacedecl                     { [$1] }
-       | {- empty -}                   { [] }
+header         :: { Located (HsModule RdrName) }
+       : 'module' modid maybemoddeprec maybeexports 'where' header_body
+               {% fileSrcSpan >>= \ loc ->
+                  return (L loc (HsModule (Just $2) $4 $6 [] $3)) }
+       | missing_module_keyword importdecls
+               {% fileSrcSpan >>= \ loc ->
+                  return (L loc (HsModule Nothing Nothing $2 [] Nothing)) }
 
 
-ifacedecl :: { HsDecl RdrName }
-       : var '::' sigtype      
-                { SigD (Sig $1 $3) }
-       | 'type' syn_hdr '=' ctype      
-               { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
-       | 'data' tycl_hdr constrs       -- No deriving in hi-boot
-               { TyClD (mkTyData DataType $2 Nothing (reverse (unLoc $3)) Nothing) }
-        | 'data' tycl_hdr 'where' gadt_constrlist      
-               { TyClD (mkTyData DataType $2 Nothing (reverse (unLoc $4)) Nothing) }
-       | 'newtype' tycl_hdr            -- Constructor is optional
-               { TyClD (mkTyData NewType $2 Nothing [] Nothing) }
-       | 'newtype' tycl_hdr '=' newconstr
-               { TyClD (mkTyData NewType $2 Nothing [$4] Nothing) }
-       | 'class' tycl_hdr fds
-               { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
+header_body :: { [LImportDecl RdrName] }
+       :  '{'            importdecls           { $2 }
+       |      vocurly    importdecls           { $2 }
 
 -----------------------------------------------------------------------------
 -- The Export List
 
 -----------------------------------------------------------------------------
 -- The Export List
@@ -371,7 +368,7 @@ qcnames :: { [RdrName] }
 
 qcname         :: { Located RdrName }  -- Variable or data constructor
        :  qvar                                 { $1 }
 
 qcname         :: { Located RdrName }  -- Variable or data constructor
        :  qvar                                 { $1 }
-       |  gcon                                 { $1 }
+       |  qcon                                 { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -397,7 +394,7 @@ optqualified :: { Bool }
        : 'qualified'                           { True  }
        | {- empty -}                           { False }
 
        : 'qualified'                           { True  }
        | {- empty -}                           { False }
 
-maybeas :: { Located (Maybe ModuleName) }
+maybeas :: { Located (Maybe Module) }
        : 'as' modid                            { LL (Just (unLoc $2)) }
        | {- empty -}                           { noLoc Nothing }
 
        : 'as' modid                            { LL (Just (unLoc $2)) }
        | {- empty -}                           { noLoc Nothing }
 
@@ -446,24 +443,27 @@ topdecl :: { OrdList (LHsDecl RdrName) }
        | decl                                  { unLoc $1 }
 
 tycl_decl :: { LTyClDecl RdrName }
        | decl                                  { unLoc $1 }
 
 tycl_decl :: { LTyClDecl RdrName }
-       : 'type' syn_hdr '=' ctype      
-               -- Note ctype, not sigtype.
+       : 'type' type '=' ctype 
+               -- Note type on the left of the '='; this allows
+               -- infix type constructors to be declared
+               -- 
+               -- Note ctype, not sigtype, on the right
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
-               { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
+               {% do { (tc,tvs) <- checkSynHdr $2
+                     ; return (LL (TySynonym tc tvs $4)) } }
 
 
-       | 'data' tycl_hdr constrs deriving
-               { L (comb4 $1 $2 $3 $4)
-                   (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) }
+       | data_or_newtype tycl_hdr constrs deriving
+               { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr 
+                                       -- in case constrs and deriving are both empty
+                   (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) }
 
 
-        | 'data' tycl_hdr opt_kind_sig 'where' gadt_constrlist -- No deriving for GADTs
+        | data_or_newtype tycl_hdr opt_kind_sig 
+                'where' gadt_constrlist
+                deriving
                { L (comb4 $1 $2 $4 $5)
                { L (comb4 $1 $2 $4 $5)
-                   (mkTyData DataType $2 $3 (reverse (unLoc $5)) Nothing) }
-
-       | 'newtype' tycl_hdr '=' newconstr deriving
-               { L (comb3 $1 $4 $5)
-                   (mkTyData NewType $2 Nothing [$4] (unLoc $5)) }
+                   (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
 
        | 'class' tycl_hdr fds where
                { let 
 
        | 'class' tycl_hdr fds where
                { let 
@@ -472,16 +472,14 @@ tycl_decl :: { LTyClDecl RdrName }
                  L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs 
                                          binds) }
 
                  L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs 
                                          binds) }
 
+data_or_newtype :: { Located NewOrData }
+       : 'data'        { L1 DataType }
+       | 'newtype'     { L1 NewType }
+
 opt_kind_sig :: { Maybe Kind }
        :                               { Nothing }
        | '::' kind                     { Just $2 }
 
 opt_kind_sig :: { Maybe Kind }
        :                               { Nothing }
        | '::' kind                     { Just $2 }
 
-syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
-               -- We don't retain the syntax of an infix
-               -- type synonym declaration. Oh well.
-       : tycon tv_bndrs                { ($1, $2) }
-       | tv_bndr tyconop tv_bndr       { ($2, [$1,$3]) }
-
 -- tycl_hdr parses the header of a type or class decl,
 -- which takes the form
 --     T a b
 -- tycl_hdr parses the header of a type or class decl,
 -- which takes the form
 --     T a b
@@ -489,7 +487,7 @@ syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
 --     (Eq a, Ord b) => T a b
 -- Rather a lot of inlining here, else we get reduce/reduce errors
 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
 --     (Eq a, Ord b) => T a b
 -- Rather a lot of inlining here, else we get reduce/reduce errors
 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
-       : context '=>' type             {% checkTyClHdr $1 $3 >>= return.LL }
+       : context '=>' type             {% checkTyClHdr $1         $3 >>= return.LL }
        | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 
 -----------------------------------------------------------------------------
        | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 
 -----------------------------------------------------------------------------
@@ -511,14 +509,14 @@ where     :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
        : 'where' decllist              { LL (unLoc $2) }
        | {- empty -}                   { noLoc nilOL }
 
        : 'where' decllist              { LL (unLoc $2) }
        | {- empty -}                   { noLoc nilOL }
 
-binds  ::  { Located [HsBindGroup RdrName] }   -- May have implicit parameters
-       : decllist                      { L1 [cvBindGroup (unLoc $1)] }
-       | '{'            dbinds '}'     { LL [HsIPBinds (unLoc $2)] }
-       |     vocurly    dbinds close   { L (getLoc $2) [HsIPBinds (unLoc $2)] }
+binds  ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
+       : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
+       | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
+       |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
 
 
-wherebinds :: { Located [HsBindGroup RdrName] }        -- May have implicit parameters
+wherebinds :: { Located (HsLocalBinds RdrName) }       -- May have implicit parameters
        : 'where' binds                 { LL (unLoc $2) }
        : 'where' binds                 { LL (unLoc $2) }
-       | {- empty -}                   { noLoc [] }
+       | {- empty -}                   { noLoc emptyLocalBinds }
 
 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
@@ -532,15 +530,13 @@ rules     :: { OrdList (LHsDecl RdrName) }        -- Reversed
 
 rule   :: { LHsDecl RdrName }
        : STRING activation rule_forall infixexp '=' exp
 
 rule   :: { LHsDecl RdrName }
        : STRING activation rule_forall infixexp '=' exp
-            { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
-
-activation :: { Activation }           -- Omitted means AlwaysActive
-        : {- empty -}                           { AlwaysActive }
-        | explicit_activation                   { $1 }
+            { LL $ RuleD (HsRule (getSTRING $1) 
+                                 ($2 `orElse` AlwaysActive) 
+                                 $3 $4 $6) }
 
 
-inverse_activation :: { Activation }   -- Omitted means NeverActive
-        : {- empty -}                           { NeverActive }
-        | explicit_activation                   { $1 }
+activation :: { Maybe Activation } 
+        : {- empty -}                           { Nothing }
+        | explicit_activation                   { Just $1 }
 
 explicit_activation :: { Activation }  -- In brackets
         : '[' INTEGER ']'              { ActiveAfter  (fromInteger (getINTEGER $2)) }
 
 explicit_activation :: { Activation }  -- In brackets
         : '[' INTEGER ']'              { ActiveAfter  (fromInteger (getINTEGER $2)) }
@@ -777,8 +773,8 @@ type :: { LHsType RdrName }
 gentype :: { LHsType RdrName }
         : btype                         { $1 }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
 gentype :: { LHsType RdrName }
         : btype                         { $1 }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
-        | btype  '`' tyvar '`' gentype  { LL $ HsOpTy $1 $3 $5 }
-       | btype '->' gentype            { LL $ HsFunTy $1 $3 }
+        | btype tyvarop  gentype       { LL $ HsOpTy $1 $2 $3 }
+       | btype '->' ctype              { LL $ HsFunTy $1 $3 }
 
 btype :: { LHsType RdrName }
        : btype atype                   { LL $ HsAppTy $1 $2 }
 
 btype :: { LHsType RdrName }
        : btype atype                   { LL $ HsAppTy $1 $2 }
@@ -788,10 +784,10 @@ atype :: { LHsType RdrName }
        : gtycon                        { L1 (HsTyVar (unLoc $1)) }
        | tyvar                         { L1 (HsTyVar (unLoc $1)) }
        | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }
        : gtycon                        { L1 (HsTyVar (unLoc $1)) }
        | tyvar                         { L1 (HsTyVar (unLoc $1)) }
        | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }
-       | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed  ($2:$4) }
+       | '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
        | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
        | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
-       | '[' type ']'                  { LL $ HsListTy  $2 }
-       | '[:' type ':]'                { LL $ HsPArrTy  $2 }
+       | '[' ctype ']'                 { LL $ HsListTy  $2 }
+       | '[:' ctype ':]'               { LL $ HsPArrTy  $2 }
        | '(' ctype ')'                 { LL $ HsParTy   $2 }
        | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
 -- Generics
        | '(' ctype ')'                 { LL $ HsParTy   $2 }
        | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
 -- Generics
@@ -813,8 +809,8 @@ comma_types0  :: { [LHsType RdrName] }
        | {- empty -}                   { [] }
 
 comma_types1   :: { [LHsType RdrName] }
        | {- empty -}                   { [] }
 
 comma_types1   :: { [LHsType RdrName] }
-       : type                          { [$1] }
-       | type  ',' comma_types1        { $1 : $3 }
+       : ctype                         { [$1] }
+       | ctype  ',' comma_types1       { $1 : $3 }
 
 tv_bndrs :: { [LHsTyVarBndr RdrName] }
         : tv_bndr tv_bndrs             { $1 : $2 }
 
 tv_bndrs :: { [LHsTyVarBndr RdrName] }
         : tv_bndr tv_bndrs             { $1 : $2 }
@@ -855,22 +851,39 @@ akind     :: { Kind }
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
-newconstr :: { LConDecl RdrName }
-       : conid atype   { LL $ ConDecl $1 [] (noLoc []) (PrefixCon [$2]) }
-       | conid '{' var '::' ctype '}'
-                       { LL $ ConDecl $1 [] (noLoc []) (RecCon [($3, $5)]) }
-
 gadt_constrlist :: { Located [LConDecl RdrName] }
        : '{'            gadt_constrs '}'       { LL (unLoc $2) }
        |     vocurly    gadt_constrs close     { $2 }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
         : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
 gadt_constrlist :: { Located [LConDecl RdrName] }
        : '{'            gadt_constrs '}'       { LL (unLoc $2) }
        |     vocurly    gadt_constrs close     { $2 }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
         : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
+        | gadt_constrs ';'             { $1 }
         | gadt_constr                   { L1 [$1] } 
 
         | gadt_constr                   { L1 [$1] } 
 
+-- We allow the following forms:
+--     C :: Eq a => a -> T a
+--     C :: forall a. Eq a => !a -> T a
+--     D { x,y :: a } :: T a
+--     forall a. Eq a => D { x,y :: a } :: T a
+
 gadt_constr :: { LConDecl RdrName }
 gadt_constr :: { LConDecl RdrName }
-        : qcon '::' sigtype
-              { LL (GadtDecl $1 $3) } 
+        : 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 autrijus
+       | constr_stuff_record '::' sigtype
+               { let (con,details) = unLoc $1 in 
+                 LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) }
+{-
+       | forall context '=>' constr_stuff_record '::' sigtype
+               { let (con,details) = unLoc $4 in 
+                 LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6)) }
+       | forall constr_stuff_record '::' sigtype
+               { let (con,details) = unLoc $2 in 
+                 LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4)) }
+-}
+
 
 constrs :: { Located [LConDecl RdrName] }
         : {- empty; a GHC extension -}  { noLoc [] }
 
 constrs :: { Located [LConDecl RdrName] }
         : {- empty; a GHC extension -}  { noLoc [] }
@@ -883,10 +896,10 @@ constrs1 :: { Located [LConDecl RdrName] }
 constr :: { LConDecl RdrName }
        : forall context '=>' constr_stuff      
                { let (con,details) = unLoc $4 in 
 constr :: { LConDecl RdrName }
        : forall context '=>' constr_stuff      
                { let (con,details) = unLoc $4 in 
-                 LL (ConDecl con (unLoc $1) $2 details) }
+                 LL (ConDecl con Explicit (unLoc $1) $2 details ResTyH98) }
        | forall constr_stuff
                { let (con,details) = unLoc $2 in 
        | forall constr_stuff
                { let (con,details) = unLoc $2 in 
-                 LL (ConDecl con (unLoc $1) (noLoc []) details) }
+                 LL (ConDecl con Explicit (unLoc $1) (noLoc []) details ResTyH98) }
 
 forall :: { Located [LHsTyVarBndr RdrName] }
        : 'forall' tv_bndrs '.'         { LL $2 }
 
 forall :: { Located [LHsTyVarBndr RdrName] }
        : 'forall' tv_bndrs '.'         { LL $2 }
@@ -905,6 +918,10 @@ constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrN
        | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
        | btype conop btype             { LL ($2, InfixCon $1 $3) }
 
        | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
        | btype conop btype             { LL ($2, InfixCon $1 $3) }
 
+constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+       : oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
+       | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
+
 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
        : fielddecl ',' fielddecls      { unLoc $1 : $3 }
        | fielddecl                     { [unLoc $1] }
 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
        : fielddecl ',' fielddecls      { unLoc $1 : $3 }
        | fielddecl                     { [unLoc $1] }
@@ -963,8 +980,7 @@ gdrhs :: { Located [LGRHS RdrName] }
        | gdrh                  { L1 [$1] }
 
 gdrh :: { LGRHS RdrName }
        | gdrh                  { L1 [$1] }
 
 gdrh :: { LGRHS RdrName }
-       : '|' quals '=' exp     { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) : 
-                                                       unLoc $2)) }
+       : '|' quals '=' exp     { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
        : infixexp '::' sigtype
 
 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
        : infixexp '::' sigtype
@@ -972,16 +988,17 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
                                      return (LL $ unitOL (LL $ SigD s)) }
                -- See the above notes for why we need infixexp here
        | var ',' sig_vars '::' sigtype 
                                      return (LL $ unitOL (LL $ SigD s)) }
                -- See the above notes for why we need infixexp here
        | var ',' sig_vars '::' sigtype 
-                               { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
+                               { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
        | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
                                             | n <- unLoc $3 ] }
        | '{-# INLINE'   activation qvar '#-}'        
        | 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 True  $3 $2)) }
-       | '{-# NOINLINE' inverse_activation qvar '#-}' 
-                               { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
+                               { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
        | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
        | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
-                               { LL $ toOL [ LL $ SigD (SpecSig $2 t)
+                               { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
                                            | t <- $4] }
                                            | t <- $4] }
+       | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
+                               { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
+                                           | t <- $5] }
        | '{-# SPECIALISE' 'instance' inst_type '#-}'
                                { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 
        | '{-# SPECIALISE' 'instance' inst_type '#-}'
                                { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 
@@ -1004,7 +1021,7 @@ exp10 :: { LHsExpr RdrName }
        : '\\' aexp aexps opt_asig '->' exp     
                        {% checkPatterns ($2 : reverse $3) >>= \ ps -> 
                           return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
        : '\\' aexp aexps opt_asig '->' exp     
                        {% checkPatterns ($2 : reverse $3) >>= \ ps -> 
                           return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
-                                           (GRHSs (unguardedRHS $6) []
+                                           (GRHSs (unguardedRHS $6) emptyLocalBinds
                                                        )])) }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
        | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
                                                        )])) }
        | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
        | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
@@ -1012,12 +1029,11 @@ exp10 :: { LHsExpr RdrName }
        | '-' fexp                              { LL $ mkHsNegApp $2 }
 
        | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
        | '-' fexp                              { LL $ mkHsNegApp $2 }
 
        | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
-                                          checkDo loc (unLoc $2)  >>= \ stmts ->
-                                          return (L loc (mkHsDo DoExpr stmts)) }
+                                          checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
+                                          return (L loc (mkHsDo DoExpr stmts body)) }
        | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
        | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
-                                          checkMDo loc (unLoc $2)  >>= \ stmts ->
-                                          return (L loc (mkHsDo MDoExpr stmts)) }
-
+                                          checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
+                                          return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
         | scc_annot exp                                { LL $ if opt_SccProfilingOn
                                                        then HsSCC (unLoc $1) $2
                                                        else HsPar $2 }
         | scc_annot exp                                { LL $ if opt_SccProfilingOn
                                                        then HsSCC (unLoc $1) $2
                                                        else HsPar $2 }
@@ -1085,7 +1101,7 @@ aexp2     :: { LHsExpr RdrName }
        | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
 
        | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
        | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
 
        | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
-       | TH_VAR_QUOTE gcon     { LL $ HsBracket (VarBr (unLoc $2)) }
+       | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
        | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }                       
        | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
        | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }                       
@@ -1126,13 +1142,11 @@ texps :: { [LHsExpr RdrName] }
 list :: { LHsExpr RdrName }
        : exp                   { L1 $ ExplicitList placeHolderType [$1] }
        | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
 list :: { LHsExpr RdrName }
        : exp                   { L1 $ ExplicitList placeHolderType [$1] }
        | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
-       | exp '..'              { LL $ ArithSeqIn (From $1) }
-       | exp ',' exp '..'      { LL $ ArithSeqIn (FromThen $1 $3) }
-       | exp '..' exp          { LL $ ArithSeqIn (FromTo $1 $3) }
-       | exp ',' exp '..' exp  { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
-       | exp pquals            { LL $ mkHsDo ListComp 
-                                       (reverse (L (getLoc $1) (ResultStmt $1) : 
-                                          unLoc $2)) }
+       | exp '..'              { LL $ ArithSeq noPostTcExpr (From $1) }
+       | exp ',' exp '..'      { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
+       | exp '..' exp          { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
+       | exp ',' exp '..' exp  { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+       | exp pquals            { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
 
 lexps :: { Located [LHsExpr RdrName] }
        : lexps ',' exp                 { LL ($3 : unLoc $1) }
 
 lexps :: { Located [LHsExpr RdrName] }
        : lexps ',' exp                 { LL ($3 : unLoc $1) }
@@ -1172,12 +1186,9 @@ parr :: { LHsExpr RdrName }
        | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
        | lexps                         { L1 $ ExplicitPArr placeHolderType 
                                                       (reverse (unLoc $1)) }
        | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
        | lexps                         { L1 $ ExplicitPArr placeHolderType 
                                                       (reverse (unLoc $1)) }
-       | exp '..' exp                  { LL $ PArrSeqIn (FromTo $1 $3) }
-       | exp ',' exp '..' exp          { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
-       | exp pquals                    { LL $ mkHsDo PArrComp 
-                                           (reverse (L (getLoc $1) (ResultStmt $1) :
-                                                unLoc $2))
-                                       }
+       | exp '..' exp                  { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
+       | exp ',' exp '..' exp          { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+       | exp pquals                    { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
 
 -- We are reusing `lexps' and `pquals' from the list case.
 
 
 -- We are reusing `lexps' and `pquals' from the list case.
 
@@ -1213,8 +1224,7 @@ gdpats :: { Located [LGRHS RdrName] }
        | gdpat                         { L1 [$1] }
 
 gdpat  :: { LGRHS RdrName }
        | gdpat                         { L1 [$1] }
 
 gdpat  :: { LGRHS RdrName }
-       : '|' quals '->' exp            { let r = L (getLoc $4) (ResultStmt $4)
-                                         in LL $ GRHS (reverse (r : unLoc $2)) }
+       : '|' quals '->' exp            { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
 
 -----------------------------------------------------------------------------
 -- Statement sequences
 
 -----------------------------------------------------------------------------
 -- Statement sequences
@@ -1224,7 +1234,7 @@ stmtlist :: { Located [LStmt RdrName] }
        |     vocurly   stmts close     { $2 }
 
 --     do { ;; s ; s ; ; s ;; }
        |     vocurly   stmts close     { $2 }
 
 --     do { ;; s ; s ; ; s ;; }
--- The last Stmt should be a ResultStmt, but that's hard to enforce
+-- The last Stmt should be an expression, but that's hard to enforce
 -- here, because we need too much lookahead if we see do { e ; }
 -- So we use ExprStmts throughout, and switch the last one over
 -- in ParseUtils.checkDo instead
 -- here, because we need too much lookahead if we see do { e ; }
 -- So we use ExprStmts throughout, and switch the last one over
 -- in ParseUtils.checkDo instead
@@ -1246,13 +1256,13 @@ maybe_stmt :: { Maybe (LStmt RdrName) }
 stmt  :: { LStmt RdrName }
        : qual                          { $1 }
        | infixexp '->' exp             {% checkPattern $3 >>= \p ->
 stmt  :: { LStmt RdrName }
        : qual                          { $1 }
        | infixexp '->' exp             {% checkPattern $3 >>= \p ->
-                                          return (LL $ BindStmt p $1) }
-       | 'rec' stmtlist                { LL $ RecStmt (unLoc $2) undefined undefined undefined }
+                                          return (LL $ mkBindStmt p $1) }
+       | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
 
 qual  :: { LStmt RdrName }
 
 qual  :: { LStmt RdrName }
-       : infixexp '<-' exp             {% checkPattern $1 >>= \p ->
-                                          return (LL $ BindStmt p $3) }
-       | exp                           { L1 $ ExprStmt $1 placeHolderType }
+       : exp '<-' exp                  {% checkPattern $1 >>= \p ->
+                                          return (LL $ mkBindStmt p $3) }
+       | exp                           { L1 $ mkExprStmt $1 }
        | 'let' binds                   { LL $ LetStmt (unLoc $2) }
 
 -----------------------------------------------------------------------------
        | 'let' binds                   { LL $ LetStmt (unLoc $2) }
 
 -----------------------------------------------------------------------------
@@ -1281,14 +1291,12 @@ dbinds  :: { Located [LIPBind RdrName] }
 dbind  :: { LIPBind RdrName }
 dbind  : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
 
 dbind  :: { LIPBind RdrName }
 dbind  : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
 
------------------------------------------------------------------------------
--- Variables, Constructors and Operators.
+ipvar  :: { Located (IPName RdrName) }
+       : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
+       | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
 
 
-identifier :: { Located RdrName }
-       : qvar                          { $1 }
-       | gcon                          { $1 }
-       | qvarop                        { $1 }
-       | qconop                        { $1 }
+-----------------------------------------------------------------------------
+-- Deprecations
 
 depreclist :: { Located [RdrName] }
 depreclist : deprec_var                        { L1 [unLoc $1] }
 
 depreclist :: { Located [RdrName] }
 depreclist : deprec_var                        { L1 [unLoc $1] }
@@ -1296,49 +1304,25 @@ depreclist : deprec_var                 { L1 [unLoc $1] }
 
 deprec_var :: { Located RdrName }
 deprec_var : var                       { $1 }
 
 deprec_var :: { Located RdrName }
 deprec_var : var                       { $1 }
-          | tycon                      { $1 }
-
-gcon   :: { Located RdrName }  -- Data constructor namespace
-       : sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
-       | qcon                  { $1 }
--- the case of '[:' ':]' is part of the production `parr'
-
-sysdcon        :: { Located DataCon }  -- Wired in data constructors
-       : '(' ')'               { LL unitDataCon }
-       | '(' commas ')'        { LL $ tupleCon Boxed $2 }
-       | '[' ']'               { LL nilDataCon }
-
-var    :: { Located RdrName }
-       : varid                 { $1 }
-       | '(' varsym ')'        { LL (unLoc $2) }
-
-qvar   :: { Located RdrName }
-       : qvarid                { $1 }
-       | '(' varsym ')'        { LL (unLoc $2) }
-       | '(' qvarsym1 ')'      { LL (unLoc $2) }
--- We've inlined qvarsym here so that the decision about
--- whether it's a qvar or a var can be postponed until
--- *after* we see the close paren.
-
-ipvar  :: { Located (IPName RdrName) }
-       : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
-       | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
+          | con                        { $1 }
 
 
+-----------------------------------------
+-- Data constructors
 qcon   :: { Located RdrName }
        : qconid                { $1 }
        | '(' qconsym ')'       { LL (unLoc $2) }
 qcon   :: { Located RdrName }
        : qconid                { $1 }
        | '(' qconsym ')'       { LL (unLoc $2) }
+       | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
+-- The case of '[:' ':]' is part of the production `parr'
 
 
-varop  :: { Located RdrName }
-       : varsym                { $1 }
-       | '`' varid '`'         { LL (unLoc $2) }
-
-qvarop :: { Located RdrName }
-       : qvarsym               { $1 }
-       | '`' qvarid '`'        { LL (unLoc $2) }
+con    :: { Located RdrName }
+       : conid                 { $1 }
+       | '(' consym ')'        { LL (unLoc $2) }
+       | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
 
 
-qvaropm :: { Located RdrName }
-       : qvarsym_no_minus      { $1 }
-       | '`' qvarid '`'        { LL (unLoc $2) }
+sysdcon        :: { Located DataCon }  -- Wired in data constructors
+       : '(' ')'               { LL unitDataCon }
+       | '(' commas ')'        { LL $ tupleCon Boxed $2 }
+       | '[' ']'               { LL nilDataCon }
 
 conop :: { Located RdrName }
        : consym                { $1 }  
 
 conop :: { Located RdrName }
        : consym                { $1 }  
@@ -1367,10 +1351,6 @@ qtyconop :: { Located RdrName }  -- Qualified or unqualified
        : qtyconsym                     { $1 }
        | '`' qtycon '`'                { LL (unLoc $2) }
 
        : qtyconsym                     { $1 }
        | '`' qtycon '`'                { LL (unLoc $2) }
 
-tyconop        :: { Located RdrName }  -- Unqualified
-       : tyconsym                      { $1 }
-       | '`' tycon '`'                 { LL (unLoc $2) }
-
 qtycon :: { Located RdrName }  -- Qualified or unqualified
        : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
        | tycon                         { $1 }
 qtycon :: { Located RdrName }  -- Qualified or unqualified
        : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
        | tycon                         { $1 }
@@ -1386,12 +1366,16 @@ tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
 
 -----------------------------------------------------------------------------
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
 
 -----------------------------------------------------------------------------
--- Any operator
+-- Operators
 
 op     :: { Located RdrName }   -- used in infix decls
        : varop                 { $1 }
        | conop                 { $1 }
 
 
 op     :: { Located RdrName }   -- used in infix decls
        : varop                 { $1 }
        | conop                 { $1 }
 
+varop  :: { Located RdrName }
+       : varsym                { $1 }
+       | '`' varid '`'         { LL (unLoc $2) }
+
 qop    :: { LHsExpr RdrName }   -- used in sections
        : qvarop                { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
 qop    :: { LHsExpr RdrName }   -- used in sections
        : qvarop                { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
@@ -1400,8 +1384,52 @@ qopm     :: { LHsExpr RdrName }   -- used in sections
        : qvaropm               { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
 
        : qvaropm               { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
 
+qvarop :: { Located RdrName }
+       : qvarsym               { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
+
+qvaropm :: { Located RdrName }
+       : qvarsym_no_minus      { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
+
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
--- VarIds
+-- Type variables
+
+tyvar   :: { Located RdrName }
+tyvar   : tyvarid              { $1 }
+       | '(' tyvarsym ')'      { LL (unLoc $2) }
+
+tyvarop :: { Located RdrName }
+tyvarop : '`' tyvarid '`'      { LL (unLoc $2) }
+       | tyvarsym              { $1 }
+
+tyvarid        :: { Located RdrName }
+       : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
+       | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
+       | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
+       | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
+       | '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 
+
+var    :: { Located RdrName }
+       : varid                 { $1 }
+       | '(' varsym ')'        { LL (unLoc $2) }
+
+qvar   :: { Located RdrName }
+       : qvarid                { $1 }
+       | '(' varsym ')'        { LL (unLoc $2) }
+       | '(' qvarsym1 ')'      { LL (unLoc $2) }
+-- We've inlined qvarsym here so that the decision about
+-- whether it's a qvar or a var can be postponed until
+-- *after* we see the close paren.
 
 qvarid :: { Located RdrName }
        : varid                 { $1 }
 
 qvarid :: { Located RdrName }
        : varid                 { $1 }
@@ -1418,30 +1446,6 @@ varid_no_unsafe :: { Located RdrName }
        | special_id            { L1 $! mkUnqual varName (unLoc $1) }
        | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
 
        | special_id            { L1 $! mkUnqual varName (unLoc $1) }
        | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
 
-tyvar  :: { Located RdrName }
-       : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
-       | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
-       | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
-       | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
-       | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
-
--- These special_ids are treated as keywords in various places, 
--- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe' and 'forall' whose treatment differs depending on context
-special_id :: { Located UserFS }
-special_id
-       : 'as'                  { L1 FSLIT("as") }
-       | 'qualified'           { L1 FSLIT("qualified") }
-       | 'hiding'              { L1 FSLIT("hiding") }
-       | 'export'              { L1 FSLIT("export") }
-       | 'label'               { L1 FSLIT("label")  }
-       | 'dynamic'             { L1 FSLIT("dynamic") }
-       | 'stdcall'             { L1 FSLIT("stdcall") }
-       | 'ccall'               { L1 FSLIT("ccall") }
-
------------------------------------------------------------------------------
--- Variables 
-
 qvarsym :: { Located RdrName }
        : varsym                { $1 }
        | qvarsym1              { $1 }
 qvarsym :: { Located RdrName }
        : varsym                { $1 }
        | qvarsym1              { $1 }
@@ -1462,8 +1466,21 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
        | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
 
 
        | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
 
 
--- See comments with special_id
-special_sym :: { Located UserFS }
+-- These special_ids are treated as keywords in various places, 
+-- but as ordinary ids elsewhere.   'special_id' collects all these
+-- except 'unsafe' and 'forall' whose treatment differs depending on context
+special_id :: { Located FastString }
+special_id
+       : 'as'                  { L1 FSLIT("as") }
+       | 'qualified'           { L1 FSLIT("qualified") }
+       | 'hiding'              { L1 FSLIT("hiding") }
+       | 'export'              { L1 FSLIT("export") }
+       | 'label'               { L1 FSLIT("label")  }
+       | 'dynamic'             { L1 FSLIT("dynamic") }
+       | 'stdcall'             { L1 FSLIT("stdcall") }
+       | 'ccall'               { L1 FSLIT("ccall") }
+
+special_sym :: { Located FastString }
 special_sym : '!'      { L1 FSLIT("!") }
            | '.'       { L1 FSLIT(".") }
            | '*'       { L1 FSLIT("*") }
 special_sym : '!'      { L1 FSLIT("!") }
            | '.'       { L1 FSLIT(".") }
            | '*'       { L1 FSLIT("*") }
@@ -1511,10 +1528,10 @@ close :: { () }
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)
 
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)
 
-modid  :: { Located ModuleName }
-       : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
+modid  :: { Located Module }
+       : CONID                 { L1 $ mkModuleFS (getCONID $1) }
         | QCONID               { L1 $ let (mod,c) = getQCONID $1 in
         | QCONID               { L1 $ let (mod,c) = getQCONID $1 in
-                                 mkModuleNameFS
+                                 mkModuleFS
                                   (mkFastString
                                     (unpackFS mod ++ '.':unpackFS c))
                                }
                                   (mkFastString
                                     (unpackFS mod ++ '.':unpackFS c))
                                }
@@ -1549,6 +1566,8 @@ getPRIMINTEGER    (L _ (ITprimint    x)) = x
 getPRIMFLOAT   (L _ (ITprimfloat  x)) = x
 getPRIMDOUBLE  (L _ (ITprimdouble x)) = x
 getTH_ID_SPLICE (L _ (ITidEscape 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
+getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
 
 -- Utilities for combining source spans
 comb2 :: Located a -> Located b -> SrcSpan
 
 -- Utilities for combining source spans
 comb2 :: Located a -> Located b -> SrcSpan
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)