struct ast* rlength(struct ast* a) {
switch (a->node_type) {
case N_STRING_1: {
return new_integer_node(strlen(string_value(a)));
break;
};
case N_STRING_2: {
return new_integer_node(strlen(string_value(a)));
break;
};
case N_IDENTIFIER: {
return rlength(eval_ast(a));
break;
};
case N_ARRAY: {
return new_integer_node(array_tree_size(a->left));
break;
};
case N_ARRAY_CONTENT: {
return rlength(eval_ast(a->left));
break;
};
default: {
no_method_error("length", a);
break;
};
};
return new_nil_node();
};
struct ast* eval_instance_native_method(struct ast* m) {
if (m != NULL){
char* method_name;
if (m->node_type == N_METHOD_CALL_1) {
method_name = strdup(((struct method_call_node*)m)->method_name);
};
if (!strcmp(method_name, LENGTH)) {
struct method_call_node* mc = (struct method_call_node*)m;
return rlength(eval_ast(mc->left_ast));
} else if (!strcmp(method_name, EACH_ITERATOR)) {
struct method_call_node* mc = (struct method_call_node*)m;
return reach(eval_ast(mc->left_ast), mc->opt_block);
} else if (!strcmp(method_name, RESPOND_TO)) {
struct method_call_node* mc = (struct method_call_node*)m;
struct list_node* arg_node = mc->args;
if (list_length(arg_node) != 1){
wrong_arguments_error(list_length(arg_node), 1);
}
return rrespond_to(eval_ast(mc->left_ast), strdup(string_value(eval_ast(arg_node->arg))));
} else if (!strcmp(method_name, NIL_METHOD)) {
return rnil((struct method_call_node*)m);
} else if (!strcmp(method_name, OBJECT_ID)) {
return robject_id((struct method_call_node*)m);
};
};
return new_nil_node();
};
struct ast* rrespond_to(struct ast* a, char* method_name){
switch (a->node_type) {
case N_STRING_1: {
return new_bool_node(string_is_in_array((void*)string_methods_array, method_name));
};
case N_STRING_2: {
return new_bool_node(string_is_in_array((void*)string_methods_array, method_name));
};
case N_ARRAY: {
return new_bool_node(string_is_in_array((void*)array_methods_array, method_name));
};
case N_INTEGER : {
return new_bool_node(string_is_in_array((void*)integer_methods_array, method_name));
};
case N_BOOL : {
return new_bool_node(string_is_in_array((void*)bool_methods_array, method_name));
};
case N_OBJECT : {
struct object_node* o = (struct object_node*) a;
return new_bool_node(NULL != find_method_for_class(o->class_ptr->name, strdup(method_name)));
};
case N_IDENTIFIER: {
return rrespond_to(eval_ast(a), strdup(method_name));
};
case N_ARRAY_CONTENT: {
return rrespond_to(eval_ast(a->left), strdup(method_name));
};
default: {
no_method_error("respond_to?", a);
break;
};
}
}
MalVal *EVAL(MalVal *ast, GHashTable *env) {
if (!ast || mal_error) return NULL;
//g_print("EVAL: %s\n", _pr_str(ast,1));
if (ast->type != MAL_LIST) {
return eval_ast(ast, env);
}
if (!ast || mal_error) return NULL;
// apply list
//g_print("EVAL apply list: %s\n", _pr_str(ast,1));
if (_count(ast) == 0) { return ast; }
MalVal *a0 = _nth(ast, 0);
assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1));
MalVal *el = eval_ast(ast, env);
if (!el || mal_error) { return NULL; }
MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el);
//g_print("eval_invoke el: %s\n", _pr_str(el,1));
return f(_nth(el, 1), _nth(el, 2));
}
struct ast* reach(struct ast* a, struct ast* block) {
if (a->node_type == N_ARRAY) {
if (block != NULL) {
struct ast* arr = (struct ast*) a->left;
struct opt_block_node* b = (struct opt_block_node*) block;
// obtengo arreglo a partir de Array
int arr_size = array_tree_size(arr);
struct ast* result[arr_size];
struct ast* ptr = arr;
int i;
for (i = (arr_size - 1); i > -1; i--) {
result[i] = ptr->left;
ptr = ptr->right;
};
// itero sobre array
for (i = 0; i < arr_size; i++) {
push_scope();
// put first arg to scope
if (b->opt_ids != NULL) {
put_sym(SYM_VAR, string_value(b->opt_ids->arg), result[i], NULL);
};
// eval block stmts
eval_ast(b->stmts);
pop_scope();
};
return a;
} else {
block_is_required_error(EACH_ITERATOR);
};
} else {
no_method_error(EACH_ITERATOR, a);
};
};
struct ast* eval_class_native_method(struct method_call_node* m){
if (m != NULL) {
// new
if (!strcmp(m->method_name, NEW)) {
//creo objeto
struct class* class_ptr = find_class(string_value(m->left_ast));
struct sym* sym_list = copy_instance_variables_for_class(class_ptr);
struct ast* new_object = new_object_node(class_ptr, sym_list);
struct sym* s = find_method_for_class(string_value(m->left_ast), "initialize");
// initialize está definido
if (s != NULL) {
// llamo a initialize sobre el objeto
eval_and_push_args_and_object_info(s->args, m->args, new_object);
struct ast* eval = eval_ast(s->ast); //eval initialize
update_instance(new_object); //Antes de hacer pop, salvo en la instancia los cambios en sus variables de instancia
pop_scope(); // pop del scope pusheado
};
return new_object;
};
};
};
///////////////////////////////
// FIXME - make it loop over
// - eval_ast
// - apply
//
ast
EVAL (ast tree, environment::ptr a_env)
{
for (;;)
{
if (!tree)
return tree;
if (tree->type () != node_type_enum::LIST)
return eval_ast (tree, a_env);
// not as_or_throw - we know the type
auto root_list = tree->as<ast_node_list> ();
if (root_list->empty ())
return tree;
//
auto fn_handle_def = [root_list, &a_env]()
{
if (root_list->size () != 3)
raise<mal_exception_eval_invalid_arg> (root_list->to_string ());
const auto& key = (*root_list)[1]->as_or_throw<ast_node_symbol, mal_exception_eval_invalid_arg> ()->symbol ();
ast_node::ptr value = EVAL ((*root_list)[2], a_env);
a_env->set (key, value);
return value;
};
// tco
auto fn_handle_let_tco = [root_list, &a_env]() -> tco
{
if (root_list->size () != 3)
raise<mal_exception_eval_invalid_arg> (root_list->to_string ());
const ast_node_container_base* let_bindings = nullptr;
const auto root_list_arg_1 = (*root_list)[1];
switch (root_list_arg_1->type ())
{
case node_type_enum::LIST:
case node_type_enum::VECTOR:
let_bindings = root_list_arg_1->as<ast_node_container_base> ();
break;
default:
raise<mal_exception_eval_invalid_arg> (root_list_arg_1->to_string ());
};
//
auto let_env = environment::make (a_env);
if (let_bindings->size () % 2 != 0)
raise<mal_exception_eval_invalid_arg> (let_bindings->to_string ());
for (size_t i = 0, e = let_bindings->size(); i < e; i += 2)
{
const auto& key = (*let_bindings)[i]->as_or_throw<ast_node_symbol, mal_exception_eval_invalid_arg> ()->symbol ();
ast_node::ptr value = EVAL ((*let_bindings)[i + 1], let_env);
let_env->set (key, value);
}
return {(*root_list)[2], let_env};
};
// tco
auto fn_handle_apply_tco= [&tree, &a_env]() -> tco
{
ast_node::ptr new_node = eval_ast (tree, a_env);
auto callable_list = new_node->as_or_throw<ast_node_list, mal_exception_eval_not_list> ();
const size_t list_size = callable_list->size ();
if (list_size == 0)
raise<mal_exception_eval_not_callable> (callable_list->to_string ());
auto && callable_node = (*callable_list)[0]->as_or_throw<ast_node_callable, mal_exception_eval_not_callable> ();
return callable_node->call_tco (call_arguments (callable_list, 1, list_size - 1));
};
// tco
auto fn_handle_do_tco = [root_list, &a_env]() -> tco
{
const size_t list_size = root_list->size ();
if (list_size < 2)
raise<mal_exception_eval_invalid_arg> (root_list->to_string ());
for (size_t i = 1, e = list_size - 1; i < e; ++i)
{
/*retVal = */EVAL ((*root_list)[i], a_env);
}
return {(*root_list)[list_size - 1], a_env};
};
// tco
auto fn_handle_if_tco = [root_list, &a_env] () -> tco
{
const size_t list_size = root_list->size ();
if (list_size < 3 || list_size > 4)
raise<mal_exception_eval_invalid_arg> (root_list->to_string ());
ast_node::ptr condNode = EVAL ((*root_list)[1], a_env);
const bool cond = !(condNode == ast_node::nil_node) && !(condNode == ast_node::false_node);
if (cond)
return {(*root_list)[2], a_env};
else if (list_size == 4)
return {(*root_list)[3], a_env};
return tco {nullptr, nullptr, ast_node::nil_node};
};
auto fn_handle_fn = [root_list, &a_env] () -> ast
{
const size_t list_size = root_list->size ();
if (list_size != 3)
raise<mal_exception_eval_invalid_arg> (root_list->to_string ());
auto&& bindsNode = (*root_list)[1];
auto&& astNode = (*root_list)[2];
ast_node::ptr retVal = std::make_shared<ast_node_callable_lambda> (bindsNode, astNode, a_env);
return retVal;
};
auto first = (*root_list)[0];
if (first->type () == node_type_enum::SYMBOL)
{
// apply special symbols
// not as_or_throw - we know the type
const auto first_symbol = first->as<ast_node_symbol> ();
const auto& symbol = first_symbol->symbol ();
if (symbol == "def!")
{
return fn_handle_def ();
}
else if (symbol == "let*")
{
std::tie (tree, a_env, std::ignore) = fn_handle_let_tco ();
continue;
}
else if (symbol == "do")
{
std::tie (tree, a_env, std::ignore) = fn_handle_do_tco ();
continue;
}
else if (symbol == "if")
{
ast retVal;
std::tie (tree, a_env, retVal) = fn_handle_if_tco ();
if (retVal)
return retVal;
continue;
}
else if (symbol == "fn*")
{
return fn_handle_fn ();
}
}
// apply
{
ast retVal;
std::tie (tree, a_env, retVal) = fn_handle_apply_tco ();
if (retVal)
return retVal;
continue;
}
}
}
long lispy_eval_result(lispy_result* result)
{
return eval_ast(result->mpc_result->output);
}
static long eval_ast_root(mpc_ast_t* ast)
{
// Root has three children. Regex + expression + Regex
assert(ast->children_num == 3);
return eval_ast(ast->children[1]);
}
struct ast* rputs(struct ast* a){
if (a->node_type == N_METHOD_CALL_0 || a->node_type == N_METHOD_CALL_1 || a->node_type == N_METHOD_CALL_2) {
struct method_call_node* m = (struct method_call_node*)a;
struct list_node* arg_node = m->args;
// caso especial: puts() sin parámetros imprime salto de línea
if (arg_node == NULL) {
printf("\n");
// comportamiento normal
} else {
while(arg_node != NULL){
struct ast* evaluated = eval_ast(arg_node->arg);
rputs(evaluated);
arg_node = arg_node->next;
};
};
} else if (a->node_type == N_ARRAY) {
int arr_size = array_tree_size(a->left);
struct ast* result[arr_size];
struct ast* ptr = a->left;
int i;
for (i = 0; i < arr_size; i++) {
result[i] = ptr;
ptr = ptr->right;
};
ptr = result[arr_size-1];
for (i = arr_size-1; i >= 0; i--) {
rputs(eval_ast(result[i]));
};
} else if (a->node_type == N_ARRAY_CONTENT) {
rputs(eval_ast(a->left));
} else if (a->node_type == N_STRING_1) {
printf("%s\n", string_value(a));
} else if (a->node_type == N_STRING_2) {
char * str = malloc(sizeof( strlen(string_value(a)) ));
strcpy(str, string_value(a));
str = build_end_of_lines(str);
printf("%s\n", str);
} else if (a->node_type == N_INTEGER) {
printf("%d\n", int_value(a));
} else if (a->node_type == N_DOUBLE) {
double d = double_value(a);
if ( d - floor(d) == 0.0 ) {
printf( "%g.0\n", d );
} else {
printf( "%g\n", d );
};
} else if (a->node_type == N_BOOL) {
printf("%s\n", bool_value(a) ? "true" : "false");
} else if (a->node_type == N_NIL) {
printf("\n");
} else if (a->node_type == N_OBJECT) {
struct object_node * object = (struct object_node *) a;
printf("<#%s:%p>\n", object->class_ptr->name, (void *)object);
} else {
printf("Puts doesn't support %s type, sorry :D\n", type_name(a->node_type));
};
return new_nil_node();
};
struct ast* robject_id(struct method_call_node* m) {
struct ast* evaluated = eval_ast(m->left_ast);
return new_integer_node((long)evaluated);
};
struct ast* rnil(struct method_call_node* m) {
struct ast* evaluated = eval_ast(m->left_ast);
return new_bool_node(evaluated->node_type == N_NIL);
};
