[project @ 2000-10-24 13:23:33 by sewardj]

Compile everything needed by main/HscMain.

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 7459929..2509004 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -28,6 +28,7 @@ module CmdLineOpts (
        dopt_CoreToDo,
        dopt_StgToDo,
        dopt_HscLang,
+       dopt_OutName,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
@@ -276,10 +277,11 @@ data DynFlag
    deriving (Eq)
 
 data DynFlags = DynFlags {
-  coreToDo :: CoreToDo,
-  stgToDo  :: StgToDo,
-  hscLang  :: HscLang,
-  flags    :: [DynFlag]
+  coreToDo   :: CoreToDo,
+  stgToDo    :: StgToDo,
+  hscLang    :: HscLang,
+  hscOutName :: String,  -- name of the file in which to place output
+  flags      :: [DynFlag]
  }
 
 dopt :: DynFlag -> DynFlags -> Bool
@@ -291,10 +293,13 @@ dopt_CoreToDo = coreToDo
 dopt_StgToDo :: DynFlags -> StgToDo
 dopt_StgToDo = stgToDo
 
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
+
 data HscLang
-  = HscC     String   -- String is the filename to put output into
-  | HscAsm   String   -- ditto
-  | HscJava  String   -- ditto
+  = HscC
+  | HscAsm
+  | HscJava
   | HscInterpreter
 
 dopt_HscLang :: DynFlags -> HscLang

diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 727f771..a8b7d01 100644 (file)
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -31,8 +31,8 @@ import Module         ( Module )
 import CmdLineOpts
 import ErrUtils                ( dumpIfSet_dyn )
 import Outputable
-import CmdLineOpts     ( DynFlags(..), HscLang(..) )
-import TmpFiles                ( newTmpName )
+import CmdLineOpts     ( DynFlags, HscLang(..), dopt_OutName )
+import TmpFiles                ( newTempName )
 
 import IO              ( IOMode(..), hClose, openFile, Handle )
 \end{code}
@@ -63,17 +63,18 @@ codeOutput dflags mod_name tycons classes core_binds stg_binds
 
     -- Dunno if the above comment is still meaningful now.  JRS 001024.
 
-    do stub_names <- outputForeignStubs c_code h_code
+    do let filenm = dopt_OutName dflags 
+       stub_names <- outputForeignStubs dflags c_code h_code
        case dopt_HscLang dflags of
           HscInterpreter -> return stub_names
-          HscAsm  filenm -> outputAsm dflags filenm flat_abstractC ncg_uniqs
+          HscAsm         -> outputAsm dflags filenm flat_abstractC ncg_uniqs
                             >> return stub_names
-          HscC    filenm -> outputC dflags filenm flat_abstractC       
+          HscC           -> outputC dflags filenm flat_abstractC       
                             >> return stub_names
-          HscJava filenm -> outputJava dflags filenm mod_name tycons core_binds
+          HscJava        -> outputJava dflags filenm mod_name tycons core_binds
                             >> return stub_names
 
-doOutput :: (Handle -> IO ()) -> IO ()
+doOutput :: String -> (Handle -> IO ()) -> IO ()
 doOutput filenm io_action
   = (do        handle <- openFile filenm WriteMode
        io_action handle
@@ -91,7 +92,7 @@ doOutput filenm io_action
 
 \begin{code}
 outputC dflags filenm flat_absC
-  = do dumpIfSet_dyn Opt_D_dump_realC dflags "Real C" (dumpRealC flat_absC)
+  = do dumpIfSet_dyn dflags Opt_D_dump_realC "Real C" (dumpRealC flat_absC)
        doOutput filenm (\ h -> writeRealC h flat_absC)
 \end{code}
 
@@ -107,8 +108,8 @@ outputAsm dflags filenm flat_absC ncg_uniqs
 
 #ifndef OMIT_NATIVE_CODEGEN
 
-  = do dumpIfSet_dyn Opt_D_dump_stix dflags "Final stix code" stix_final
-       dumpIfSet_dyn Opt_D_dump_asm dflags "Asm code" ncg_output_d
+  = do dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
+       dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
        doOutput filenm ( \f -> printForAsm f ncg_output_d)
   where
     (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
@@ -147,13 +148,13 @@ outputJava dflags filenm mod tycons core_binds
 \begin{code}
 outputForeignStubs dflags c_code h_code
   = do
-       dumpIfSet_dyn Opt_D_dump_foreign dflags 
+       dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export header file" stub_h_output_d
 
        maybe_stub_h_file
            <- outputForeignStubs_help True{-.h output-} stub_h_output_w
 
-       dumpIfSet_dyn Opt_D_dump_foreign dflags 
+       dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export stubs" stub_c_output_d
 
         maybe_stub_c_file
@@ -173,13 +174,11 @@ outputForeignStubs dflags c_code h_code
 -- 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 Nothing
-outputForeignStubs_help is_header switch doc_str =
-  case switch of
-    Nothing    -> return Nothing
-    Just fname -> newTempName suffix >>= \ fname ->
-                  writeFile fname (include_prefix ++ doc_str) >>
-                  return (Just suffix)
+outputForeignStubs_help is_header ""      = return Nothing
+outputForeignStubs_help is_header doc_str 
+   = newTempName suffix >>= \ fname ->
+     writeFile fname (include_prefix ++ doc_str) >>
+     return (Just suffix)
   where
     suffix
        | is_header   = "h_stub"

diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs
index 310c747..39e05b9 100644 (file)
--- a/ghc/compiler/main/TmpFiles.hs
+++ b/ghc/compiler/main/TmpFiles.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.3 2000/10/23 09:03:27 simonpj Exp $
+-- $Id: TmpFiles.hs,v 1.4 2000/10/24 13:23:33 sewardj Exp $
 --
 -- Temporary file management
 --
@@ -21,7 +21,9 @@ import Config
 import Util
 
 -- hslibs
--- import Posix                commented out SLPJ
+#ifndef mingw32_TARGET_OS
+import Posix ( getProcessID )
+#endif
 import Exception
 import IOExts
 
@@ -57,6 +59,13 @@ cleanTempFiles verbose = do
 type Suffix = String
 
 -- find a temporary name that doesn't already exist.
+#ifdef mingw32_TARGET_OS
+getProcessID :: IO Int
+getProcessID
+   = do putStr "warning: faking getProcessID in main/TmpFiles.lhs"
+        return 12345
+#endif
+
 newTempName :: Suffix -> IO FilePath
 newTempName extn = do
   x <- getProcessID

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index d82fe3f..7cf5dd2 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.43 2000/10/24 08:40:10 simonpj Exp $
+$Id: Parser.y,v 1.44 2000/10/24 13:23:33 sewardj Exp $
 
 Haskell grammar.
 
@@ -278,7 +278,7 @@ importdecls :: { [RdrNameImportDecl] }
 
 importdecl :: { RdrNameImportDecl }
        : 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec 
-               { ImportDecl (mkSrcModuleFS $5) $3 $4 $6 $7 $2 }
+               { ImportDecl (mkModuleNameFS $5) $3 $4 $6 $7 $2 }
 
 maybe_src :: { WhereFrom }
        : '{-# SOURCE' '#-}'                    { ImportByUserSource }
@@ -875,7 +875,7 @@ dbind       : ipvar '=' exp                 { ($1, $3) }
 
 depreclist :: { [RdrName] }
 depreclist : deprec_var                        { [$1] }
-          | deprec_var ',' depreclist  { $1 : $2 }
+          | deprec_var ',' depreclist  { $1 : $3 }
 
 deprec_var :: { RdrName }
 deprec_var : var                       { $1 }
@@ -1061,7 +1061,7 @@ layout_on_for_do  :: { () }       : {% layoutOn False }
 -- Miscellaneous (mostly renamings)
 
 modid  :: { ModuleName }
-       : CONID                 { mkSrcModuleFS $1 }
+       : CONID                 { mkModuleNameFS $1 }
 
 tycon  :: { RdrName }
        : CONID                 { mkUnqual tcClsName $1 }