[project @ 2000-11-16 11:39:36 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / Parser.y

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index d067c64..9dc85a2 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.41 2000/10/12 11:47:26 sewardj Exp $
+$Id: Parser.y,v 1.48 2000/11/16 11:39:37 simonmar Exp $
 
 Haskell grammar.
 
@@ -9,10 +9,9 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( parse ) where
+module Parser ( ParseStuff(..), parse ) where
 
 import HsSyn
-import HsPragmas
 import HsTypes         ( mkHsTupCon )
 import HsPat            ( InPat(..) )
 
@@ -20,7 +19,7 @@ import RdrHsSyn
 import Lex
 import ParseUtil
 import RdrName
-import PrelInfo                ( mAIN_Name )
+import PrelNames
 import OccName         ( UserFS, varName, ipName, tcName, dataName, tcClsName, tvName )
 import SrcLoc          ( SrcLoc )
 import Module
@@ -114,6 +113,8 @@ Conflicts: 14 shift/reduce
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
 
+ '__expr'      { ITexpr }
+
 {-
  '__interface' { ITinterface }                 -- interface keywords
  '__export'    { IT__export }
@@ -203,6 +204,13 @@ Conflicts: 14 shift/reduce
 %%
 
 -----------------------------------------------------------------------------
+-- Entry points
+
+parse   :: { ParseStuff }
+       :  module                               { PModule $1 }
+       |  '__expr' exp                         { PExpr   $2 }
+
+-----------------------------------------------------------------------------
 -- Module Header
 
 -- The place for module deprecation is really too restrictive, but if it
@@ -278,7 +286,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 }
@@ -332,14 +340,12 @@ topdecl :: { RdrBinding }
        | srcloc 'data' ctype '=' constrs deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (mkTyData 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
-                     (mkTyData 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) ->
@@ -347,8 +353,7 @@ topdecl :: { RdrBinding }
                        (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 binds $1))) }
 
        | srcloc 'instance' inst_type where
                { let (binds,sigs) 
@@ -451,7 +456,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 ] }
 
@@ -736,8 +741,8 @@ aexp1       :: { RdrNameHsExpr }
        : ipvar                         { HsIPVar $1 }
        | var_or_con                    { $1 }
        | literal                       { HsLit $1 }
-       | INTEGER                       { HsOverLit (mkHsIntegralLit $1) }
-       | RATIONAL                      { HsOverLit (mkHsFractionalLit $1) }
+       | INTEGER                       { HsOverLit (HsIntegral   $1 fromInteger_RDR) }
+       | RATIONAL                      { HsOverLit (HsFractional $1 fromRational_RDR) }
        | '(' exp ')'                   { HsPar $2 }
        | '(' exp ',' texps ')'         { ExplicitTuple ($2 : reverse $4) Boxed}
        | '(#' texps '#)'               { ExplicitTuple (reverse $2)      Unboxed }
@@ -766,8 +771,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 (ReturnStmt $1 : body $3))
+                                                          $2
+                                                 )
+                                       }
 
 lexps :: { [RdrNameHsExpr] }
        : lexps ',' exp                 { $3 : $1 }
@@ -776,6 +787,10 @@ lexps :: { [RdrNameHsExpr] }
 -----------------------------------------------------------------------------
 -- List Comprehensions
 
+pquals :: { [[RdrNameStmt]] }
+       : pquals '|' quals              { $3 : $1 }
+       | '|' quals                     { [$2] }
+
 quals :: { [RdrNameStmt] }
        : quals ',' qual                { $3 : $1 }
        | qual                          { [$1] }
@@ -876,6 +891,14 @@ 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 }
@@ -1056,7 +1079,7 @@ layout_on_for_do  :: { () }       : {% layoutOn False }
 -- Miscellaneous (mostly renamings)
 
 modid  :: { ModuleName }
-       : CONID                 { mkSrcModuleFS $1 }
+       : CONID                 { mkModuleNameFS $1 }
 
 tycon  :: { RdrName }
        : CONID                 { mkUnqual tcClsName $1 }
@@ -1082,6 +1105,8 @@ commas :: { Int }
 -----------------------------------------------------------------------------
 
 {
+data ParseStuff = PModule RdrNameHsModule | PExpr RdrNameHsExpr
+
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 }