[project @ 1999-10-29 13:41:23 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / lib / Prelude.hs
index ebee5b4..68a8314 100644 (file)
@@ -113,7 +113,10 @@ module Prelude (
     ,unsafeInterleaveIO,nh_write,primCharToInt
 
     -- debugging hacks
-    ,ST(..)
+    --,ST(..)
+    --,primIntToAddr
+    --,primGetArgc
+    --,primGetArgv
   ) where
 
 -- Standard value bindings {Prelude} ----------------------------------------
@@ -1549,11 +1552,11 @@ primPmFail        = error "Pattern Match Failure"
 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:
@@ -1702,24 +1705,24 @@ data IOResult  = IOResult  deriving (Show)
 
 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
@@ -1760,16 +1763,13 @@ writetohandle fname h (c:cs)
 
 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