something slightly closer to working

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
+  %w{rspec open4}.each do |gem|
+    s.add_dependency(gem)
+  end
+end

lib/Mapper.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, ForeignFunctionInterface, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, ForeignFunctionInterface #-} -- , UndecidableInstances #-}
 {-# INCLUDE <ruby.h> #-}
 
 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
+dumpRuby rval = undefined

lib/RubyMap.chs

@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+-- {-# LANGUAGE TypeSynonymInstances #-}
 module RubyMap where
 #include "rshim.h"
 #include <ruby.h>
@@ -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

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(<<EOF
+{-# LANGUAGE FlexibleInstances, ForeignFunctionInterface, UndecidableInstances #-}
+import Foreign.Ptr
 import RubyMap
-import Mapper
+
 main :: IO ()
 main = return ()
 EOF
                  )
       file.print(haskell_str)
+      puts("Hask: #{haskell_str}\n")
       # TODO add foreign export calls immediately for each toplevel func
       # cheap hacky way: first word on each line, nub it to get rid of
       # function types.
       # tricky bit: generating interface for each
       functions={}
       haskell_str.each_line do |line|
-        if line =~ /^[^ ]/ then
-          functions[line.split(/ /)[0]]=1
+        # skkeeeeeeetchy. FIXME use haskell-src-exts or something more sensible here
+        if line =~ /^[^ \-{].*/ then
+          functions[line.split(/ /)[0]]=1   
         end
       end
+      if functions.size() == 0
+        # no point going on, there's nothing to load
+        return
+      end
+
       functions.keys.each do |fname|
-        file.print "\n#{fname} :: RValue -> 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

lib/rshim.c

@@ -1,4 +1,7 @@
+
 #include "rshim.h"
+
+#include <ruby.h>
 #include <stdio.h>
 
 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);
+}
+
+

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 <ruby.h>
 
@@ -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
+
+

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(<<EOF
--- partial function, will probably crash and burn
-double i = let j = fromRuby i in return (toRuby $ j + j)
+    haskell = Hubris.new(<<EOF
+double (T_FIXNUM i) = T_FIXNUM (i + i)
 EOF
                                  )
     haskell.double(1).should eql(2)
     haskell.double("foo").should raise_error(RuntimeError)
   end
-
+
+
 end