/* ruby-module.c
 * S-Lang interface to the Ruby interpreter.
 * 
 * Copyright (c) 2008 Paul Boekholt.
 * Released under the terms of the GNU GPL (version 2 or later).
 * 
 * This borrows some ideas from Perl's Inline::Ruby by Neil Watkiss
 * and Vim's if_ruby.c by Shugo Maeda.
 */
#include <ruby.h>
#include <slang.h>
#ifdef RUBY_VM /* Ruby 1.9 */
void Init_prelude(void);
static VALUE gProgName = Qnil;
#else
#define RFLOAT_VALUE(v) (RFLOAT(v)->value)
#endif
SLANG_MODULE(ruby);

#define MODULE_MAJOR_VERSION	0
#define MODULE_MINOR_VERSION	0
#define MODULE_PATCH_LEVEL	6
static char *Module_Version_String = "0.0.6";
#define MODULE_VERSION_NUMBER	\
   (MODULE_MAJOR_VERSION*10000+MODULE_MINOR_VERSION*100+MODULE_PATCH_LEVEL)
/*{{{ definitions */

/* S-Lang exception raised when Ruby throws an exception */
static int Ruby_Error = 0;

/* Ruby exception raised when S-Lang throws an exception in a callback */
static VALUE rb_SLangException = 0;

#define CHECK_ERROR 	if (state)\
{\
   SLang_verror(Ruby_Error, "Ruby error: %s", RSTRING_PTR(ruby_get_error_info(state)));\
}

/* These macros set Ruby's stack_start when the Ruby interpreter is called.
 * Without them the garbage collector will cause segmentation faults if the
 * module is dynamically loaded.
 * See also:
 * http://blade.nagaokaut.ac.jp/cgi-bin/scat.rb/ruby/ruby-talk/67877
 * http://blade.nagaokaut.ac.jp/cgi-bin/scat.rb/ruby/ruby-talk/74605
 */

static VALUE *global_stack_start = 0;

#define DECLARE_STACK_START VALUE *old_stack_start;\
   VALUE stack_start

#ifdef HAVE_RUBY_INIT_STACK
#ifdef __ia64
#define PUSH_STACK_START old_stack_start = global_stack_start;\
   global_stack_start = &stack_start;\
   ruby_init_stack(global_stack_start, rb_ia64_bsp())
#define POP_STACK_START ruby_init_stack(old_stack_start, rb_ia64_bsp());\
   global_stack_start = old_stack_start
#else
#define PUSH_STACK_START old_stack_start = global_stack_start;\
   global_stack_start = &stack_start;\
   ruby_init_stack(global_stack_start)

#define POP_STACK_START ruby_init_stack(old_stack_start);\
   global_stack_start = old_stack_start
#endif
#else
extern void Init_stack(VALUE*);
#define PUSH_STACK_START old_stack_start = global_stack_start;\
   global_stack_start = &stack_start;\
   Init_stack(global_stack_start)

#define POP_STACK_START Init_stack(old_stack_start);\
   global_stack_start = old_stack_start
#endif

static SLang_Name_Type *rb_sget_method = 0;

/*{{{ SLangProc */

/* Ruby class to hold a S-Lang function reference as a proc */
static VALUE cSLangProc = 0;

typedef struct SLangProc {
   SLang_Name_Type *callback;
} SLangProc;

static void free_SLangProc(void *data)
{
   SLfree(data);
}

/*}}}*/
/*{{{ ruby value type */

static int Value_Type_Id = 0;
typedef struct
{
   VALUE v;
}
value_type;
#define DUMMY_VALUE_TYPE 255

/* freer */
static void free_value_type(value_type *pt)
{
   SLfree((char *) pt);
}

/* allocator */
static SLang_MMT_Type *allocate_value_type(VALUE v)
{
   value_type *pt;
   SLang_MMT_Type *mmt;
   
   pt = (value_type *) SLmalloc(sizeof(value_type));
   if (pt == NULL)
     return NULL;
   memset((char *) pt, 0, sizeof(value_type));
   
   pt->v = v;
   rb_gc_register_address(&(pt->v));
   if (NULL == (mmt = SLang_create_mmt(Value_Type_Id, (VOID_STAR) pt)))
     {
	free_value_type(pt);
	return NULL;
     }
   return mmt;
}

/* destructor */
static void destroy_value(SLtype type, VOID_STAR f)
{
   value_type *pt;
   (void) type;
   pt = (value_type *) f;
   rb_gc_unregister_address(&(pt->v));
   free_value_type(f);
}

/* constructor */
static void value_new(VALUE v)
{
   SLang_MMT_Type *mmt;
   if (NULL == (mmt = allocate_value_type(v)))
     {
	SLang_verror(SL_RunTime_Error, "value_new failed");
     }
   if (-1 == SLang_push_mmt(mmt))
     {
	SLang_free_mmt(mmt);
	(void) SLang_push_null();
     }
}

/*}}}*/

/*}}}*/
/*{{{ error info */

/* This was adapted from Vim's if_ruby.c and Apache's mod_ruby.c,
 * both by Shugo Maeda
 */

/* copied from eval.c */
#define TAG_RETURN      0x1
#define TAG_BREAK       0x2
#define TAG_NEXT        0x3
#define TAG_RETRY       0x4
#define TAG_REDO        0x5
#define TAG_RAISE       0x6
#define TAG_THROW       0x7
#define TAG_FATAL       0x8
#define TAG_MASK        0xf

#define STRING_LITERAL(s) rb_str_new(s, sizeof(s) - 1)
#define STR_CAT_LITERAL(str, s) rb_str_cat(str, s, sizeof(s) - 1)


static VALUE ruby_get_error_info(int state)
{
   char buff[BUFSIZ];
   VALUE errmsg;
   VALUE eclass;
   VALUE einfo;
   
   errmsg = STRING_LITERAL("");
   switch (state)
     {
      case TAG_RETURN:
	STR_CAT_LITERAL(errmsg, ": unexpected return\n");
	break;
      case TAG_NEXT:
	STR_CAT_LITERAL(errmsg, ": unexpected next\n");
	break;
      case TAG_BREAK:
	STR_CAT_LITERAL(errmsg, ": unexpected break\n");
	break;
      case TAG_REDO:
	STR_CAT_LITERAL(errmsg, ": unexpected redo\n");
	break;
      case TAG_RETRY:
	STR_CAT_LITERAL(errmsg, ": retry outside of rescue clause\n");
	break;
      case TAG_RAISE:
      case TAG_FATAL:
#ifdef RUBY_VM
	eclass = CLASS_OF(rb_errinfo());
	einfo = rb_obj_as_string(rb_errinfo());
#else
	eclass = CLASS_OF(ruby_errinfo);
	einfo = rb_obj_as_string(ruby_errinfo);
#endif
	if (eclass == rb_eRuntimeError && RSTRING_LEN(einfo) == 0)
	  {
	     STR_CAT_LITERAL(errmsg, "E272: unhandled exception");
	  }
	else
	  {
	     VALUE epath;
	     char *p;
	     epath = rb_class_path(eclass);
	     snprintf(buff, BUFSIZ, "%s: %s",
		      RSTRING_PTR(epath), RSTRING_PTR(einfo));
	     p = strchr(buff, '\n');
	     if (p) *p = '\0';
	     STR_CAT_LITERAL(errmsg, buff);
	  }
	
	break;
      default:
	snprintf(buff, BUFSIZ, ": unknown longjmp status %d", state);
	rb_str_cat(errmsg, buff, strlen(buff));
	STR_CAT_LITERAL(errmsg, buff);
	break;
     }
   return errmsg;
}

/*}}}*/
/*{{{ moving values between Ruby and S-Lang */

/* Basic types (strings, integers and floats) are converted.
 * Hashes, objects and other ruby types are converted to opaque
 * Ruby_Value_Type objects in S-Lang.
 * Ruby arrays are recursively converted to S-Lang lists.
 * S-Lang arrays and lists are recursively converted to Ruby arrays
 * Converting other S-Lang datatypes to Ruby isn't supported.
 */
static void _rb_to_slang(VALUE v)
{
   switch (TYPE(v))
     {
      case T_FIXNUM:
	SLang_push_int(NUM2INT(v));
	return;
      case T_BIGNUM:
	SLang_push_double(NUM2DBL(v));
	return;
      case T_FLOAT:
	SLang_push_double(RFLOAT_VALUE(v));
	return;
      case T_STRING:
	  {
	     /* SLang_push_string(RSTRING_PTR(v)); */
	     SLang_BString_Type *bstr;
	     bstr = SLbstring_create((unsigned char *)RSTRING_PTR(v), RSTRING_LEN(v));
	     if (bstr != NULL)
	       (void) SLang_push_bstring(bstr);
	     SLbstring_free(bstr);
	     return;
	  }
      case T_SYMBOL:
	SLang_push_string((char *) rb_id2name(SYM2ID(v)));
	return;
      case T_ARRAY:
	  {
	     int size;
	     size = RARRAY(v)->len;
	     int i;
	     /* Push a new list on the stack */
	     (void) SLang_execute_function("list_new");
	     for (i = 0; i < size; i++)
	       {
		  /* Duplicate the list */
		  SLdup_n(1);
		  /* Convert the array element to S-Lang, push it to the stack */
		  _rb_to_slang(rb_ary_entry(v, i));
		  /* Take the duplicate, and the Ruby array element, off the
		   * stack, and append the element.  It's pass by reference so
		   * the duplicate and original are the same thing.
		   */
		  (void) SLang_execute_function("list_append");
	       }
	     /* One reference to the list is left on the stack.
	      * This way we can convert arrays larger than the S-Lang
	      * stack size (2500 items).
	      */
	     return;
	  }
      case T_FALSE:
	SLang_push_integer(0);
	return;
      case T_TRUE:
	SLang_push_integer(1);
	return;
      case T_NIL:
	SLang_push_null();
	return;
      default:
	value_new(v);
     }
}

/* This takes a value from the S-Lang stack and returns it as a VALUE */
static VALUE _slang_to_rb(void)
{
   int type = SLang_peek_at_stack();
   if (type == Value_Type_Id)
     {
	value_type *vt;
	VALUE v;
	SLang_MMT_Type *mmt;
	if (NULL == (mmt = SLang_pop_mmt(Value_Type_Id)))
	  {
	     return Qnil;
	  }
	vt = SLang_object_from_mmt(mmt);
	v = vt->v;
	SLang_free_mmt(mmt);
	return v;
     }
   
   switch(type)
     {
      case SLANG_CHAR_TYPE:
      case SLANG_UCHAR_TYPE:
      case SLANG_SHORT_TYPE:
      case SLANG_USHORT_TYPE:
      case SLANG_INT_TYPE:
	  {	     
	     int integer;
	     if (-1 == SLang_pop_int(&integer))
	       {
		  return Qnil;
	       }
	     return INT2NUM(integer);
	  }
      case SLANG_UINT_TYPE:
	  {
	     unsigned int integer;
	     if (-1 == SLang_pop_uint(&integer))
	       {
		  return Qnil;
	       }
	     return UINT2NUM(integer);
	  }
      case SLANG_FLOAT_TYPE:
      case SLANG_DOUBLE_TYPE:
	  {
	     double f;
	     if (-1 == SLang_pop_double(&f))
	       {
		  return Qnil;
	       }
	     return rb_float_new(f);
	  }
      case SLANG_STRING_TYPE:
	  {
	     char *s;
	     VALUE v;
	     if (-1 == SLang_pop_slstring(&s))
	       {
		  return Qnil;
	       }
	     v = rb_str_new2(s);
	     SLang_free_slstring(s);
	     return v;
	  }
      case SLANG_BSTRING_TYPE:
	  {
	     SLang_BString_Type *bvalue;
	     unsigned char *bptr;
	     unsigned int bstrlen;
	     VALUE v;
	     if (-1 == SLang_pop_bstring(&bvalue))
	       {
		  return Qnil;
	       }
	     bptr = SLbstring_get_pointer(bvalue, &bstrlen);

	     v = rb_str_new((char *)bptr, bstrlen);
	     SLbstring_free(bvalue);
	     return v;
	  }
      case SLANG_LIST_TYPE:
	  {
	     VALUE v;
	     int i;
	     int length = SLstack_depth();
	     /* This can't convert lists greater than the stack size */
	     (void) SLang_execute_function("__push_list");
	     length = SLstack_depth() - length + 1; /* __push_list() has taken one off */
	     v = rb_ary_new();
	     for (i =0; i < length; i++)
	       {
		  rb_ary_unshift(v, _slang_to_rb());
	       }
	     return v;
	  }
      case SLANG_ARRAY_TYPE:
	  {
	     VALUE v;
	     int i;
	     SLtype data_type;
	     SLang_Array_Type *at;
	     int length;
	     void **dp;
	     
	     if (-1 == SLang_pop_array(&at, 1))
	       return Qnil;
	     data_type = at->data_type;
	     length = at->num_elements;
	     dp = (void **)at->data;
	     
	     v = rb_ary_new2(length);
	     for (i =0; i < length; i++)
	       {
		  SLang_push_value(data_type, dp);
		  dp++;
		  rb_ary_push(v, _slang_to_rb());
	       }
	     SLang_free_array(at);
	     return v;
	  }
      case SLANG_REF_TYPE:
	  {
	     VALUE v;
	     SLangProc *proc;
	     proc = (SLangProc *)SLmalloc(sizeof(SLangProc));
	     proc->callback = SLang_pop_function();
	     v = Data_Wrap_Struct(cSLangProc, 0, free_SLangProc, proc);
	     return v;
	  }
      default:
	SLang_verror(SL_Usage_Error, "Unsupported S-Lang type");
	return Qnil;
     }
}

/*}}}*/
/*{{{ rb_eval */

static void slrb_eval(char *s)
{
   VALUE v;
   DECLARE_STACK_START;
   PUSH_STACK_START;
   int state;
   v = rb_eval_string_protect(s, &state);
   POP_STACK_START;
   CHECK_ERROR;
   _rb_to_slang(v);
}


/*}}}*/
/*{{{ method call helper functions */
static VALUE my_rb_apply(VALUE argv)
{
   int cmd;
   VALUE rv;
   VALUE recv = rb_ary_shift(argv);
   VALUE name = rb_check_convert_type( rb_ary_shift(argv), T_STRING, "String", "to_s" );
   DECLARE_STACK_START;
   PUSH_STACK_START;
   cmd = rb_intern(StringValuePtr(name));
   rv = rb_apply(recv, cmd, argv);
   POP_STACK_START;
   return rv;
}

static VALUE call_SLangProc(VALUE args, VALUE self
#ifdef HAVE_TYPE_RB_BLOCK_CALL_FUNC
			    /* See http://www.ruby-forum.com/topic/137005  */
			    , int argc, VALUE *argv
#endif
			   )
{
   SLangProc *data;
   /* this counts the number of return values */
   int count = SLstack_depth();
   VALUE rv;
   
   Data_Get_Struct(self, struct SLangProc, data);
   
   (void) SLang_start_arg_list();
#ifdef HAVE_TYPE_RB_BLOCK_CALL_FUNC
   if (argc)
     {
	int i;
	for (i = 0; i < argc; i++)
	  {
	     _rb_to_slang(argv[i]);
	  }
     }
   else
#endif
     if (T_ARRAY == TYPE(args))
       {
	  /* Ruby gives multiple args in an array.  Push the elements on the stack. */
	  int size = RARRAY(args)->len;
	  int i;
	  for (i = 0; i < size; i++)
	    {
	       _rb_to_slang(rb_ary_entry(args, i));
	    }
       }
   else
     {
	/* If it's just one argument, it's not passed in an array */
	_rb_to_slang(args);
     }
   (void) SLang_end_arg_list();
   
   
   switch ( SLexecute_function(data->callback))
     {
      case 0:
	rb_raise(rb_SLangException, "S-Lang function does not exist");
	break;
      case -1:
	/* Clear the S-Lang error and raise a Ruby error. */
	SLang_set_error(0);
	rb_raise(rb_SLangException, "S-Lang error");
     }
   
   rv = rb_ary_new();
   for(count = SLstack_depth() - count; count > 0; count--)
     rb_ary_unshift(rv, _slang_to_rb());
   return rv;
}

static VALUE SLangProc_call(self, args)
{
#ifdef HAVE_TYPE_RB_BLOCK_CALL_FUNC
   return call_SLangProc(args, self, 0, 0);
#else
   return call_SLangProc(args, self);
#endif
}

static VALUE my_iter(VALUE argv)
{
   VALUE rv;
   VALUE block = rb_ary_shift(argv);
   rv = rb_iterate(&my_rb_apply, argv, &call_SLangProc, block);
   return rv;
}

static VALUE SLangProc_to_s(self, args)
{
   SLangProc *data;
   VALUE rv;   
   Data_Get_Struct(self, struct SLangProc, data);
   rv = rb_str_new2(data->callback->name);
   return rv;
}

/*}}}*/
/*{{{ rb_call_function */

static void slrb_call_function(void)
{
   int nargs, i;
   VALUE argv;
   VALUE retval;
   int state;
   DECLARE_STACK_START;
   PUSH_STACK_START;
   
   nargs = SLang_Num_Function_Args;
   if (!nargs)
     {
	SLang_verror(SL_Usage_Error, "rb_call_function needs at least one arg");
	return;
     }
   i = nargs;
   
   argv = rb_ary_new();
   
   if (nargs > 1 && SLANG_REF_TYPE == SLang_peek_at_stack())
     {
	/* If the last argument is a reference to a function, convert it to a block. */
	VALUE v;
	SLangProc *proc;
	int state;
	proc = (SLangProc *)SLmalloc(sizeof(SLangProc));
	proc->callback = SLang_pop_function();
	v = Data_Wrap_Struct(cSLangProc, 0, free_SLangProc, proc);
	i--;
	
	while (i > 0)
	  {
	     i--;
	     rb_ary_unshift(argv, _slang_to_rb());
	  }
	rb_ary_unshift(argv, Qnil);
	rb_ary_unshift(argv, v);
	retval = rb_protect(&my_iter, argv, &state);
	CHECK_ERROR;
	_rb_to_slang(retval);
	return;
     }
   
   while (i > 0)
     {
	i--;
	rb_ary_unshift(argv, _slang_to_rb());
     }
   rb_ary_unshift(argv, Qnil);
   
   retval = rb_protect(&my_rb_apply, argv, &state);
   CHECK_ERROR;
   _rb_to_slang(retval);
}

/*}}}*/
/*{{{ rb_call_method */
static void slrb_call_method(void)
{
   int nargs, i;
   VALUE argv;
   VALUE retval;
   int state;
   
   nargs = SLang_Num_Function_Args;
   i = nargs;
   argv = rb_ary_new();
   if (nargs > 0 && SLANG_REF_TYPE == SLang_peek_at_stack())
     {
	VALUE v;
	SLangProc *proc;
	proc = (SLangProc *)SLmalloc(sizeof(SLangProc));
	proc->callback = SLang_pop_function();
	v = Data_Wrap_Struct(cSLangProc, 0, free_SLangProc, proc);
	i--;
	
	while (i > 0)
	  {
	     i--;
	     rb_ary_unshift(argv, _slang_to_rb());
	  }
	rb_ary_unshift(argv, v);
	rb_gc_register_address(&argv);
	retval = rb_protect(&my_iter, argv, &state);
	CHECK_ERROR;
	_rb_to_slang(retval);
	return;
     }
   i = nargs;
   while (i > 0)
     {
	i--;
	rb_ary_unshift(argv, _slang_to_rb());
     }
   /* We must use rb_protect here, rb_rescue can still cause segfaults */
   retval = rb_protect(&my_rb_apply, argv, &state);
   CHECK_ERROR;
   _rb_to_slang(retval);
}

/*}}}*/
/*{{{ sget method */

static void slrb_sget_method(void)
{
   int nargs;
   nargs = SLang_Num_Function_Args;
   /* The stack looks like: receiver; args; name
    * Change it to receiver; name; args
    */
   (void) SLroll_stack(nargs);
   slrb_call_method();
}

static int cl_sget(SLtype type, char *name)
{
   (void) type;
   int len;
   char *realname;
   if (NULL == SLang_pop_mmt(Value_Type_Id))
     return -1;
   /* convert x.foo_p() in S-Lang to x.foo? in Ruby */
   len = strlen(name);
   if (name[len-2] == '_'
       && name[len-1] == 'p'
       && (realname = SLmalloc(len - 1)))
     {
	memcpy(realname, name, len - 2);
	realname[len - 2] = '?';
	realname[len - 1] = 0;
	SLang_push_malloced_string(realname);
     }
   else
     {
	SLang_push_string(name);
     }
   SLang_push_function(rb_sget_method);
   return 0;
}
/*}}}*/
/*{{{ sput method */

static int cl_sput(SLtype type, char *name)
{
   SLang_MMT_Type *mmt;
   value_type *vt;
   char *setter_method;
   VALUE vsetter_method;
   VALUE new_value;
   VALUE argv;
   (void) type;
   int state;
   
   if (NULL == (mmt = SLang_pop_mmt(Value_Type_Id)))
     return -1;
   vt = SLang_object_from_mmt(mmt);
   
   if (NULL == (setter_method = SLmalloc(strlen(name) + 1)))
     {
	SLang_free_mmt(mmt);
	return -1;
     }
   
   sprintf(setter_method, "%s=", name);
   vsetter_method = rb_str_new2(setter_method);
   SLfree(setter_method);
   new_value = _slang_to_rb();
   
   argv = rb_ary_new3(3, vt->v, vsetter_method, new_value);
   SLang_free_mmt(mmt);
   (void) rb_protect(&my_rb_apply, argv, &state);
   CHECK_ERROR;
   return 0;
}

/*}}}*/
/*{{{ aget method */

/* This is similar to the sget method, but calls the objects '[]' method. */
static int cl_aget(SLtype type, unsigned int num_indices)
{
   SLang_MMT_Type *mmt;
   value_type *recvt;
   VALUE argv;
   int i;
   int state;
   
   (void) type;
   
   if (num_indices < 1)
     {
	SLang_verror(SL_Usage_Error, "at least one index is required");
	return -1;
     }
   
   if (NULL == (mmt = SLang_pop_mmt(Value_Type_Id)))
     {
	return -1;
     }
   recvt = SLang_object_from_mmt(mmt);
   
   argv = rb_ary_new2(2 + num_indices);
   rb_ary_store(argv, 0, recvt->v);
   rb_ary_store(argv, 1, rb_str_new2("[]"));
   for (i = num_indices + 1; i > 1; i--)
     {
	rb_ary_store(argv, i, _slang_to_rb());
     }
   
   SLang_free_mmt(mmt);
   _rb_to_slang(rb_protect(&my_rb_apply, argv, &state));
   CHECK_ERROR;
   return 0;
}


/*}}}*/
/*{{{ aput method */

static int cl_aput(SLtype type, unsigned int num_indices)
{
   SLang_MMT_Type *mmt;
   value_type *recvt;
   VALUE argv;
   int i;
   int state;
   
   (void) type;
   
   if (num_indices < 1)
     {
	SLang_verror(SL_Usage_Error, "at least one index is required");
	return -1;
     }
   
   if (NULL == (mmt = SLang_pop_mmt(Value_Type_Id)))
     {
	return -1;
     }
   recvt = SLang_object_from_mmt(mmt);
   
   argv = rb_ary_new2(3 + num_indices);
   rb_ary_store(argv, 0, recvt->v);
   rb_ary_store(argv, 1, rb_str_new2("[]="));
   for (i = num_indices + 1; i > 1; i--)
     {
	rb_ary_store(argv, i, _slang_to_rb());
     }
   rb_ary_store(argv, 2+num_indices, _slang_to_rb());
   
   SLang_free_mmt(mmt);
   (void) rb_protect(&my_rb_apply, argv, &state);
   CHECK_ERROR;
   return 0;
}


/*}}}*/
/*{{{ rb_load_file */
static void slrb_load_file(const char *s)
{
   int state;
   DECLARE_STACK_START;
   PUSH_STACK_START;
   rb_load_protect(rb_str_new2(s), 0, &state);
   POP_STACK_START;
   CHECK_ERROR;
}

/*}}}*/
/*{{{ intrinsics */

static SLang_Intrin_Fun_Type Module_Intrinsics [] =
{
   MAKE_INTRINSIC_1("rb_eval", slrb_eval, SLANG_VOID_TYPE, SLANG_STRING_TYPE),
   MAKE_INTRINSIC_0("rb_call_function", slrb_call_function, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("rb_call_method", slrb_call_method, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_0("rb_sget_method", slrb_sget_method, SLANG_VOID_TYPE),
   MAKE_INTRINSIC_1("rb_load_file", slrb_load_file, SLANG_VOID_TYPE, SLANG_STRING_TYPE),
   SLANG_END_INTRIN_FUN_TABLE
};

static SLang_Intrin_Var_Type Module_Variables [] =
{
   MAKE_VARIABLE("_ruby_module_version_string", &Module_Version_String, SLANG_STRING_TYPE, 1),
   SLANG_END_INTRIN_VAR_TABLE
};

static SLang_IConstant_Type Module_Constants [] =
{
   MAKE_ICONSTANT("_ruby_module_version", MODULE_VERSION_NUMBER),
   SLANG_END_ICONST_TABLE
};

/*}}}*/
/*{{{ register class */

void Init_SLangProc(void)
{
   rb_gc_register_address(&cSLangProc);
   cSLangProc = rb_define_class("SLangProc", rb_cProc);
   
   rb_undef_method(cSLangProc, "new");
   rb_undef_method(cSLangProc, "[]");
   rb_undef_method(cSLangProc, "[]=");
   rb_define_method(cSLangProc, "call", SLangProc_call, -2);
   rb_define_method(cSLangProc, "to_s", SLangProc_to_s, -2);
}

static int register_value_type(void)
{
   SLang_Class_Type *cl;
   if (Value_Type_Id)
     return 0;
   if ((NULL == (cl = SLclass_allocate_class("Ruby_Value_Type")))
       || (-1 == SLclass_set_destroy_function(cl, destroy_value))
       || (-1 == SLclass_register_class(cl, SLANG_VOID_TYPE, sizeof(value_type), SLANG_CLASS_TYPE_MMT))
       || (-1 == SLclass_set_sget_function(cl, cl_sget))
       || (-1 == SLclass_set_sput_function(cl, cl_sput))
       || (-1 == SLclass_set_aget_function(cl, cl_aget))
       || (-1 == SLclass_set_aput_function(cl, cl_aput)))
     return -1;
   
   Value_Type_Id = SLclass_get_class_id(cl);
   
   return 0;
}

int init_ruby_module_ns(char *ns_name)
{
   char *rb_sget_method_name;
   DECLARE_STACK_START;
   SLang_NameSpace_Type *ns = SLns_create_namespace(ns_name);
   if ((ns == NULL)
       || (NULL == (rb_sget_method_name = SLmalloc(strlen(ns_name) + 16)))
       || (0 > sprintf(rb_sget_method_name, "%s->rb_sget_method", ns_name))
       || (-1 == register_value_type())
       || (-1 == SLns_add_intrin_fun_table(ns, Module_Intrinsics, NULL))
       || (-1 == SLns_add_intrin_var_table(ns, Module_Variables, NULL))
       || (-1 == SLns_add_iconstant_table(ns, Module_Constants, NULL)))
     return -1;
   rb_sget_method = SLang_get_function(rb_sget_method_name);
   SLfree(rb_sget_method_name);
   if (Ruby_Error == 0)
     {
	if (-1 == (Ruby_Error = SLerr_new_exception(SL_RunTime_Error, "RubyError", "Ruby Error")))
	  return -1;
     }
   ruby_init();
#ifdef RUBY_VM
   /* see http://www.ruby-forum.com/topic/148632 */
   rb_gc_register_address(&gProgName);
   gProgName = rb_str_new2("embedded");
   rb_define_variable("$0", &gProgName);
   rb_define_variable("$PROGRAM_NAME", &gProgName);
#endif
   PUSH_STACK_START;
   ruby_script("embedded");
   ruby_init_loadpath();
#ifdef RUBY_VM
   Init_prelude();
#endif
   if (rb_SLangException == 0)
     {
	rb_gc_register_address(&rb_SLangException);
	rb_SLangException = rb_define_class("SLangException", rb_eStandardError);
     }
   if (cSLangProc == 0)
     Init_SLangProc();
   
   return 0;
}
