/*
 * Runtime functions
 * (C) 2006, Pascal Schmidt <arena-language@ewetel.net>
 * see file ../doc/LICENSE for license
 */

#include <stdlib.h>
#include <string.h>

#include "stdlib.h"

/*
 * Return type of expression
 *
 * This function returns a string representation of the type of
 * the first argument.
 */
value *rt_type_of(arena_state *s, unsigned int argc, value **argv)
{
  char *buf;
  switch (argv[0]->type) {
    case VALUE_TYPE_VOID:
      buf = "void";
      break;
    case VALUE_TYPE_BOOL:
      buf = "bool";
      break;
    case VALUE_TYPE_INT:
      buf = "int";
      break;
    case VALUE_TYPE_FLOAT:
      buf = "float";
      break;
    case VALUE_TYPE_STRING:
      buf = "string";
      break;
    case VALUE_TYPE_ARRAY:
      buf = "array";
      break;
    case VALUE_TYPE_STRUCT:
      buf = "struct";
      break;
    case VALUE_TYPE_FN:
      buf = "fn";
      break;
    case VALUE_TYPE_RES:
      buf = "resource";
      break;
    default:
      buf = "unknown";
  }
  return value_make_string(buf);
}

/*
 * Return template of value
 *
 * Returns the template of a struct value if it was instantiated from a
 * template definition and the "__template" member has not been overwritten
 * since. It returns void otherwise.
 */
value *rt_tmpl_of(arena_state *s, unsigned int argc, value **argv)
{
  if (argv[0]->type != VALUE_TYPE_STRUCT) {
    return value_make_void();
  }
  return value_get_struct(argv[0], "__template");
}

/*
 * Check whether all arguments have given type
 */
static value *is_type(unsigned int argc, value **argv, unsigned int type)
{
  unsigned int i;
  
  for (i = 0; i < argc; i++) {
    if (argv[i]->type != type) {
      return value_make_bool(0);
    }
  }
  return value_make_bool(1);
}

/*
 * Check whether arguments are all voids
 */
value *rt_is_void(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_VOID);
}

/*
 * Check whether arguments are all bools
 */
value *rt_is_bool(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_BOOL);
}

/*
 * Check whether arguments are all ints
 */
value *rt_is_int(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_INT);
}

/*
 * Check whether arguments are all floats
 */
value *rt_is_float(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_FLOAT);
}

/*
 * Check whether arguments are all strings
 */
value *rt_is_string(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_STRING);
}

/*
 * Check whether arguments are all arrays
 */
value *rt_is_array(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_ARRAY);
}

/*
 * Check whether arguments are all structs
 */
value *rt_is_struct(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_STRUCT);
}

/*
 * Check whether arguments are all functions
 */
value *rt_is_fn(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_FN);
}

/*
 * Check whether arguments are all resources
 */
value *rt_is_resource(arena_state *s, unsigned int argc, value **argv)
{
  return is_type(argc, argv, VALUE_TYPE_RES);
}

/*
 * Check whether struct is of a given template  (including parent templates)
 */
static value *is_tmpl(arena_state *s, value *val, const char *wanted)
{
  symtab_entry *entry;
  value *type;
  char *typename;
  int res = 0;

  type = value_get_struct(val, "__template");
  if (type->type != VALUE_TYPE_STRING) {
    value_free(type);
    return value_make_bool(0);
  }
  typename = type->value_u.string_val.value;
  
  while (typename) {
    entry = symtab_stack_lookup(s, typename);
    if (!entry || entry->type != SYMTAB_ENTRY_TMPL) {
      break;
    }
    if (strcmp(entry->symbol, wanted) == 0) {
      res = 1;
      break;
    }
    typename = entry->entry_u.def.parent;
  }
  
  value_free(type);
  return value_make_bool(res);
}

/*
 * Return numeric type for type name
 */
static int nametype(const char *name)
{
  int wanted = 0;

  if (strcmp(name, "void") == 0) {
    wanted = VALUE_TYPE_VOID;
  } else if (strcmp(name, "bool") == 0) {
    wanted = VALUE_TYPE_BOOL;
  } else if (strcmp(name, "int") == 0) {
    wanted = VALUE_TYPE_INT;
  } else if (strcmp(name, "float") == 0) {
    wanted = VALUE_TYPE_FLOAT;
  } else if (strcmp(name, "string") == 0) {
    wanted = VALUE_TYPE_STRING;
  } else if (strcmp(name, "array") == 0) {
    wanted = VALUE_TYPE_ARRAY;
  } else if (strcmp(name, "struct") == 0) {
    wanted = VALUE_TYPE_STRUCT;
  } else if (strcmp(name, "fn") == 0) {
    wanted = VALUE_TYPE_FN;
  } else if (strcmp(name, "resource") == 0) {
    wanted = VALUE_TYPE_RES;
  }
  return wanted;
}

/*
 * Check whether argument has specified type
 *
 * The type is given as a string identifying the desired type.
 */
value *rt_is_a(arena_state *s, unsigned int argc, value **argv)
{
  const char *name = argv[1]->value_u.string_val.value;
  unsigned int wanted = 0;
  
  if (!value_str_compat(argv[1])) {
    return value_make_bool(0);
  }

  wanted = nametype(name);  
  if (wanted == 0 && argv[0]->type == VALUE_TYPE_STRUCT) {
    return is_tmpl(s, argv[0], name);
  }
  return value_make_bool(argv[0]->type == wanted);
}

/*
 * Check existence of symtab entry of specific type
 */
static value *isdefined(arena_state *s, value *val, unsigned int wanted)
{
  char *name = val->value_u.string_val.value;
  symtab_entry *entry;
  
  if (!value_str_compat(val)) {
    return value_make_bool(0);
  }
  
  entry = symtab_stack_lookup(s, name);
  return value_make_bool(entry && entry->type == wanted);
}

/*
 * Check existence of function
 *
 * This function returns true if the given function name exists in
 * the current symbol table scope.
 */
value *rt_is_function(arena_state *s, unsigned int argc, value **argv)
{
  return isdefined(s, argv[0], SYMTAB_ENTRY_FUNCTION);
}

/*
 * Check existence of variable
 *
 * This function returns true if the given variable name exists in
 * the current symbol table scope.
 */
value *rt_is_var(arena_state *s, unsigned int argc, value **argv)
{
  return isdefined(s, argv[0], SYMTAB_ENTRY_VAR);
}

/*
 * Check existence of template
 *
 * This function returns true if the given template name exists in
 * the current symbol table scope.
 */
value *rt_is_tmpl(arena_state *s, unsigned int argc, value **argv)
{
  return isdefined(s, argv[0], SYMTAB_ENTRY_TMPL);
}

/*
 * Check for local symbol
 *
 * Returns true if the given name is from the local scope.
 */
value *rt_is_local(arena_state *s, unsigned int argc, value **argv)
{
  char *name = argv[0]->value_u.string_val.value;
  
  if (!value_str_compat(argv[0])) {
    return value_make_bool(0);
  }
  return value_make_bool(symtab_stack_local(s, name));
}

/*
 * Check for global symbol
 */
value *rt_is_global(arena_state *s, unsigned int argc, value **argv)
{
  char *name = argv[0]->value_u.string_val.value;
  symtab_entry *entry;
  
  if (!value_str_compat(argv[0])) {
    return value_make_bool(0);
  }
  entry = symtab_stack_lookup(s, name);
  return value_make_bool(entry && !symtab_stack_local(s, name));
}

/*
 * Define a variable
 *
 * This function uses its first parameter as a variable names and
 * assigns the value of the second parameter to the new variable.
 * It returns true on success and false on failure.
 */
value *rt_set(arena_state *s, unsigned int argc, value **argv)
{
  char *name = argv[0]->value_u.string_val.value;
  
  if (!value_str_compat(argv[0])) {
    return value_make_bool(0);
  }

  if (argv[1]->type != VALUE_TYPE_FN) {
    symtab_stack_add_variable(s, name, argv[1]);
  } else {
    symtab_stack_add_function(s, name, argv[1]->value_u.fn_val);
  }
  return value_make_bool(1);
}

/*
 * Variable reference
 *
 * This function takes the name of a variable as argument and returns
 * the value of the variable if it exists. If not, a void value is
 * returned.
 */
value *rt_get(arena_state *s, unsigned int argc, value **argv)
{
  char *name = argv[0]->value_u.string_val.value;
  symtab_entry *entry;
  
  if (!value_str_compat(argv[0])) {
    return value_make_void();
  }
  
  entry = symtab_stack_lookup(s, name);
  if (!entry || entry->type == SYMTAB_ENTRY_TMPL) {
    return value_make_void();
  }
  if (entry->type == SYMTAB_ENTRY_VAR) {
    return value_copy(entry->entry_u.var);
  } else {
    return value_make_fn(entry->entry_u.sig);
  }
}

/*
 * Unset variable or function
 *
 * Removes a variable or function from the current symbol table. In
 * the case of variables, the memory used by their values will also
 * be freed.
 */
value *rt_unset(arena_state *s, unsigned int argc, value **argv)
{
  unsigned int i;
  
  for (i = 0; i < argc; i++) {
    value_cast_inplace(s, &argv[i], VALUE_TYPE_STRING);
    if (value_str_compat(argv[i])) {
      symtab_stack_delete(s, argv[i]->value_u.string_val.value);
    }
  }
  
  return value_make_void();
}

/*
 * Debugging assertion
 *
 * Terminates the program if one the arguments evaluates to false.
 */
value *rt_assert(arena_state *s, unsigned int argc, value **argv)
{
  unsigned int i;
  
  for (i = 0; i < argc; i++) {
    value_cast_inplace(s, &argv[i], VALUE_TYPE_BOOL);
    if (!argv[i]->value_u.bool_val) {
      fatal(s, "assertion failure");
      break;
    }
  }
  return value_make_void();
}

/*
 * Make symbols global
 *
 * This function treats its arguments as variable names and
 * adds them to the global scope.
 */
value *rt_global(arena_state *s, unsigned int argc, value **argv)
{
  symtab_entry *entry;
  unsigned int i;
  
  for (i = 0; i < argc; i++) {
    value_cast_inplace(s, &argv[i], VALUE_TYPE_STRING);
    if (argv[i]->value_u.string_val.value) {
      entry = symtab_stack_lookup(s, argv[i]->value_u.string_val.value);
      if (entry && entry->type == SYMTAB_ENTRY_VAR) {
        symtab_stack_add_global(s, entry->symbol, entry->entry_u.var);
      }
    }
  }
  return value_make_void();
}

/*
 * Get static template member by name(s)
 */
value *rt_get_static(arena_state *s, unsigned int argc, value **argv)
{
  char *tmpl = argv[0]->value_u.string_val.value;
  char *name = argv[1]->value_u.string_val.value;
  symtab_entry *entry;
  expr ex;
  
  if (!value_str_compat(argv[0]) || !value_str_compat(argv[1])) {
    return value_make_void();
  }
  
  entry = symtab_stack_lookup(s, tmpl);
  if (!entry || entry->type != SYMTAB_ENTRY_TMPL) {
    return value_make_void();
  }
  
  ex.type  = EXPR_STATIC_REF;
  ex.tname = tmpl;
  ex.name  = name;
  
  return eval_static_ref(s, &ex);
}

/*
 * Cast to given type
 */
value *rt_cast_to(arena_state *s, unsigned int argc, value **argv)
{
  const char *name = argv[1]->value_u.string_val.value;
  int wanted;
  
  wanted = nametype(name);
  if (wanted == 0) {
    fatal(s, "unknown type name `%s'", name);
    return value_make_void();
  }
  return value_cast(s, argv[0], wanted);
}

/*
 * Get language and library versions
 */
value *rt_versions(arena_state *s, unsigned int argc, value **argv)
{
  value *res, *elem;
  
  res = value_make_struct();
  
  elem = value_make_int(2);
  value_set_struct(res, "v_language_major", elem);
  value_free(elem);

  elem = value_make_int(2);
  value_set_struct(res, "v_language_minor", elem);
  value_free(elem);

  elem = value_make_int(3);
  value_set_struct(res, "v_library_major", elem);
  value_free(elem);

  elem = value_make_int(0);
  value_set_struct(res, "v_library_minor", elem);
  value_free(elem);
  
  return res;
}


syntax highlighted by Code2HTML, v. 0.9.1