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
c1d8b21c
Commit
c1d8b21c
authored
Nov 02, 2000
by
sewardj
Browse files
[project @ 2000-11-02 13:58:44 by sewardj]
Most, but not all changes needed to get CompManager to compile.
parent
31c886b4
Changes
5
Expand all
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/basicTypes/Module.lhs
View file @
c1d8b21c
...
...
@@ -21,7 +21,7 @@ in a different DLL, by setting the DLL flag.
\begin{code}
module Module
(
Module, moduleName
Module, moduleName
, packageOfModule,
-- abstract, instance of Eq, Ord, Outputable
, ModuleName
, isModuleInThisPackage, mkModuleInThisPackage,
...
...
@@ -255,7 +255,7 @@ moduleString :: Module -> EncodedString
moduleString (Module (ModuleName fs) _) = _UNPK_ fs
moduleName :: Module -> ModuleName
moduleName (Module mod
_
) = mod
moduleName (Module mod
pkg_info
) = mod
moduleUserString :: Module -> UserString
moduleUserString (Module mod _) = moduleNameUserString mod
...
...
@@ -264,6 +264,10 @@ isModuleInThisPackage :: Module -> Bool
isModuleInThisPackage (Module nm ThisPackage) = True
isModuleInThisPackage _ = False
packageOfModule :: Module -> Maybe PackageName
packageOfModule (Module nm (AnotherPackage pn)) = Just pn
packageOfModule _ = Nothing
printModulePrefix :: Module -> Bool
-- When printing, say M.x
printModulePrefix (Module nm ThisPackage) = False
...
...
ghc/compiler/ghci/CmSummarise.lhs
View file @
c1d8b21c
...
...
@@ -13,10 +13,9 @@ where
#include "HsVersions.h"
import List ( nub )
import Char (
ord,
isAlphaNum )
import Char ( isAlphaNum )
import Util ( unJust )
import HscTypes ( ModuleLocation(..) )
import FastTypes
import Module
import Outputable
...
...
@@ -36,7 +35,6 @@ data ModSummary
= ModSummary {
ms_mod :: Module, -- name, package
ms_location :: ModuleLocation, -- location
ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi
}
...
...
@@ -44,15 +42,9 @@ instance Outputable ModSummary where
ppr ms
= sep [text "ModSummary {",
nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
text "ms_ppsource =" <+> fooble (ms_ppsource ms),
text "ms_imports=" <+> ppr (ms_imports ms)]),
char '}'
]
where
fooble Nothing = text "Nothing"
fooble (Just (cppd_source_name,fp))
= text "(fp =" <+> int fp <> text ","
<+> text (show cppd_source_name) <> text ")"
data ModImport
= MINormal ModuleName | MISource ModuleName
...
...
@@ -80,28 +72,13 @@ type Fingerprint = Int
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
= if isModuleInThisPackage mod
then do
let source_fn = unJust (ml_hspp_file location) "summarise"
modsrc <- readFile source_fn
let imps = getImports modsrc
fp = fingerprint modsrc
return (ModSummary mod location (Just (source_fn,fp)) (Just imps))
else
return (ModSummary mod location Nothing Nothing)
fingerprint :: String -> Int
fingerprint s
= dofp s (_ILIT 3) (_ILIT 3)
where
-- Copied from hash() in Hugs' storage.c.
dofp :: String -> FastInt -> FastInt -> Int
dofp [] m fp = iBox fp
dofp (c:cs) m fp = dofp cs (m +# _ILIT 1)
(iabs (fp +# m *# iUnbox (ord c)))
iabs :: FastInt -> FastInt
iabs n = if n <# _ILIT 0 then (_ILIT 0) -# n else n
| isModuleInThisPackage mod
= do let hspp_fn = unJust (ml_hspp_file location) "summarise"
modsrc <- readFile hspp_fn
let imps = getImports modsrc
return (ModSummary mod location (Just imps))
| otherwise
= return (ModSummary mod location Nothing)
\end{code}
Collect up the imports from a Haskell source module. This is
...
...
@@ -141,21 +118,21 @@ clean s
where
-- running through text we want to keep
keep [] = []
keep ('"':cs) = dquote cs
keep ('"':cs) = dquote cs
-- "
-- try to eliminate single quotes when they're part of
-- an identifier...
keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
keep ('\'':cs) = squote cs
keep ('-':'-':cs) = linecomment cs
keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
keep ('{':'-':cs) = runcomment cs
keep ('{':'-':cs) = runcomment cs
-- -}
keep (c:cs) = c : keep cs
-- in a double-quoted string
dquote [] = []
dquote ('\\':'\"':cs) = dquote cs
dquote ('\\':'\"':cs) = dquote cs
-- "
dquote ('\\':'\\':cs) = dquote cs
dquote ('\"':cs) = keep cs
dquote ('\"':cs) = keep cs
-- "
dquote (c:cs) = dquote cs
-- in a single-quoted string
...
...
ghc/compiler/ghci/CompManager.lhs
View file @
c1d8b21c
This diff is collapsed.
Click to expand it.
ghc/compiler/main/DriverPipeline.hs
View file @
c1d8b21c
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.1
4
2000/1
0/31
13:
01
:4
6
sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.1
5
2000/1
1/02
13:
58
:4
5
sewardj Exp $
--
-- GHC Driver
--
...
...
@@ -14,10 +14,10 @@ module DriverPipeline (
genPipeline
,
runPipeline
,
-- interfaces for the compilation manager (interpreted/batch-mode)
preprocess
,
compile
,
preprocess
,
compile
,
CompResult
(
..
),
-- batch-mode linking interface
doLink
,
doLink
)
where
#
include
"HsVersions.h"
...
...
ghc/compiler/main/Finder.lhs
View file @
c1d8b21c
...
...
@@ -6,7 +6,8 @@
\begin{code}
module Finder (
initFinder, -- :: PackageConfigInfo -> IO (),
findModule -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
emptyHomeDirCache -- :: IO ()
) where
#include "HsVersions.h"
...
...
@@ -18,6 +19,7 @@ import DriverState
import Module
import FiniteMap
import Util
import Panic ( panic )
import IOExts
import Directory
...
...
@@ -35,11 +37,12 @@ source, interface, and object files for a module live.
\begin{code}
-- v_PkgDirCache caches contents of package directories, never expunged
GLOBAL_VAR(v_PkgDirCache, error "no pkg cache!", FiniteMap String (PackageName, FilePath))
GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!",
FiniteMap String (PackageName, FilePath))
-- v_HomeDirCache caches contents of home directories,
-- expunged whenever we create a new finder.
GLOBAL_VAR(v_HomeDirCache,
Nothing,
Maybe (FiniteMap String FilePath))
GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
initFinder :: PackageConfigInfo -> IO ()
...
...
@@ -54,6 +57,10 @@ initFinder pkgs
-- ; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
}
emptyHomeDirCache :: IO ()
emptyHomeDirCache
= writeIORef v_HomeDirCache Nothing
findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findModule name
= do { hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
...
...
@@ -69,7 +76,7 @@ findModule_wrk name
= do { j <- maybeHomeModule name
; case j of
Just home_module -> return (Just home_module)
Nothing
-> maybePackageModule name
Nothing
-> maybePackageModule name
}
maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
...
...
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