hruby 0.0.3 → 0.1.0
raw patch · 10 files changed
+171/−148 lines, 10 files
Files
- Foreign/Ruby/Bindings.hsc +87/−77
- Foreign/Ruby/Helpers.hs +6/−14
- cbits/shim.c +41/−0
- cbits/shim.h +17/−0
- cbits1.8/shim.c +0/−12
- cbits1.8/shim.h +0/−11
- cbits1.9/shim.c +0/−12
- cbits1.9/shim.h +0/−11
- hruby.cabal +18/−10
- test/roundtrip.hs +2/−1
Foreign/Ruby/Bindings.hsc view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances #-}+{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances, CPP #-} #include "shim.h" @@ -29,61 +29,6 @@ let arrayblock = (#ptr struct s_dispatch, args) ptr pokeArray arrayblock vals -builtinToInt :: RBuiltin -> CULong-builtinToInt RNONE = 0x00-builtinToInt RNIL = 0x01-builtinToInt ROBJECT = 0x02-builtinToInt RCLASS = 0x03-builtinToInt RICLASS = 0x04-builtinToInt RMODULE = 0x05-builtinToInt RFLOAT = 0x06-builtinToInt RSTRING = 0x07-builtinToInt RREGEXP = 0x08-builtinToInt RARRAY = 0x09-builtinToInt RFIXNUM = 0x0a-builtinToInt RHASH = 0x0b-builtinToInt RSTRUCT = 0x0c-builtinToInt RBIGNUM = 0x0d-builtinToInt RFILE = 0x0e-builtinToInt RTRUE = 0x20-builtinToInt RFALSE = 0x21-builtinToInt RDATA = 0x22-builtinToInt RMATCH = 0x23-builtinToInt RSYMBOL = 0x24-builtinToInt RBLKTAG = 0x3b-builtinToInt RUNDEF = 0x3c-builtinToInt RVARMAP = 0x3d-builtinToInt RSCOPE = 0x3e-builtinToInt RNODE = 0x3f--intToBuiltin :: CULong -> RBuiltin--- intToBuiltin 0x00 = RNONE-intToBuiltin 0x01 = RNIL-intToBuiltin 0x02 = ROBJECT-intToBuiltin 0x03 = RCLASS-intToBuiltin 0x04 = RICLASS-intToBuiltin 0x05 = RMODULE-intToBuiltin 0x06 = RFLOAT-intToBuiltin 0x07 = RSTRING-intToBuiltin 0x08 = RREGEXP-intToBuiltin 0x09 = RARRAY-intToBuiltin 0x0a = RFIXNUM-intToBuiltin 0x0b = RHASH-intToBuiltin 0x0c = RSTRUCT-intToBuiltin 0x0d = RBIGNUM-intToBuiltin 0x0e = RFILE-intToBuiltin 0x20 = RTRUE-intToBuiltin 0x21 = RFALSE-intToBuiltin 0x22 = RDATA-intToBuiltin 0x23 = RMATCH-intToBuiltin 0x24 = RSYMBOL-intToBuiltin 0x3b = RBLKTAG-intToBuiltin 0x3c = RUNDEF-intToBuiltin 0x3d = RVARMAP-intToBuiltin 0x3e = RSCOPE-intToBuiltin 0x3f = RNODE-intToBuiltin _ = RNONE- -- | The ruby built-in types data RBuiltin = RNONE | RNIL@@ -105,11 +50,17 @@ | RDATA | RMATCH | RSYMBOL- | RBLKTAG | RUNDEF+ | RNODE+#ifdef RUBY2+ | RCOMPLEX+ | RRATIONAL+ | RZOMBIE+#else+ | RBLKTAG | RVARMAP | RSCOPE- | RNODE+#endif deriving (Show) -- | Ruby native types, as encoded in the Value type.@@ -118,6 +69,7 @@ | RFalse | RTrue | RSymbol+ | RUndef | RBuiltin RBuiltin deriving (Show) @@ -151,7 +103,11 @@ 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+#ifdef RUBY2+foreign import ccall "rb_errinfo" rb_errinfo :: IO RValue+#else foreign import ccall "&ruby_errinfo" ruby_errinfo :: Ptr RValue+#endif 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 ()@@ -167,38 +123,92 @@ 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 "rb_float_new" rb_float_new :: Double -> 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 :: RValue+rbFalse,rbTrue,rbNil,rbUndef :: RValue+#ifdef RUBY2+rbFalse = intPtrToPtr 0x00+rbTrue = intPtrToPtr 0x14+rbNil = intPtrToPtr 0x08+rbUndef = intPtrToPtr 0x34+#else rbFalse = intPtrToPtr 0-rbTrue :: RValue-rbTrue = intPtrToPtr 2-rbNil :: RValue-rbNil = intPtrToPtr 4+rbTrue = intPtrToPtr 2+rbNil = intPtrToPtr 4+rbUndef = intPtrToPtr 6+#endif rtype :: RValue -> IO RType-rtype rv | ptrToIntPtr rv .&. 1 == 1 = return RFixNum- | ptrToIntPtr rv == 0 = return RFalse- | ptrToIntPtr rv == 2 = return RTrue- | ptrToIntPtr rv == 4 = return RNil- | ptrToIntPtr rv .&. 0xff == 0x0e = return RSymbol- | otherwise = fmap (RBuiltin . intToBuiltin . (.&. 0x3f)) (peek rv)---peekArrayLength :: RValue -> IO CLong-peekArrayLength = (#peek struct RArray, len)--peekRFloatValue :: RValue -> IO Double-peekRFloatValue = (#peek struct RFloat, value)+rtype v = rubyType v >>= \x -> case x of+#ifdef RUBY2+ 0x00 -> return RUndef+ 0x01 -> return (RBuiltin ROBJECT)+ 0x02 -> return (RBuiltin RCLASS)+ 0x03 -> return (RBuiltin RMODULE)+ 0x04 -> return (RBuiltin RFLOAT)+ 0x05 -> return (RBuiltin RSTRING)+ 0x06 -> return (RBuiltin RREGEXP)+ 0x07 -> return (RBuiltin RARRAY)+ 0x08 -> return (RBuiltin RHASH)+ 0x09 -> return (RBuiltin RSTRUCT)+ 0x0a -> return (RBuiltin RBIGNUM)+ 0x0b -> return (RBuiltin RFILE)+ 0x0c -> return (RBuiltin RDATA)+ 0x0d -> return (RBuiltin RMATCH)+ 0x0e -> return (RBuiltin RCOMPLEX)+ 0x0f -> return (RBuiltin RRATIONAL)+ 0x11 -> return RNil+ 0x12 -> return RTrue+ 0x13 -> return RFalse+ 0x14 -> return RSymbol+ 0x15 -> return RFixNum+ 0x1b -> return (RBuiltin RUNDEF)+ 0x1c -> return (RBuiltin RNODE)+ 0x1d -> return (RBuiltin RICLASS)+ 0x1e -> return (RBuiltin RZOMBIE)+#else+ 0x00 -> return RUndef+ 0x01 -> return RNil+ 0x02 -> return (RBuiltin ROBJECT)+ 0x03 -> return (RBuiltin RCLASS)+ 0x04 -> return (RBuiltin RICLASS)+ 0x05 -> return (RBuiltin RMODULE)+ 0x06 -> return (RBuiltin RFLOAT)+ 0x07 -> return (RBuiltin RSTRING)+ 0x08 -> return (RBuiltin RREGEXP)+ 0x09 -> return (RBuiltin RARRAY)+ 0x0a -> return RFixNum+ 0x0b -> return (RBuiltin RHASH)+ 0x0c -> return (RBuiltin RSTRUCT)+ 0x0d -> return (RBuiltin RBIGNUM)+ 0x0e -> return (RBuiltin RFILE)+ 0x20 -> return RTrue+ 0x21 -> return RFalse+ 0x22 -> return (RBuiltin RDATA)+ 0x23 -> return (RBuiltin RMATCH)+ 0x24 -> return RSymbol+ 0x3b -> return (RBuiltin RBLKTAG)+ 0x3c -> return RUndef+ 0x3d -> return (RBuiltin RVARMAP)+ 0x3e -> return (RBuiltin RSCOPE)+ 0x3f -> return (RBuiltin RNODE)+#endif+ _ -> return RUndef rb_string_value_cstr :: RValue -> IO String rb_string_value_cstr v = do
Foreign/Ruby/Helpers.hs view
@@ -28,17 +28,13 @@ toRuby :: a -> IO RValue fromRubyIntegral :: Integral n => RValue -> IO (Maybe n)-fromRubyIntegral r = do- t <- rtype r- case t of- RFixNum -> return (Just (fromIntegral (ptrToIntPtr r `shiftR` 1)))- _ -> return Nothing+fromRubyIntegral = fmap (Just . fromIntegral) . num2long toRubyIntegral :: Integral n => n -> IO RValue-toRubyIntegral n = return (intPtrToPtr ( (fromIntegral n `shiftL` 1) .|. 1))+toRubyIntegral = int2num . fromIntegral fromRubyArray :: FromRuby a => RValue -> IO (Maybe [a]) fromRubyArray v = do- nbelems <- peekArrayLength v+ nbelems <- arrayLength v fmap sequence (forM [0..(nbelems-1)] (rb_ary_entry v >=> fromRuby)) instance FromRuby a => FromRuby [a] where@@ -73,9 +69,9 @@ toRuby = toRuby . T.encodeUtf8 instance ToRuby Double where- toRuby = rb_float_new+ toRuby = newFloat instance FromRuby Double where- fromRuby = fmap Just . peekRFloatValue+ fromRuby = fmap Just . num2dbl instance FromRuby Integer where fromRuby = fromRubyIntegral@@ -132,11 +128,7 @@ return Nothing instance ToRuby Value where- toRuby (Number (I x)) = do- let maxRubyInt = fromIntegral (maxBound :: IntPtr) `shiftR` 1 :: Integer- if x >= maxRubyInt- then BS.useAsCString (BS.pack (show x)) (\cs -> rb_cstr_to_inum cs 10 0)- else toRubyIntegral x+ toRuby (Number (I x)) = toRuby x toRuby (Number (D x)) = toRuby x toRuby (String t) = let bs = T.encodeUtf8 t in BS.useAsCString bs c_rb_str_new2
+ cbits/shim.c view
@@ -0,0 +1,41 @@+#include "shim.h"++VALUE safeCall(VALUE args)+{+ struct s_dispatch * d = (struct s_dispatch *) args;+ VALUE myclass = rb_const_get(rb_cObject, rb_intern(d->classname));+ VALUE o = rb_funcall2(myclass, rb_intern(d->methodname), d->nbargs, d->args);+ free(d->methodname);+ free(d->classname);+ return o;+}++long arrayLength(VALUE r)+{+ return RARRAY_LEN(r);+}++VALUE newFloat(double d) {+#ifdef RUBY2+ rb_float_new_in_heap(d);+#else+ rb_float_new(d);+#endif+}++int rubyType(VALUE obj) {+ return rb_type(obj);+}++VALUE int2num(long x) {+ return INT2NUM(x);+}++long num2long(VALUE v) {+ return NUM2LONG(v);+}++double num2dbl(VALUE v) {+ NUM2DBL(v);+}+
+ cbits/shim.h view
@@ -0,0 +1,17 @@+#include <ruby.h>++struct s_dispatch {+ char * classname;+ char * methodname;+ int nbargs;+ VALUE args[16];+};++VALUE safeCall(VALUE args);+long arrayLength(VALUE r);++VALUE newFloat(double d);+int rubyType(VALUE obj);+VALUE int2num(long x);+long num2long(VALUE v);+double num2dbl(VALUE v);
− cbits1.8/shim.c
@@ -1,12 +0,0 @@-#include "shim.h"--VALUE safeCall(VALUE args)-{- struct s_dispatch * d = (struct s_dispatch *) args;- VALUE myclass = rb_const_get(rb_cObject, rb_intern(d->classname));- VALUE o = rb_funcall2(myclass, rb_intern(d->methodname), d->nbargs, d->args);- free(d->methodname);- free(d->classname);- return o;-}-
− cbits1.8/shim.h
@@ -1,11 +0,0 @@-#include "/usr/lib/ruby/1.8/x86_64-linux/ruby.h"--struct s_dispatch {- char * classname;- char * methodname;- int nbargs;- VALUE args[16];-};--VALUE safeCall(VALUE args);-
− cbits1.9/shim.c
@@ -1,12 +0,0 @@-#include "shim.h"--VALUE safeCall(VALUE args)-{- struct s_dispatch * d = (struct s_dispatch *) args;- VALUE myclass = rb_const_get(rb_cObject, rb_intern(d->classname));- VALUE o = rb_funcall2(myclass, rb_intern(d->methodname), d->nbargs, d->args);- free(d->methodname);- free(d->classname);- return o;-}-
− cbits1.9/shim.h
@@ -1,11 +0,0 @@-#include "/usr/lib/ruby/1.8/x86_64-linux/ruby.h"--struct s_dispatch {- char * classname;- char * methodname;- int nbargs;- VALUE args[16];-};--VALUE safeCall(VALUE args);-
hruby.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hruby-version: 0.0.3+version: 0.1.0 synopsis: Embed Ruby in your Haskell program. description: Warning: this is completely experimental. Everything you need should be in "Foreign.Ruby". license: BSD3@@ -14,6 +14,10 @@ build-type: Simple cabal-version: >=1.8 +Flag Ruby20+ Description: Enable when you use Ruby 2.0. It will default to Ruby 1.8.+ Default: False+ Flag Ruby19 Description: Enable when you use Ruby 1.9 (not implemented yet). It will default to Ruby 1.8. Default: False@@ -28,16 +32,20 @@ ghc-options: -Wall extensions: BangPatterns, OverloadedStrings build-depends: base ==4.6.*, aeson, bytestring, attoparsec, vector, text, unordered-containers- if flag(ruby19)- extra-libraries: ruby1.9- c-sources: cbits1.9/shim.c- install-includes: cbits1.9/shim.h- include-dirs: cbits1.9+ c-sources: cbits/shim.c+ install-includes: cbits/shim.h+ include-dirs: cbits+ if flag(ruby20)+ extra-libraries: ruby+ cc-options: -DRUBY2+ include-dirs: /usr/include/ruby-2.0.0, /usr/include/ruby-2.0.0/x86_64-linux else- extra-libraries: ruby1.8- c-sources: cbits1.8/shim.c- install-includes: cbits1.8/shim.h- include-dirs: cbits1.8+ if flag(ruby19)+ extra-libraries: ruby1.9+ include-dirs: /usr/lib/ruby/1.9/x86_64-linux+ else+ extra-libraries: ruby1.8+ include-dirs: /usr/lib/ruby/1.8/x86_64-linux Test-Suite test-roundtrip hs-source-dirs: test
test/roundtrip.hs view
@@ -51,6 +51,7 @@ out <- run (fromRuby x) void (run (setGC True)) run startGC+ when (out /= Just v) (run (print out)) assert (Just v == out) Left (rr,_) -> run (print rr) >> assert False @@ -59,7 +60,7 @@ ruby_init ruby_init_loadpath rb_define_module "test"- st <- rb_load_protect "test/test.rb" 0+ st <- rb_load_protect "./test/test.rb" 0 unless (st == 0) (showErrorStack >>= error) quickCheckWith (stdArgs { maxSuccess = 1000 } ) roundTrip ruby_finalize