[project @ 2000-10-27 13:50:25 by sewardj]

Half-way through versioning so it will compile, sans interpreter, with 4.08.1

ghc/compiler/ghci/CmLink.lhs

@@ -89,20 +89,6 @@ link :: PackageConfigInfo
      -> PersistentLinkerState 
      -> IO LinkResult
 
-#ifndef GHCI_NOTYET
---link = panic "CmLink.link: not implemented"
-link pci groups pls1
-   = do putStrLn "Hello from the Linker!"
-        putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
-        putStrLn "Bye-bye from the Linker!"
-        return (LinkOK pls1)
-
-ppLinkableSCC :: SCC Linkable -> SDoc
-ppLinkableSCC (CyclicSCC xs) = ppr xs
-ppLinkableSCC (AcyclicSCC x) = ppr [x]
-
-
-#else
 link pci [] pls = return (LinkOK pls)
 link pci (group:groups) pls = do
    -- the group is either all objects or all interpretable, for now
@@ -120,7 +106,6 @@ link pci (group:groups) pls = do
 				   itbl_env=new_itbl_env})
     else
 	return (LinkErrs pls (ptext SLIT("linker: group must contain all objects or all interpreted modules")))
-#endif
 
 modname_of_linkable (LM nm _) = nm
 modname_of_linkable (LP _)    = panic "modname_of_linkable: package"

ghc/compiler/ghci/Linker.lhs

@@ -6,22 +6,30 @@
 \begin{code}
 {-# OPTIONS -#include "Linker.h" #-}
 module Linker ( 
-#ifdef GHCI
    loadObj,      -- :: String -> IO ()
    unloadObj,    -- :: String -> IO ()
    lookupSymbol, -- :: String -> IO (Maybe Addr)
    resolveObjs,  -- :: IO ()
    linkPrelude -- tmp
-#endif
   )  where
 
 import IO
 import Exception
 import Addr
 import PrelByteArr
-import PrelPack (packString)
+import PrelPack 	(packString)
+import Panic		( panic )
+
+#if __GLASGOW_HASKELL__ <= 408
+loadObj      = bogus "loadObj"
+unloadObj    = bogus "unloadObj"
+lookupSymbol = bogus "lookupSymbol"
+resolveObjs  = bogus "resolveObjs"
+linkPrelude  = bogus "linkPrelude"
+bogus f = panic ("Linker." ++ f ++ ": this hsc was built without an interpreter.")
+
+#else
 
-#ifdef GHCI
 linkPrelude = do
   hPutStr stderr "Loading HSstd_cbits.o..."
   loadObj "/home/simonmar/builds/i386-unknown-linux-boot/ghc/lib/std/cbits/HSstd_cbits.o"
@@ -86,5 +94,5 @@ foreign import "unloadObj" unsafe
 foreign import "resolveObjs" unsafe
    c_resolveObjs :: IO Int
 
-#endif /* GHCI */
+#endif /* __GLASGOW_HASKELL__ <= 408 */
 \end{code}

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.9 2000/10/27 11:48:55 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.10 2000/10/27 13:50:25 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -39,11 +39,9 @@ import Config
 import Util
 import MkIface		( pprIface )
 
-import Posix
 import Directory
 import System
 import IOExts
--- import Posix		commented out temp by SLPJ to get going on windows
 import Exception
 
 import IO
@@ -574,7 +572,7 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
 
 	-- this is the prefix used for the split .s files
 	tmp_pfx <- readIORef v_TmpDir
-	x <- getProcessID
+	x <- myGetProcessID
 	let split_s_prefix = tmp_pfx ++ "/ghc" ++ show x
 	writeIORef v_Split_prefix split_s_prefix
 	addFilesToClean [split_s_prefix ++ "__*"] -- d:-)

ghc/compiler/main/DriverUtil.hs

 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.4 2000/10/26 16:21:02 sewardj Exp $
+-- $Id: DriverUtil.hs,v 1.5 2000/10/27 13:50:25 sewardj Exp $
 --
 -- Utils for the driver
 --
@@ -72,7 +72,6 @@ instance Typeable BarfKind where
 
 -----------------------------------------------------------------------------
 -- Reading OPTIONS pragmas
-
 getOptionsFromSource 
 	:: String		-- input file
 	-> IO [String]		-- options, if any

ghc/compiler/main/Finder.lhs

@@ -24,6 +24,7 @@ import Directory
 import List
 import IO
 import Monad
+import Outputable	( showSDoc, ppr )	-- debugging only
 \end{code}
 
 The Finder provides a thin filesystem abstraction to the rest of the
@@ -45,13 +46,22 @@ initFinder :: PackageConfigInfo -> IO ()
 initFinder (PackageConfigInfo pkgs) = do
   -- expunge our home cache
   writeIORef v_HomeDirCache Nothing
-
   -- lazilly fill in the package cache
   writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
+  pkg_dbg_info <- readIORef v_PkgDirCache
+  putStrLn (unlines (map show (fmToList pkg_dbg_info)))
 
-  
 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 findModule name = do
+  hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
+  maybe_m <- findModule_wrk name
+  case maybe_m of
+     Nothing -> hPutStrLn stderr "Not Found"
+     Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
+  return maybe_m
+  
+findModule_wrk :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+findModule_wrk name = do
   j <- maybeHomeModule name
   case j of
 	Just home_module -> return (Just home_module)
@@ -148,9 +158,9 @@ maybePackageModule mod_name = do
 	Just (pkg_name,path) -> 
 	    return (Just (mkModule mod_name pkg_name,
 			  ModuleLocation{ 
-				hs_file  = error "package module; no source",
+				hs_file  = "error:_package_module;_no_source",
 				hi_file  = hi,
-				obj_file = error "package module; no object"
+				obj_file = "error:_package_module;_no_object"
 			   }
 		   ))
 

ghc/compiler/main/HscMain.lhs

@@ -62,7 +62,7 @@ import HscTypes		( ModDetails, ModIface(..), PersistentCompilerState(..),
 			  GenAvailInfo(..), RdrAvailInfo, OrigNameEnv(..),
 			  PackageRuleBase, HomeIfaceTable, PackageIfaceTable,
 			  extendTypeEnv, groupTyThings, TypeEnv, TyThing,
-			  typeEnvClasses, typeEnvTyCons )
+			  typeEnvClasses, typeEnvTyCons, emptyIfaceTable )
 import RnMonad		( ExportItem, ParsedIface(..) )
 import CmSummarise	( ModSummary(..), name_of_summary, ms_get_imports,
 			  mimp_name )
@@ -111,6 +111,7 @@ hscMain dflags summary maybe_old_iface hst hit pcs
       -- ????? source_unchanged :: Bool -- extracted from summary?
       let source_unchanged = trace "WARNING: source_unchanged?!" False
       ;
+      putStrLn "checking old iface ...";
       (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
          <- checkOldIface dflags hit hst pcs (ms_mod summary)
 			  source_unchanged maybe_old_iface;
@@ -122,6 +123,7 @@ hscMain dflags summary maybe_old_iface hst hit pcs
           what_next | recomp_reqd || no_old_iface = hscRecomp 
                     | otherwise                   = hscNoRecomp
       ;
+      putStrLn "doing what_next ...";
       what_next dflags summary maybe_checked_iface
                 hst hit pcs_ch
       }}
@@ -376,7 +378,8 @@ initPersistentCompilerState :: IO PersistentCompilerState
 initPersistentCompilerState 
   = do prs <- initPersistentRenamerState
        return (
-        PCS { pcs_PST   = initPackageDetails,
+        PCS { pcs_PIT   = emptyIfaceTable,
+              pcs_PST   = initPackageDetails,
 	      pcs_insts = emptyInstEnv,
 	      pcs_rules = emptyRuleBase,
 	      pcs_PRS   = prs

ghc/compiler/main/HscTypes.lhs

@@ -9,7 +9,7 @@ module HscTypes (
 
 	ModDetails(..),	ModIface(..), GlobalSymbolTable, 
 	HomeSymbolTable, PackageSymbolTable,
-	HomeIfaceTable, PackageIfaceTable, 
+	HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
 	lookupTable, lookupTableByModName,
 
 	IfaceDecls(..), 
@@ -71,7 +71,7 @@ import Type		( Type )
 import FiniteMap	( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
 import Bag		( Bag )
 import Maybes		( seqMaybe )
-import UniqFM 		( UniqFM )
+import UniqFM 		( UniqFM, emptyUFM )
 import Outputable
 import SrcLoc		( SrcLoc, isGoodSrcLoc )
 import Util		( thenCmp )
@@ -90,7 +90,11 @@ data ModuleLocation
 	hs_file  :: FilePath,
 	hi_file  :: FilePath,
 	obj_file :: FilePath
-      }
+     }
+     deriving Show
+
+instance Outputable ModuleLocation where
+   ppr = text . show
 \end{code}
 
 For a module in another package, the hs_file and obj_file
@@ -181,6 +185,9 @@ type PackageIfaceTable  = IfaceTable
 type HomeSymbolTable    = SymbolTable	-- Domain = modules in the home package
 type PackageSymbolTable = SymbolTable	-- Domain = modules in the some other package
 type GlobalSymbolTable  = SymbolTable	-- Domain = all modules
+
+emptyIfaceTable :: IfaceTable
+emptyIfaceTable = emptyUFM
 \end{code}
 
 Simple lookups in the symbol table.

ghc/compiler/main/Main.hs

 {-# OPTIONS -W -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.12 2000/10/27 11:48:55 sewardj Exp $
+-- $Id: Main.hs,v 1.13 2000/10/27 13:50:25 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -259,16 +259,3 @@ setTopDir args = do
   return others
 
 beginMake = panic "`ghc --make' unimplemented"
-
------------------------------------------------------------------------------
--- compatibility code
-
-#if __GLASGOW_HASKELL__ <= 408
-catchJust = catchIO
-ioErrors  = justIoErrors
-throwTo   = raiseInThread
-#endif
-
-#ifdef mingw32_TARGET_OS
-foreign import "_getpid" getProcessID :: IO Int 
-#endif

ghc/compiler/main/TmpFiles.hs

 -----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.4 2000/10/24 13:23:33 sewardj Exp $
+-- $Id: TmpFiles.hs,v 1.5 2000/10/27 13:50:25 sewardj Exp $
 --
 -- Temporary file management
 --
@@ -21,9 +21,6 @@ import Config
 import Util
 
 -- hslibs
-#ifndef mingw32_TARGET_OS
-import Posix ( getProcessID )
-#endif
 import Exception
 import IOExts
 
@@ -59,16 +56,9 @@ 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
+  x <- myGetProcessID
   tmp_dir <- readIORef v_TmpDir
   findTempName tmp_dir x
   where findTempName tmp_dir x = do

ghc/compiler/stgSyn/StgInterp.lhs

@@ -9,7 +9,6 @@ module StgInterp (
     ClosureEnv, ItblEnv,
     linkIModules,
     stgToInterpSyn,
---    runStgI  -- tmp, for testing
  ) where
 
 {- -----------------------------------------------------------------------------
@@ -30,7 +29,16 @@ module StgInterp (
 
 #include "HsVersions.h"
 
-#ifdef GHCI
+#if __GLASGOW_HASKELL__ <= 408
+
+import Panic ( panic )
+type ItblEnv = ()
+type ClosureEnv = ()
+linkIModules   = panic "StgInterp.linkIModules: this hsc was not built with an interpreter"
+stgToInterpSyn = panic "StgInterp.linkIModules: this hsc was not built with an interpreter"
+
+#else
+
 import Linker
 import Id 		( Id, idPrimRep )
 import Outputable
@@ -61,7 +69,6 @@ import CTypes
 import FastString
 import GlaExts		( Int(..) )
 import Module		( moduleNameFS )
-#endif
 
 import TyCon		( TyCon, isDataTyCon, tyConDataCons, tyConFamilySize )
 import Class		( Class, classTyCon )
@@ -1227,5 +1234,6 @@ load addr = do x <- peek addr
 
 foreign import "strncpy" strncpy :: Addr -> ByteArray# -> CInt -> IO ()
 
+#endif /* #if __GLASGOW_HASKELL__ <= 408 */
 \end{code}
 

ghc/compiler/utils/Util.lhs

@@ -53,16 +53,26 @@ module Util (
 #endif
 
 	, global
+	, myProcessID
+
+#if __GLASGOW_HASKELL__ <= 408
+	, catchJust
+	, ioErrors
+	, throwTo
+#endif
 
     ) where
 
 #include "HsVersions.h"
 
+import IO		( hPutStrLn, stderr )
 import List		( zipWith4 )
 import Panic		( panic )
 import IOExts		( IORef, newIORef, unsafePerformIO )
 import FastTypes
-
+#if __GLASGOW__HASKELL__ <= 408
+import Exception	( catchIO, justIoErrors, raiseInThread )
+#endif
 infixr 9 `thenCmp`
 \end{code}
 
@@ -704,3 +714,20 @@ global :: a -> IORef a
 global a = unsafePerformIO (newIORef a)
 \end{code}
 
+Compatibility stuff:
+
+\begin{code}
+#if __GLASGOW_HASKELL__ <= 408
+catchJust = catchIO
+ioErrors  = justIoErrors
+throwTo   = raiseInThread
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import "_getpid" myProcessID :: IO Int 
+#else
+myProcessID :: IO Int
+myProcessID = do hPutStrLn stderr "Warning:myProcessID"
+                 return 12345
+#endif
+\end{code}