[project @ 2002-03-05 11:22:44 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 9a8e23f..8c41409 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -45,7 +45,7 @@ import Id             ( idName )
 import IdInfo          ( CafInfo(..), CgInfoEnv, CgInfo(..) )
 import StringBuffer    ( hGetStringBuffer, freeStringBuffer )
 import Parser
-import Lex             ( PState(..), ParseResult(..) )
+import Lex             ( ParseResult(..), ExtFlags(..), mkPState )
 import SrcLoc          ( mkSrcLoc )
 import Finder          ( findModule )
 import Rename          ( checkOldIface, renameModule, closeIfaceDecls )
@@ -57,6 +57,7 @@ import MkIface                ( mkFinalIface )
 import TcModule
 import InstEnv         ( emptyInstEnv )
 import Desugar
+import Flattening       ( flatten, flattenExpr )
 import SimplCore
 import CoreUtils       ( coreBindsSize )
 import CoreTidy                ( tidyCorePgm )
@@ -65,7 +66,7 @@ import StgSyn
 import CoreToStg       ( coreToStg )
 import SimplStg                ( stg2stg )
 import CodeGen         ( codeGen )
-import CodeOutput      ( codeOutput )
+import CodeOutput      ( codeOutput, outputForeignStubs )
 
 import Module          ( ModuleName, moduleName, mkHomeModule )
 import CmdLineOpts
@@ -80,7 +81,7 @@ import HscStats               ( ppSourceStats )
 import HscTypes
 import FiniteMap       ( FiniteMap, plusFM, emptyFM, addToFM )
 import OccName         ( OccName )
-import Name            ( Name, nameModule, nameOccName, getName, isGlobalName )
+import Name            ( Name, nameModule, nameOccName, getName )
 import NameEnv         ( emptyNameEnv, mkNameEnv )
 import Module          ( Module )
 
@@ -245,6 +246,13 @@ hscRecomp ghci_mode dflags have_object
              <- _scc_ "DeSugar" 
                deSugar dflags pcs_tc hst this_mod print_unqual tc_result
 
+           -------------------
+           -- FLATTENING
+           -------------------
+       ; flat_details
+            <- _scc_ "Flattening"
+               flatten dflags pcs_tc hst ds_details
+
        ; pcs_middle
            <- _scc_ "pcs_middle"
                if ghci_mode == OneShot 
@@ -271,7 +279,7 @@ hscRecomp ghci_mode dflags have_object
            -------------------
        ; simpl_details
             <- _scc_     "Core2Core"
-               core2core dflags pcs_middle hst dont_discard ds_details
+               core2core dflags pcs_middle hst dont_discard flat_details
 
            -------------------
            -- TIDY
@@ -360,7 +368,12 @@ hscRecomp ghci_mode dflags have_object
                          mkFinalIface ghci_mode dflags location 
                                    maybe_checked_iface new_iface tidy_details
 
-                   return ( False, False, Just (bcos,itbl_env), final_iface )
+                   ------------------ Create f-x-dynamic C-side stuff ---
+                    (istub_h_exists, istub_c_exists) 
+                       <- outputForeignStubs dflags c_code h_code
+
+                   return ( istub_h_exists, istub_c_exists, 
+                             Just (bcos,itbl_env), final_iface )
 #else
                then error "GHC not compiled with interpreter"
 #endif
@@ -411,12 +424,11 @@ myParseModule dflags src_filename
 
       buf <- hGetStringBuffer True{-expand tabs-} src_filename
 
-      let glaexts | dopt Opt_GlasgowExts dflags = 1#
-                 | otherwise                   = 0#
+      let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                          parrEF        = dopt Opt_PArr        dflags}
+         loc  = mkSrcLoc (_PK_ src_filename) 1
 
-      case parseModule buf PState{ bol = 0#, atbol = 1#,
-                                  context = [], glasgow_exts = glaexts,
-                                  loc = mkSrcLoc (_PK_ src_filename) 1 } of {
+      case parseModule buf (mkPState loc exts) of {
 
        PFailed err -> do { hPutStrLn stderr (showSDoc err);
                             freeStringBuffer buf;
@@ -549,8 +561,11 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr
                -- Desugar it
          ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
        
+               -- Flatten it
+       ; flat_expr <- flattenExpr dflags pcs2 hst ds_expr
+
                -- Simplify it
-       ; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
+       ; simpl_expr <- simplifyExpr dflags pcs2 hst flat_expr
 
                -- Tidy it (temporary, until coreSat does cloning)
        ; tidy_expr <- tidyCoreExpr simpl_expr
@@ -582,12 +597,11 @@ hscParseStmt dflags str
 
       buf <- stringToStringBuffer str
 
-      let glaexts | dopt Opt_GlasgowExts dflags = 1#
-                         | otherwise                   = 0#
+      let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                          parrEF        = dopt Opt_PArr        dflags}
+         loc  = mkSrcLoc SLIT("<interactive>") 1
 
-      case parseStmt buf PState{ bol = 0#, atbol = 1#,
-                                context = [], glasgow_exts = glaexts,
-                                loc = mkSrcLoc SLIT("<interactive>") 1 } of {
+      case parseStmt buf (mkPState loc exts) of {
 
        PFailed err -> do { hPutStrLn stderr (showSDoc err);
 --     Not yet implemented in <4.11    freeStringBuffer buf;
@@ -667,13 +681,11 @@ hscThing dflags hst hit pcs0 ic str
 myParseIdentifier dflags str
   = do buf <- stringToStringBuffer str
  
-       let glaexts | dopt Opt_GlasgowExts dflags = 1#
-                  | otherwise                   = 0#
+       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                           parrEF        = dopt Opt_PArr        dflags}
+          loc  = mkSrcLoc SLIT("<interactive>") 1
 
-       case parseIdentifier buf 
-               PState{ bol = 0#, atbol = 1#,
-                       context = [], glasgow_exts = glaexts,
-                       loc = mkSrcLoc SLIT("<interactive>") 1 } of
+       case parseIdentifier buf (mkPState loc exts) of
 
          PFailed err -> do { hPutStrLn stderr (showSDoc err);
                              freeStringBuffer buf;