fix subtle 32/64 bit bug

Gemfile

@@ -1,5 +1,5 @@
 source :rubygems
-gem 'jeweler', '1.4.0'
+gem 'jeweler', '1.5.1'
 gem  'gemcutter'
 gem 'rspec', '1.3.0'
 gem 'rake'

Haskell/Language/Ruby/Hubris/Binding.hsc

@@ -206,7 +206,11 @@ foreign import ccall safe "intern.h rb_hash_aref" rb_hash_aref :: Value -> Value
 
 
 createException :: String -> IO Value
-createException s = newCAString s >>= buildException --  ("puts HaskellError.methods(); HaskellError.new") >>= rb_eval_string
+createException s = do putStrLn "creating an exception"
+                       putStrLn s
+                       e <- (newCAString s >>= buildException) --  ("puts HaskellError.methods(); HaskellError.new") >>= rb_eval_string
+                       putStrLn ("exception looks like: " ++ show e)
+                       return e
 
 
 

Haskell/Language/Ruby/Hubris/LibraryBuilder.hs

@@ -116,25 +116,29 @@ genC exports (Zname zmoduleName) = unlines $
          ] ++ map cDef exports ++  ["}"]
   where
     cWrapper :: (String,Int) -> String
-    cWrapper (f,arity) = let res = unlines ["VALUE " ++ f ++ "(VALUE mod, VALUE v){"
-                                         ,"  eprintf(\""++f++" has been called\\n\");"
-                               -- also needs to curry on the ruby side
-
-                               -- v is actually an array now, so we need to stash each element in
-                               -- a nested haskell tuple. for the moment, let's just take the first one.
+    cWrapper (f,arity) = 
+      let res = unlines 
+                ["VALUE hubrish_" ++ f ++ "("++ (concat . intersperse "," . take arity $ repeat "VALUE") ++ ");",
+                 "VALUE " ++ f ++ "(VALUE mod, VALUE v){"
+                ,"  eprintf(\""++f++" has been called\\n\");"
+                 -- also needs to curry on the ruby side
+
+                 -- v is actually an array now, so we need to stash each element in
+                 -- a nested haskell tuple. for the moment, let's just take the first one.
 
-                                         ,"  VALUE res = hubrish_" ++ f ++ "(" ++ intercalate "," ["rb_ary_entry(v," ++ show i ++ ")"| i<- [0..(arity-1)]] ++ ");"
-                                         ,"  eprintf(\"hubrish "++f++" has been called\\n\");"
---                              ,"  return res;"
-                                         ,"  if (rb_obj_is_kind_of(res,rb_eException)) {"
-                                         ,"    eprintf(\""++f++" has provoked an exception\\n\");"                               
-                                         ,"    rb_exc_raise(res);"
-                                         ,"  } else {"
-                                         ,"    eprintf(\"returning from "++f++"\\n\");"
-                                         ,"    return res;"
-                                         ,"  }"
-                                         ,"}"]
-                       in res 
+                ,"  unsigned long res = hubrish_" ++ f ++ "(" ++ intercalate "," ["rb_ary_entry(v," ++ show i ++ ")"| i<- [0..(arity-1)]] ++ ");"
+                ,"  eprintf(\"hubrish "++f++" has been called\\n\");"
+                ,"  eprintf(\"result is %p\\n\",res);"
+                 --                                         ,"  res = res | 0x100000000;"
+                ,"  if (rb_obj_is_kind_of(res,rb_eException)) {"
+                ,"    eprintf(\""++f++" has provoked an exception\\n\");"                               
+                ,"    rb_exc_raise(res);"
+                ,"  } else {"
+                ,"    eprintf(\"returning from "++f++"\\n\");"
+                ,"    return res;"
+                ,"  }"
+                ,"}"]
+      in res 
 
     cDef :: (String,Int) -> String
     -- adef f =  "  eprintf(\"Defining |" ++ f  ++ "|\\n\");\n" ++ "rb_define_method(Fake, \"" ++ f ++"\","++ f++", 1);"
@@ -149,8 +153,9 @@ haskellBoilerplate moduleName = unlines ["{-# LANGUAGE ForeignFunctionInterface,
                                          "import Control.Exception",
                                          "import Data.Either",
                                          "import Data.Function(($))",
-                                         "import qualified Prelude as P(show)",
+                                         "import qualified Prelude as P(show,putStrLn)",
                                          "import Data.Tuple (uncurry)",
+                                         "import Foreign.C.Types",
                                          "import qualified " ++ moduleName]
 
 
@@ -159,11 +164,12 @@ haskellBoilerplate moduleName = unlines ["{-# LANGUAGE ForeignFunctionInterface,
 genWrapper (func,arity) mod = unlines $ [func ++ " :: " ++ myType
                                             ,func ++ " " ++  unwords symbolArgs ++ " = " ++ defHask 
                                             ,"foreign export ccall \"hubrish_" ++  func ++ "\" " ++ func ++ " :: " ++ myType]
-  where myType = intercalate "->" (take (1+arity) $ repeat " Value ")
+  where myType = intercalate "->" (take (1+arity) $ repeat " CULong ")
         -- mark's patented gensyms. just awful.
         symbolArgs = take arity $ map ( \ x -> "fake_arg_symbol_"++[x]) ['a' .. 'z']
         defHask = "unsafePerformIO $ do\n  r <- try $ evaluate $ toRuby $" ++ mod ++"."++ func  ++ " " ++ unwords (map (\ x -> "(toHaskell " ++ x ++ ")") symbolArgs) ++ "\n  case r of\n" ++     
-                  unlines ["   Left (e::SomeException) -> createException (P.show e) `traces` \"died in haskell\"",
+--                  unlines ["   Left (e::SomeException) -> createException (P.show e) `traces` (\"died in haskell wrapper\" P.++ P.show e) ",
+                  unlines ["   Left (e::SomeException) ->  createException (P.show e) >>= \\e2 -> P.putStrLn (\"in generated haskell: \") >> P.putStrLn (P.show e2) >> return e2",
                            "   Right a -> return a"]
 
 say :: String -> InterpreterT IO ()

Haskell/cbits/rshim.c

@@ -39,8 +39,15 @@ VALUE keys(VALUE hash) {
 }
 
 VALUE buildException(char * message) {
+
+  printf("buildException\n");
+  printf("with %s\n", message);
   VALUE errclass = rb_eval_string("HaskellError");
+  printf("errclass: %p\n", errclass);
   VALUE errobj = rb_exc_new2(errclass, message);
+  printf("errobj: %p\n", errobj);
+  printf("kind_of errobj: %d\n", rb_obj_is_kind_of(errobj, rb_eException));
+  printf("True is %d, false is %d\n", Qtrue, Qfalse);
   return errobj;
   //   return rb_funcall(errclass, rb_intern("new"), 1, rb_str_new2(message)); 
 }

Haskell/hubris.cabal

@@ -19,22 +19,6 @@ Description:    Support library for Hubris, the Ruby to Haskell bridge
                 .
                 Anyway, this version strips the boilerplate that used to be necessary, and is intended to be used in conjunction with <http://github.com/mwotton/Hubris>.
 
-Library
-        -- the ordering is critical, because Cabal doesn't do dependency analysis.
-        Exposed-Modules: Language.Ruby.Hubris.Binding, Language.Ruby.Hubris, Language.Ruby.Hubris.LibraryBuilder, Language.Ruby.Hubris.ZCode, Language.Ruby.Hubris.GHCBuild, Includes
-        c-sources: cbits/rshim.c
-        -- includes:  cbits/rshim.h
-        install-includes:  cbits/rshim.h
-        include-dirs: cbits
-        cc-options: -U__BLOCKS__ -DHAVE_SNPRINTF
-        extra-libraries: ruby
-        -- a proper fix for this would involve autoconf and I'm not feeling up to it.
-        -- best to pass the args on the command line.
-        --extra-include-dirs=/opt/local/include/ruby-1.9.1/ 
-        --extra-lib-dirs: /opt/local/lib
-        extra-libraries: ruby
-        build-depends:  ghc,  Cabal>=1.7.4 && < 2.0, base, haskell98, containers, bytestring, array, mtl, old-time, ghc-paths, hint >= 0.3.3.2, HUnit
-
 Executable Hubrify
   Main-is:           Hubrify.hs
   Build-Depends:     base >= 3 && < 5, ghc, Cabal>=1.7.4 && < 2.0, base, haskell98, containers, bytestring, array, mtl, old-time, ghc-paths, hint, process

Rakefile

@@ -90,7 +90,7 @@ begin
 
 end
 
-task :spec => :check_dependencies
+# task :spec => :check_dependencies
 
 begin
   require 'reek/adapters/rake_task'

spec/hubris_spec.rb

@@ -97,7 +97,7 @@ class Bigint
   end
 
   before(:each) do
-    pending
+    # pending
     @b = Bigint.new
   end
 
@@ -161,7 +161,7 @@ class BigId
   end
 
   it 'returns a big fix'  do
-    pending
+
     @b.big_inc(1073741824).should == 1073741824
   end
 end