[project @ 2000-04-21 12:57:54 by simonpj]

/home/simonpj/tmp/msg

ghc/compiler/Makefile

 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.73 2000/03/31 03:09:35 hwloidl Exp $
+# $Id: Makefile,v 1.74 2000/04/21 12:57:54 simonpj Exp $
 
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
@@ -37,7 +37,7 @@ $(HS_PROG) :: $(HS_SRCS)
 DIRS = \
   utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn \
   specialise simplCore stranal stgSyn simplStg codeGen absCSyn main \
-  profiling parser usageSP cprAnalysis
+  profiling parser usageSP cprAnalysis javaGen
 
 
 ifeq ($(GhcWithNativeCodeGen),YES)

ghc/compiler/absCSyn/AbsCUtils.lhs

@@ -27,7 +27,7 @@ import PrimRep		( getPrimRepSize, PrimRep(..) )
 import Unique		( Unique{-instance Eq-} )
 import UniqSupply	( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
 			  UniqSupply )
-import CmdLineOpts      ( opt_ProduceC, opt_EmitCExternDecls )
+import CmdLineOpts      ( opt_OutputLanguage, opt_EmitCExternDecls )
 import Maybes		( maybeToBool )
 import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..) )
 import Panic		( panic )
@@ -330,7 +330,7 @@ flatAbsC (CSwitch discrim alts deflt)
 	returnFlt ( (tag, alt_heres), alt_tops )
 
 flatAbsC stmt@(COpStmt results (CCallOp ccall) args vol_regs)
-  | isCandidate && maybeToBool opt_ProduceC
+  | isCandidate && opt_OutputLanguage == Just "C"	-- Urgh
   = returnFlt (stmt, tdef)
   where
     (isCandidate, isDyn) =

ghc/compiler/main/CmdLineOpts.lhs

@@ -133,11 +133,9 @@ module CmdLineOpts (
 	opt_NoImplicitPrelude,
 	opt_OmitBlackHoling,
 	opt_OmitInterfacePragmas,
-	opt_ProduceC,
 	opt_ProduceExportCStubs,
 	opt_ProduceExportHStubs,
 	opt_ProduceHi,
-	opt_ProduceS,
 	opt_NoPruneDecls,
 	opt_ReportCompile,
 	opt_SourceUnchanged,
@@ -145,6 +143,9 @@ module CmdLineOpts (
 	opt_Unregisterised,
 	opt_Verbose,
 
+	opt_OutputLanguage,
+	opt_OutputFile,
+
 	-- Code generation
 	opt_UseVanillaRegs,
 	opt_UseFloatRegs,
@@ -412,11 +413,20 @@ opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 opt_NoImplicitPrelude		= lookUp  SLIT("-fno-implicit-prelude")
 opt_OmitBlackHoling		= lookUp  SLIT("-dno-black-holing")
 opt_OmitInterfacePragmas	= lookUp  SLIT("-fomit-interface-pragmas")
-opt_ProduceC  			= lookup_str "-C="
 opt_ProduceExportCStubs		= lookup_str "-F="
 opt_ProduceExportHStubs		= lookup_str "-FH="
 opt_ProduceHi 			= lookup_str "-hifile=" -- the one to produce this time 
 
+-- Language for output: "C", "asm", "java", maybe more
+-- Nothing => don't output anything
+opt_OutputLanguage :: Maybe String
+opt_OutputLanguage = lookup_str "-olang="
+
+opt_OutputFile :: String
+opt_OutputFile 	   = case lookup_str "-ofile=" of
+			Nothing -> panic "No output file specified (-ofile=xxx)"
+			Just f  -> f
+
 -- Simplifier switches
 opt_SimplNoPreInlining		= lookUp SLIT("-fno-pre-inlining")
 	-- NoPreInlining is there just to see how bad things
@@ -439,7 +449,6 @@ opt_UF_KeenessFactor		= lookup_def_float "-funfolding-keeness-factor"	   (1.5::F
 opt_UF_CheapOp  = ( 1 :: Int)	-- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
 			
-opt_ProduceS  			= lookup_str "-S="
 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 opt_NoPruneDecls		= lookUp SLIT("-fno-prune-decls")
 opt_SourceUnchanged		= lookUp SLIT("-fsource-unchanged")

ghc/compiler/main/CodeOutput.lhs

@@ -11,13 +11,18 @@ module CodeOutput( codeOutput ) where
 #ifndef OMIT_NATIVE_CODEGEN
 import AsmCodeGen	( nativeCodeGen )
 #endif
+
 #ifdef ILX
 import IlxGen		( ilxGen )
 #endif
 
+import JavaGen		( javaGen )
+import qualified PrintJava
+
 import TyCon		( TyCon )
 import Id		( Id )
 import Class		( Class )
+import CoreSyn		( CoreBind )
 import StgSyn		( StgBinding )
 import AbsCSyn		( AbstractC, absCNop )
 import PprAbsC		( dumpRealC, writeRealC )
@@ -31,52 +36,117 @@ import IO		( IOMode(..), hPutStr, hClose, openFile	)
 \end{code}
 
 
+%************************************************************************
+%*									*
+\subsection{Steering}
+%*									*
+%************************************************************************
+
 \begin{code}
 codeOutput :: Module
 	   -> [TyCon] -> [Class]	-- Local tycons and classes
+	   -> [CoreBind]		-- Core bindings
 	   -> [(StgBinding,[Id])]	-- The STG program with SRTs
 	   -> SDoc 		-- C stubs for foreign exported functions
 	   -> SDoc		-- Header file prototype for foreign exported functions
 	   -> AbstractC		-- Compiled abstract C
 	   -> UniqSupply
 	   -> IO ()
-codeOutput mod_name tycons classes stg_binds c_code h_code flat_abstractC ncg_uniqs
+codeOutput mod_name tycons classes core_binds stg_binds 
+	   c_code h_code flat_abstractC ncg_uniqs
   = -- You can have C (c_output) or assembly-language (ncg_output),
     -- but not both.  [Allowing for both gives a space leak on
     -- flat_abstractC.  WDP 94/10]
 
+    do  {
+	outputForeignStubs c_code h_code ;
+	case opt_OutputLanguage of {
+	  Nothing     -> return ()	-- No -olang=xxx flag; so no-op
+	; Just "asm"  -> outputAsm flat_abstractC ncg_uniqs	
+	; Just "C"    -> outputC flat_abstractC	
+	; Just "java" -> outputJava mod_name tycons core_binds
+	; Just foo    -> pprPanic "Don't understand output language" (quotes (text foo))
+	} }
+
+
+doOutput io_action
+  = (do	handle <- openFile opt_OutputFile WriteMode
+	io_action handle
+	hClose handle)
+    `catch` (\err -> pprPanic "Failed to open or write code output file" (text opt_OutputFile))
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{C}
+%*									*
+%************************************************************************
+
+\begin{code}
+outputC flat_absC
+  = do 
+       dumpIfSet opt_D_dump_realC "Real C" (dumpRealC flat_absC)
+       doOutput (\ h -> writeRealC h flat_absC)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Assembler}
+%*									*
+%************************************************************************
+
+\begin{code}
+outputAsm flat_absC ncg_uniqs
 #ifndef OMIT_NATIVE_CODEGEN
-    let
-	(stix_final, ncg_output_d) = nativeCodeGen flat_absC_ncg ncg_uniqs
-	ncg_output_w = (\ f -> printForAsm f ncg_output_d)
-    in
-    dumpIfSet opt_D_dump_stix "Final stix code" stix_final	>>
-    dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d 		>>
-    doOutput opt_ProduceS ncg_output_w 				>>
-#else
-#ifdef ILX
-    doOutput opt_ProduceS (\f -> printForUser f (ilxGen tycons stg_binds))		>>
-#endif
-#endif
 
-    dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d		>>
-    outputForeignStubs True{-.h output-} opt_ProduceExportHStubs stub_h_output_w	>>
+  = do	dumpIfSet opt_D_dump_stix "Final stix code" stix_final
+	dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d
+	doOutput (\ f -> printForAsm f ncg_output_d)
+  where
+    (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
+
+#else /* OMIT_NATIVE_CODEGEN */
+
+  = do 	hPutStrLn stderr "This compiler was built without a native code generator"
+	hPutStrLn stderr "Use -fvia-C instead"
+
+#endif
+\end{code}
 
-    dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
-    outputForeignStubs False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w	>>
 
-    dumpIfSet opt_D_dump_realC "Real C" c_output_d 	>>
-    doOutput opt_ProduceC c_output_w
+%************************************************************************
+%*									*
+\subsection{Java}
+%*									*
+%************************************************************************
 
+\begin{code}
+outputJava mod tycons core_binds
+  = doOutput (\ f -> printForUser f pp_java)
+	-- User style printing for now to keep indentation
   where
-    (flat_absC_c, flat_absC_ncg) =
-	 case (maybeToBool opt_ProduceC || opt_D_dump_realC,
-	       maybeToBool opt_ProduceS || opt_D_dump_asm) of
-	     (True,  False) -> (flat_abstractC, absCNop)
-	     (False, True)  -> (absCNop, flat_abstractC)
-	     (False, False) -> (absCNop, absCNop)
-	     (True,  True)  -> error "ERROR: Can't do both .hc and .s at the same time"
+    java_code = javaGen mod [{- Should be imports-}] tycons core_binds
+    pp_java   = PrintJava.compilationUnit java_code
+\end{code}
 
+
+%************************************************************************
+%*									*
+\subsection{Foreign import/export}
+%*									*
+%************************************************************************
+
+\begin{code}
+outputForeignStubs c_code h_code
+  = do
+	dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d
+	outputForeignStubs_help True{-.h output-} opt_ProduceExportHStubs stub_h_output_w
+
+	dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d
+	outputForeignStubs_help False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w
+  where
     -- C stubs for "foreign export"ed functions.
     stub_c_output_d = pprCode CStyle c_code
     stub_c_output_w = showSDoc stub_c_output_d
@@ -85,15 +155,12 @@ codeOutput mod_name tycons classes stg_binds c_code h_code flat_abstractC ncg_un
     stub_h_output_d = pprCode CStyle h_code
     stub_h_output_w = showSDoc stub_h_output_d
 
-    c_output_d = dumpRealC flat_absC_c
-    c_output_w = (\ f -> writeRealC f flat_absC_c)
-
 
-    -- don't use doOutput for dumping the f. export stubs
-    -- since it is more than likely that the stubs file will
-    -- turn out to be empty, in which case no file should be created.
-outputForeignStubs is_header switch ""      = return ()
-outputForeignStubs is_header switch doc_str =
+-- Don't use doOutput for dumping the f. export stubs
+-- since it is more than likely that the stubs file will
+-- turn out to be empty, in which case no file should be created.
+outputForeignStubs_help is_header switch ""      = return ()
+outputForeignStubs_help is_header switch doc_str =
   case switch of
     Nothing    -> return ()
     Just fname -> writeFile fname (include_prefix ++ doc_str)
@@ -101,13 +168,5 @@ outputForeignStubs is_header switch doc_str =
   include_prefix
    | is_header   = "#include \"Rts.h\"\n"
    | otherwise   = "#include \"RtsAPI.h\"\n"
-
-doOutput switch io_action
-  = case switch of
-	  Nothing    -> return ()
-	  Just fname ->
-	    openFile fname WriteMode	>>= \ handle ->
-	    io_action handle		>>
-	    hClose handle
 \end{code}
 

ghc/compiler/main/Main.lhs

@@ -208,7 +208,8 @@ doIt (core_cmds, stg_cmds)
 	--------------------------  Code output -------------------------------
     show_pass "CodeOutput" 				>>
     _scc_     "CodeOutput"
-    codeOutput this_mod local_tycons local_classes stg_binds2
+    codeOutput this_mod local_tycons local_classes
+	       tidy_binds stg_binds2
 	       c_code h_code abstractC 
 	       ncg_uniqs				>>