Commit 536a6e2a authored by simonmar's avatar simonmar
Browse files

[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>
parent 8419fa6d
......@@ -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.
......
......@@ -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),
......
{-
-----------------------------------------------------------------------------
$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,17 +197,11 @@ 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
......@@ -1105,8 +1097,6 @@ commas :: { Int }
-----------------------------------------------------------------------------
{
data ParseStuff = PModule RdrNameHsModule | PExpr RdrNameHsExpr
happyError :: P a
happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
}
......@@ -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
}
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment