[project @ 2001-04-05 11:54:37 by simonpj]
[ghc-hetmet.git] / ghc / compiler / parser / Parser.y
index 9279e44..d5c3f27 100644 (file)
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.32 2000/06/01 08:51:46 simonmar Exp $
+$Id: Parser.y,v 1.56 2001/04/05 11:54:37 simonpj Exp $
 
 Haskell grammar.
 
@@ -9,18 +9,19 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( parse ) where
+module Parser ( parseModule, parseStmt ) where
 
 import HsSyn
-import HsPragmas
 import HsTypes         ( mkHsTupCon )
 
 import RdrHsSyn
 import Lex
 import ParseUtil
 import RdrName
-import PrelInfo                ( mAIN_Name )
-import OccName         ( varName, ipName, tcName, dataName, tcClsName, tvName )
+import PrelNames       ( mAIN_Name, unitTyCon_RDR, funTyCon_RDR, listTyCon_RDR,
+                         tupleTyCon_RDR, unitCon_RDR, nilCon_RDR, tupleCon_RDR
+                       )
+import OccName         ( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import SrcLoc          ( SrcLoc )
 import Module
 import CallConv
@@ -30,6 +31,7 @@ import Panic
 
 import GlaExts
 import FastString      ( tailFS )
+import Outputable
 
 #include "HsVersions.h"
 }
@@ -88,7 +90,7 @@ Conflicts: 14 shift/reduce
  'then'        { ITthen }
  'type'        { ITtype }
  'where'       { ITwhere }
- '_scc_'       { ITscc }
+ '_scc_'       { ITscc }             -- ToDo: remove
 
  'forall'      { ITforall }                    -- GHC extension keywords
  'foreign'     { ITforeign }
@@ -109,6 +111,7 @@ Conflicts: 14 shift/reduce
  '{-# INLINE'      { ITinline_prag }
  '{-# NOINLINE'    { ITnoinline_prag }
  '{-# RULES'      { ITrules_prag }
+ '{-# SCC'        { ITscc_prag }
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
 
@@ -127,6 +130,7 @@ Conflicts: 14 shift/reduce
  '__float'     { ITfloat_lit }
  '__rational'  { ITrational_lit }
  '__addr'      { ITaddr_lit }
+ '__label'     { ITlabel_lit }
  '__litlit'    { ITlit_lit }
  '__string'    { ITstring_lit }
  '__ccall'     { ITccall $$ }
@@ -155,10 +159,10 @@ Conflicts: 14 shift/reduce
  '!'           { ITbang }
  '.'           { ITdot }
 
- '/\\'         { ITbiglam }                    -- GHC-extension symbols
-
  '{'           { ITocurly }                    -- special symbols
  '}'           { ITccurly }
+ '{|'           { ITocurlybar }
+ '|}'           { ITccurlybar }
  vccurly       { ITvccurly } -- virtual close curly (from layout)
  '['           { ITobrack }
  ']'           { ITcbrack }
@@ -181,8 +185,6 @@ Conflicts: 14 shift/reduce
 
  IPVARID       { ITipvarid  $$ }               -- GHC extension
 
- PRAGMA                { ITpragma   $$ }
-
  CHAR          { ITchar     $$ }
  STRING                { ITstring   $$ }
  INTEGER       { ITinteger  $$ }
@@ -195,11 +197,10 @@ Conflicts: 14 shift/reduce
  PRIMDOUBLE    { ITprimdouble $$ }
  CLITLIT       { ITlitlit     $$ }
 
- UNKNOWN       { ITunknown  $$ }
-
 %monad { P } { thenP } { returnP }
 %lexer { lexer } { ITeof }
-%name parse
+%name parseModule module
+%name parseStmt   maybe_stmt
 %tokentype { Token }
 %%
 
@@ -228,8 +229,8 @@ body        :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
        |      layout_on  top close             { $2 }
 
 top    :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
-       : importdecls ';' cvtopdecls            { (reverse $1,$3) }
-       | importdecls                           { (reverse $1,[]) }
+       : importdecls                           { (reverse $1,[]) }
+       | importdecls ';' cvtopdecls            { (reverse $1,$3) }
        | cvtopdecls                            { ([],$1) }
 
 cvtopdecls :: { [RdrNameHsDecl] }
@@ -279,7 +280,7 @@ importdecls :: { [RdrNameImportDecl] }
 
 importdecl :: { RdrNameImportDecl }
        : 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec 
-               { ImportDecl (mkSrcModuleFS $5) $3 $4 $6 $7 $2 }
+               { ImportDecl (mkModuleNameFS $5) $3 $4 $6 $7 $2 }
 
 maybe_src :: { WhereFrom }
        : '{-# SOURCE' '#-}'                    { ImportByUserSource }
@@ -327,37 +328,36 @@ topdecls :: { [RdrBinding] }
        | topdecl                       { [$1] }
 
 topdecl :: { RdrBinding }
-       : srcloc 'type' simpletype '=' sigtype  
+       : srcloc 'type' simpletype '=' ctype    
+               -- Note ctype, not sigtype.
+               -- 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
                { RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) }
 
        | srcloc 'data' ctype '=' constrs deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (TyData DataType cs c ts (reverse $5) (length $5) $6
-                       NoDataPragmas $1))) }
+                     (mkTyData DataType cs c ts (reverse $5) (length $5) $6 $1))) }
 
        | srcloc 'newtype' ctype '=' newconstr deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (TyData NewType cs c ts [$5] 1 $6
-                       NoDataPragmas $1))) }
+                     (mkTyData NewType cs c ts [$5] 1 $6 $1))) }
 
        | srcloc 'class' ctype fds where
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
-                  let (binds,sigs) 
-                          = cvMonoBindsAndSigs cvClassOpSig 
-                               (groupBindings $5) 
+                  let 
+                       (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig (groupBindings $5) 
                   in
                   returnP (RdrHsDecl (TyClD
-                     (mkClassDecl cs c ts $4 sigs binds 
-                       NoClassPragmas $1))) }
+                     (mkClassDecl cs c ts $4 sigs (Just binds) $1))) }
 
        | srcloc 'instance' inst_type where
                { let (binds,sigs) 
                        = cvMonoBindsAndSigs cvInstDeclSig 
                                (groupBindings $4)
-                 in RdrHsDecl (InstD
-                               (InstDecl $3 binds sigs dummyRdrVarName $1)) }
+                 in RdrHsDecl (InstD (InstDecl $3 binds sigs Nothing $1)) }
 
        | srcloc 'default' '(' types0 ')'
                { RdrHsDecl (DefD (DefaultDecl $4 $1)) }
@@ -454,7 +454,7 @@ deprecations :: { RdrBinding }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 deprecation :: { RdrBinding }
-       : srcloc exportlist STRING
+       : srcloc depreclist STRING
                { foldr RdrAndBindings RdrNullBind 
                        [ RdrHsDecl (DeprecD (Deprecation n $3 $1)) | n <- $2 ] }
 
@@ -493,7 +493,7 @@ sigtypes :: { [RdrNameHsType] }
        | sigtypes ',' sigtype          { $3 : $1 }
 
 sigtype :: { RdrNameHsType }
-       : ctype                         { mkHsForAllTy Nothing [] $1 }
+       : ctype                         { (mkHsForAllTy Nothing [] $1) }
 
 sig_vars :: { [RdrName] }
         : sig_vars ',' var             { $3 : $1 }
@@ -506,16 +506,21 @@ sig_vars :: { [RdrName] }
 ctype  :: { RdrNameHsType }
        : 'forall' tyvars '.' ctype     { mkHsForAllTy (Just $2) [] $4 }
        | context type                  { mkHsForAllTy Nothing   $1 $2 }
-               -- A type of form (context => type) is an *implicit* HsForAllTy
+       -- A type of form (context => type) is an *implicit* HsForAllTy
        | type                          { $1 }
 
 type :: { RdrNameHsType }
-       : btype '->' type               { HsFunTy $1 $3 }
+       : gentype '->' type             { HsFunTy $1 $3 }
        | ipvar '::' type               { mkHsIParamTy $1 $3 }
-       | btype                         { $1 }
+       | gentype                       { $1 }
+
+gentype :: { RdrNameHsType }
+        : btype                         { $1 }
+-- Generics
+        | atype tyconop atype           { HsOpTy $1 $2 $3 }
 
 btype :: { RdrNameHsType }
-       : btype atype                   { HsAppTy $1 $2 }
+       : btype atype                   { (HsAppTy $1 $2) }
        | atype                         { $1 }
 
 atype :: { RdrNameHsType }
@@ -524,14 +529,9 @@ atype :: { RdrNameHsType }
        | '(' type ',' types ')'        { HsTupleTy (mkHsTupCon tcName Boxed  ($2:$4)) ($2 : reverse $4) }
        | '(#' types '#)'               { HsTupleTy (mkHsTupCon tcName Unboxed     $2) (reverse $2)      }
        | '[' type ']'                  { HsListTy $2 }
-       | '(' ctype ')'                 { $2 }
-
-gtycon         :: { RdrName }
-       : qtycon                        { $1 }
-       | '(' ')'                       { unitTyCon_RDR }
-       | '(' '->' ')'                  { funTyCon_RDR }
-       | '[' ']'                       { listTyCon_RDR }
-       | '(' commas ')'                { tupleTyCon_RDR $2 }
+       | '(' ctype ')'                 { $2 }
+-- Generics
+        | INTEGER                       { HsNumTy $1 }
 
 -- An inst_type is what occurs in the head of an instance decl
 --     e.g.  (Foo a, Gaz b) => Wibble a b
@@ -541,7 +541,7 @@ inst_type :: { RdrNameHsType }
        : ctype                         {% checkInstType $1 }
 
 types0  :: { [RdrNameHsType] }
-       : types                         { $1 }
+       : types                         { reverse $1 }
        | {- empty -}                   { [] }
 
 types  :: { [RdrNameHsType] }
@@ -573,6 +573,11 @@ varids0    :: { [RdrName] }
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
+newconstr :: { RdrNameConDecl }
+       : srcloc conid atype    { mkConDecl $2 [] [] (VanillaCon [Unbanged $3]) $1 }
+       | srcloc conid '{' var '::' type '}'
+                               { mkConDecl $2 [] [] (RecCon [([$4], Unbanged $6)]) $1 }
+
 constrs :: { [RdrNameConDecl] }
        : constrs '|' constr            { $3 : $1 }
        | constr                        { [$1] }
@@ -591,34 +596,22 @@ context :: { RdrNameContext }
        : btype '=>'                    {% checkContext $1 }
 
 constr_stuff :: { (RdrName, RdrNameConDetails) }
-       : scontype                      { (fst $1, VanillaCon (snd $1)) }
+       : btype                         {% mkVanillaCon $1 []               }
+       | btype '!' atype satypes       {% mkVanillaCon $1 (Banged $3 : $4) }
+       | gtycon '{' fielddecls '}'     {% mkRecCon $1 $3 }
        | sbtype conop sbtype           { ($2, InfixCon $1 $3) }
-       | con '{' fielddecls '}'        { ($1, RecCon (reverse $3)) }
 
-newconstr :: { RdrNameConDecl }
-       : srcloc conid atype    { mkConDecl $2 [] [] (NewCon $3 Nothing) $1 }
-       | srcloc conid '{' var '::' type '}'
-                               { mkConDecl $2 [] [] (NewCon $6 (Just $4)) $1 }
-
-scontype :: { (RdrName, [RdrNameBangType]) }
-       : btype                         {% splitForConApp $1 [] }
-       | scontype1                     { $1 }
-
-scontype1 :: { (RdrName, [RdrNameBangType]) }
-       : btype '!' atype               {% splitForConApp $1 [Banged $3] }
-       | scontype1 satype              { (fst $1, snd $1 ++ [$2] ) }
-        | '(' consym ')'               { ($2,[]) }
-
-satype :: { RdrNameBangType }
-       : atype                         { Unbanged $1 }
-       | '!' atype                     { Banged   $2 }
+satypes        :: { [RdrNameBangType] }
+       : atype satypes                 { Unbanged $1 : $2 }
+       | '!' atype satypes             { Banged   $2 : $3 }
+       | {- empty -}                   { [] }
 
 sbtype :: { RdrNameBangType }
        : btype                         { Unbanged $1 }
        | '!' atype                     { Banged   $2 }
 
 fielddecls :: { [([RdrName],RdrNameBangType)] }
-       : fielddecls ',' fielddecl      { $3 : $1 }
+       : fielddecl ',' fielddecls      { $1 : $3 }
        | fielddecl                     { [$1] }
 
 fielddecl :: { ([RdrName],RdrNameBangType) }
@@ -662,15 +655,16 @@ dclasses :: { [RdrName] }
 -}
 
 valdef :: { RdrBinding }
-       : infixexp srcloc opt_sig rhs           {% checkValDef $1 $3 $4 $2 }
-       | infixexp srcloc '::' sigtype          {% checkValSig $1 $4 $2 }
+       : infixexp srcloc opt_sig rhs           {% (checkValDef $1 $3 $4 $2) }
+       | infixexp srcloc '::' sigtype          {% (checkValSig $1 $4 $2) }
        | var ',' sig_vars srcloc '::' sigtype  { foldr1 RdrAndBindings 
                                                         [ RdrSig (Sig n $6 $4) | n <- $1:$3 ]
-                                               }
+                                                }
+
 
 rhs    :: { RdrNameGRHSs }
-       : '=' srcloc exp wherebinds     { GRHSs (unguardedRHS $3 $2) 
-                                                               $4 Nothing}
+       : '=' srcloc exp wherebinds     { (GRHSs (unguardedRHS $3 $2) 
+                                                               $4 Nothing)}
        | gdrhs wherebinds              { GRHSs (reverse $1) $2 Nothing }
 
 gdrhs :: { [RdrNameGRHS] }
@@ -684,13 +678,14 @@ gdrh :: { RdrNameGRHS }
 -- Expressions
 
 exp   :: { RdrNameHsExpr }
-       : infixexp '::' sigtype         { ExprWithTySig $1 $3 }
+       : infixexp '::' sigtype         { (ExprWithTySig $1 $3) }
        | infixexp 'with' dbinding      { HsWith $1 $3 }
        | infixexp                      { $1 }
 
 infixexp :: { RdrNameHsExpr }
        : exp10                         { $1 }
-       | infixexp qop exp10            { OpApp $1 $2 (panic "fixity") $3 }
+       | infixexp qop exp10            { (OpApp $1 (HsVar $2) 
+                                               (panic "fixity") $3 )}
 
 exp10 :: { RdrNameHsExpr }
        : '\\' aexp aexps opt_asig '->' srcloc exp      
@@ -701,62 +696,70 @@ exp10 :: { RdrNameHsExpr }
        | 'let' declbinds 'in' exp              { HsLet $2 $4 }
        | 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 }
        | 'case' srcloc exp 'of' altslist       { HsCase $3 $5 $2 }
-       | '-' fexp                              { NegApp $2 (error "NegApp") }
-       | srcloc 'do' stmtlist                  { HsDo DoStmt $3 $1 }
+       | '-' fexp                              { mkHsNegApp $2 }
+       | srcloc 'do' stmtlist                  { HsDo DoExpr $3 $1 }
 
        | '_ccall_'    ccallid aexps0           { HsCCall $2 $3 False False cbot }
        | '_ccall_GC_' ccallid aexps0           { HsCCall $2 $3 True  False cbot }
        | '_casm_'     CLITLIT aexps0           { HsCCall $2 $3 False True  cbot }
        | '_casm_GC_'  CLITLIT aexps0           { HsCCall $2 $3 True  True  cbot }
 
-        | '_scc_' STRING exp                   { if opt_SccProfilingOn
-                                                       then HsSCC $2 $3
-                                                       else HsPar $3 }
+        | scc_annot exp                                { if opt_SccProfilingOn
+                                                       then HsSCC $1 $2
+                                                       else HsPar $2 }
 
        | fexp                                  { $1 }
 
+scc_annot :: { FAST_STRING }
+       : '_scc_' STRING                        { $2 }
+       | '{-# SCC' STRING '#-}'                { $2 }
+
 ccallid :: { FAST_STRING }
        :  VARID                                { $1 }
        |  CONID                                { $1 }
 
 fexp   :: { RdrNameHsExpr }
-       : fexp aexp                             { HsApp $1 $2 }
+       : fexp aexp                             { (HsApp $1 $2) }
        | aexp                                  { $1 }
 
 aexps0         :: { [RdrNameHsExpr] }
-       : aexps                                 { reverse $1 }
+       : aexps                                 { (reverse $1) }
 
 aexps  :: { [RdrNameHsExpr] }
        : aexps aexp                            { $2 : $1 }
        | {- empty -}                           { [] }
 
 aexp   :: { RdrNameHsExpr }
-       : aexp '{' fbinds '}'           {% mkRecConstrOrUpdate $1 (reverse $3) }
-       | aexp1                         { $1 }
+        : var_or_con '{|' gentype '|}'          { (HsApp $1 (HsType $3)) }
+       | aexp '{' fbinds '}'                   {% (mkRecConstrOrUpdate $1 
+                                                       (reverse $3)) }
+       | aexp1                                 { $1 }
+
+var_or_con :: { RdrNameHsExpr }
+        : qvar                          { HsVar $1 }
+        | gcon                          { HsVar $1 }
 
 aexp1  :: { RdrNameHsExpr }
-       : qvar                          { HsVar $1 }
-       | ipvar                         { HsIPVar $1 }
-       | gcon                          { HsVar $1 }
-       | literal                       { HsLit $1 }
+       : ipvar                         { HsIPVar $1 }
+       | var_or_con                    { $1 }
+       | literal                       { HsLit $1 }
+       | INTEGER                       { HsOverLit (HsIntegral   $1) }
+       | RATIONAL                      { HsOverLit (HsFractional $1) }
        | '(' exp ')'                   { HsPar $2 }
        | '(' exp ',' texps ')'         { ExplicitTuple ($2 : reverse $4) Boxed}
        | '(#' texps '#)'               { ExplicitTuple (reverse $2)      Unboxed }
        | '[' list ']'                  { $2 }
-       | '(' infixexp qop ')'          { SectionL $2 $3  }
-       | '(' qopm infixexp ')'         { SectionR $2 $3 }
+       | '(' infixexp qop ')'          { (SectionL $2 (HsVar $3))  }
+       | '(' qopm infixexp ')'         { (SectionR $2 $3) }
        | qvar '@' aexp                 { EAsPat $1 $3 }
        | '_'                           { EWildPat }
        | '~' aexp1                     { ELazyPat $2 }
 
-commas :: { Int }
-       : commas ','                    { $1 + 1 }
-       | ','                           { 2 }
-
 texps :: { [RdrNameHsExpr] }
        : texps ',' exp                 { $3 : $1 }
        | exp                           { [$1] }
 
+
 -----------------------------------------------------------------------------
 -- List expressions
 
@@ -770,8 +773,14 @@ list :: { RdrNameHsExpr }
        | exp ',' exp '..'              { ArithSeqIn (FromThen $1 $3) }
        | exp '..' exp                  { ArithSeqIn (FromTo $1 $3) }
        | exp ',' exp '..' exp          { ArithSeqIn (FromThenTo $1 $3 $5) }
-       | exp srcloc '|' quals                  { HsDo ListComp (reverse 
-                                               (ReturnStmt $1 : $4)) $2 }
+       | exp srcloc pquals             {% let { body [qs] = qs;
+                                                body  qss = [ParStmt (map reverse qss)] }
+                                          in
+                                          returnP ( HsDo ListComp
+                                                          (reverse (ExprStmt $1 $2 : body $3))
+                                                          $2
+                                                 )
+                                       }
 
 lexps :: { [RdrNameHsExpr] }
        : lexps ',' exp                 { $3 : $1 }
@@ -780,15 +789,13 @@ lexps :: { [RdrNameHsExpr] }
 -----------------------------------------------------------------------------
 -- List Comprehensions
 
-quals :: { [RdrNameStmt] }
-       : quals ',' qual                { $3 : $1 }
-       | qual                          { [$1] }
+pquals :: { [[RdrNameStmt]] }
+       : pquals '|' quals              { $3 : $1 }
+       | '|' quals                     { [$2] }
 
-qual  :: { RdrNameStmt }
-       : srcloc infixexp '<-' exp      {% checkPattern $2 `thenP` \p ->
-                                          returnP (BindStmt p $4 $1) }
-       | srcloc exp                    { GuardStmt $2 $1 }
-       | srcloc 'let' declbinds        { LetStmt $3 }
+quals :: { [RdrNameStmt] }
+       : quals ',' stmt                { $3 : $1 }
+       | stmt                          { [$1] }
 
 -----------------------------------------------------------------------------
 -- Case alternatives
@@ -808,9 +815,9 @@ alts1       :: { [RdrNameMatch] }
 
 alt    :: { RdrNameMatch }
        : infixexp opt_sig ralt wherebinds
-                                       {% checkPattern $1 `thenP` \p ->
+                                       {% (checkPattern $1 `thenP` \p ->
                                           returnP (Match [] [p] $2
-                                                    (GRHSs $3 $4 Nothing)) }
+                                                    (GRHSs $3 $4 Nothing))  )}
 
 ralt :: { [RdrNameGRHS] }
        : '->' srcloc exp               { [GRHS [ExprStmt $3 $2] $2] }
@@ -843,6 +850,12 @@ stmts1 :: { [RdrNameStmt] }
        | stmts1 ';'                    { $1 }
        | stmt                          { [$1] }
 
+-- for typing stmts at the GHCi prompt, where the input may consist of
+-- just comments.
+maybe_stmt :: { Maybe RdrNameStmt }
+       : stmt                          { Just $1 }
+       | {- nothing -}                 { Nothing }
+
 stmt  :: { RdrNameStmt }
        : srcloc infixexp '<-' exp      {% checkPattern $2 `thenP` \p ->
                                           returnP (BindStmt p $4 $1) }
@@ -880,6 +893,22 @@ dbind      : ipvar '=' exp                 { ($1, $3) }
 -----------------------------------------------------------------------------
 -- Variables, Constructors and Operators.
 
+depreclist :: { [RdrName] }
+depreclist : deprec_var                        { [$1] }
+          | deprec_var ',' depreclist  { $1 : $3 }
+
+deprec_var :: { RdrName }
+deprec_var : var                       { $1 }
+          | tycon                      { $1 }
+
+gtycon         :: { RdrName }
+       : qtycon                        { $1 }
+       | '(' qtyconop ')'              { $2 }
+       | '(' ')'                       { unitTyCon_RDR }
+       | '(' '->' ')'                  { funTyCon_RDR }
+       | '[' ']'                       { listTyCon_RDR }
+       | '(' commas ')'                { tupleTyCon_RDR $2 }
+
 gcon   :: { RdrName }
        : '(' ')'               { unitCon_RDR }
        | '[' ']'               { nilCon_RDR }
@@ -899,11 +928,7 @@ qvar       :: { RdrName }
 -- *after* we see the close paren.
 
 ipvar  :: { RdrName }
-       : IPVARID               { (mkSrcUnqual ipName (tailFS $1)) }
-
-con    :: { RdrName }
-       : conid                 { $1 }
-       | '(' consym ')'        { $2 }
+       : IPVARID               { (mkUnqual varName (tailFS $1)) }
 
 qcon   :: { RdrName }
        : qconid                { $1 }
@@ -918,7 +943,7 @@ qvarop :: { RdrName }
        | '`' qvarid '`'        { $2 }
 
 qvaropm :: { RdrName }
-       : qvarsymm              { $1 }
+       : qvarsym_no_minus      { $1 }
        | '`' qvarid '`'        { $2 }
 
 conop :: { RdrName }
@@ -936,9 +961,9 @@ op  :: { RdrName }   -- used in infix decls
        : varop                 { $1 }
        | conop                 { $1 }
 
-qop    :: { RdrNameHsExpr }   -- used in sections
-       : qvarop                { HsVar $1 }
-       | qconop                { HsVar $1 }
+qop    :: { RdrName {-HsExpr-} }   -- used in sections
+       : qvarop                { $1 }
+       | qconop                { $1 }
 
 qopm   :: { RdrNameHsExpr }   -- used in sections
        : qvaropm               { HsVar $1 }
@@ -949,55 +974,55 @@ qopm      :: { RdrNameHsExpr }   -- used in sections
 
 qvarid :: { RdrName }
        : varid                 { $1 }
-       | QVARID                { case $1 of { (mod,n) ->
-                                 mkSrcQual varName mod n } }
+       | QVARID                { mkQual varName $1 }
 
 varid :: { RdrName }
-       : VARID                 { mkSrcUnqual varName $1 }
-       | 'as'                  { as_var_RDR }
-       | 'qualified'           { qualified_var_RDR }
-       | 'hiding'              { hiding_var_RDR }
-       | 'forall'              { forall_var_RDR }
-       | 'export'              { export_var_RDR }
-       | 'label'               { label_var_RDR }
-       | 'dynamic'             { dynamic_var_RDR }
-       | 'unsafe'              { unsafe_var_RDR }
-       | 'stdcall'             { stdcall_var_RDR }
-       | 'ccall'               { ccall_var_RDR }
+       : varid_no_unsafe       { $1 }
+       | 'unsafe'              { mkUnqual varName SLIT("unsafe") }
 
 varid_no_unsafe :: { RdrName }
-       : VARID                 { mkSrcUnqual varName $1 }
-       | 'as'                  { as_var_RDR }
-       | 'qualified'           { qualified_var_RDR }
-       | 'hiding'              { hiding_var_RDR }
-       | 'forall'              { forall_var_RDR }
-       | 'export'              { export_var_RDR }
-       | 'label'               { label_var_RDR }
-       | 'dynamic'             { dynamic_var_RDR }
-       | 'stdcall'             { stdcall_var_RDR }
-       | 'ccall'               { ccall_var_RDR }
+       : VARID                 { mkUnqual varName $1 }
+       | special_id            { mkUnqual varName $1 }
+       | 'forall'              { mkUnqual varName SLIT("forall") }
+
+tyvar  :: { RdrName }
+       : VARID                 { mkUnqual tvName $1 }
+       | special_id            { mkUnqual tvName $1 }
+       | 'unsafe'              { mkUnqual tvName SLIT("unsafe") }
+
+-- These special_ids are treated as keywords in various places, 
+-- but as ordinary ids elsewhere.   A special_id collects all thsee
+-- except 'unsafe' and 'forall' whose treatment differs depending on context
+special_id :: { UserFS }
+special_id
+       : 'as'                  { SLIT("as") }
+       | 'qualified'           { SLIT("qualified") }
+       | 'hiding'              { SLIT("hiding") }
+       | 'export'              { SLIT("export") }
+       | 'label'               { SLIT("label")  }
+       | 'dynamic'             { SLIT("dynamic") }
+       | 'stdcall'             { SLIT("stdcall") }
+       | 'ccall'               { SLIT("ccall") }
 
 -----------------------------------------------------------------------------
 -- ConIds
 
 qconid :: { RdrName }
        : conid                 { $1 }
-       | QCONID                { case $1 of { (mod,n) ->
-                                 mkSrcQual dataName mod n } }
+       | QCONID                { mkQual dataName $1 }
 
 conid  :: { RdrName }
-       : CONID                 { mkSrcUnqual dataName $1 }
+       : CONID                 { mkUnqual dataName $1 }
 
 -----------------------------------------------------------------------------
 -- ConSyms
 
 qconsym :: { RdrName }
        : consym                { $1 }
-       | QCONSYM               { case $1 of { (mod,n) ->
-                                 mkSrcQual dataName mod n } }
+       | QCONSYM               { mkQual dataName $1 }
 
 consym :: { RdrName }
-       : CONSYM                { mkSrcUnqual dataName $1 }
+       : CONSYM                { mkUnqual dataName $1 }
 
 -----------------------------------------------------------------------------
 -- VarSyms
@@ -1006,37 +1031,39 @@ qvarsym :: { RdrName }
        : varsym                { $1 }
        | qvarsym1              { $1 }
 
-qvarsymm :: { RdrName }
-       : varsymm               { $1 }
+qvarsym_no_minus :: { RdrName }
+       : varsym_no_minus       { $1 }
        | qvarsym1              { $1 }
 
+qvarsym1 :: { RdrName }
+qvarsym1 : QVARSYM             { mkQual varName $1 }
+
 varsym :: { RdrName }
-       : VARSYM                { mkSrcUnqual varName $1 }
-       | '-'                   { minus_RDR }
-       | '!'                   { pling_RDR }
-       | '.'                   { dot_RDR }
+       : varsym_no_minus       { $1 }
+       | '-'                   { mkUnqual varName SLIT("-") }
 
-varsymm :: { RdrName } -- varsym not including '-'
-       : VARSYM                { mkSrcUnqual varName $1 }
-       | '!'                   { pling_RDR }
-       | '.'                   { dot_RDR }
+varsym_no_minus :: { RdrName } -- varsym not including '-'
+       : VARSYM                { mkUnqual varName $1 }
+       | special_sym           { mkUnqual varName $1 }
 
-qvarsym1 :: { RdrName }
-       : QVARSYM               { case $1 of { (mod,n) ->
-                                 mkSrcQual varName mod n } }
 
-literal :: { HsLit }
-       : INTEGER               { HsInt    $1 }
-       | CHAR                  { HsChar   $1 }
-       | RATIONAL              { HsFrac   $1 }
-       | STRING                { HsString $1 }
+-- See comments with special_id
+special_sym :: { UserFS }
+special_sym : '!'      { SLIT("!") }
+           | '.'       { SLIT(".") }
+
+-----------------------------------------------------------------------------
+-- Literals
 
+literal :: { HsLit }
+       : CHAR                  { HsChar       $1 }
+       | STRING                { HsString     $1 }
        | PRIMINTEGER           { HsIntPrim    $1 }
        | PRIMCHAR              { HsCharPrim   $1 }
        | PRIMSTRING            { HsStringPrim $1 }
        | PRIMFLOAT             { HsFloatPrim  $1 }
        | PRIMDOUBLE            { HsDoublePrim $1 }
-       | CLITLIT               { HsLitLit     $1 }
+       | CLITLIT               { HsLitLit     $1 (error "Parser.y: CLITLIT") }
 
 srcloc :: { SrcLoc }   :       {% getSrcLocP }
  
@@ -1054,31 +1081,28 @@ layout_on_for_do  :: { () }     : {% layoutOn False }
 -- Miscellaneous (mostly renamings)
 
 modid  :: { ModuleName }
-       : CONID                 { mkSrcModuleFS $1 }
+       : CONID                 { mkModuleNameFS $1 }
 
 tycon  :: { RdrName }
-       : CONID                 { mkSrcUnqual tcClsName $1 }
+       : CONID                 { mkUnqual tcClsName $1 }
+
+tyconop        :: { RdrName }
+       : CONSYM                { mkUnqual tcClsName $1 }
 
 qtycon :: { RdrName }
        : tycon                 { $1 }
-       | QCONID                { case $1 of { (mod,n) ->
-                                 mkSrcQual tcClsName mod n } }
+       | QCONID                { mkQual tcClsName $1 }
+
+qtyconop :: { RdrName }
+         : tyconop             { $1 }
+         | QCONSYM             { mkQual tcClsName $1 }
 
 qtycls         :: { RdrName }
        : qtycon                { $1 }
 
-tyvar  :: { RdrName }
-       : VARID                 { mkSrcUnqual tvName $1 }
-       | 'as'                  { as_tyvar_RDR }
-       | 'qualified'           { qualified_tyvar_RDR }
-       | 'hiding'              { hiding_tyvar_RDR }
-       | 'export'              { export_tyvar_RDR }
-       | 'label'               { label_tyvar_RDR }
-       | 'dynamic'             { dynamic_tyvar_RDR }
-       | 'unsafe'              { unsafe_tyvar_RDR }
-       | 'stdcall'             { stdcall_tyvar_RDR }
-       | 'ccall'               { ccall_tyvar_RDR }
-       -- NOTE: no 'forall'
+commas :: { Int }
+       : commas ','                    { $1 + 1 }
+       | ','                           { 2 }
 
 -----------------------------------------------------------------------------