[project @ 2000-12-04 16:42:14 by rrt]

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

diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 642e90d..84f5645 100644 (file)
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -21,15 +21,14 @@ import qualified PrintJava
 
 import TyCon           ( TyCon )
 import Id              ( Id )
-import Class           ( Class )
 import CoreSyn         ( CoreBind )
+import OccurAnal       ( occurAnalyseBinds )
 import StgSyn          ( StgBinding )
 import AbsCSyn         ( AbstractC )
 import PprAbsC         ( dumpRealC, writeRealC )
-import UniqSupply      ( UniqSupply )
 import Module          ( Module )
 import CmdLineOpts
-import ErrUtils                ( dumpIfSet_dyn )
+import ErrUtils                ( dumpIfSet_dyn, showPass )
 import Outputable
 import CmdLineOpts     ( DynFlags, HscLang(..), dopt_OutName )
 import TmpFiles                ( newTempName )
@@ -63,16 +62,18 @@ codeOutput dflags mod_name tycons core_binds stg_binds
 
     -- Dunno if the above comment is still meaningful now.  JRS 001024.
 
-    do let filenm = dopt_OutName dflags 
-       stub_names <- outputForeignStubs dflags c_code h_code
-       case dopt_HscLang dflags of
-          HscInterpreted -> return stub_names
-          HscAsm         -> outputAsm dflags filenm flat_abstractC
-                            >> return stub_names
-          HscC           -> outputC dflags filenm flat_abstractC       
-                            >> return stub_names
-          HscJava        -> outputJava dflags filenm mod_name tycons core_binds
-                            >> return stub_names
+    do { showPass dflags "CodeOutput"
+       ; let filenm = dopt_OutName dflags 
+       ; stub_names <- outputForeignStubs dflags c_code h_code
+       ; case dopt_HscLang dflags of
+             HscInterpreted -> return stub_names
+             HscAsm         -> outputAsm dflags filenm flat_abstractC
+                              >> return stub_names
+             HscC           -> outputC dflags filenm flat_abstractC    
+                              >> return stub_names
+             HscJava        -> outputJava dflags filenm mod_name tycons core_binds
+                              >> return stub_names
+       }
 
 doOutput :: String -> (Handle -> IO ()) -> IO ()
 doOutput filenm io_action
@@ -132,10 +133,12 @@ outputAsm dflags filenm flat_absC
 
 \begin{code}
 outputJava dflags filenm mod tycons core_binds
-  = doOutput filenm (\ f -> printForUser f pp_java)
+  = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java)
        -- User style printing for now to keep indentation
   where
-    java_code = javaGen mod [{- Should be imports-}] tycons core_binds
+    occ_anal_binds = occurAnalyseBinds core_binds
+       -- Make sure we have up to date dead-var information
+    java_code = javaGen mod [{- Should be imports-}] tycons occ_anal_binds
     pp_java   = PrintJava.compilationUnit java_code
 \end{code}
 
@@ -177,15 +180,15 @@ outputForeignStubs dflags c_code h_code
 -- turn out to be empty, in which case no file should be created.
 outputForeignStubs_help is_header ""      = return Nothing
 outputForeignStubs_help is_header doc_str 
-   = newTempName suffix >>= \ fname ->
-     writeFile fname (include_prefix ++ doc_str) >>
-     return (Just suffix)
+   = do fname <- newTempName suffix
+        writeFile fname (include_prefix ++ doc_str)
+        return (Just fname)
   where
     suffix
        | is_header   = "h_stub"
        | otherwise   = "c_stub"
     include_prefix
-       | is_header   = "#include \"Rts.h\"\n"
+       | is_header   = "#include \"HsFFI.h\"\n"
        | otherwise   = "#include \"RtsAPI.h\"\n"
 \end{code}