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
b59837e6
Commit
b59837e6
authored
Feb 13, 2001
by
simonmar
Browse files
[project @ 2001-02-13 18:01:22 by simonmar]
style nitpicking
parent
ba123ed2
Changes
4
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/ghci/InteractiveUI.hs
View file @
b59837e6
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.4
7
2001/02/13 1
7:13:39 sewardj
Exp $
-- $Id: InteractiveUI.hs,v 1.4
8
2001/02/13 1
8:01:23 simonmar
Exp $
--
-- GHC Interactive User Interface
--
...
...
@@ -254,25 +254,16 @@ doCommand expr
=
do
expr_expanded
<-
expandExpr
expr
-- io (putStrLn ( "Before: " ++ expr ++ "\nAfter: " ++ expr_expanded))
expr_ok
<-
timeIt
(
do
stuff
<-
evalExpr
expr_expanded
finishEvalExpr
stuff
)
finishEvalExpr
expr_expanded
stuff
)
when
expr_ok
(
rememberExpr
expr_expanded
)
return
False
-- possibly print the type and revert CAFs after evaluating an expression
finishEvalExpr
Nothing
=
return
False
finishEvalExpr
(
Just
(
unqual
,
ty
))
=
do
b
<-
isOptionSet
ShowType
io
(
when
b
(
printForUser
stdout
unqual
(
text
"::"
<+>
ppr
ty
)))
b
<-
isOptionSet
RevertCAFs
io
(
when
b
revertCAFs
)
return
True
-- Returned Maybe indicates whether or not the expr was successfully
-- parsed, renamed and typechecked.
evalExpr
::
String
->
GHCi
(
Maybe
(
PrintUnqualified
,
Type
))
evalExpr
::
String
->
GHCi
Bool
evalExpr
expr
|
null
(
filter
(
not
.
isSpace
)
expr
)
=
return
Nothing
=
return
False
|
otherwise
=
do
st
<-
getGHCiState
dflags
<-
io
(
getDynFlags
)
...
...
@@ -280,10 +271,21 @@ evalExpr expr
io
(
cmGetExpr
(
cmstate
st
)
dflags
True
(
current_module
st
)
expr
)
setGHCiState
st
{
cmstate
=
new_cmstate
}
case
maybe_stuff
of
Nothing
->
return
Nothing
Just
(
hv
,
unqual
,
ty
)
->
do
io
(
cmRunExpr
hv
)
flushEverything
return
(
Just
(
unqual
,
ty
))
Nothing
->
return
False
Just
(
hv
,
unqual
,
ty
)
->
do
io
(
cmRunExpr
hv
)
return
True
-- possibly print the type and revert CAFs after evaluating an expression
finishEvalExpr
_
False
=
return
False
finishEvalExpr
expr
True
=
do
b
<-
isOptionSet
ShowType
-- re-typecheck, don't wrap with print this time
when
b
(
io
(
putStr
":: "
)
>>
typeOfExpr
expr
)
b
<-
isOptionSet
RevertCAFs
io
(
when
b
revertCAFs
)
flushEverything
return
True
flushEverything
::
GHCi
()
flushEverything
...
...
@@ -322,9 +324,14 @@ setContext ""
=
throwDyn
(
OtherError
"syntax: `:m <module>'"
)
setContext
m
|
not
(
isUpper
(
head
m
))
||
not
(
all
isAlphaNum
(
tail
m
))
=
throwDyn
(
OtherError
(
"strange looking module name: `"
++
m
++
"'"
))
setContext
mn
=
do
m
<-
io
(
moduleNameToModule
(
mkModuleName
mn
))
st
<-
getGHCiState
setContext
str
=
do
st
<-
getGHCiState
let
mn
=
mkModuleName
str
m
<-
case
[
m
|
m
<-
modules
st
,
moduleName
m
==
mn
]
of
(
m
:
_
)
->
return
m
[]
->
io
(
moduleNameToModule
mn
)
if
(
isHomeModule
m
&&
m
`
notElem
`
modules
st
)
then
throwDyn
(
OtherError
(
showSDoc
(
quotes
(
ppr
(
moduleName
m
))
<+>
text
"is not currently loaded, use :load"
)))
...
...
@@ -334,9 +341,9 @@ moduleNameToModule :: ModuleName -> IO Module
moduleNameToModule
mn
=
do
maybe_stuff
<-
findModule
mn
case
maybe_stuff
of
Nothing
->
throwDyn
(
OtherError
(
"can't find module `"
++
moduleNameUserString
mn
++
"'"
))
Just
(
m
,
_
)
->
return
m
Nothing
->
throwDyn
(
OtherError
(
"can't find module `"
++
moduleNameUserString
mn
++
"'"
))
Just
(
m
,
_
)
->
return
m
changeDirectory
::
String
->
GHCi
()
changeDirectory
d
=
io
(
setCurrentDirectory
d
)
...
...
@@ -679,8 +686,8 @@ linkPackages cmdline_libs pkgs
else
do
loadObj
static_ish
putStr
"done.
\n
"
Right
dll_unadorned
->
do
dll_ok
<-
ocA
ddDLL
(
packString
dll_unadorned
)
if
dll_ok
==
1
->
do
dll_ok
<-
a
ddDLL
dll_unadorned
if
dll_ok
then
putStr
"done.
\n
"
else
do
putStr
"not found.
\n
"
croak
...
...
@@ -732,8 +739,8 @@ loadClassified :: Either FilePath String -> IO ()
loadClassified
(
Left
obj_absolute_filename
)
=
do
loadObj
obj_absolute_filename
loadClassified
(
Right
dll_unadorned
)
=
do
dll_ok
<-
ocA
ddDLL
(
packString
dll_unadorned
)
if
dll_ok
==
1
=
do
dll_ok
<-
a
ddDLL
dll_unadorned
if
dll_ok
then
return
()
else
throwDyn
(
OtherError
(
"can't find .o or .so/.DLL for: "
++
dll_unadorned
))
...
...
@@ -746,10 +753,6 @@ locateOneObj (d:ds) obj
b
<-
doesFileExist
path
if
b
then
return
(
Left
path
)
else
locateOneObj
ds
obj
type
PackedString
=
ByteArray
Int
foreign
import
"ocAddDLL"
unsafe
ocAddDLL
::
PackedString
->
IO
Int
-----------------------------------------------------------------------------
-- timing & statistics
...
...
ghc/compiler/ghci/Linker.lhs
View file @
b59837e6
...
...
@@ -11,6 +11,7 @@ module Linker (
unloadObj, -- :: String -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs, -- :: IO ()
addDLL -- :: String -> IO Bool
) where
import Foreign ( Ptr, nullPtr )
...
...
@@ -46,6 +47,9 @@ resolveObjs = do
then panic "resolveObjs: failed"
else return ()
addDLL str = do
r <- c_addDLL (packString str)
return (r == 0)
type PackedString = ByteArray Int
...
...
@@ -63,4 +67,8 @@ foreign import "resolveObjs" unsafe
foreign import "initLinker" unsafe
initLinker :: IO ()
foreign import "addDLL" unsafe
c_addDLL :: PackedString -> IO Int
\end{code}
ghc/rts/Linker.c
View file @
b59837e6
/* -----------------------------------------------------------------------------
* $Id: Linker.c,v 1.2
7
2001/02/13 1
3:11:07 sewardj
Exp $
* $Id: Linker.c,v 1.2
8
2001/02/13 1
8:01:22 simonmar
Exp $
*
* (c) The GHC Team, 2000
*
...
...
@@ -47,35 +47,6 @@ static int ocGetNames_PEi386 ( ObjectCode* oc );
static
int
ocResolve_PEi386
(
ObjectCode
*
oc
);
#endif
int
ocAddDLL
(
char
*
dll_name
);
/* -----------------------------------------------------------------------------
* Add a DLL from which symbols may be found. In the ELF case, just
* do RTLD_GLOBAL-style add, so no further messing around needs to
* happen in order that symbols in the loaded .so are findable --
* lookupSymbol() will subsequently see them by dlsym on the program's
* dl-handle. Returns 0 if fail, 1 if success.
*/
int
ocAddDLL
(
char
*
dll_name
)
{
# if defined(OBJFORMAT_ELF)
void
*
hdl
;
char
buf
[
100
];
if
(
strlen
(
dll_name
)
>
50
)
barf
(
"ocAddDLL: excessively long .so/.DLL name `%s'"
,
dll_name
);
sprintf
(
buf
,
"lib%s.so"
,
dll_name
);
hdl
=
dlopen
(
buf
,
RTLD_NOW
|
RTLD_GLOBAL
);
return
(
hdl
==
NULL
)
?
0
:
1
;
# elif defined(OBJFORMAT_PEi386)
barf
(
"ocAddDLL: not implemented on PEi386 yet"
);
return
0
;
# else
barf
(
"ocAddDLL: not implemented on this platform"
);
# endif
}
/* -----------------------------------------------------------------------------
* Built-in symbols from the RTS
*/
...
...
@@ -307,6 +278,33 @@ initLinker( void )
dl_prog_handle
=
dlopen
(
NULL
,
RTLD_LAZY
);
}
/* -----------------------------------------------------------------------------
* Add a DLL from which symbols may be found. In the ELF case, just
* do RTLD_GLOBAL-style add, so no further messing around needs to
* happen in order that symbols in the loaded .so are findable --
* lookupSymbol() will subsequently see them by dlsym on the program's
* dl-handle. Returns 0 if fail, 1 if success.
*/
int
addDLL
(
char
*
dll_name
)
{
# if defined(OBJFORMAT_ELF)
void
*
hdl
;
char
*
buf
;
buf
=
stgMallocBytes
(
strlen
(
dll_name
)
+
10
,
"addDll"
);
sprintf
(
buf
,
"lib%s.so"
,
dll_name
);
hdl
=
dlopen
(
buf
,
RTLD_NOW
|
RTLD_GLOBAL
);
free
(
buf
);
return
(
hdl
==
NULL
)
?
0
:
1
;
# elif defined(OBJFORMAT_PEi386)
barf
(
"addDLL: not implemented on PEi386 yet"
);
return
0
;
# else
barf
(
"addDLL: not implemented on this platform"
);
# endif
}
/* -----------------------------------------------------------------------------
* lookup a symbol in the hash table
*/
...
...
ghc/rts/Linker.h
View file @
b59837e6
/* -----------------------------------------------------------------------------
* $Id: Linker.h,v 1.
2
2001/0
1/24 15:39:50
simonmar Exp $
* $Id: Linker.h,v 1.
3
2001/0
2/13 18:01:22
simonmar Exp $
*
* (c) The GHC Team, 2000
*
...
...
@@ -21,3 +21,6 @@ HsInt loadObj( char *path );
/* resolve all the currently unlinked objects in memory */
HsInt
resolveObjs
(
void
);
/* load a dynamic library */
HsInt
addDLL
(
char
*
path
);
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