-> 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
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"
\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"
foreign import "resolveObjs" unsafe
c_resolveObjs :: IO Int
-#endif /* GHCI */
+#endif /* __GLASGOW_HASKELL__ <= 408 */
\end{code}
-----------------------------------------------------------------------------
--- $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
--
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
-- 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:-)
-----------------------------------------------------------------------------
--- $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
--
-----------------------------------------------------------------------------
-- Reading OPTIONS pragmas
-
getOptionsFromSource
:: String -- input file
-> IO [String] -- options, if any
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
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)
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"
}
))
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 )
-- ????? 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;
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
}}
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
ModDetails(..), ModIface(..), GlobalSymbolTable,
HomeSymbolTable, PackageSymbolTable,
- HomeIfaceTable, PackageIfaceTable,
+ HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
lookupTable, lookupTableByModName,
IfaceDecls(..),
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 )
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
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.
{-# 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
--
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
-----------------------------------------------------------------------------
--- $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
--
import Util
-- hslibs
-#ifndef mingw32_TARGET_OS
-import Posix ( getProcessID )
-#endif
import Exception
import IOExts
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
ClosureEnv, ItblEnv,
linkIModules,
stgToInterpSyn,
--- runStgI -- tmp, for testing
) where
{- -----------------------------------------------------------------------------
#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
import FastString
import GlaExts ( Int(..) )
import Module ( moduleNameFS )
-#endif
import TyCon ( TyCon, isDataTyCon, tyConDataCons, tyConFamilySize )
import Class ( Class, classTyCon )
foreign import "strncpy" strncpy :: Addr -> ByteArray# -> CInt -> IO ()
+#endif /* #if __GLASGOW_HASKELL__ <= 408 */
\end{code}
#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}
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}
projects / ghc-hetmet.git / commitdiff