Commit dfb12323 authored by sewardj's avatar sewardj
Browse files

[project @ 1999-10-15 11:02:06 by sewardj]

Added basic support for foreign export dynamic.

Many aspects of it are still broken:
* Only supports x86-linux.
* The range of allowable types is small: Char Int Float Double
  Addr and Word.
* Adjustor thunks are never freed.
* Returning Doubles or Floats doesn't work at all.

I expect to fix some of these shortly.  foreign import also
needs redoing, so it can accept any number of arguments of
any type.

Also:
* Fixed setRtsFlags in Evaluator.c to make it endian-independent.
* Fixed raisePrim in Evaluator.c so things like division by zero,
  array index errors, etc, throw an exception instead of
  terminating StgHugs.  raisePrim is renamed makeErrorCall.
parent f5fd4677
/* -----------------------------------------------------------------------------
* $Id: Assembler.h,v 1.7 1999/07/06 16:17:39 sewardj Exp $
* $Id: Assembler.h,v 1.8 1999/10/15 11:02:06 sewardj Exp $
*
* (c) The GHC Team 1994-1998.
*
......@@ -89,9 +89,7 @@ typedef enum {
ADDR_REP = 'A',
FLOAT_REP = 'F',
DOUBLE_REP = 'D',
#ifdef PROVIDE_STABLE
STABLE_REP = 's', /* StablePtr a */
#endif
#ifdef PROVIDE_FOREIGN
FOREIGN_REP = 'f', /* ForeignObj */
#endif
......
# ----------------------------------------------------------------------------- #
# $Id: Makefile,v 1.10 1999/07/06 15:24:35 sewardj Exp $ #
# $Id: Makefile,v 1.11 1999/10/15 11:02:09 sewardj Exp $ #
# ----------------------------------------------------------------------------- #
TOP = ../..
......@@ -27,7 +27,7 @@ C_SRCS = link.c type.c static.c storage.c derive.c input.c compiler.c subst.c \
translate.c codegen.c lift.c free.c stgSubst.c optimise.c output.c \
hugs.c dynamic.c stg.c sainteger.c interface.c
SRC_CC_OPTS = -g -I$(GHC_DIR)/interpreter -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -DCOMPILING_RTS -Wall -Wstrict-prototypes -DDEBUG -DDEBUG_EXTRA
SRC_CC_OPTS = -g -O -I$(GHC_DIR)/interpreter -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -DCOMPILING_RTS -Wall -Wstrict-prototypes -Wno-unused -DDEBUG -DDEBUG_EXTRA -Winline
GHC_LIBS_NEEDED = $(TOP)/ghc/rts/libHSrts.a
......@@ -39,7 +39,7 @@ hugs: $(C_OBJS) ../rts/Sanity.o ../rts/Assembler.o ../rts/Disassembler.o \
../rts/StgCRun.o nHandle.so
$(CC) -o $@ -rdynamic $(CC_OPTS) $^ $(GHC_LIBS_NEEDED) -lbfd -liberty -ldl -lm
nHandle.so:
nHandle.so: nHandle.c
gcc -O -fPIC -shared -o nHandle.so nHandle.c
$(TOP)/ghc/rts/libHSrts.a:
......
......@@ -7,8 +7,8 @@
* in the distribution for details.
*
* $RCSfile: connect.h,v $
* $Revision: 1.7 $
* $Date: 1999/06/07 17:22:45 $
* $Revision: 1.8 $
* $Date: 1999/10/15 11:02:09 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -74,6 +74,7 @@ extern Name nameReturn, nameBind; /* for translating monad comps */
extern Name nameMFail;
extern Name nameListMonad; /* builder function for List Monad */
extern Name namePrint; /* printing primitive */
extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */
extern Text textPrelude;
extern Text textNum; /* used to process default decls */
#if NPLUSK
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: free.c,v $
* $Revision: 1.4 $
* $Date: 1999/04/27 10:06:52 $
* $Revision: 1.5 $
* $Date: 1999/10/15 11:02:09 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -116,7 +116,7 @@ static List freeVarsExpr( List acc, StgExpr e )
case NAME:
return acc; /* Names are never free vars */
default:
printf("\n\n");
printf("\n");
ppStgExpr(e);
printf("\n");
internal("freeVarsExpr");
......
......@@ -8,8 +8,8 @@
* in the distribution for details.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.10 $
* $Date: 1999/10/11 12:22:58 $
* $Revision: 1.11 $
* $Date: 1999/10/15 11:02:10 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -811,7 +811,8 @@ static Void local makeStackEntry ( ScriptInfo* ent, String iname )
);
if (!ok) {
ERRMSG(0)
"Can't file source or object+interface for module \"%s\"",
/* "Can't file source or object+interface for module \"%s\"", */
"Can't file source for module \"%s\"",
iname
EEND;
}
......@@ -825,7 +826,6 @@ static Void local makeStackEntry ( ScriptInfo* ent, String iname )
? (oAvail && iAvail && timeEarlier(sTime,oTime))
: TRUE;
*/
fromObj = FALSE;
/* ToDo: namesUpto overflow */
......
......@@ -8,8 +8,8 @@
* in the distribution for details.
*
* $RCSfile: input.c,v $
* $Revision: 1.6 $
* $Date: 1999/06/07 17:22:32 $
* $Revision: 1.7 $
* $Date: 1999/10/15 11:02:12 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -124,7 +124,8 @@ static Text textWildcard;
static Text textModule, textImport, textInterface, textInstImport;
static Text textHiding, textQualified, textAsMod;
static Text textExport, textUnsafe, text__All;
static Text textExport, textDynamic, textUUExport;
static Text textUnsafe, textUUAll;
Text textNum; /* Num */
Text textPrelude; /* Prelude */
......@@ -1470,12 +1471,14 @@ static Int local yylex() { /* Read next input token ... */
if (it==textInstImport) return INSTIMPORT;
if (it==textImport) return IMPORT;
if (it==textExport) return EXPORT;
if (it==textDynamic) return DYNAMIC;
if (it==textUUExport) return UUEXPORT;
if (it==textHiding) return HIDING;
if (it==textQualified) return QUALIFIED;
if (it==textAsMod) return ASMOD;
if (it==textWildcard) return '_';
if (it==textAll && !haskell98) return ALL;
if (it==text__All) return ALL;
if (it==textUUAll) return ALL;
if (it==textRepeat && reading==KEYBOARD)
return repeatLast();
......@@ -1671,14 +1674,16 @@ Int what; {
textModule = findText("module");
textInterface = findText("__interface");
textInstImport = findText("__instimport");
textExport = findText("__export");
textExport = findText("export");
textDynamic = findText("dynamic");
textUUExport = findText("__export");
textImport = findText("import");
textHiding = findText("hiding");
textQualified = findText("qualified");
textAsMod = findText("as");
textWildcard = findText("_");
textAll = findText("forall");
text__All = findText("__forall");
textUUAll = findText("__forall");
varMinus = mkVar(textMinus);
varPlus = mkVar(textPlus);
varBang = mkVar(textBang);
......
......@@ -60,7 +60,8 @@ module Prelude (
-- module Ratio,
Ratio, Rational, (%), numerator, denominator, approxRational,
-- Non-standard exports
IO(..), IOResult(..), Addr,
IO(..), IOResult(..), Addr, StablePtr,
makeStablePtr, freeStablePtr, deRefStablePtr,
Bool(False, True),
Maybe(Nothing, Just),
......@@ -111,8 +112,8 @@ module Prelude (
,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
,unsafeInterleaveIO,nh_write,primCharToInt
-- ToDo: rm -- these are only for debugging
,primPlusInt,primEqChar,primRunIO
-- debugging hacks
,ST(..)
) where
-- Standard value bindings {Prelude} ----------------------------------------
......@@ -1383,7 +1384,7 @@ nonnull p s = [(cs,t) | (cs@(_:_),t) <- [span p s]]
lexLitChar :: ReadS String
lexLitChar ('\\':s) = [('\\':esc, t) | (esc,t) <- lexEsc s]
where
lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = [([c],s)]
lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = [([c],s)] -- "
lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)]
lexEsc s@(d:_) | isDigit d = lexDigits s
lexEsc s@(c:_) | isUpper c
......@@ -1548,6 +1549,13 @@ primPmFail = error "Pattern Match Failure"
primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
primMkIO = ST
primCreateAdjThunk :: (a -> b) -> String -> IO Addr
primCreateAdjThunk fun typestr
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- primCreateAdjThunkARCH sp p
return a
-- The following primitives are only needed if (n+k) patterns are enabled:
primPmNpk :: Integral a => Int -> a -> Maybe a
primPmNpk n x = if n'<=x then Just (x-n') else Nothing
......@@ -1655,7 +1663,6 @@ writeFile fname contents
then (ioError.IOError) ("writeFile: can't create file " ++ fname)
else writetohandle fname h contents
appendFile :: FilePath -> String -> IO ()
appendFile fname contents
= copy_String_to_cstring fname >>= \ptr ->
......@@ -1694,46 +1701,43 @@ instance Show Exception where
data IOResult = IOResult deriving (Show)
type FILE_STAR = Int -- FILE *
type Ptr = Int -- char *
foreign import stdcall "nHandle.so" "nh_stdin" nh_stdin :: IO FILE_STAR
foreign import stdcall "nHandle.so" "nh_stdout" nh_stdout :: IO FILE_STAR
foreign import stdcall "nHandle.so" "nh_stderr" nh_stderr :: IO FILE_STAR
foreign import stdcall "nHandle.so" "nh_write" nh_write :: FILE_STAR -> Int -> IO ()
foreign import stdcall "nHandle.so" "nh_read" nh_read :: FILE_STAR -> IO Int
foreign import stdcall "nHandle.so" "nh_open" nh_open :: Int -> Int -> IO FILE_STAR
foreign import stdcall "nHandle.so" "nh_open" nh_open :: Addr -> Int -> IO FILE_STAR
foreign import stdcall "nHandle.so" "nh_flush" nh_flush :: FILE_STAR -> IO ()
foreign import stdcall "nHandle.so" "nh_close" nh_close :: FILE_STAR -> IO ()
foreign import stdcall "nHandle.so" "nh_errno" nh_errno :: IO Int
foreign import stdcall "nHandle.so" "nh_malloc" nh_malloc :: Int -> IO Ptr
foreign import stdcall "nHandle.so" "nh_free" nh_free :: Ptr -> IO ()
foreign import stdcall "nHandle.so" "nh_store" nh_store :: Ptr -> Int -> IO ()
foreign import stdcall "nHandle.so" "nh_load" nh_load :: Ptr -> IO Int
foreign import stdcall "nHandle.so" "nh_malloc" nh_malloc :: Int -> IO Addr
foreign import stdcall "nHandle.so" "nh_free" nh_free :: Addr -> IO ()
foreign import stdcall "nHandle.so" "nh_store" nh_store :: Addr -> Int -> IO ()
foreign import stdcall "nHandle.so" "nh_load" nh_load :: Addr -> IO Int
foreign import stdcall "nHandle.so" "nh_argc" nh_argc :: IO Int
foreign import stdcall "nHandle.so" "nh_argvb" nh_argvb :: Int -> Int -> IO Int
foreign import stdcall "nHandle.so" "nh_getenv" nh_getenv :: Ptr -> IO Ptr
foreign import stdcall "nHandle.so" "nh_getenv" nh_getenv :: Addr -> IO Addr
copy_String_to_cstring :: String -> IO Ptr
copy_String_to_cstring :: String -> IO Addr
copy_String_to_cstring s
= nh_malloc (1 + length s) >>= \ptr0 ->
let loop ptr [] = nh_store ptr 0 >> return ptr0
loop ptr (c:cs) = --trace ("Out `" ++ [c] ++ "'") (
nh_store ptr (primCharToInt c) >> loop (ptr+1) cs
--)
loop ptr (c:cs) = nh_store ptr (primCharToInt c) >> loop (incAddr ptr) cs
in
loop ptr0 s
if isNullAddr ptr0
then error "copy_String_to_cstring: malloc failed"
else loop ptr0 s
copy_cstring_to_String :: Ptr -> IO String
copy_cstring_to_String :: Addr -> IO String
copy_cstring_to_String ptr
= nh_load ptr >>= \ci ->
if ci == 0
then return []
else copy_cstring_to_String (ptr+1) >>= \cs ->
--trace ("In " ++ show ci) (
else copy_cstring_to_String (incAddr ptr) >>= \cs ->
return ((primIntToChar ci) : cs)
--)
readfromhandle :: FILE_STAR -> IO String
readfromhandle h
......@@ -1772,7 +1776,7 @@ primGetEnv v
= copy_String_to_cstring v >>= \ptr ->
nh_getenv ptr >>= \ptr2 ->
nh_free ptr >>
if ptr2 == 0
if isNullAddr ptr2
then return []
else
copy_cstring_to_String ptr2 >>= \result ->
......@@ -1799,12 +1803,12 @@ primRunST m = fst (unST m theWorld)
unST (ST a) = a
instance Functor (ST s) where
fmap f x = x >>= (return . f)
fmap f x = x >>= (return . f)
instance Monad (ST s) where
m >> k = m >>= \ _ -> k
return x = ST $ \ s -> (x,s)
m >>= k = ST $ \s -> case unST m s of { (a,s') -> unST (k a) s' }
m >> k = ST (\s -> case unST m s of { (a,s') -> unST k s' })
return x = ST (\s -> (x,s))
m >>= k = ST (\s -> case unST m s of { (a,s') -> unST (k a) s' })
-- used when Hugs invokes top level function
......@@ -1812,7 +1816,7 @@ primRunIO :: IO () -> ()
primRunIO m
= protect (fst (unST m realWorld))
where
realWorld = error "panic: Hugs entered the real world"
realWorld = error "primRunIO: entered the RealWorld"
protect :: () -> ()
protect comp
= primCatch comp (\e -> fst (unST (putStr (show e ++ "\n")) realWorld))
......@@ -1829,12 +1833,14 @@ unsafeInterleaveIO = unsafeInterleaveST
------------------------------------------------------------------------------
-- Word, Addr, ForeignObj, Prim*Array ----------------------------------------
-- Word, Addr, StablePtr, Prim*Array -----------------------------------------
------------------------------------------------------------------------------
data Addr
nullAddr = primIntToAddr 0
nullAddr = primIntToAddr 0
incAddr a = primIntToAddr (1 + primAddrToInt a)
isNullAddr a = 0 == primAddrToInt a
instance Eq Addr where
(==) = primEqAddr
......@@ -1860,9 +1866,14 @@ instance Ord Word where
(>) = primGtWord
--data ForeignObj
--makeForeignObj :: Addr -> IO ForeignObj
--makeForeignObj = primMakeForeignObj
data StablePtr a
makeStablePtr :: a -> IO (StablePtr a)
makeStablePtr = primMakeStablePtr
deRefStablePtr :: StablePtr a -> IO a
deRefStablePtr = primDeRefStablePtr
freeStablePtr :: StablePtr a -> IO ()
freeStablePtr = primFreeStablePtr
data PrimArray a -- immutable arrays with Int indices
......@@ -1874,172 +1885,6 @@ data PrimMutableByteArray s
------------------------------------------------------------------------------
-- hooks to call libHS_cbits -------------------------------------------------
------------------------------------------------------------------------------
{-
type FILE_OBJ = ForeignObj -- as passed into functions
type CString = PrimByteArray
type How = Int
type Binary = Int
type OpenFlags = Int
type IOFileAddr = Addr -- as returned from functions
type FD = Int
type OpenStdFlags = Int
type Readable = Int -- really Bool
type Exclusive = Int -- really Bool
type RC = Int -- standard return code
type Bytes = PrimMutableByteArray RealWorld
type Flush = Int -- really Bool
foreign import stdcall "libHS_cbits.so" "freeStdFileObject"
freeStdFileObject :: ForeignObj -> IO ()
foreign import stdcall "libHS_cbits.so" "freeFileObject"
freeFileObject :: ForeignObj -> IO ()
foreign import stdcall "libHS_cbits.so" "setBuf"
prim_setBuf :: FILE_OBJ -> Addr -> Int -> IO ()
foreign import stdcall "libHS_cbits.so" "getBufSize"
prim_getBufSize :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "inputReady"
prim_inputReady :: FILE_OBJ -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "fileGetc"
prim_fileGetc :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "fileLookAhead"
prim_fileLookAhead :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "readBlock"
prim_readBlock :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "readLine"
prim_readLine :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "readChar"
prim_readChar :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "writeFileObject"
prim_writeFileObject :: FILE_OBJ -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "filePutc"
prim_filePutc :: FILE_OBJ -> Char -> IO RC
foreign import stdcall "libHS_cbits.so" "getBufStart"
prim_getBufStart :: FILE_OBJ -> Int -> IO Addr
foreign import stdcall "libHS_cbits.so" "getWriteableBuf"
prim_getWriteableBuf :: FILE_OBJ -> IO Addr
foreign import stdcall "libHS_cbits.so" "getBufWPtr"
prim_getBufWPtr :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "setBufWPtr"
prim_setBufWPtr :: FILE_OBJ -> Int -> IO ()
foreign import stdcall "libHS_cbits.so" "closeFile"
prim_closeFile :: FILE_OBJ -> Flush -> IO RC
foreign import stdcall "libHS_cbits.so" "fileEOF"
prim_fileEOF :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "setBuffering"
prim_setBuffering :: FILE_OBJ -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "flushFile"
prim_flushFile :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "getBufferMode"
prim_getBufferMode :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "seekFileP"
prim_seekFileP :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "setTerminalEcho"
prim_setTerminalEcho :: FILE_OBJ -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "getTerminalEcho"
prim_getTerminalEcho :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "isTerminalDevice"
prim_isTerminalDevice :: FILE_OBJ -> IO RC
foreign import stdcall "libHS_cbits.so" "setConnectedTo"
prim_setConnectedTo :: FILE_OBJ -> FILE_OBJ -> Int -> IO ()
foreign import stdcall "libHS_cbits.so" "ungetChar"
prim_ungetChar :: FILE_OBJ -> Char -> IO RC
foreign import stdcall "libHS_cbits.so" "readChunk"
prim_readChunk :: FILE_OBJ -> Addr -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "writeBuf"
prim_writeBuf :: FILE_OBJ -> Addr -> Int -> IO RC
foreign import stdcall "libHS_cbits.so" "getFileFd"
prim_getFileFd :: FILE_OBJ -> IO FD
foreign import stdcall "libHS_cbits.so" "fileSize_int64"
prim_fileSize_int64 :: FILE_OBJ -> Bytes -> IO RC
foreign import stdcall "libHS_cbits.so" "getFilePosn"
prim_getFilePosn :: FILE_OBJ -> IO Int
foreign import stdcall "libHS_cbits.so" "setFilePosn"
prim_setFilePosn :: FILE_OBJ -> Int -> IO Int
foreign import stdcall "libHS_cbits.so" "getConnFileFd"
prim_getConnFileFd :: FILE_OBJ -> IO FD
foreign import stdcall "libHS_cbits.so" "allocMemory__"
prim_allocMemory__ :: Int -> IO Addr
foreign import stdcall "libHS_cbits.so" "getLock"
prim_getLock :: FD -> Exclusive -> IO RC
foreign import stdcall "libHS_cbits.so" "openStdFile"
prim_openStdFile :: FD -> OpenStdFlags -> Readable -> IO IOFileAddr
foreign import stdcall "libHS_cbits.so" "openFile"
prim_openFile :: CString -> How -> Binary -> OpenFlags -> IO IOFileAddr
foreign import stdcall "libHS_cbits.so" "freeFileObject"
prim_freeFileObject :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "freeStdFileObject"
prim_freeStdFileObject :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "const_BUFSIZ"
const_BUFSIZ :: Int
foreign import stdcall "libHS_cbits.so" "setConnNonBlockingIOFlag__"
prim_setConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "clearConnNonBlockingIOFlag__"
prim_clearConnNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "setNonBlockingIOFlag__"
prim_setNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "clearNonBlockingIOFlag__"
prim_clearNonBlockingIOFlag__ :: FILE_OBJ -> IO ()
foreign import stdcall "libHS_cbits.so" "getErrStr__"
prim_getErrStr__ :: IO Addr
foreign import stdcall "libHS_cbits.so" "getErrNo__"
prim_getErrNo__ :: IO Int
foreign import stdcall "libHS_cbits.so" "getErrType__"
prim_getErrType__ :: IO Int
--foreign import stdcall "libHS_cbits.so" "seekFile_int64"
-- prim_seekFile_int64 :: FILE_OBJ -> Int -> Int64 -> IO RC
-}
-- showFloat ------------------------------------------------------------------
showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
......@@ -2194,12 +2039,6 @@ floatToDigits base x =
in gen [] (r * bk) s (mUp * bk) (mDn * bk)
in (map toInt (reverse rds), k)
{-
-- Exponentiation with(out) a cache for the most common numbers.
expt :: Integer -> Int -> Integer
expt base n = base^n
-}
-- Exponentiation with a cache for the most common numbers.
minExpt = 0::Int
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: link.c,v $
* $Revision: 1.7 $
* $Date: 1999/04/27 10:06:54 $
* $Revision: 1.8 $
* $Date: 1999/10/15 11:02:15 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -35,9 +35,7 @@ Type typePrimMutableArray;
Type typePrimMutableByteArray;
Type typeFloat;
Type typeDouble;
#ifdef PROVIDE_STABLE
Type typeStable;
#endif
#ifdef PROVIDE_WEAK
Type typeWeak;
#endif
......@@ -113,9 +111,11 @@ Name namePmLe;
Name namePmSubtract;
Name namePmFromInteger;
Name nameMkIO;
Name nameRunST;
Name nameUnpackString;
Name nameError;
Name nameInd;
Name nameCreateAdjThunk;
Name nameAnd;
Name nameConCmp;
......@@ -165,9 +165,7 @@ Name nameMkPrimByteArray;
Name nameMkRef;
Name nameMkPrimMutableArray;
Name nameMkPrimMutableByteArray;
#ifdef PROVIDE_STABLE
Name nameMkStable; /* StablePtr# a -> StablePtr a */
#endif
#ifdef PROVIDE_WEAK
Name nameMkWeak; /* Weak# a -> Weak a */
#endif
......@@ -290,9 +288,7 @@ Void linkPreludeTC(void) { /* Hook to tycons and classes in */
typePrimMutableByteArray = linkTycon("PrimMutableByteArray");
typeFloat = linkTycon("Float");
typeDouble = linkTycon("Double");
#ifdef PROVIDE_STABLE
typeStable = linkTycon("StablePtr");
#endif
#ifdef PROVIDE_WEAK
typeWeak = linkTycon("Weak");
#endif
......@@ -342,9 +338,7 @@ Void linkPreludeTC(void) { /* Hook to tycons and classes in */
nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP);
nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP);
nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP);
#ifdef PROVIDE_STABLE
nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP);
#endif
nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0);
#ifdef PROVIDE_FOREIGN
nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0);
......@@ -477,6 +471,8 @@ Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
implementPrim(n);
}
nameRunST = linkName("primRunST");
/* static(tidyInfix) */
nameNegate = linkName("negate");
/* user interface */
......@@ -492,6 +488,7 @@ Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
/* translator */
nameEqChar = linkName("primEqChar");
nameEqInt = linkName("primEqInt");
nameCreateAdjThunk = linkName("primCreateAdjThunk");
#if !OVERLOADED_CONSTANTS
nameEqInteger = linkName("primEqInteger");
#endif /* !OVERLOADED_CONSTANTS */
......@@ -565,6 +562,9 @@ Int what; {
pFun(nameError, "error");
pFun(nameUnpackString, "primUnpackString");
// /* foreign export dynamic */
//pFun(nameCreateAdjThunk, "primCreateAdjThunk");
/* hooks for handwritten bytecode */
pFun(namePrimSeq, "primSeq");
pFun(namePrimCatch, "primCatch");
......
......@@ -16,9 +16,7 @@ extern Name nameMkW;
extern Name nameMkA;