module Foreign.Ruby.Bindings where
import Foreign
import Foreign.C
type RValue = Ptr CULong
type RID = CULong
data ShimDispatch = ShimDispatch String String [RValue]
instance Storable ShimDispatch where
sizeOf _ = ((152))
alignment = sizeOf
peek ptr = do a <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 0)) ptr)
b <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 8)) ptr)
return (ShimDispatch a b [])
poke ptr (ShimDispatch c m vals) = do
cs <- newCString c
cm <- newCString m
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr cs
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr cm
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (length vals)
let arrayblock = ((\hsc_ptr -> hsc_ptr `plusPtr` 24)) ptr
pokeArray arrayblock vals
data RBuiltin = RNONE
| RNIL
| ROBJECT
| RCLASS
| RICLASS
| RMODULE
| RFLOAT
| RSTRING
| RREGEXP
| RARRAY
| RFIXNUM
| RHASH
| RSTRUCT
| RBIGNUM
| RFILE
| RTRUE
| RFALSE
| RDATA
| RMATCH
| RSYMBOL
| RUNDEF
| RNODE
deriving (Show)
data RType = RFixNum
| RNil
| RFalse
| RTrue
| RSymbol
| RUndef
| RBuiltin RBuiltin
deriving (Show)
type Registered0 = IO RValue
type Registered1 = RValue -> IO RValue
type Registered2 = RValue -> RValue -> IO RValue
foreign import ccall "wrapper" mkRegistered0 :: Registered0 -> IO (FunPtr Registered0)
foreign import ccall "wrapper" mkRegistered1 :: Registered1 -> IO (FunPtr Registered1)
foreign import ccall "wrapper" mkRegistered2 :: Registered2 -> IO (FunPtr Registered2)
type RegisteredCB3 = RValue -> RValue -> RValue -> IO Int
foreign import ccall "wrapper" mkRegisteredCB3 :: RegisteredCB3 -> IO (FunPtr RegisteredCB3)
foreign import ccall "ruby_init" ruby_init :: IO ()
foreign import ccall "ruby_finalize" ruby_finalize :: IO ()
foreign import ccall "ruby_init_loadpath" ruby_init_loadpath :: IO ()
foreign import ccall "rb_str_new2" c_rb_str_new2 :: CString -> IO RValue
foreign import ccall "rb_ary_new2" rb_ary_new2 :: CLong -> IO RValue
foreign import ccall "rb_ary_new4" rb_ary_new4 :: CLong -> Ptr RValue -> IO RValue
foreign import ccall "rb_load_protect" c_rb_load_protect :: RValue -> Int -> Ptr Int -> IO ()
foreign import ccall "rb_funcall" c_rb_funcall_0 :: RValue -> RID -> Int -> IO RValue
foreign import ccall "rb_funcall" c_rb_funcall_1 :: RValue -> RID -> Int -> RValue -> IO RValue
foreign import ccall "rb_funcall" c_rb_funcall_2 :: RValue -> RID -> Int -> RValue -> RValue -> IO RValue
foreign import ccall "rb_funcall" c_rb_funcall_3 :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> IO RValue
foreign import ccall "rb_funcall" c_rb_funcall_4 :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> RValue -> IO RValue
foreign import ccall "rb_funcall" c_rb_funcall_5 :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> RValue -> RValue -> IO RValue
foreign import ccall "rb_gv_get" c_rb_gv_get :: CString -> IO RValue
foreign import ccall "rb_intern" c_rb_intern :: CString -> IO RID
foreign import ccall "rb_id2name" rb_id2name :: RID -> IO CString
foreign import ccall "rb_string_value_ptr" c_rb_string_value_ptr :: Ptr RValue -> IO CString
foreign import ccall "&rb_cObject" rb_cObject :: Ptr RValue
foreign import ccall "rb_iv_set" c_rb_iv_set :: RValue -> CString -> RValue -> IO RValue
foreign import ccall "rb_define_class" c_rb_define_class :: CString -> RValue -> IO RValue
foreign import ccall "rb_define_method" c_rb_define_method :: RValue -> CString -> FunPtr a -> Int -> IO ()
foreign import ccall "rb_define_global_function" c_rb_define_global_function :: CString -> FunPtr a -> Int -> IO ()
foreign import ccall "rb_const_get" rb_const_get :: RValue -> RID -> IO RValue
foreign import ccall "&safeCall" safeCallback :: FunPtr (RValue -> IO RValue)
foreign import ccall "rb_protect" c_rb_protect :: FunPtr (RValue -> IO RValue) -> RValue -> Ptr Int -> IO RValue
foreign import ccall "rb_string_value_cstr" c_rb_string_value_cstr :: Ptr RValue -> IO CString
foreign import ccall "rb_ary_new" rb_ary_new :: IO RValue
foreign import ccall "rb_ary_push" rb_ary_push :: RValue -> RValue -> IO RValue
foreign import ccall "rb_ary_entry" rb_ary_entry :: RValue -> CLong -> IO RValue
foreign import ccall "rb_hash_foreach" rb_hash_foreach :: RValue -> FunPtr a -> RValue -> IO ()
foreign import ccall "rb_big2str" rb_big2str :: RValue -> CInt -> IO RValue
foreign import ccall "rb_cstr_to_inum" rb_cstr_to_inum :: CString -> CInt -> CInt -> IO RValue
foreign import ccall "newFloat" newFloat :: Double -> IO RValue
foreign import ccall "rb_hash_new" rb_hash_new :: IO RValue
foreign import ccall "rb_hash_aset" rb_hash_aset :: RValue -> RValue -> RValue -> IO RValue
foreign import ccall "rb_define_module" c_rb_define_module :: CString -> IO ()
foreign import ccall "arrayLength" arrayLength :: RValue -> IO CLong
foreign import ccall "rubyType" rubyType :: RValue -> IO CInt
foreign import ccall "num2dbl" num2dbl :: RValue -> IO Double
foreign import ccall "int2num" int2num :: CLong -> IO RValue
foreign import ccall "num2long" num2long :: RValue -> IO CLong
sym2id :: RValue -> RID
sym2id x = (fromIntegral (ptrToIntPtr x)) `shiftR` 8
id2sym :: RID -> RValue
id2sym x = intPtrToPtr (fromIntegral ( (x `shiftL` 8) .|. 0x0e ))
rbFalse,rbTrue,rbNil,rbUndef :: RValue
rbFalse = intPtrToPtr 0
rbTrue = intPtrToPtr 2
rbNil = intPtrToPtr 4
rbUndef = intPtrToPtr 6
rtype :: RValue -> IO RType
rtype v = rubyType v >>= \x -> case x of
(0) -> return RUndef
(2) -> return (RBuiltin ROBJECT)
(3) -> return (RBuiltin RCLASS)
(5) -> return (RBuiltin RMODULE)
(6) -> return (RBuiltin RFLOAT)
(7) -> return (RBuiltin RSTRING)
(8) -> return (RBuiltin RREGEXP)
(9) -> return (RBuiltin RARRAY)
(11) -> return (RBuiltin RHASH)
(12) -> return (RBuiltin RSTRUCT)
(13) -> return (RBuiltin RBIGNUM)
(14) -> return (RBuiltin RFILE)
(34) -> return (RBuiltin RDATA)
(35) -> return (RBuiltin RMATCH)
(1) -> return RNil
(32) -> return RTrue
(33) -> return RFalse
(36) -> return RSymbol
(10) -> return RFixNum
(60) -> return (RBuiltin RUNDEF)
(63) -> return (RBuiltin RNODE)
(4) -> return (RBuiltin RICLASS)
_ -> return RUndef
rb_string_value_cstr :: RValue -> IO String
rb_string_value_cstr v = do
pv <- new v
o <- c_rb_string_value_cstr pv >>= peekCString
free pv
return o
rb_define_global_function :: String
-> FunPtr a
-> Int
-> IO ()
rb_define_global_function s f i = withCString s (\cs -> c_rb_define_global_function cs f i)
rb_define_method :: RValue -> String -> FunPtr a -> Int -> IO ()
rb_define_method r s f i = withCString s (\cs -> c_rb_define_method r cs f i)
rb_define_class :: String -> RValue -> IO RValue
rb_define_class str rv = withCString str (\s -> c_rb_define_class s rv)
rb_str_new2 :: String -> IO RValue
rb_str_new2 str = withCString str c_rb_str_new2
rb_define_module :: String -> IO ()
rb_define_module str = withCString str c_rb_define_module
rb_iv_set :: RValue
-> String
-> RValue
-> IO RValue
rb_iv_set obj varname varvalue = withCString ('@' : varname) $ \cvarname -> c_rb_iv_set obj cvarname varvalue
rb_load_protect :: String
-> Int
-> IO Int
rb_load_protect rv a = do
bptr <- new 0
rvs <- rb_str_new2 rv
c_rb_load_protect rvs a bptr
status <- peek bptr
free bptr
return status
rb_funcall :: RValue -> RID -> [RValue] -> IO RValue
rb_funcall a b [] = c_rb_funcall_0 a b 0
rb_funcall a b [d] = c_rb_funcall_1 a b 1 d
rb_funcall a b [d,e] = c_rb_funcall_2 a b 2 d e
rb_funcall a b [d,e,f] = c_rb_funcall_3 a b 3 d e f
rb_funcall a b [d,e,f,g] = c_rb_funcall_4 a b 4 d e f g
rb_funcall a b [d,e,f,g,h] = c_rb_funcall_5 a b 5 d e f g h
rb_funcall _ _ _ = error "Can't call functions with that many arguments"
rbMethodCall :: String -> String -> [RValue] -> IO RValue
rbMethodCall classname methodname args = do
c <- getClass classname
m <- rb_intern methodname
rb_funcall c m args
getClass :: String -> IO RValue
getClass s = do
i <- rb_intern s
o <- peek rb_cObject
rb_const_get o i
rb_gv_get :: String -> IO RValue
rb_gv_get s = withCString s c_rb_gv_get
rb_intern :: String -> IO RID
rb_intern s = withCString s c_rb_intern
rb_string_value_ptr :: RValue -> IO String
rb_string_value_ptr rv = do
rvp <- new rv
o <- c_rb_string_value_ptr rvp >>= peekCString
free rvp
return o