X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FCodeOutput.lhs;h=6985bd76fcdcba4300a98c62c10e898f59b72733;hb=8af9e46751058eecc15d0251c5e250ebcb8367da;hp=8b5138abb4a1d256531abdab31fbf4829a26a4b7;hpb=475940d68ab79a5f352ccaca485baa17a2df0765;p=ghc-hetmet.git

diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index 8b5138a..6985bd7 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -4,6 +4,13 @@
 \section{Code output phase}
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module CodeOutput( codeOutput, outputForeignStubs ) where
 
 #include "HsVersions.h"
@@ -81,7 +88,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
 	; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
 	; case hscTarget dflags of {
              HscInterpreted -> return ();
-             HscAsm         -> outputAsm dflags filenm this_mod location flat_abstractC;
+             HscAsm         -> outputAsm dflags filenm flat_abstractC;
              HscC           -> outputC dflags filenm this_mod location 
 				 flat_abstractC stubs_exist pkg_deps
 				 foreign_stubs;
@@ -124,8 +131,8 @@ outputC dflags filenm mod location flat_absC
        
 	   ffi_decl_headers 
 	      = case foreign_stubs of
-		  NoStubs 		  -> []
-		  ForeignStubs _ _ fdhs _ -> map unpackFS (nub fdhs)
+		  NoStubs 		-> []
+		  ForeignStubs _ _ fdhs -> map unpackFS (nub fdhs)
 			-- Remove duplicates, because distinct foreign import decls
 			-- may cite the same #include.  Order doesn't matter.
 
@@ -144,10 +151,10 @@ outputC dflags filenm mod location flat_absC
 	  hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
 	  hPutStr h cc_injects
 	  when stub_h_exists $ 
-	     hPutStrLn h ("#include \"" ++ (filenameOf stub_h) ++ "\"")
+	     hPutStrLn h ("#include \"" ++ inc_stub_h ++ "\"")
 	  writeCs dflags h flat_absC
   where
-    (_, stub_h) = mkStubPaths dflags (moduleName mod) location
+    (_, _, inc_stub_h) = mkStubPaths dflags (moduleName mod) location
 \end{code}
 
 
@@ -158,16 +165,15 @@ outputC dflags filenm mod location flat_absC
 %************************************************************************
 
 \begin{code}
-outputAsm dflags filenm this_mod location flat_absC
+outputAsm dflags filenm flat_absC
 
 #ifndef OMIT_NATIVE_CODEGEN
 
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
-       ncg_output_d <- {-# SCC "NativeCodeGen" #-}
-			  nativeCodeGen dflags this_mod location flat_absC ncg_uniqs
-       dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" (docToSDoc ncg_output_d)
+
        {-# SCC "OutputAsm" #-} doOutput filenm $
-	   \f -> printDoc LeftMode f ncg_output_d
+	   \f -> {-# SCC "NativeCodeGen" #-}
+	         nativeCodeGen dflags f ncg_uniqs flat_absC
   where
 
 #else /* OMIT_NATIVE_CODEGEN */
@@ -217,7 +223,7 @@ outputForeignStubs dflags mod location stubs
 	stub_h_exists <- doesFileExist stub_h
 	return (stub_h_exists, stub_c_exists)
 
-  | ForeignStubs h_code c_code _ _ <- stubs
+  | ForeignStubs h_code c_code _ <- stubs
   = do
 	let
 	    stub_c_output_d = pprCode CStyle c_code
@@ -259,7 +265,7 @@ outputForeignStubs dflags mod location stubs
 
         return (stub_h_file_exists, stub_c_file_exists)
   where
-   (stub_c, stub_h) = mkStubPaths dflags (moduleName mod) location
+   (stub_c, stub_h, _) = mkStubPaths dflags (moduleName mod) location
 
 cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
 cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n"