[project @ 2001-01-17 16:54:04 by simonmar]

Remove IfaceStuff and ParserStuff hacks, use happy-1.9's new multiple
%name feature.  GHCi's command line isn't stuck in -fglasgow-exts mode
any more.

<CoverMyBack>
YOU NOW NEED HAPPY 1.9 TO BUILD GHC.
</CoverMyBack>

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 56527b2..a1269c4 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -280,14 +280,14 @@ myParseModule dflags src_filename
       let glaexts | dopt Opt_GlasgowExts dflags = 1#
                  | otherwise                   = 0#
 
-      case parse buf PState{ bol = 0#, atbol = 1#,
-                            context = [], glasgow_exts = glaexts,
-                            loc = mkSrcLoc (_PK_ src_filename) 1 } of {
+      case parseModule buf PState{ bol = 0#, atbol = 1#,
+                                  context = [], glasgow_exts = glaexts,
+                                  loc = mkSrcLoc (_PK_ src_filename) 1 } of {
 
        PFailed err -> do { hPutStrLn stderr (showSDoc err);
                             return Nothing };
 
-       POk _ (PModule rdr_module@(HsModule mod_name _ _ _ _ _ _)) -> do {
+       POk _ rdr_module@(HsModule mod_name _ _ _ _ _ _) -> do {
 
       dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
       
@@ -433,7 +433,7 @@ hscExpr dflags hst hit pcs0 this_module expr wrap_print
         if (wrap_print && not is_IO_type)
                then do (new_pcs, maybe_stuff)
                          <- hscExpr dflags hst hit pcs2 this_module
-                               ("print (" ++ expr ++ ")") False
+                               ("putStr (show (" ++ expr ++ "))") False
                        case maybe_stuff of
                           Nothing -> return (new_pcs, maybe_stuff)
                           Just (bcos, _, _) ->
@@ -464,23 +464,20 @@ hscParseExpr dflags str
       showPass dflags "Parser"
       -- _scc_     "Parser"
 
-      buf <- stringToStringBuffer ("__expr " ++ str)
+      buf <- stringToStringBuffer str
 
-      -- glaexts is True for now (because of the daft __expr at the front
-      -- of the string...)
-      let glaexts = 1#
-      --let glaexts | dopt Opt_GlasgowExts dflags = 1#
-      --           | otherwise                   = 0#
+      let glaexts | dopt Opt_GlasgowExts dflags = 1#
+                         | otherwise             = 0#
 
-      case parse buf PState{ bol = 0#, atbol = 1#,
-                            context = [], glasgow_exts = glaexts,
-                            loc = mkSrcLoc SLIT("<no file>") 0 } of {
+      case parseExpr buf PState{ bol = 0#, atbol = 1#,
+                                context = [], glasgow_exts = glaexts,
+                                loc = mkSrcLoc SLIT("<no file>") 0 } of {
 
-       PFailed err -> do { freeStringBuffer buf;
-                           hPutStrLn stderr (showSDoc err);
+       PFailed err -> do { hPutStrLn stderr (showSDoc err);
+                           freeStringBuffer buf;
                             return Nothing };
 
-       POk _ (PExpr rdr_expr) -> do {
+       POk _ rdr_expr -> do {
 
       --ToDo: can't free the string buffer until we've finished this
       -- compilation sweep and all the identifiers have gone away.

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 3ff951a..97404b2 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -123,7 +123,6 @@ data Token
   | ITccallconv
 
   | ITinterface                        -- interface keywords
-  | ITexpr
   | IT__export
   | ITdepends
   | IT__forall
@@ -313,7 +312,6 @@ ghcExtensionKeywordsFM = listToUFM $
 
        -- interface keywords
         ("__interface",                ITinterface),
-        ("__expr",             ITexpr),
        ("__export",            IT__export),
        ("__depends",           ITdepends),
        ("__forall",            IT__forall),

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index dbc68a2..a3b437d 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.49 2000/11/24 17:02:03 simonpj Exp $
+$Id: Parser.y,v 1.50 2001/01/17 16:54:04 simonmar Exp $
 
 Haskell grammar.
 
@@ -9,7 +9,7 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( ParseStuff(..), parse ) where
+module Parser ( parseModule, parseExpr ) where
 
 import HsSyn
 import HsTypes         ( mkHsTupCon )
@@ -113,8 +113,6 @@ Conflicts: 14 shift/reduce
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
 
- '__expr'      { ITexpr }
-
 {-
  '__interface' { ITinterface }                 -- interface keywords
  '__export'    { IT__export }
@@ -199,18 +197,12 @@ Conflicts: 14 shift/reduce
 
 %monad { P } { thenP } { returnP }
 %lexer { lexer } { ITeof }
-%name parse
+%name parseModule module
+%name parseExpr   exp
 %tokentype { Token }
 %%
 
 -----------------------------------------------------------------------------
--- 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
@@ -1105,8 +1097,6 @@ commas :: { Int }
 -----------------------------------------------------------------------------
 
 {
-data ParseStuff = PModule RdrNameHsModule | PExpr RdrNameHsExpr
-
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 }

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 3d7af50..fa9ddb7 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -28,7 +28,7 @@ Import declarations
 
 
 {
-module ParseIface ( parseIface, IfaceStuff(..) ) where
+module ParseIface ( parseIface, parseType, parseRules, parseIdInfo ) where
 
 #include "HsVersions.h"
 
@@ -69,7 +69,11 @@ import GlaExts
 import FastString      ( tailFS )
 }
 
-%name      parseIface
+%name      parseIface      iface
+%name      parseType       type
+%name      parseIdInfo     id_info
+%name      parseRules      rules_and_deprecs
+
 %tokentype  { Token }
 %monad     { P }{ thenP }{ returnP }
 %lexer      { lexer } { ITeof }
@@ -193,17 +197,6 @@ import FastString  ( tailFS )
  UNKNOWN       { ITunknown  $$ }
 %%
 
--- iface_stuff is the main production.
--- It recognises (a) a whole interface file
---              (b) a type (so that type sigs can be parsed lazily)
---              (c) the IdInfo part of a signature (same reason)
-
-iface_stuff :: { IfaceStuff }
-iface_stuff : iface            { PIface   $1 }
-           | type              { PType    $1 }
-           | id_info           { PIdInfo  $1 }
-           | rules_and_deprecs { PRulesAndDeprecs $1 }
-
 iface          :: { ParsedIface }
 iface          : '__interface' package mod_name 
                        version sub_versions
@@ -369,7 +362,7 @@ maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 maybe_idinfo  : {- empty -}    { \_ -> [] }
              | pragma          { \x -> if opt_IgnoreIfacePragmas then [] 
                                        else case $1 of
-                                               POk _ (PIdInfo id_info) -> id_info
+                                               POk _ id_info -> id_info
                                                PFailed err -> pprPanic "IdInfo parse failed" 
                                                                        (vcat [ppr x, err])
                                }
@@ -390,8 +383,15 @@ maybe_idinfo  : {- empty -}        { \_ -> [] }
        dates from a time where we picked up a .hi file first if it existed.]
     -}
 
-pragma :: { ParseResult IfaceStuff }
-pragma : src_loc PRAGMA        { parseIface $2 PState{ bol = 0#, atbol = 1#,
+pragma :: { ParseResult [HsIdInfo RdrName] }
+pragma : src_loc PRAGMA        { parseIdInfo $2 PState{ bol = 0#, atbol = 1#,
+                                                       context = [],
+                                                       glasgow_exts = 1#,
+                                                       loc = $1 }
+                               }
+
+rules_prag :: { ParseResult ([RdrNameRuleDecl], IfaceDeprecs) }
+rules_prag : src_loc PRAGMA    { parseRules $2 PState{ bol = 0#, atbol = 1#,
                                                        context = [],
                                                        glasgow_exts = 1#,
                                                        loc = $1 }
@@ -401,8 +401,8 @@ pragma      : src_loc PRAGMA        { parseIface $2 PState{ bol = 0#, atbol = 1#,
 
 rules_and_deprecs_part :: { ([RdrNameRuleDecl], IfaceDeprecs) }
 rules_and_deprecs_part : {- empty -}   { ([], Nothing) }
-                      | pragma         { case $1 of
-                                            POk _ (PRulesAndDeprecs rds) -> rds
+                      | rules_prag     { case $1 of
+                                            POk _ rds -> rds
                                             PFailed err -> pprPanic "Rules/Deprecations parse failed" err
                                        }
 
@@ -941,10 +941,5 @@ checkVersion :: { () }
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
-data IfaceStuff = PIface          ParsedIface
-               | PIdInfo          [HsIdInfo RdrName]
-               | PType            RdrNameHsType
-               | PRulesAndDeprecs ([RdrNameRuleDecl], IfaceDeprecs)
-
 mk_con_decl name (ex_tvs, ex_ctxt) details loc = mkConDecl name ex_tvs ex_ctxt details loc
 }

diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index ee10b6f..9742091 100644 (file)
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -37,7 +37,7 @@ import RdrHsSyn               ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
 import BasicTypes      ( Version, defaultFixity )
 import RnEnv
 import RnMonad
-import ParseIface      ( parseIface, IfaceStuff(..) )
+import ParseIface      ( parseIface )
 
 import Name            ( Name {-instance NamedThing-}, nameOccName,
                          nameModule, isLocalName, nameIsLocalOrFrom,
@@ -527,7 +527,7 @@ readIface file_path
        Right contents -> 
 
     case parseIface contents init_parser_state of
-       POk _ (PIface iface) -> returnRn (Right iface)
+       POk _ iface          -> returnRn (Right iface)
        PFailed err          -> bale_out err
        parse_result         -> bale_out empty
                -- This last case can happen if the interface file is (say) empty