,unsafeInterleaveIO,nh_write,primCharToInt
-- debugging hacks
- ,ST(..)
+ --,ST(..)
+ --,primIntToAddr
+ --,primGetArgc
+ --,primGetArgv
) where
-- Standard value bindings {Prelude} ----------------------------------------
primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
primMkIO = ST
-primCreateAdjThunk :: (a -> b) -> String -> IO Addr
-primCreateAdjThunk fun typestr
+primCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
+primCreateAdjThunk fun typestr callconv
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
- a <- primCreateAdjThunkARCH sp p
+ a <- primCreateAdjThunkARCH sp p callconv
return a
-- The following primitives are only needed if (n+k) patterns are enabled:
type FILE_STAR = Int -- FILE *
-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 :: 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 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 :: Addr -> IO Addr
+foreign import "nHandle" "nh_stdin" nh_stdin :: IO FILE_STAR
+foreign import "nHandle" "nh_stdout" nh_stdout :: IO FILE_STAR
+foreign import "nHandle" "nh_stderr" nh_stderr :: IO FILE_STAR
+foreign import "nHandle" "nh_write" nh_write :: FILE_STAR -> Int -> IO ()
+foreign import "nHandle" "nh_read" nh_read :: FILE_STAR -> IO Int
+foreign import "nHandle" "nh_open" nh_open :: Addr -> Int -> IO FILE_STAR
+foreign import "nHandle" "nh_flush" nh_flush :: FILE_STAR -> IO ()
+foreign import "nHandle" "nh_close" nh_close :: FILE_STAR -> IO ()
+foreign import "nHandle" "nh_errno" nh_errno :: IO Int
+
+foreign import "nHandle" "nh_malloc" nh_malloc :: Int -> IO Addr
+foreign import "nHandle" "nh_free" nh_free :: Addr -> IO ()
+foreign import "nHandle" "nh_store" nh_store :: Addr -> Int -> IO ()
+foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Int
+
+--foreign import "nHandle" "nh_argc" nh_argc :: IO Int
+--foreign import "nHandle" "nh_argvb" nh_argvb :: Int -> Int -> IO Int
+foreign import "nHandle" "nh_getenv" nh_getenv :: Addr -> IO Addr
copy_String_to_cstring :: String -> IO Addr
copy_String_to_cstring s
primGetRawArgs :: IO [String]
primGetRawArgs
- = nh_argc >>= \argc ->
- accumulate (map (get_one_arg 0) [0 .. argc-1])
+ = primGetArgc >>= \argc ->
+ accumulate (map get_one_arg [0 .. argc-1])
where
- get_one_arg :: Int -> Int -> IO String
- get_one_arg offset argno
- = nh_argvb argno offset >>= \cb ->
- if cb == 0
- then return []
- else get_one_arg (offset+1) argno >>= \s ->
- return ((primIntToChar cb):s)
+ get_one_arg :: Int -> IO String
+ get_one_arg argno
+ = primGetArgv argno >>= \a ->
+ copy_cstring_to_String a
primGetEnv :: String -> IO String
primGetEnv v