{-# OPTIONS -#include "tclhaskell.h" #-}
-- Automatically generated by HaskellDirect (ihc), snapshot 240699
-- Created: 14:34 , Friday 30 July, 1999
-- Command line: -c tclHaskell.idl -o TclPrim.hs -fhs-to-c --hugs -fno-qualified-names

module TclPrim
       ( readCharOffAddr
       , writeCharOffAddr
       , primMalloc
       , primFree
       , primPutEnv
       , primTclDebug
       , primInitTcl
       , primRunTcl
       , primRunNonBlockingTcl
       , primRunOnceTcl
       , primExecuteTcl
       , primExecuteTcl_
       , primGetEvent
       , primSetVar
       , primCheckAnyWindowsTcl
       ) where
       
import Prelude
import Addr (Addr,nullAddr)
import Int 
import Word 

doThenFree ::(Addr -> IO ()) -> (Addr -> IO b) -> Addr -> IO b
doThenFree f act ptr = do
   v <- act ptr
   f ptr
   return v

freeString = primFree

marshallBool :: Bool -> IO Int32
marshallBool v = return (if v then (-1) else 0)

unmarshallBool :: Int32 -> IO Bool
unmarshallBool v = return (v /= 0)

marshallString :: String -> IO Addr
marshallString str = do
 pstr  <- primMalloc len
 writeElt pstr 0 str
 return pstr
  where
   len = 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 -> IO String
unmarshallString ptr
 | ptr == nullAddr = return ""
 | otherwise	   = do
   loop ptr 0
  where
   loop ptr n = do
    v  <- readCharOffAddr ptr n
    if v == '\0'
     then return []
     else do
       vs <- loop ptr (n+1)
       return (v:vs)


readCharOffAddr :: Addr
                -> Int32
                -> IO Char
readCharOffAddr arg1 arg2 =
  prim_TclPrim_readCharOffAddr arg1
                               arg2

primitive prim_TclPrim_readCharOffAddr :: Addr -> Int32 -> IO Char
writeCharOffAddr :: Addr
                 -> Int32
                 -> Char
                 -> IO ()
writeCharOffAddr arg1 arg2 arg3 =
  prim_TclPrim_writeCharOffAddr arg1
                                arg2
                                arg3

primitive prim_TclPrim_writeCharOffAddr :: Addr -> Int32 -> Char -> IO ()
primMalloc :: Word32
           -> IO Addr
primMalloc arg1 = prim_TclPrim_primMalloc arg1

primitive prim_TclPrim_primMalloc :: Word32 -> IO Addr
primFree :: Addr
         -> IO ()
primFree arg1 =
  prim_TclPrim_primFree arg1

primitive prim_TclPrim_primFree :: Addr -> IO ()
primPutEnv :: String
           -> IO ()
primPutEnv str =
  do
    str <- marshallString str
    prim_TclPrim_primPutEnv str
    freeString str

primitive prim_TclPrim_primPutEnv :: Addr -> IO ()
primTclDebug :: Bool
             -> IO ()
primTclDebug flg =
  do
    flg <- marshallBool flg
    prim_TclPrim_primTclDebug flg

primitive prim_TclPrim_primTclDebug :: Int32 -> IO ()
primInitTcl :: IO Bool
primInitTcl =
  do
    o_primInitTcl <- prim_TclPrim_primInitTcl
    unmarshallBool o_primInitTcl

primitive prim_TclPrim_primInitTcl :: IO Int32
primRunTcl :: IO Bool
primRunTcl =
  do
    o_primRunTcl <- prim_TclPrim_primRunTcl
    unmarshallBool o_primRunTcl

primitive prim_TclPrim_primRunTcl :: IO Int32
primRunNonBlockingTcl :: IO Bool
primRunNonBlockingTcl =
  do
    o_primRunNonBlockingTcl <- prim_TclPrim_primRunNonBlockingTcl
    unmarshallBool o_primRunNonBlockingTcl

primitive prim_TclPrim_primRunNonBlockingTcl :: IO Int32
primRunOnceTcl :: IO Bool
primRunOnceTcl =
  do
    o_primRunOnceTcl <- prim_TclPrim_primRunOnceTcl
    unmarshallBool o_primRunOnceTcl

primitive prim_TclPrim_primRunOnceTcl :: IO Int32
primExecuteTcl :: String
               -> IO String
primExecuteTcl cmd =
  do
    cmd <- marshallString cmd
    o_primExecuteTcl <- prim_TclPrim_primExecuteTcl cmd
    freeString cmd
    o_primExecuteTcl <- unmarshallString o_primExecuteTcl
    return (o_primExecuteTcl)

primitive prim_TclPrim_primExecuteTcl :: Addr -> IO Addr
primExecuteTcl_ :: String
                -> IO ()
primExecuteTcl_ cmd =
  do
    cmd <- marshallString cmd
    prim_TclPrim_primExecuteTcl_ cmd
    freeString cmd

primitive prim_TclPrim_primExecuteTcl_ :: Addr -> IO ()
primGetEvent :: IO String
primGetEvent =
  do
    o_primGetEvent <- prim_TclPrim_primGetEvent
    unmarshallString o_primGetEvent

primitive prim_TclPrim_primGetEvent :: IO Addr
primSetVar :: String
           -> String
           -> IO ()
primSetVar varname inp =
  do
    varname <- marshallString varname
    inp <- marshallString inp
    prim_TclPrim_primSetVar varname inp
    freeString varname
    freeString inp

primitive prim_TclPrim_primSetVar :: Addr -> Addr -> IO ()
primCheckAnyWindowsTcl :: IO Bool
primCheckAnyWindowsTcl =
  do
    o_primCheckAnyWindowsTcl <- prim_TclPrim_primCheckAnyWindowsTcl
    unmarshallBool o_primCheckAnyWindowsTcl

primitive prim_TclPrim_primCheckAnyWindowsTcl :: IO Int32
needPrims_hugs 2