[project @ 2003-09-23 15:38:35 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 23f00c9..ed6f405 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -36,9 +36,9 @@ import CoreLint               ( lintUnfolding )
 import HsSyn
 
 import RdrName         ( nameRdrName )
-import StringBuffer    ( hGetStringBuffer, freeStringBuffer )
+import StringBuffer    ( hGetStringBuffer )
 import Parser
-import Lex             ( ParseResult(..), ExtFlags(..), mkPState )
+import Lexer           ( P(..), ParseResult(..), mkPState, showPFailed )
 import SrcLoc          ( mkSrcLoc )
 import TcRnDriver      ( checkOldIface, tcRnModule, tcRnExtCore, tcRnIface )
 import RnEnv           ( extendOrigNameCache )
@@ -48,10 +48,8 @@ import MkIface               ( mkIface )
 import Desugar
 import Flattening       ( flatten )
 import SimplCore
-import CoreUtils       ( coreBindsSize )
 import TidyPgm         ( tidyCorePgm )
 import CorePrep                ( corePrepPgm )
-import StgSyn
 import CoreToStg       ( coreToStg )
 import SimplStg                ( stg2stg )
 import CodeGen         ( codeGen )
@@ -72,8 +70,6 @@ import ParserCore
 import ParserCoreUtils
 import FiniteMap       ( emptyFM )
 import Name            ( nameModule )
-import NameEnv         ( emptyNameEnv )
-import NameSet         ( emptyNameSet )
 import Module          ( Module, ModLocation(..), showModMsg )
 import FastString
 import Maybes          ( expectJust )
@@ -156,7 +152,8 @@ hscNoRecomp hsc_env pcs_ch have_object
                        showModMsg have_object mod location);
 
       -- Typecheck 
-      (pcs_tc, maybe_tc_result) <- tcRnIface hsc_env pcs_ch old_iface ;
+      (pcs_tc, maybe_tc_result) <- _scc_ "tcRnIface"
+                                  tcRnIface hsc_env pcs_ch old_iface ;
 
       case maybe_tc_result of {
          Nothing -> return (HscFail pcs_tc);
@@ -390,17 +387,12 @@ myParseModule dflags src_filename
       _scc_  "Parser" do
       buf <- hGetStringBuffer src_filename
 
-      let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
-                          ffiEF         = dopt Opt_FFI         dflags,
-                          withEF        = dopt Opt_With        dflags,
-                          parrEF        = dopt Opt_PArr        dflags}
-         loc  = mkSrcLoc (mkFastString src_filename) 1
+      let loc  = mkSrcLoc (mkFastString src_filename) 1 0
 
-      case parseModule buf (mkPState loc exts) of {
+      case unP parseModule (mkPState buf loc dflags) of {
 
-       PFailed err -> do { hPutStrLn stderr (showSDoc err);
-                            freeStringBuffer buf;
-                            return Nothing };
+       PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);
+                                 return Nothing };
 
        POk _ rdr_module -> do {
 
@@ -516,17 +508,12 @@ hscParseStmt dflags str
 
       buf <- stringToStringBuffer str
 
-      let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
-                          ffiEF         = dopt Opt_FFI         dflags,
-                          withEF        = dopt Opt_With        dflags,
-                          parrEF        = dopt Opt_PArr        dflags}
-         loc  = mkSrcLoc FSLIT("<interactive>") 1
+      let loc  = mkSrcLoc FSLIT("<interactive>") 1 0
 
-      case parseStmt buf (mkPState loc exts) of {
+      case unP parseStmt (mkPState buf loc dflags) of {
 
-       PFailed err -> do { hPutStrLn stderr (showSDoc err);
---     Not yet implemented in <4.11    freeStringBuffer buf;
-                            return Nothing };
+       PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);     
+                                  return Nothing };
 
        -- no stmt: the line consisted of just space or comments
        POk _ Nothing -> return Nothing;
@@ -535,7 +522,6 @@ hscParseStmt dflags str
 
       --ToDo: can't free the string buffer until we've finished this
       -- compilation sweep and all the identifiers have gone away.
-      --freeStringBuffer buf;
       dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_stmt);
       return (Just rdr_stmt)
       }}
@@ -577,20 +563,13 @@ hscThing hsc_env pcs0 ic str
 myParseIdentifier dflags str
   = do buf <- stringToStringBuffer str
  
-       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
-                           ffiEF         = dopt Opt_FFI         dflags,
-                           withEF        = dopt Opt_With        dflags,
-                           parrEF        = dopt Opt_PArr        dflags}
-          loc  = mkSrcLoc FSLIT("<interactive>") 1
+       let loc  = mkSrcLoc FSLIT("<interactive>") 1 0
+       case unP parseIdentifier (mkPState buf loc dflags) of
 
-       case parseIdentifier buf (mkPState loc exts) of
+         PFailed l1 l2 err -> do { hPutStrLn stderr (showPFailed l1 l2 err);
+                                    return Nothing }
 
-         PFailed err -> do { hPutStrLn stderr (showSDoc err);
-                             freeStringBuffer buf;
-                              return Nothing }
-
-         POk _ rdr_name -> do { --should, but can't: freeStringBuffer buf;
-                                return (Just rdr_name) }
+         POk _ rdr_name -> return (Just rdr_name)
 #endif
 \end{code}