{-# OPTIONS -#include "tclhaskell.h" #-} -- Automatically generated by HaskellDirect (ihc), snapshot 240699 -- Created: 14:35 , Friday 30 July, 1999 -- Command line: -c tclHaskell.idl -o TclPrimGhc.hs -fhs-to-c -- Modified by hand by Meurig Sage to remove HDirect.hs dependencies module TclPrim ( readCharOffAddr , writeCharOffAddr , primMalloc , primFree , primPutEnv , primTclDebug , primInitTcl , primRunTcl , primRunNonBlockingTcl , primRunOnceTcl , primExecuteTcl , primExecuteTcl_ , primGetEvent , primSetVar , primCheckAnyWindowsTcl ) where import Prelude import qualified Addr import qualified Int import qualified Word import Prelude ((==)) freeString = primFree marshallBool :: Bool -> IO Int.Int32 marshallBool v = return (if v then (-1) else 0) unmarshallBool :: Int.Int32 -> IO Bool unmarshallBool v = return (v /= 0) marshallString :: String -> IO Addr.Addr marshallString str = do pstr <- primMalloc len writeElt pstr 0 str return pstr where len = Word.intToWord32 (length str + 1) writeElt addr n [] = writeCharOffAddr addr n '\0' writeElt addr n (v :vs) = do writeCharOffAddr addr n v writeElt addr (n + 1) vs unmarshallString :: Addr.Addr -> IO String unmarshallString ptr | ptr == Addr.nullAddr = return "" | otherwise = do loop ptr 0 where loop ptr n = do v <- readCharOffAddr ptr n if v == '\0' then do return [] else do vs <- loop ptr (n + 1) return (v : vs) readCharOffAddr :: Addr.Addr -> Int.Int32 -> IO Char readCharOffAddr arg1 arg2 = prim_readCharOffAddr arg1 arg2 foreign import "readCharOffAddr" prim_readCharOffAddr :: Addr.Addr -> Int.Int32 -> IO Char writeCharOffAddr :: Addr.Addr -> Int.Int32 -> Char -> IO () writeCharOffAddr arg1 arg2 arg3 = prim_writeCharOffAddr arg1 arg2 arg3 foreign import "writeCharOffAddr" prim_writeCharOffAddr :: Addr.Addr -> Int.Int32 -> Char -> IO () primMalloc :: Word.Word32 -> IO Addr.Addr primMalloc arg1 = prim_primMalloc arg1 foreign import "primMalloc" prim_primMalloc :: Word.Word32 -> IO Addr.Addr primFree :: Addr.Addr -> IO () primFree arg1 = prim_primFree arg1 foreign import "primFree" prim_primFree :: Addr.Addr -> IO () primPutEnv :: String -> IO () primPutEnv str = do str <- marshallString str prim_primPutEnv str freeString str foreign import "primPutEnv" prim_primPutEnv :: Addr.Addr -> IO () primTclDebug :: Bool -> IO () primTclDebug flg = do flg <- marshallBool flg prim_primTclDebug flg foreign import "primTclDebug" prim_primTclDebug :: Int.Int32 -> IO () primInitTcl :: IO Bool primInitTcl = do o_primInitTcl <- prim_primInitTcl unmarshallBool o_primInitTcl foreign import "primInitTcl" prim_primInitTcl :: IO Int.Int32 primRunTcl :: IO Bool primRunTcl = do o_primRunTcl <- prim_primRunTcl unmarshallBool o_primRunTcl foreign import "primRunTcl" prim_primRunTcl :: IO Int.Int32 primRunNonBlockingTcl :: IO Bool primRunNonBlockingTcl = do o_primRunNonBlockingTcl <- prim_primRunNonBlockingTcl unmarshallBool o_primRunNonBlockingTcl foreign import "primRunNonBlockingTcl" prim_primRunNonBlockingTcl :: IO Int.Int32 primRunOnceTcl :: IO Bool primRunOnceTcl = do o_primRunOnceTcl <- prim_primRunOnceTcl unmarshallBool o_primRunOnceTcl foreign import "primRunOnceTcl" prim_primRunOnceTcl :: IO Int.Int32 primExecuteTcl :: String -> IO String primExecuteTcl cmd = do cmd <- marshallString cmd o_primExecuteTcl <- prim_primExecuteTcl cmd freeString cmd o_primExecuteTcl <- unmarshallString o_primExecuteTcl return (o_primExecuteTcl) foreign import "primExecuteTcl" prim_primExecuteTcl :: Addr.Addr -> IO Addr.Addr primExecuteTcl_ :: String -> IO () primExecuteTcl_ cmd = do cmd <- marshallString cmd prim_primExecuteTcl_ cmd freeString cmd foreign import "primExecuteTcl_" prim_primExecuteTcl_ :: Addr.Addr -> IO () primGetEvent :: IO String primGetEvent = do o_primGetEvent <- prim_primGetEvent unmarshallString o_primGetEvent foreign import "primGetEvent" prim_primGetEvent :: IO Addr.Addr primSetVar :: String -> String -> IO () primSetVar varname inp = do varname <- marshallString varname inp <- marshallString inp prim_primSetVar varname inp freeString varname freeString inp foreign import "primSetVar" prim_primSetVar :: Addr.Addr -> Addr.Addr -> IO () primCheckAnyWindowsTcl :: IO Bool primCheckAnyWindowsTcl = do o_primCheckAnyWindowsTcl <- prim_primCheckAnyWindowsTcl unmarshallBool o_primCheckAnyWindowsTcl foreign import "primCheckAnyWindowsTcl" prim_primCheckAnyWindowsTcl :: IO Int.Int32