Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
6ef5df4a
Commit
6ef5df4a
authored
Oct 27, 2000
by
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
Changes
11
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/ghci/CmLink.lhs
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.
9
2000/10/27 1
1:48:5
5 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.
10
2000/10/27 1
3:50:2
5 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
<-
g
etProcessID
x
<-
myG
etProcessID
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
View file @
6ef5df4a
-----------------------------------------------------------------------------
-- $Id: DriverUtil.hs,v 1.
4
2000/10/2
6
1
6:21:02
sewardj Exp $
-- $Id: DriverUtil.hs,v 1.
5
2000/10/2
7
1
3: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
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.1
2
2000/10/27 1
1:48:5
5 sewardj Exp $
-- $Id: Main.hs,v 1.1
3
2000/10/27 1
3:50:2
5 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
View file @
6ef5df4a
-----------------------------------------------------------------------------
-- $Id: TmpFiles.hs,v 1.
4
2000/10/2
4
13:
23:33
sewardj Exp $
-- $Id: TmpFiles.hs,v 1.
5
2000/10/2
7
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
<-
g
etProcessID
x
<-
myG
etProcessID
tmp_dir
<-
readIORef
v_TmpDir
findTempName
tmp_dir
x
where
findTempName
tmp_dir
x
=
do
...
...
ghc/compiler/stgSyn/StgInterp.lhs
View file @
6ef5df4a
...
...
@@ -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
View file @
6ef5df4a
...
...
@@ -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}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment