[project @ 2001-11-26 09:20:25 by simonpj]
[ghc-hetmet.git] / ghc / compiler / parser / Parser.y
index 6e7fbf6..95c46a1 100644 (file)
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.45 2000/10/26 16:51:44 sewardj Exp $
+$Id: Parser.y,v 1.77 2001/11/26 09:20:26 simonpj Exp $
 
 Haskell grammar.
 
@@ -9,27 +9,34 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( parse ) where
+module Parser ( parseModule, parseStmt, parseIdentifier ) where
 
 import HsSyn
 import HsTypes         ( mkHsTupCon )
-import HsPat            ( InPat(..) )
+import TypeRep          ( IPName(..) )
 
 import RdrHsSyn
 import Lex
 import ParseUtil
 import RdrName
-import PrelInfo                ( mAIN_Name )
-import OccName         ( UserFS, 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 ForeignCall     ( Safety(..), CExportSpec(..), CCallSpec(..), 
+                         CCallConv(..), CCallTarget(..), defaultCCallConv,
+                         DNCallSpec(..) )
+import OccName         ( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import SrcLoc          ( SrcLoc )
 import Module
-import CallConv
 import CmdLineOpts     ( opt_SccProfilingOn )
-import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), NewOrData(..) )
+import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), 
+                         NewOrData(..), StrictnessMark(..), Activation(..) )
 import Panic
 
 import GlaExts
-import FastString      ( tailFS )
+import CStrings                ( CLabelString )
+import FastString
+import Maybes          ( orElse )
 import Outputable
 
 #include "HsVersions.h"
@@ -89,7 +96,7 @@ Conflicts: 14 shift/reduce
  'then'        { ITthen }
  'type'        { ITtype }
  'where'       { ITwhere }
- '_scc_'       { ITscc }
+ '_scc_'       { ITscc }             -- ToDo: remove
 
  'forall'      { ITforall }                    -- GHC extension keywords
  'foreign'     { ITforeign }
@@ -100,16 +107,18 @@ Conflicts: 14 shift/reduce
  'with'        { ITwith }
  'stdcall'      { ITstdcallconv }
  'ccall'        { ITccallconv }
- '_ccall_'     { ITccall (False, False, False) }
- '_ccall_GC_'  { ITccall (False, False, True)  }
- '_casm_'      { ITccall (False, True,  False) }
- '_casm_GC_'   { ITccall (False, True,  True)  }
+ 'dotnet'       { ITdotnet }
+ '_ccall_'     { ITccall (False, False, PlayRisky) }
+ '_ccall_GC_'  { ITccall (False, False, PlaySafe)  }
+ '_casm_'      { ITccall (False, True,  PlayRisky) }
+ '_casm_GC_'   { ITccall (False, True,  PlaySafe)  }
 
  '{-# SPECIALISE'  { ITspecialise_prag }
  '{-# SOURCE'     { ITsource_prag }
  '{-# INLINE'      { ITinline_prag }
  '{-# NOINLINE'    { ITnoinline_prag }
  '{-# RULES'      { ITrules_prag }
+ '{-# SCC'        { ITscc_prag }
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
 
@@ -138,7 +147,7 @@ Conflicts: 14 shift/reduce
  '__A'         { ITarity }
  '__P'         { ITspecialise }
  '__C'         { ITnocaf }
- '__U'         { ITunfold $$ }
+ '__U'         { ITunfold }
  '__S'         { ITstrict $$ }
  '__M'         { ITcprinfo $$ }
 -}
@@ -181,7 +190,8 @@ Conflicts: 14 shift/reduce
  QVARSYM       { ITqvarsym  $$ }
  QCONSYM       { ITqconsym  $$ }
 
- IPVARID       { ITipvarid  $$ }               -- GHC extension
+ IPDUPVARID    { ITdupipvarid   $$ }           -- GHC extension
+ IPSPLITVARID          { ITsplitipvarid $$ }           -- GHC extension
 
  CHAR          { ITchar     $$ }
  STRING                { ITstring   $$ }
@@ -197,7 +207,9 @@ Conflicts: 14 shift/reduce
 
 %monad { P } { thenP } { returnP }
 %lexer { lexer } { ITeof }
-%name parse
+%name parseModule module
+%name parseStmt   maybe_stmt
+%name parseIdentifier  identifier
 %tokentype { Token }
 %%
 
@@ -276,8 +288,8 @@ importdecls :: { [RdrNameImportDecl] }
        | {- empty -}                           { [] }
 
 importdecl :: { RdrNameImportDecl }
-       : 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec 
-               { ImportDecl (mkModuleNameFS $5) $3 $4 $6 $7 $2 }
+       : 'import' srcloc maybe_src optqualified modid maybeas maybeimpspec 
+               { ImportDecl $5 $3 $4 $6 $7 $2 }
 
 maybe_src :: { WhereFrom }
        : '{-# SOURCE' '#-}'                    { ImportByUserSource }
@@ -325,13 +337,17 @@ 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
+       | srcloc 'data' ctype constrs deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (mkTyData DataType cs c ts (reverse $5) (length $5) $6 $1))) }
+                     (mkTyData DataType cs c ts (reverse $4) (length $4) $5 $1))) }
 
        | srcloc 'newtype' ctype '=' newconstr deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
@@ -344,7 +360,7 @@ topdecl :: { RdrBinding }
                        (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig (groupBindings $5) 
                   in
                   returnP (RdrHsDecl (TyClD
-                     (mkClassDecl cs c ts $4 sigs binds $1))) }
+                     (mkClassDecl cs c ts $4 sigs (Just binds) $1))) }
 
        | srcloc 'instance' inst_type where
                { let (binds,sigs) 
@@ -352,23 +368,45 @@ topdecl :: { RdrBinding }
                                (groupBindings $4)
                  in RdrHsDecl (InstD (InstDecl $3 binds sigs Nothing $1)) }
 
-       | srcloc 'default' '(' types0 ')'
-               { RdrHsDecl (DefD (DefaultDecl $4 $1)) }
+       | srcloc 'default' '(' types0 ')'               { RdrHsDecl (DefD (DefaultDecl $4 $1)) }
+       | 'foreign' fordecl                             { RdrHsDecl $2 }
+       | '{-# DEPRECATED' deprecations '#-}'           { $2 }
+       | '{-# RULES' rules '#-}'                       { $2 }
+       | decl                                          { $1 }
 
-       | srcloc 'foreign' 'import' callconv ext_name 
-         unsafe_flag varid_no_unsafe '::' sigtype
-               { RdrHsDecl (ForD (ForeignDecl $7 (FoImport $6) $9 (mkExtName $5 $7) $4 $1)) }
+fordecl :: { RdrNameHsDecl }
+fordecl : srcloc 'label' ext_name varid '::' sigtype
+               { ForD (ForeignImport $4 $6 (LblImport ($3 `orElse` mkExtName $4)) $1) }
 
-       | srcloc 'foreign' 'export' callconv ext_name varid '::' sigtype
-               { RdrHsDecl (ForD (ForeignDecl $6 FoExport $8 (mkExtName $5 $6) $4 $1)) }
 
-       | srcloc 'foreign' 'label' ext_name varid '::' sigtype
-               { RdrHsDecl (ForD (ForeignDecl $5 FoLabel $7 (mkExtName $4 $5)
-                                       defaultCallConv $1)) }
+       ----------- ccall/stdcall decls ------------
+       | srcloc 'import' ccallconv ext_name unsafe_flag varid_no_unsafe '::' sigtype
+               { let
+                   call_spec = CCallSpec (StaticTarget ($4 `orElse` mkExtName $6)) $3 $5
+                 in
+                 ForD (ForeignImport $6 $8 (CImport call_spec) $1)
+               }
 
-       | '{-# DEPRECATED' deprecations '#-}'           { $2 }
-       | '{-# RULES' rules '#-}'                       { $2 }
-       | decl                                          { $1 }
+       | srcloc 'import' ccallconv 'dynamic' unsafe_flag varid_no_unsafe '::' sigtype
+               { let
+                   call_spec = CCallSpec DynamicTarget $3 $5
+                 in
+                 ForD (ForeignImport $6 $8 (CImport call_spec) $1)
+               }
+
+       | srcloc 'export' ccallconv ext_name varid '::' sigtype
+               { ForD (ForeignExport $5 $7 (CExport (CExportStatic ($4 `orElse` mkExtName $5) $3)) $1) }
+
+       | srcloc 'export' ccallconv 'dynamic' varid '::' sigtype
+               { ForD (ForeignImport $5 $7 (CDynImport $3) $1) } 
+
+
+       ----------- .NET decls ------------
+       | srcloc 'import' 'dotnet' ext_name varid '::' sigtype
+               { ForD (ForeignImport $5 $7 (DNImport (DNCallSpec ($4 `orElse` mkExtName $5))) $1) }
+
+       | srcloc 'import' 'dotnet' 'type' ext_name tycon
+               { TyClD (ForeignType $6 $5 DNType $1) }
 
 decls  :: { [RdrBinding] }
        : decls ';' decl                { $3 : $1 }
@@ -379,18 +417,14 @@ decls     :: { [RdrBinding] }
 decl   :: { RdrBinding }
        : fixdecl                       { $1 }
        | valdef                        { $1 }
-       | '{-# INLINE'   srcloc opt_phase qvar '#-}'    { RdrSig (InlineSig $4 $3 $2) }
-       | '{-# NOINLINE' srcloc opt_phase qvar '#-}'    { RdrSig (NoInlineSig $4 $3 $2) }
+       | '{-# INLINE'   srcloc activation qvar '#-}'         { RdrSig (InlineSig True  $4 $3 $2) }
+       | '{-# NOINLINE' srcloc inverse_activation qvar '#-}' { RdrSig (InlineSig False $4 $3 $2) }
        | '{-# SPECIALISE' srcloc qvar '::' sigtypes '#-}'
                { foldr1 RdrAndBindings 
                    (map (\t -> RdrSig (SpecSig $3 t $2)) $5) }
        | '{-# SPECIALISE' srcloc 'instance' inst_type '#-}'
                { RdrSig (SpecInstSig $4 $2) }
 
-opt_phase :: { Maybe Int }
-          : INTEGER                     { Just (fromInteger $1) }
-          | {- empty -}                 { Nothing }
-
 wherebinds :: { RdrNameHsBinds }
        : where                 { cvBinds cvValSig (groupBindings $1) }
 
@@ -421,8 +455,16 @@ rules      :: { RdrBinding }
        |  {- empty -}                          { RdrNullBind }
 
 rule   :: { RdrBinding }
-       : STRING rule_forall fexp '=' srcloc exp
-            { RdrHsDecl (RuleD (HsRule $1 [] $2 $3 $6 $5)) }
+       : STRING activation rule_forall infixexp '=' srcloc exp
+            { RdrHsDecl (RuleD (HsRule $1 $2 $3 $4 $7 $6)) }
+
+activation :: { Activation }           -- Omitted means AlwaysActive
+        : {- empty -}                           { AlwaysActive }
+        | '[' INTEGER ']'                       { ActiveAfter (fromInteger $2) }
+
+inverse_activation :: { Activation }   -- Omitted means NeverActive
+        : {- empty -}                           { NeverActive }
+        | '[' INTEGER ']'                       { ActiveAfter (fromInteger $2) }
 
 rule_forall :: { [RdrNameRuleBndr] }
        : 'forall' rule_var_list '.'            { $2 }
@@ -454,19 +496,18 @@ deprecation :: { RdrBinding }
 -----------------------------------------------------------------------------
 -- Foreign import/export
 
-callconv :: { Int }
-       : 'stdcall'             { stdCallConv }
-       | 'ccall'               { cCallConv }
-       | {- empty -}           { defaultCallConv }
+ccallconv :: { CCallConv }
+       : 'stdcall'             { StdCallConv }
+       | 'ccall'               { CCallConv }
+       | {- empty -}           { defaultCCallConv }
 
-unsafe_flag :: { Bool }
-       : 'unsafe'              { True }
-       | {- empty -}           { False }
+unsafe_flag :: { Safety }
+       : 'unsafe'              { PlayRisky }
+       | {- empty -}           { PlaySafe }
 
-ext_name :: { Maybe ExtName }
-       : 'dynamic'             { Just Dynamic }
-       | STRING                { Just (ExtName $1 Nothing)   }
-       | STRING STRING         { Just (ExtName $2 (Just $1)) }
+ext_name :: { Maybe CLabelString }
+       : STRING                { Just $1 }
+       | STRING STRING         { Just $2 }     -- Ignore "module name" for now
        | {- empty -}           { Nothing }
 
 
@@ -534,7 +575,7 @@ inst_type :: { RdrNameHsType }
        : ctype                         {% checkInstType $1 }
 
 types0  :: { [RdrNameHsType] }
-       : types                         { $1 }
+       : types                         { reverse $1 }
        | {- empty -}                   { [] }
 
 types  :: { [RdrNameHsType] }
@@ -567,12 +608,16 @@ 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 }
+       : srcloc conid atype    { mkConDecl $2 [] [] (VanillaCon [unbangedType $3]) $1 }
+       | srcloc conid '{' var '::' ctype '}'
+                               { mkConDecl $2 [] [] (RecCon [([$4], unbangedType $6)]) $1 }
 
 constrs :: { [RdrNameConDecl] }
-       : constrs '|' constr            { $3 : $1 }
+        : {- empty; a GHC extension -}  { [] }
+        | '=' constrs1                  { $2 }
+
+constrs1 :: { [RdrNameConDecl] }
+       : constrs1 '|' constr           { $3 : $1 }
        | constr                        { [$1] }
 
 constr :: { RdrNameConDecl }
@@ -590,18 +635,18 @@ context :: { RdrNameContext }
 
 constr_stuff :: { (RdrName, RdrNameConDetails) }
        : btype                         {% mkVanillaCon $1 []               }
-       | btype '!' atype satypes       {% mkVanillaCon $1 (Banged $3 : $4) }
+       | btype '!' atype satypes       {% mkVanillaCon $1 (BangType MarkedUserStrict $3 : $4) }
        | gtycon '{' fielddecls '}'     {% mkRecCon $1 $3 }
        | sbtype conop sbtype           { ($2, InfixCon $1 $3) }
 
 satypes        :: { [RdrNameBangType] }
-       : atype satypes                 { Unbanged $1 : $2 }
-       | '!' atype satypes             { Banged   $2 : $3 }
+       : atype satypes                 { unbangedType $1 : $2 }
+       | '!' atype satypes             { BangType MarkedUserStrict $2 : $3 }
        | {- empty -}                   { [] }
 
 sbtype :: { RdrNameBangType }
-       : btype                         { Unbanged $1 }
-       | '!' atype                     { Banged   $2 }
+       : btype                         { unbangedType $1 }
+       | '!' atype                     { BangType MarkedUserStrict $2 }
 
 fielddecls :: { [([RdrName],RdrNameBangType)] }
        : fielddecl ',' fielddecls      { $1 : $3 }
@@ -611,8 +656,8 @@ fielddecl :: { ([RdrName],RdrNameBangType) }
        : sig_vars '::' stype           { (reverse $1, $3) }
 
 stype :: { RdrNameBangType }
-       : ctype                         { Unbanged $1 } 
-       | '!' atype                     { Banged   $2 }
+       : ctype                         { unbangedType $1 }
+       | '!' atype                     { BangType MarkedUserStrict $2 }
 
 deriving :: { Maybe [RdrName] }
        : {- empty -}                   { Nothing }
@@ -656,16 +701,15 @@ valdef :: { RdrBinding }
 
 
 rhs    :: { RdrNameGRHSs }
-       : '=' srcloc exp wherebinds     { (GRHSs (unguardedRHS $3 $2) 
-                                                               $4 Nothing)}
-       | gdrhs wherebinds              { GRHSs (reverse $1) $2 Nothing }
+       : '=' srcloc exp wherebinds     { (GRHSs (unguardedRHS $3 $2) $4 placeHolderType)}
+       | gdrhs wherebinds              { GRHSs (reverse $1) $2 placeHolderType }
 
 gdrhs :: { [RdrNameGRHS] }
        : gdrhs gdrh                    { $2 : $1 }
        | gdrh                          { [$1] }
 
 gdrh :: { RdrNameGRHS }
-       : '|' srcloc quals '=' exp      { GRHS (reverse (ExprStmt $5 $2 : $3)) $2 }
+       : '|' srcloc quals '=' exp      { GRHS (reverse (ResultStmt $5 $2 : $3)) $2 }
 
 -----------------------------------------------------------------------------
 -- Expressions
@@ -681,28 +725,33 @@ infixexp :: { RdrNameHsExpr }
                                                (panic "fixity") $3 )}
 
 exp10 :: { RdrNameHsExpr }
-       : '\\' aexp aexps opt_asig '->' srcloc exp      
-                       {% checkPatterns ($2 : reverse $3) `thenP` \ ps -> 
-                          returnP (HsLam (Match [] ps $4 
-                                           (GRHSs (unguardedRHS $7 $6) 
-                                                  EmptyBinds Nothing))) }
+       : '\\' srcloc aexp aexps opt_asig '->' srcloc exp       
+                       {% checkPatterns $2 ($3 : reverse $4) `thenP` \ ps -> 
+                          returnP (HsLam (Match ps $5 
+                                           (GRHSs (unguardedRHS $8 $7) 
+                                                  EmptyBinds placeHolderType))) }
        | '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                              { mkHsNegApp $2 }
-       | srcloc 'do' stmtlist                  { HsDo DoStmt $3 $1 }
+       | srcloc 'do' stmtlist                  {% checkDo $3  `thenP` \ stmts ->
+                                                  returnP (HsDo DoExpr stmts $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 }
+       | '_ccall_'    ccallid aexps0           { HsCCall $2 $3 PlayRisky False placeHolderType }
+       | '_ccall_GC_' ccallid aexps0           { HsCCall $2 $3 PlaySafe  False placeHolderType }
+       | '_casm_'     CLITLIT aexps0           { HsCCall $2 $3 PlayRisky True  placeHolderType }
+       | '_casm_GC_'  CLITLIT aexps0           { HsCCall $2 $3 PlaySafe  True  placeHolderType }
 
-        | '_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 }
@@ -732,8 +781,8 @@ aexp1       :: { RdrNameHsExpr }
        : ipvar                         { HsIPVar $1 }
        | var_or_con                    { $1 }
        | literal                       { HsLit $1 }
-       | INTEGER                       { HsOverLit (mkHsIntegralLit $1) }
-       | RATIONAL                      { HsOverLit (mkHsFractionalLit $1) }
+       | INTEGER                       { HsOverLit (mkHsIntegral   $1) }
+       | RATIONAL                      { HsOverLit (mkHsFractional $1) }
        | '(' exp ')'                   { HsPar $2 }
        | '(' exp ',' texps ')'         { ExplicitTuple ($2 : reverse $4) Boxed}
        | '(#' texps '#)'               { ExplicitTuple (reverse $2)      Unboxed }
@@ -756,14 +805,20 @@ texps :: { [RdrNameHsExpr] }
 -- avoiding another shift/reduce-conflict.
 
 list :: { RdrNameHsExpr }
-       : exp                           { ExplicitList [$1] }
-       | lexps                         { ExplicitList (reverse $1) }
+       : exp                           { ExplicitList placeHolderType [$1] }
+       | lexps                         { ExplicitList placeHolderType (reverse $1) }
        | exp '..'                      { ArithSeqIn (From $1) }
        | 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 (ResultStmt $1 $2 : body $3))
+                                                          $2
+                                                 )
+                                       }
 
 lexps :: { [RdrNameHsExpr] }
        : lexps ',' exp                 { $3 : $1 }
@@ -772,15 +827,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
@@ -799,13 +852,13 @@ alts1     :: { [RdrNameMatch] }
        | alt                           { [$1] }
 
 alt    :: { RdrNameMatch }
-       : infixexp opt_sig ralt wherebinds
-                                       {% (checkPattern $1 `thenP` \p ->
-                                          returnP (Match [] [p] $2
-                                                    (GRHSs $3 $4 Nothing))  )}
+       : srcloc infixexp opt_sig ralt wherebinds
+                                       {% (checkPattern $1 $2 `thenP` \p ->
+                                          returnP (Match [p] $3
+                                                    (GRHSs $4 $5 placeHolderType))  )}
 
 ralt :: { [RdrNameGRHS] }
-       : '->' srcloc exp               { [GRHS [ExprStmt $3 $2] $2] }
+       : '->' srcloc exp               { [GRHS [ResultStmt $3 $2] $2] }
        | gdpats                        { (reverse $1) }
 
 gdpats :: { [RdrNameGRHS] }
@@ -813,32 +866,39 @@ gdpats :: { [RdrNameGRHS] }
        | gdpat                         { [$1] }
 
 gdpat  :: { RdrNameGRHS }
-       : srcloc '|' quals '->' exp     { GRHS (reverse (ExprStmt $5 $1:$3)) $1}
+       : srcloc '|' quals '->' exp     { GRHS (reverse (ResultStmt $5 $1:$3)) $1}
 
 -----------------------------------------------------------------------------
 -- Statement sequences
 
 stmtlist :: { [RdrNameStmt] }
-       : '{'                   stmts '}'       { reverse $2 }
-       |     layout_on_for_do  stmts close     { reverse $2 }
-
--- Stmt list should really end in an expression, but it's not
--- convenient to enforce this here, so we throw out erroneous
--- statement sequences in the renamer instead.
-
+       : '{'                   stmts '}'       { $2 }
+       |     layout_on_for_do  stmts close     { $2 }
+
+--     do { ;; s ; s ; ; s ;; }
+-- The last Stmt should be a ResultStmt, 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
 stmts :: { [RdrNameStmt] }
-       : ';' stmts1                    { $2 }
-       | stmts1                        { $1 }
+       : stmt stmts_help               { $1 : $2 }
+       | ';' stmts                     { $2 }
+       | {- empty -}                   { [] }
 
-stmts1 :: { [RdrNameStmt] }
-       : stmts1 ';' stmt               { $3 : $1 }
-       | stmts1 ';'                    { $1 }
-       | stmt                          { [$1] }
+stmts_help :: { [RdrNameStmt] }
+       : ';' stmts                     { $2 }
+       | {- empty -}                   { [] }
+
+-- 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 ->
+       : srcloc infixexp '<-' exp      {% checkPattern $1 $2 `thenP` \p ->
                                           returnP (BindStmt p $4 $1) }
-       | srcloc exp                    { ExprStmt $2 $1 }
+       | srcloc exp                    { ExprStmt $2 placeHolderType $1 }
        | srcloc 'let' declbinds        { LetStmt $3 }
 
 -----------------------------------------------------------------------------
@@ -856,22 +916,27 @@ fbind     :: { (RdrName, RdrNameHsExpr, Bool) }
 -----------------------------------------------------------------------------
 -- Implicit Parameter Bindings
 
-dbinding :: { [(RdrName, RdrNameHsExpr)] }
+dbinding :: { [(IPName RdrName, RdrNameHsExpr)] }
        : '{' dbinds '}'                { $2 }
        | layout_on dbinds close        { $2 }
 
-dbinds         :: { [(RdrName, RdrNameHsExpr)] }
+dbinds         :: { [(IPName RdrName, RdrNameHsExpr)] }
        : dbinds ';' dbind              { $3 : $1 }
        | dbinds ';'                    { $1 }
        | dbind                         { [$1] }
        | {- empty -}                   { [] }
 
-dbind  :: { (RdrName, RdrNameHsExpr) }
+dbind  :: { (IPName RdrName, RdrNameHsExpr) }
 dbind  : ipvar '=' exp                 { ($1, $3) }
 
 -----------------------------------------------------------------------------
 -- Variables, Constructors and Operators.
 
+identifier :: { RdrName }
+       : qvar                          { $1 }
+       | gcon                          { $1 }
+       | qop                           { $1 }
+
 depreclist :: { [RdrName] }
 depreclist : deprec_var                        { [$1] }
           | deprec_var ',' depreclist  { $1 : $3 }
@@ -906,8 +971,9 @@ qvar        :: { RdrName }
 -- whether it's a qvar or a var can be postponed until
 -- *after* we see the close paren.
 
-ipvar  :: { RdrName }
-       : IPVARID               { (mkUnqual ipName (tailFS $1)) }
+ipvar  :: { IPName RdrName }
+       : IPDUPVARID            { Dupable   (mkUnqual varName $1) }
+       | IPSPLITVARID          { MustSplit (mkUnqual varName $1) }
 
 qcon   :: { RdrName }
        : qconid                { $1 }
@@ -1042,7 +1108,7 @@ literal :: { HsLit }
        | PRIMSTRING            { HsStringPrim $1 }
        | PRIMFLOAT             { HsFloatPrim  $1 }
        | PRIMDOUBLE            { HsDoublePrim $1 }
-       | CLITLIT               { HsLitLit     $1 (error "Parser.y: CLITLIT") }
+       | CLITLIT               { HsLitLit     $1 placeHolderType }
 
 srcloc :: { SrcLoc }   :       {% getSrcLocP }
  
@@ -1061,6 +1127,11 @@ layout_on_for_do  :: { () }      : {% layoutOn False }
 
 modid  :: { ModuleName }
        : CONID                 { mkModuleNameFS $1 }
+        | QCONID               { mkModuleNameFS
+                                  (mkFastString
+                                    (unpackFS (fst $1) ++ 
+                                       '.':unpackFS (snd $1)))
+                               }
 
 tycon  :: { RdrName }
        : CONID                 { mkUnqual tcClsName $1 }