hubris 0.0.3 → 0.0.4

data/.gitignore

@@ -0,0 +1,31 @@
+*.aux
+*.dvi
+*.gem
+*.hi
+*.log
+*.nav
+*.o
+*.out
+*.snm
+*.toc
+*.vrb
+.#*
+.bundle
+.jhci-hist
+RubyMap.hi
+RubyMap.hs
+RubyMap.o
+Setup
+dist
+hs.out
+hs.out_code.c
+lib/RubyMap.chi
+lib/RubyMap.chs.h
+lib/RubyMap.hi
+lib/RubyMap.hs
+lib/RubyMap.o
+lib/rshim.o
+pkg/
+pkg/*
+sample/tmp
+sample/tmp.old

data/.rvmrc

@@ -0,0 +1,2 @@
+rvm_install_on_use_flag=1
+rvm 1.9.1

data/Gemfile

@@ -0,0 +1,11 @@
+source :rubygems
+# gem 'jeweler', '1.5.1'
+# gem  'gemcutter'
+# gem 'rspec', '1.3.0'
+# gem 'rake'
+# gem 'rake-compiler'
+# gem 'open4'
+# source "http://rubygems.org"
+
+# Specify your gem's dependencies in Hubris.gemspec
+gemspec

data/Haskell/Hubrify.hs

@@ -0,0 +1,69 @@
+module Main where
+import Language.Ruby.Hubris.LibraryBuilder
+import System
+import System.Exit
+-- import Control.Monad (when)
+import System.Console.GetOpt
+
+data Options = Options
+     { optVerbose     :: Bool
+     , optStrict      :: Bool
+     , optShowVersion :: Bool
+     , optOutput      :: FilePath
+     , optModule      :: String
+     , optInput       :: Maybe FilePath
+     , optPackages    :: [String]
+     } deriving Show
+
+defaultOptions :: Options
+defaultOptions    = Options
+     { optVerbose     = False
+     , optShowVersion = False
+     , optOutput      = error "output must be defined"
+     , optModule      = error "module must be defined"
+     , optStrict      = False
+     , optInput       = Nothing
+     , optPackages    = []
+     }
+
+options :: [OptDescr (Options -> Options)]
+options =
+     [ Option "v"     ["verbose"]
+         (NoArg (\opts -> opts { optVerbose = True }))
+         "chatty output on stderr"
+     , Option [] ["strict"]
+         (NoArg (\opts -> opts { optStrict = True }))
+         "bondage and discipline mode"
+     , Option "o"     ["output"]
+         (ReqArg (\f opts -> opts { optOutput = f }) "libFile")
+         "output FILE"
+     , Option "m"     ["module"]
+         (ReqArg (\f opts -> opts { optModule = f }) "module")
+         "module to be wrapped"
+     , Option "p"     ["package"]
+         (ReqArg (\d opts -> opts { optPackages = optPackages opts ++ [d] }) "DIR")
+         "package"
+     ]
+
+hubrisOpts :: [String] -> IO (Options, [String])
+hubrisOpts argv =
+       case getOpt Permute options argv of
+          (o, n, []) -> return (foldl (flip id) defaultOptions o, n)
+          (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+      where header = "Usage: Hubrify --module MODULE --output LIBFILE (--packages PACKAGE1 ...) sourceFiles ..."
+
+main :: IO ()
+main = do
+   (o, srcs) <- getArgs >>= hubrisOpts
+   -- HACK this may be the worst thing ever
+                      
+   let ghcArgs = if optStrict o
+                 then ["-Wall", "-Werror", "-fno-warn-unused-imports"]
+                 else []
+   -- putStrLn $ show $ optPackages o
+
+   res <- generateLib (optOutput o) srcs (optModule o) ("-fPIC":ghcArgs) (optPackages o)
+   -- print res
+   case res of
+     Left a  -> putStrLn ("Failed: " ++ a) >> exitFailure
+     Right _ -> exitSuccess

data/Haskell/LICENSE

@@ -0,0 +1,22 @@
+(The MIT License)
+
+Copyright (c) 2009 Mark Wotton
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+'Software'), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+            permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

data/Haskell/Language/Ruby/Foo.hs

@@ -0,0 +1,20 @@
+module Foo (wrap, testString, wrap2, external, can_be_called, cannot_be_called) where
+can_be_called :: Int -> Int
+can_be_called x = 2 * x
+
+could_be_called :: Int -> Int
+could_be_called x = 3 * x
+wrap :: Int -> Int
+wrap x = 3 - x
+
+wrap2 :: Int -> Int
+wrap2 x = 3 - x
+
+cannot_be_called = map
+
+internal = 1
+external = 10
+
+
+testString :: Int -> String
+testString x = show x

data/Haskell/Language/Ruby/Hubris/Binding.hsc

@@ -0,0 +1,214 @@
+{-# LANGUAGE ForeignFunctionInterface, CPP, TypeSynonymInstances #-}
+
+{- TODO
+
+Rip the array trnaslation stuff out to a utility function. same with hashes.
+
+install as package. This is a bit iffy for GHC/JHC compatibility - if we commit to
+Cabal, that leaves JHC out in the cold.
+
+perhaps need cabal file for ghc and equivalent for jhc.
+
+also: do we want to support different versions of ruby? for the moment, you just get
+whichever ruby.h is first in the search place.
+
+-}
+
+
+module Language.Ruby.Hubris.Binding where
+ 
+#include "rshim.h"
+#include <ruby.h>
+
+import Control.Applicative
+-- import Control.Monad
+import Data.Word
+-- import Foreign.Ptr
+import Foreign.C.Types	
+import Foreign.C.String
+import System.IO.Unsafe (unsafePerformIO)
+import Data.Maybe
+
+rubyType :: Value -> RubyType
+rubyType = toEnum . rtype
+
+-- this is awful, but I don't want to pull in C2HS - it pulls in
+-- alex and happy, and they're difficult to specify as dependencies
+-- in cabal.
+
+#{enum Int,,
+       T_NONE, 
+       T_NIL, 
+       T_OBJECT, 
+       T_CLASS,
+       T_ICLASS,
+       T_MODULE  ,
+       T_FLOAT   ,
+       T_STRING  ,
+       T_REGEXP  ,
+       T_ARRAY   ,
+       T_FIXNUM  ,
+       T_HASH    ,
+       T_STRUCT  ,
+       T_BIGNUM  ,
+       T_FILE    ,
+ 
+       T_TRUE    ,
+       T_FALSE   ,
+       T_DATA    ,
+       T_MATCH   ,
+       T_SYMBOL  ,
+ 
+       T_UNDEF   ,
+       T_NODE    ,
+       T_MASK }
+
+data RubyType =  RT_NONE
+              |  RT_NIL      
+              |  RT_OBJECT   
+              | RT_CLASS    
+              | RT_ICLASS   
+              | RT_MODULE   
+              | RT_FLOAT    
+              | RT_STRING   
+              | RT_REGEXP   
+              | RT_ARRAY    
+              | RT_FIXNUM   
+              | RT_HASH     
+              | RT_STRUCT   
+              | RT_BIGNUM   
+              | RT_FILE     
+                
+              | RT_TRUE     
+              | RT_FALSE    
+              | RT_DATA     
+              | RT_MATCH    
+              | RT_SYMBOL   
+                
+              | RT_UNDEF    
+              | RT_NODE     
+              | RT_MASK     
+                deriving (Eq, Show)
+
+instance Enum RubyType where
+ fromEnum RT_NONE     = tNone
+
+ fromEnum RT_NIL      = tNil
+ fromEnum RT_OBJECT   = tObject
+ fromEnum RT_CLASS    = tClass
+ fromEnum RT_ICLASS   = tIclass
+ fromEnum RT_MODULE   = tModule
+ fromEnum RT_FLOAT    = tFloat
+ fromEnum RT_STRING   = tString
+ fromEnum RT_REGEXP   = tRegexp
+ fromEnum RT_ARRAY    = tArray
+ fromEnum RT_FIXNUM   = tFixnum
+ fromEnum RT_HASH     = tHash
+ fromEnum RT_STRUCT   = tStruct
+ fromEnum RT_BIGNUM   = tBignum
+ fromEnum RT_FILE     = tFile
+
+ fromEnum RT_TRUE     = tTrue
+ fromEnum RT_FALSE    = tFalse
+ fromEnum RT_DATA     = tData
+ fromEnum RT_MATCH    = tMatch
+ fromEnum RT_SYMBOL   = tSymbol
+ fromEnum RT_UNDEF    = tUndef
+ fromEnum RT_NODE     = tNode
+
+ fromEnum RT_MASK     = tMask
+ -- this is unnecessarily slow. fix it later.                        
+ toEnum x = fromJust $ lookup x assoc
+   where assoc = [( tNone   , RT_NONE)
+                 ,( tNil    , RT_NIL      )
+                 ,( tObject , RT_OBJECT   )
+                 ,( tClass  , RT_CLASS    )
+                 ,( tIclass , RT_ICLASS   )
+                 ,( tModule , RT_MODULE   )
+                 ,( tFloat  , RT_FLOAT    )
+                 ,( tString , RT_STRING   )
+                 ,( tRegexp , RT_REGEXP   )
+                 ,( tArray  , RT_ARRAY    )
+                 ,( tFixnum , RT_FIXNUM   )
+                 ,( tHash   , RT_HASH     )
+                 ,( tStruct , RT_STRUCT   )
+                 ,( tBignum , RT_BIGNUM   )
+                 ,( tFile   , RT_FILE     )
+                  
+                 ,( tTrue   , RT_TRUE     )
+                 ,( tFalse  , RT_FALSE    )
+                 ,( tData   , RT_DATA     )
+                 ,( tMatch  , RT_MATCH    )
+                 ,( tSymbol , RT_SYMBOL   )
+                 ,( tUndef  , RT_UNDEF    )
+                 ,( tNode   , RT_NODE     )
+                  
+                 ,( tMask   , RT_MASK     )]
+
+
+
+
+constToRuby :: RubyConst -> Value
+constToRuby = fromIntegral . fromEnum 
+--  RUBY_VERSION_CODE <= 187
+data RubyConst  = RUBY_Qfalse 
+                | RUBY_Qtrue  
+                | RUBY_Qnil   
+                | RUBY_Qundef 
+
+instance Enum RubyConst where
+  fromEnum RUBY_Qfalse = 0
+  fromEnum RUBY_Qtrue = 2
+  fromEnum RUBY_Qnil = 4
+  fromEnum RUBY_Qundef = 6
+
+  toEnum 0 = RUBY_Qfalse
+  toEnum 2 = RUBY_Qtrue
+  toEnum 4 = RUBY_Qnil
+  toEnum 6 = RUBY_Qundef
+  toEnum 12 = RUBY_Qnil
+-- {# enum ruby_special_consts as RubyConst {} deriving (Eq,Show) #}
+
+str2cstr str = rb_str2cstr str 0
+type Value = CULong -- FIXME, we'd prefer to import the type VALUE directly
+foreign import ccall safe "ruby.h rb_str2cstr"    rb_str2cstr    :: Value -> CInt -> IO CString
+foreign import ccall safe "ruby.h rb_str_new2"    rb_str_new2    :: CString -> IO Value
+foreign import ccall safe "ruby.h rb_str_new2"    rb_str_new_    :: CString -> Int -> IO Value 
+foreign import ccall safe "ruby.h rb_ary_new2"    rb_ary_new2    :: CLong -> IO Value
+foreign import ccall safe "ruby.h rb_ary_push"    rb_ary_push    :: Value -> Value -> IO ()
+foreign import ccall safe "ruby.h rb_float_new"   rb_float_new   :: Double -> Value
+foreign import ccall safe "ruby.h rb_big2str"     rb_big2str     :: Value -> Int -> IO Value
+foreign import ccall safe "ruby.h rb_str_to_inum" rb_str_to_inum :: Value -> Int -> Int -> Value
+-- foreign import ccall safe "ruby.h ruby_init" ruby_init :: IO ()
+
+rb_str_new = uncurry rb_str_new_
+
+-- 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 safe "rshim.h rb_ary_len" rb_ary_len :: Value -> CUInt
+foreign import ccall safe "rshim.h rtype"      rtype      :: Value -> Int
+
+foreign import ccall safe "rshim.h int2fix"    int2fix    :: Int -> Value
+foreign import ccall safe "rshim.h fix2int"    fix2int    :: Value -> Int
+foreign import ccall safe "rshim.h num2dbl"    num2dbl    :: Value -> Double  -- technically CDoubles, but jhc promises they're the same
+foreign import ccall safe "rshim.h keys"       rb_keys    :: Value -> IO Value
+foreign import ccall safe "rshim.h buildException" buildException :: CString -> IO Value
+-- foreign import ccall safe "ruby.h rb_funcall" rb_funcall :: Value -> ID ->
+
+-- this line crashes jhc
+foreign import ccall safe "intern.h rb_ary_entry" rb_ary_entry :: Value -> CLong -> IO Value
+
+foreign import ccall safe "ruby.h rb_raise" rb_raise :: Value -> CString -> IO ()
+foreign import ccall safe "ruby.h rb_eval_string" rb_eval_string :: CString -> IO Value
+
+foreign import ccall safe "intern.h rb_hash_aset" rb_hash_aset :: Value -> Value -> Value -> IO ()
+foreign import ccall safe "intern.h rb_hash_new" rb_hash_new :: IO Value
+foreign import ccall safe "intern.h rb_hash_aref" rb_hash_aref :: Value -> Value -> IO Value
+
+
+createException :: String -> IO Value
+createException s = newCAString s >>= buildException
+
+
+
+
+

data/Haskell/Language/Ruby/Hubris/GHCBuild.hs

@@ -0,0 +1,46 @@
+module Language.Ruby.Hubris.GHCBuild (ghcBuild, defaultGHCOptions, GHCOptions(..), withTempFile) where
+import Config
+import Debug.Trace
+import DynFlags
+import GHC
+import GHC.Paths
+import Outputable
+import StringBuffer
+import System.Process
+import Control.Monad(forM_,guard)
+import System.IO(hPutStr, hClose, openTempFile)
+import System( exitWith, system)
+import System.Exit
+import Language.Ruby.Hubris.Includes (extraIncludeDirs) -- this is generated by Cabal
+
+
+newtype GHCOptions = GHCOptions { strict :: Bool }
+defaultGHCOptions = GHCOptions { strict = True }
+type Filename = String
+
+
+standardGHCFlags = (words $ "--make -shared -dynamic -fPIC -optc-DHAVE_SNPRINTF -lHSrts-ghc" ++Config.cProjectVersion)
+                   ++ map ("-I"++) extraIncludeDirs
+                           
+withTempFile :: String -> String -> IO String
+withTempFile pattern code = do (name, handle) <- openTempFile "/tmp" pattern
+                               hPutStr handle code
+                               hClose handle
+                               return name
+
+ghcBuild :: Filename -> String -> String -> [Filename] -> [Filename] -> [String]-> IO (Either String Filename)
+ghcBuild libFile immediateSource modName extra_sources c_sources args =
+    do -- putStrLn ("modname is " ++ modName)
+          putStrLn immediateSource
+          haskellSrcFile <- withTempFile "hubris_XXXXX.hs" immediateSource
+          putStrLn ("ghc is " ++ ghc)
+          (code, out, err) <- noisySystem ghc $ standardGHCFlags ++ ["-o",libFile,"-optl-Wl,-rpath," ++ libdir,
+                                                                     haskellSrcFile, "-L" ++ libdir] ++ extra_sources ++ c_sources ++ args
+          return $ case code of
+            ExitSuccess -> Right libFile
+            otherCode   -> Left $ unlines ["Errcode: " ++show code,"output: " ++ out, "error: " ++ err]
+               
+noisySystem :: String -> [String] -> IO (ExitCode, String,String)
+noisySystem cmd args = (putStrLn . unwords) (cmd:args) >> readProcessWithExitCode cmd args ""
+
+ 

data/Haskell/Language/Ruby/Hubris/Hash.hs

@@ -0,0 +1,27 @@
+module Language.Ruby.Hubris.Hash where
+import qualified Language.Ruby.Hubris.Binding as Ruby
+import Prelude hiding(lookup)
+import Control.Applicative
+
+newtype RubyHash = RubyHash Ruby.Value
+
+-- can only call these functions when we have a ruby interpreter
+-- initialised. shouldn't usually be a problem, but needs to be
+-- done when testing from haskell.
+
+-- to test: does this break horribly when we have multiple threads?
+
+new = RubyHash <$> Ruby.rb_hash_new 
+insert (RubyHash v) = Ruby.rb_hash_aset v
+
+-- no Maybe here - we'd just need to test again later, as we're passing
+-- a Ruby value
+lookup (RubyHash v) key = Ruby.rb_hash_aref v key
+
+-- maybe should extract strings?
+keys :: RubyHash -> IO [Ruby.RValue]
+keys (RubyHash v) = do Ruby.T_ARRAY res <- Ruby.fromVal <$> Ruby.rb_keys v
+                       return res
+
+toList rhash = keys rhash >>=  mapM (\k -> lookup rhash (Ruby.fromRVal k) >>= \v -> return (k,v))
+

data/Haskell/Language/Ruby/Hubris/Interpolator.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Interpolator where
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Parse
+
+-- The first string in each pair is literal, the second is a variable to
+-- be interpolated.
+parse :: String -> [(String, String)]
+-- parse "Foo#{foo}rah#{foo}"   = [("Foo", "foo ++ bar"), ("rah", "foo")]
+parse str = 
+gen :: [(String, String)] -> Q Exp -> Q Exp
+gen [] x = x 
+-- gen ((string,variable) : xs) x = gen xs [| $x ++ $(lift string) ++ $(return $ VarE $ mkName variable) |]
+gen ((string,expr) : xs) x = gen xs [| $x ++ $(lift string) ++ $(return $ lift $ parseExp expr) |]
+-- gen ((string,variable) : xs) x = gen xs [| $x ++ $(lift string) ++ $(stringE variable) |]
+
+-- Here we generate the Haskell code for the splice
+-- from an input format string.
+interpolate :: String -> Q Exp
+interpolate s = gen (parse s) [| "" |] 

data/Haskell/Language/Ruby/Hubris/LibraryBuilder.hs

@@ -0,0 +1,181 @@
+
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables #-}
+module Language.Ruby.Hubris.LibraryBuilder where
+import Language.Ruby.Hubris
+import Language.Haskell.Interpreter
+-- import Language.Haskell.Meta.QQ.HsHere
+import Language.Ruby.Hubris.GHCBuild
+
+import List(intersperse)
+import Data.List(intercalate)
+import qualified Debug.Trace
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error.Class
+import Data.Maybe(catMaybes,fromJust, isJust)
+
+import GHC(parseStaticFlags, noLoc)
+import System.IO(hPutStr, hClose, openTempFile)
+import System.Exit
+import Language.Ruby.Hubris.ZCode (zenc,Zname(..))
+
+type Filename = String
+dotrace a b = b
+
+-- weirdly, mapMaybeM doesn't exist.
+mapMaybeM :: (Functor m, Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
+mapMaybeM func ls  = catMaybes <$> (sequence $ map func ls)
+
+generateLib :: Filename -> [Filename] -> ModuleName -> [String] -> [String] -> IO (Either Filename String)
+generateLib libFile sources moduleName buildArgs packages = do
+  -- set up the static args once  
+  GHC.parseStaticFlags $ map noLoc $ map ("-package "++) ("hubris":packages)
+
+  s <- generateSource sources moduleName
+  case s of
+     Right (c,mod) -> do bindings <- withTempFile "hubris_interface_XXXXX.c" c
+                         ghcBuild libFile mod ("Language.Ruby.Hubris.Exports." ++ moduleName) sources [bindings] buildArgs
+     Left x -> return . Left $ show x
+                                            
+type Funcname = String               
+type Wrapper = String
+
+
+callable ::String -> InterpreterT IO (Maybe Int)
+callable func = do
+  ok <- typeChecks str
+  if not ok
+     then return Nothing
+     else do res <- interpret str (as::Int)
+             return $ Just res
+  where str = "Language.Ruby.Hubris.arity " ++  parens func 
+  
+
+-- ok, let's see if we can come up with an expression of the right type
+exportable ::  String -> String -> InterpreterT IO (Maybe (Funcname, Int, Wrapper))
+exportable moduleName func = do say $ "checking " ++ qualName
+                                -- here's the problem - i want callable to return Maybe, not bomb
+                                -- all the way back out to the outer runInterpreter
+                                match <- callable qualName
+                                case match of
+                                  Nothing -> return Nothing
+                                  Just i -> do
+                                    let wrapped = genApp qualName i
+                                    let eqn = wrapped ++ " == " ++ haskellVal
+                                    say ("to check: " ++ eqn)
+                                    checked <- typeChecks eqn
+                                    say ("Succeeded? " ++ show checked)
+                                    return $ guard checked>> return (func, i, genWrapper (func,i) moduleName)
+                                               
+  where qualName = moduleName ++ "." ++ func
+        rubyVal = "(fromIntegral $ fromEnum $ Language.Ruby.Hubris.Binding.RUBY_Qtrue)"
+        haskellVal = "(Language.Ruby.Hubris.toHaskell " ++ rubyVal ++ ")"
+        genApp qualName i = unwords (qualName:(take i $ repeat haskellVal))
+                                     
+generateSource :: [Filename] ->   -- optional haskell source to load into the interpreter
+                   ModuleName ->   -- name of the module to build a wrapper for
+                   IO (Either InterpreterError (String,String))
+generateSource sources moduleName = runInterpreter $ do
+         loadModules sources
+         setImportsQ $ [(mod,Just mod) | mod <- ["Language.Ruby.Hubris","Language.Ruby.Hubris.Binding", moduleName]]
+         funcs <- getFunctions moduleName 
+         say ("Candidates: " ++ show funcs)
+         mapM (exportable moduleName) funcs >>= \x -> say (show x)
+         exports :: [(Funcname, Int,  Wrapper)] <- mapMaybeM (exportable moduleName) funcs
+         say ("Exportable: " ++ show exports)
+         -- return (undefined, undefined)
+         return (genC [(a,b) | (a,b,_) <- exports] (zenc moduleName),
+                 unlines (haskellBoilerplate moduleName:[wrapper | (_,_,wrapper) <- exports]))
+                          
+getFunctions moduleName = (\ x -> [a |Fun a <- x]) <$> getModuleExports moduleName
+
+
+genC :: [(String,Int)] -> Zname -> String
+genC exports (Zname zmoduleName) = unlines $ 
+         ["#include <stdio.h>"
+          ,"#include <stdlib.h>"
+          ,"#define HAVE_STRUCT_TIMESPEC 1"
+          ,"#include <ruby.h>"
+--          ,"#define DEBUG 1"
+          ,"#ifdef DEBUG"
+          ,"#define eprintf printf"
+          ,"#else"
+          ,"int eprintf(const char *f, ...){}"
+          ,"#endif"
+         ] ++
+--         map (("VALUE hubrish_"++) . (++"(VALUE);")) exports ++
+--         map (("VALUE hubrish_"++) . (++"(VALUE);")) exports ++
+         map cWrapper exports ++
+         ["extern void safe_hs_init();"
+         ,"extern VALUE Exports;"
+         ,"void Init_" ++ zmoduleName ++ "(){"
+         ,"  eprintf(\"loading " ++ zmoduleName ++ "\\n\");"
+         ,"  VALUE Fake = Qnil;"
+         ,"  safe_hs_init();"
+         ,"  Fake = rb_define_module_under(Exports, \"" ++ zmoduleName ++ "\");"
+         ] ++ map cDef exports ++  ["}"]
+  where
+    cWrapper :: (String,Int) -> String
+    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.
+                               
+                ,"  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);"
+    cDef (f,_arity) =  "  eprintf(\"Defining |" ++ f  ++ "|\\n\");\n" ++ "rb_define_method(Fake, \"" ++ f ++"\","++ f++", -2);"
+
+haskellBoilerplate moduleName = unlines ["{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}", 
+                                         "module Language.Ruby.Hubris.Exports." ++ moduleName ++ " where",
+                                         "import Language.Ruby.Hubris",
+                                         "import Language.Ruby.Hubris.Binding",
+                                         "import System.IO.Unsafe (unsafePerformIO)",
+                                         "import Control.Monad",
+                                         "import Control.Exception",
+                                         "import Data.Either",
+                                         "import Data.Function(($))",
+                                         "import qualified Prelude as P(show,putStrLn)",
+                                         "import Data.Tuple (uncurry)",
+                                         "import Foreign.C.Types",
+                                         "import qualified " ++ moduleName]
+
+
+
+-- wrapper = func ++ " b = (Language.Ruby.Hubris.wrap " ++ moduleName ++ "." ++  func ++ ") b", 
+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 " 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 wrapper\" P.++ P.show e) ",
+                  unlines ["   Left (e::SomeException) ->  createException (P.show e)" ,
+                           "   Right a -> return a"]
+ 
+say :: String -> InterpreterT IO ()
+-- say = liftIO . putStrLn
+say _ = return ()
+
+-- Local Variables:
+-- compile-command: "cd ../../../; ./Setup build"
+-- End: