[project @ 2005-07-19 16:44:50 by simonpj]
[ghc-hetmet.git] / ghc / compiler / parser / Parser.y.pp
index 8b85551..3de3793 100644 (file)
@@ -280,6 +280,14 @@ TH_TY_QUOTE        { L _ ITtyQuote       }      -- ''T
 %%
 
 -----------------------------------------------------------------------------
+-- 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
@@ -361,7 +369,7 @@ qcnames :: { [RdrName] }
 
 qcname         :: { Located RdrName }  -- Variable or data constructor
        :  qvar                                 { $1 }
-       |  gcon                                 { $1 }
+       |  qcon                                 { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -500,14 +508,14 @@ where     :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
        : '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) }
-       | {- empty -}                   { noLoc [] }
+       | {- empty -}                   { noLoc emptyLocalBinds }
 
 
 -----------------------------------------------------------------------------
@@ -859,7 +867,7 @@ gadt_constrs :: { Located [LConDecl RdrName] }
         | gadt_constr                   { L1 [$1] } 
 
 gadt_constr :: { LConDecl RdrName }
-        : qcon '::' sigtype
+        : con '::' sigtype
               { LL (GadtDecl $1 $3) } 
 
 constrs :: { Located [LConDecl RdrName] }
@@ -953,8 +961,7 @@ gdrhs :: { Located [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
@@ -994,7 +1001,7 @@ exp10 :: { LHsExpr RdrName }
        : '\\' 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 }
@@ -1002,12 +1009,11 @@ exp10 :: { LHsExpr RdrName }
        | '-' 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
-                                          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 }
@@ -1075,7 +1081,7 @@ aexp2     :: { LHsExpr RdrName }
        | '$(' 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) }                       
@@ -1116,13 +1122,11 @@ texps :: { [LHsExpr RdrName] }
 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) }
@@ -1162,12 +1166,9 @@ parr :: { LHsExpr RdrName }
        | 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.
 
@@ -1203,8 +1204,7 @@ gdpats :: { Located [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
@@ -1214,7 +1214,7 @@ stmtlist :: { Located [LStmt RdrName] }
        |     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
@@ -1236,13 +1236,13 @@ maybe_stmt :: { Maybe (LStmt RdrName) }
 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 }
        : infixexp '<-' exp             {% checkPattern $1 >>= \p ->
-                                          return (LL $ BindStmt p $3) }
-       | exp                           { L1 $ ExprStmt $1 placeHolderType }
+                                          return (LL $ mkBindStmt p $3) }
+       | exp                           { L1 $ mkExprStmt $1 }
        | 'let' binds                   { LL $ LetStmt (unLoc $2) }
 
 -----------------------------------------------------------------------------
@@ -1271,14 +1271,12 @@ dbinds  :: { Located [LIPBind RdrName] }
 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] }
@@ -1286,49 +1284,25 @@ depreclist : deprec_var                 { L1 [unLoc $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) }
+       | 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 }  
@@ -1372,12 +1346,16 @@ tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
 
 -----------------------------------------------------------------------------
--- Any operator
+-- Operators
 
 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) }
@@ -1386,23 +1364,16 @@ qopm    :: { LHsExpr RdrName }   -- used in sections
        : qvaropm               { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
 
------------------------------------------------------------------------------
--- VarIds
-
-qvarid :: { Located RdrName }
-       : varid                 { $1 }
-       | QVARID                { L1 $ mkQual varName (getQVARID $1) }
+qvarop :: { Located RdrName }
+       : qvarsym               { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
 
-varid :: { Located RdrName }
-       : varid_no_unsafe       { $1 }
-       | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
-       | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
-       | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
+qvaropm :: { Located RdrName }
+       : qvarsym_no_minus      { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
 
-varid_no_unsafe :: { Located RdrName }
-       : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
-       | special_id            { L1 $! mkUnqual varName (unLoc $1) }
-       | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
+-----------------------------------------------------------------------------
+-- Type variables
 
 tyvar   :: { Located RdrName }
 tyvar   : tyvarid              { $1 }
@@ -1425,23 +1396,36 @@ tyvarsym :: { Located RdrName }
 --              or "*", because that's used for kinds
 tyvarsym : VARSYM              { L1 $! mkUnqual tvName (getVARSYM $1) }
 
--- 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 
 
+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                { L1 $ mkQual varName (getQVARID $1) }
+
+varid :: { Located RdrName }
+       : varid_no_unsafe       { $1 }
+       | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
+       | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
+       | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
+
+varid_no_unsafe :: { Located RdrName }
+       : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
+       | special_id            { L1 $! mkUnqual varName (unLoc $1) }
+       | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
+
 qvarsym :: { Located RdrName }
        : varsym                { $1 }
        | qvarsym1              { $1 }
@@ -1462,7 +1446,20 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
        | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
 
 
--- See comments with special_id
+-- 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") }
+
 special_sym :: { Located UserFS }
 special_sym : '!'      { L1 FSLIT("!") }
            | '.'       { L1 FSLIT(".") }