From e8cceec33d8226fc80dfe71128583f6b204b1664 Mon Sep 17 00:00:00 2001 From: Mark Date: Mon, 24 Aug 2009 23:40:24 +1000 Subject: [PATCH] something slightly closer to working --- hubris.gemspec | 6 ++-- lib/Mapper.hs | 81 ++++++++++++++++++++++++--------------------- lib/RubyMap.chs | 48 +++++++++++++++++++++++---- lib/hubris.rb | 53 +++++++++++++++++++---------- lib/rshim.c | 17 ++++++++++ lib/rshim.h | 15 +++++++-- spec/hubris_spec.rb | 21 ++++++++---- 7 files changed, 168 insertions(+), 73 deletions(-) diff --git a/hubris.gemspec b/hubris.gemspec index e537467..3029113 100644 --- a/hubris.gemspec +++ b/hubris.gemspec @@ -16,5 +16,7 @@ Gem::Specification.new do |s| s.rubyforge_project = %q{hubris} s.rubygems_version = %q{1.3.0} s.summary = %q{Hubris is a Ruby Haskell bridge allowing you to call Haskell functions from your Ruby code.} - -end \ No newline at end of file + %w{rspec open4}.each do |gem| + s.add_dependency(gem) + end +end diff --git a/lib/Mapper.hs b/lib/Mapper.hs index 65be272..5377e30 100644 --- a/lib/Mapper.hs +++ b/lib/Mapper.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, ForeignFunctionInterface, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, ForeignFunctionInterface #-} -- , UndecidableInstances #-} {-# INCLUDE #-} module Mapper where @@ -14,24 +14,29 @@ newtype RString = RString CString newtype RSymbol = RSymbol Word +type RubyVal = Ptr () class Rubyable a where toRuby :: a -> RValue fromRuby :: RValue -> a -instance Rubyable Int where - toRuby a = T_FIXNUM a - fromRuby (T_FIXNUM a) = a +-- instance Rubyable Int where +-- toRuby a = T_FIXNUM a +-- fromRuby (T_FIXNUM a) = a --- instance Rubyable Integer where --- toRuby a = T_BIGNUM a --- fromRuby (T_BIGNUM a) = a +instance Rubyable Integer where + toRuby a = T_BIGNUM a + fromRuby (T_BIGNUM a) = a -instance Rubyable Bool where - toRuby False = T_FALSE - toRuby True = T_TRUE - fromRuby T_FALSE = False - fromRuby T_TRUE = True +instance Num a => Rubyable a where + toRuby a = T_BIGNUM (fromIntegral a) + fromRuby (T_BIGNUM s) = fromIntegral a + +-- instance Rubyable Bool where +-- toRuby False = T_FALSE +-- toRuby True = T_TRUE +-- fromRuby T_FALSE = False +-- fromRuby T_TRUE = True -- instance Rubyable (CArray Word RValue) where -- toRuby arr = T_ARRAY arr @@ -44,31 +49,31 @@ instance Rubyable Bool where -- return $ T_ARRAY arr -- fromRuby (T_ARRAY arr) = map fromRuby $ CArray.elems arr -instance Rubyable RString where - toRuby (RString cstr) = T_STRING cstr - fromRuby (T_STRING cstr) = RString cstr - -instance Rubyable RSymbol where - toRuby (RSymbol index) = T_SYMBOL index - fromRuby (T_SYMBOL index) = RSymbol index - -instance Integral a => Rubyable a where - toRuby a = T_FIXNUM (fromIntegral a) - fromRuby (T_FIXNUM a) = fromIntegral a - --- -- | T_REGEXP --- -- the array needs to be managed by ruby --- | T_ARRAY (CArray Word RValue) --- | T_FIXNUM Int --fixme, probably --- -- the hash needs to be managed by ruby --- | T_HASH Int -- definitely FIXME - native ruby hashes, or going to translitrate? --- -- | T_STRUCT --- | T_BIGNUM Integer --- -- | T_FILE --- | T_TRUE --- | T_FALSE --- -- | T_DATA --- | T_SYMBOL Word -- interned string +-- instance Rubyable RString where +-- toRuby (RString cstr) = T_STRING cstr +-- fromRuby (T_STRING cstr) = RString cstr + +-- instance Rubyable RSymbol where +-- toRuby (RSymbol index) = T_SYMBOL index +-- fromRuby (T_SYMBOL index) = RSymbol index + +-- -- instance Integral a => Rubyable a where +-- toRuby a = T_FIXNUM (fromIntegral a) +-- fromRuby (T_FIXNUM a) = fromIntegral a + +-- -- -- | T_REGEXP +-- -- -- the array needs to be managed by ruby +-- -- | T_ARRAY (CArray Word RValue) +-- -- | T_FIXNUM Int --fixme, probably +-- -- -- the hash needs to be managed by ruby +-- -- | T_HASH Int -- definitely FIXME - native ruby hashes, or going to translitrate? +-- -- -- | T_STRUCT +-- -- | T_BIGNUM Integer +-- -- -- | T_FILE +-- -- | T_TRUE +-- -- | T_FALSE +-- -- -- | T_DATA +-- -- | T_SYMBOL Word -- interned string instance Storable RValue where sizeOf _ = 8 -- urgh, fixme. it's just a pointer, basically. @@ -93,4 +98,4 @@ loadRuby :: Ptr RValue -> IO RValue loadRuby ptr = undefined dumpRuby :: RValue -> IO (Ptr RValue) -dumpRuby rval = undefined \ No newline at end of file +dumpRuby rval = undefined diff --git a/lib/RubyMap.chs b/lib/RubyMap.chs index 94b34e8..274b9b2 100644 --- a/lib/RubyMap.chs +++ b/lib/RubyMap.chs @@ -1,5 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE TypeSynonymInstances #-} +-- {-# LANGUAGE TypeSynonymInstances #-} module RubyMap where #include "rshim.h" #include @@ -11,18 +11,28 @@ import Foreign.C.Types import Foreign.C.String {# context lib="rshim" #} + + {# enum RubyType {} deriving (Eq) #} -- maybe Ord? --- can we have a type for Value, plz? -type Value = Ptr () -- fixme --- we're being a bit filthy here - the interface is all macros, so we're digging in to find what it actually is -foreign import ccall unsafe "rshim.h rtype" rb_type :: Value -> CInt --- FIXME jhc doesn't like importing floating point numbers, for some reason. --- foreign import ccall unsafe "ruby.h rb_num2dbl" rb_num2dbl :: Value -> CDouble +type Value = CULong + + +-- -- FIXME jhc doesn't like importing floating point numbers, for some reason. + foreign import ccall unsafe "ruby.h rb_str_to_str" rb_str_to_str :: Value -> CString foreign import ccall unsafe "ruby.h rb_ary_new2" rb_ary_new :: Int -> IO Value foreign import ccall unsafe "ruby.h rb_ary_store" rb_ary_store :: Value -> Int -> Value -> IO () +foreign import ccall unsafe "ruby.h rb_float_new" rb_float_new :: Double -> Value + +-- -- we're being a bit filthy here - the interface is all macros, so we're digging in to find what it actually is +foreign import ccall unsafe "rshim.h rtype" rtype :: Value -> Int +foreign import ccall unsafe "rshim.h int2fix" int2fix :: Int -> Value +foreign import ccall unsafe "rshim.h fix2int" fix2int :: Value -> Int + +foreign import ccall unsafe "rshim.h num2dbl" num2dbl :: Value -> Double -- technically CDoubles, but jhc promises they're the same + -- all values in here need to be allocated and tracked by ruby. @@ -47,3 +57,27 @@ data RValue = T_NIL | T_FALSE -- | T_DATA | T_SYMBOL Word -- interned string +-- deriving Show + + +-- qnil = 4 +-- qfalse = 0 +-- qtrue = 2 + +toRuby :: RValue -> Value +toRuby r = case r of +-- T_NIL -> qnil + T_FLOAT d -> rb_float_new d + -- need to take the address of the cstr, just cast it to a value + T_STRING cstr -> undefined + T_FIXNUM i -> int2fix i + --T_TRUE -> RT_TRUE + --T_FALSE -> RT_FALSE + x -> error ("sorry, haven't implemented that yet.") + +fromRuby :: Value -> RValue +fromRuby v = case toEnum $ rtype v of + RT_NIL -> T_NIL + RT_FIXNUM -> T_FIXNUM $ fix2int v + RT_STRING -> undefined + RT_FLOAT -> T_FLOAT $ num2dbl v \ No newline at end of file diff --git a/lib/hubris.rb b/lib/hubris.rb index a096a07..6e10f49 100644 --- a/lib/hubris.rb +++ b/lib/hubris.rb @@ -1,10 +1,11 @@ require 'dl/import' require 'tempfile' +require 'rubygems' require 'open4' -module Hubris +class Hubris VERSION = '0.0.2' - class Hubris +# class Hubris if RUBY_VERSION =~ /^1\.8/ extend DL::Importable else @@ -23,58 +24,75 @@ def noisy(str) output: #{stdout.read} error: #{stderr.read} EOF - return [false,msg] + return [false,str + "\n" + msg] else - return [true,""] + return [true,str + "\n"] end end def build_jhc(haskell_str) + system("rm hs.out_code.c") file=Tempfile.new("TempHs.hs") # cheap way: assert type sigs binding to RValue. Might be able to do better after, # but this'll do for the moment file.print(< RValue\n" - # end + file.print <<"EOF" + +#{fname} :: RValue -> RValue +#{fname}_external :: Value -> Value +#{fname}_external x = toRuby $ #{fname} $ fromRuby x +foreign export ccall "#{fname}_external" #{fname}_external :: Value -> Value + +EOF end file.flush - # this is so dumb + # this is so dumb. Go delete the file when we're done + # debugging system("cp #{file.path} #{file.path}.hs") - success, msg = noisy("jhc #{file.path}.hs -ilib") - if not success then + success, msg = noisy("jhc -dc #{file.path}.hs -ilib") + if not (success || File.exists?("hs.out_code.c")) then file.rewind raise SyntaxError, "JHC build failed:\nsource\n#{file.read}\n#{msg}" end # output goes to hs_out.code.c # don't need to grep out main any more # FIXME unique name for dynamic lib - lib = Tempfile.new("libDyn.so") + libname = "lib_#{rand().to_s.slice(2,10)}.dylib" - success,msg = noisy("gcc '-std=gnu99' -D_GNU_SOURCE -D'-falign-functions=4' '-D_JHC_STANDALONE=0' -ffast-math -Wshadow -Wextra -Wall -Wno-unused-parameter -o libdynhs.so \ - -DNDEBUG -D_JHC_STANDALONE=0 -O3 -fPIC -shared #{file.dirname}/hs.out_code.c -o {lib.name}") + success,msg = noisy("gcc -c '-std=gnu99' -D_GNU_SOURCE '-falign-functions=4' '-D_JHC_STANDALONE=0' -ffast-math -Wshadow -Wextra\ + -Wall -Wno-unused-parameter -DNDEBUG -O3 -fPIC -shared ./hs.out_code.c ./lib/rshim.o -I/opt/local/lib/ruby/1.8/i686-darwin9/ -I./lib -o #{libname}") if not success then raise SyntaxError, "C build failed:\n#{msg}" end - dlload lib.name + Hubris.dlload libname # get all the headers from ... somewhere headers = [] headers.each do |header| @@ -84,6 +102,7 @@ def build_jhc(haskell_str) hs_init # TODO load all the object headers into the lib end - end + +# end end diff --git a/lib/rshim.c b/lib/rshim.c index b012401..f69a3f8 100644 --- a/lib/rshim.c +++ b/lib/rshim.c @@ -1,4 +1,7 @@ + #include "rshim.h" + +#include #include void Init_rshim() { @@ -9,3 +12,17 @@ void Init_rshim() { unsigned int rtype(VALUE obj) { return TYPE(obj); } + +VALUE int2fix(int x) { + return INT2FIX(x); +} + +int fix2int(VALUE x) { + return FIX2INT(x); +} + +double num2dbl(VALUE x) { + return NUM2DBL(x); +} + + diff --git a/lib/rshim.h b/lib/rshim.h index a7757dc..1405777 100644 --- a/lib/rshim.h +++ b/lib/rshim.h @@ -1,7 +1,7 @@ #ifndef __rshim_h__ #define __rshim_h__ -#define HAVE_STRUCT_TIMESPEC 1 -// this is about as filthy as it looks, but c2hs chokes otherwise. +// #define HAVE_STRUCT_TIMESPEC 1 +/* this is about as filthy as it looks, but c2hs chokes otherwise. */ #include @@ -26,6 +26,15 @@ // did this really have to be a macro? BAD MATZ unsigned int rtype(VALUE obj); +VALUE int2fix(int i); +int fix2int(VALUE x); +double num2dbl(VALUE x); + +/* enum StaticValue { */ +/* QNIL = Qnil, */ +/* QFALSE = Qfalse, */ +/* QTRUE = Qtrue, */ +/* }; */ // argh, and again @@ -63,3 +72,5 @@ enum RubyType { RT_MASK = T_MASK , }; #endif + + diff --git a/spec/hubris_spec.rb b/spec/hubris_spec.rb index fbecdb3..993b15e 100644 --- a/spec/hubris_spec.rb +++ b/spec/hubris_spec.rb @@ -5,21 +5,28 @@ describe "Hubris" do it "can whine like a little baby when you pass it bad haskell" do - lambda {Hubris::Hubris.new("broken _ = return (1 + \"a string\")")}.should raise_error(SyntaxError) + lambda {Hubris.new("broken _ = (1 + \"a string\")")}.should raise_error(SyntaxError) + end + + it "can ignore a comment" do + lambda {Hubris.new("--blah blah blah +{- another silly comment -}")}.should_not raise_error end it "can sing like a golden bird when you treat it right, aw yeah" do - lambda {Hubris::Hubris.new("working _ = return (toRuby $ 1 + 2)")}.should_not raise_error + h = Hubris.new("working _ = T_FIXNUM (1+2)").should_not raise_error + h.working(1).should eql 3 end - + + it "can double an int in Haskell-land" do - haskell = Hubris::Hubris.new(<