Commit 6ef5df4a authored by sewardj's avatar sewardj
Browse files

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

Half-way through versioning so it will compile, sans interpreter, with 4.08.1
parent 67bc0df4
......@@ -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"
......
......@@ -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}
-----------------------------------------------------------------------------
-- $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:-)
......
-----------------------------------------------------------------------------
-- $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
......
......@@ -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"
}
))
......
......@@ -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
......
......@@ -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.
......
{-# 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
-----------------------------------------------------------------------------
-- $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
......
......@@ -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}
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment