From 536a6e2a2f4acfda2ab94231c8071e146c53ecc3 Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 17 Jan 2001 16:54:04 +0000 Subject: [PATCH] [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. YOU NOW NEED HAPPY 1.9 TO BUILD GHC. --- ghc/compiler/main/HscMain.lhs | 31 +++++++++++++--------------- ghc/compiler/parser/Lex.lhs | 2 -- ghc/compiler/parser/Parser.y | 18 ++++------------ ghc/compiler/rename/ParseIface.y | 41 ++++++++++++++++--------------------- ghc/compiler/rename/RnHiFiles.lhs | 4 ++-- 5 files changed, 38 insertions(+), 58 deletions(-) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 56527b2..a1269c4 100644 --- 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("") 0 } of { + case parseExpr buf PState{ bol = 0#, atbol = 1#, + context = [], glasgow_exts = glaexts, + loc = mkSrcLoc SLIT("") 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 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4