root/src/rr_bin_eval.c

/**
 * rr_bin_eval.c -> Part of Crules Programming language
 *
 * Crules is the legal property of its developers. Please refer to the
 * COPYRIGHT file distributed with this source distribution.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 **/

#ifdef HAVE_CONFIG_H
# include "config.h"
#else
# define CMAKE 1
# include "config.h.cmake"
#endif

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

#include <crules/crules.h>
#include <crules/opcodes.h>
#include <crules/symbols.h>
#include <crules/objects.h>
#include <crules/backend.h>
#include <crules/runtime.h>
#include <crules/garbage.h>
#include <crules/operators.h>
#include <crules/math.h>

#define Crl_Lookup_Object_DEF( x,y,z )                  \
  x = crl_rr_context_lookup_object_def( y, z );         \
  if( !x ) {                                            \
    crl_error("object <%s> not defined!\n", y );        \
  }

static crl_symbol_obj * item_assign( crl_symbol_obj *, crl_symbol_obj *,
                                     crl_context_table * );

crl_symbol_obj *
crl_rr_literal_fold( crl_symbol_obj * lit, crl_context_table * context )
{
  crl_assert( lit->type == SYMBOL_PRIMARY );
  crl_symbol_obj * retval = NULL;
  crl_type_obj_def_t ** def = NULL;

  switch( lit->op_a_t )
    {
    case TYPE_INTEGER:
      Crl_Lookup_Object_DEF( def, "Int", &context );
      break;

    case TYPE_SYMBOL_NIL:
      break;

    default:
      crl_fatal("invalid literal object <0x%x>!\n", lit->op_a_t );
      break;
    }

  if( def )
    {
      void * s = ((*def)->init_hook( lit, def ));
      Crl_Symbol_Init_Ctx( retval, context );

      crl_obj_state_t * o = (crl_obj_state_t *)
        crl_malloc( sizeof(crl_obj_state_t) );
      o->identifier = crl_strdup( (*def)->identifier );
      o->self = s;

      o->context = NULL;

      o->definition = def;

      retval->exp = OP_EXPRESS;
      retval->type = SYMBOL_PRIMARY;
      retval->op_a_t = TYPE_OBJECT;
      retval->op_a.object_state = o;
    }

  return retval;
}

static
crl_symbol_obj * item_assign( crl_symbol_obj *opa, crl_symbol_obj *opb,
                              crl_context_table *context )
{
  crl_assert( opb->type == SYMBOL_PRIMARY );
  crl_symbol_obj * retval = NULL;

  if( opb->op_a_t == TYPE_OBJECT )
    {
      if( !(crl_runtime_assignment( opa, opb, context)) )
        {
          crl_fatal("error inserting variable into table!\n");
        }
      retval = crl_runtime_evaluate_expression( opb, context );
    }
  else
    {
      crl_symbol_obj * val = crl_rr_literal_fold( opb, context );
      if( !(crl_runtime_assignment( opa, val, context)) )
        {
          crl_fatal("error inserting variable into table!\n");
        }
      retval = crl_runtime_evaluate_expression( opb, context );
    }

  return retval;
}

/*==================================================================================*/

crl_symbol_obj*
crl_runtime_assign( crl_symbol_obj** op_a , crl_symbol_obj** op_b,
                    crl_context_table * context )
{
  crl_symbol_obj *opa, *opb, *retval= NULL;
  if( op_a && op_b ) { opa= *op_a; opb= *op_b; }
  else {
    crl_error("operands A or B are undefined!\n");
    return NULL;
  }

  if( opa->type == SYMBOL_REFERENCE )
    {
      if( opb->type == SYMBOL_PRIMARY )
        {
          retval= item_assign( opa, opb, context );
        }
      else
        {
          crl_symbol_obj *t1= crl_runtime_expression_evaluator( opb, context );
          if( t1 ) { retval= crl_runtime_assign( op_a, &t1, context ); }
          else {
            crl_fatal("symbol undefined error!\n");
          }
        }
    }
  else
    {
      crl_fatal("Invalid accessor for assignment <0x%x>!\n", opa->type );
    }
  return retval;
}

crl_symbol_obj *
crl_runtime_obj_access( crl_symbol_obj * accessor, crl_symbol_obj * member,
                        crl_context_table * context )
{
  crl_symbol_obj *retval = NULL;
  crl_assert( accessor->op_a_t == TYPE_OBJECT );
  
  if( member->type == SYMBOL_REFERENCE )
    {
      crl_fatal("not implemented yet!\n");
    }
  else if( member->type == OP_CALL_GOTO )
    {
      struct crl_obj_state_t * o = accessor->op_a.object_state;
      crl_context_table * m_ctx = (crl_context_table *)
        crl_malloc( sizeof(crl_context_table) );
      crl_rr_context_init_table( &m_ctx );

      crl_rr_context_push( context->array[0], m_ctx );
      crl_rr_context_push( o->context, m_ctx );

      crl_symbol_obj** functor = crl_rr_context_lookup_function_def( member->op_a.string,
                                                                     &m_ctx );
      if( functor )
        {
          crl_debug("trying to call <%s:%s( ... )>!\n", o->identifier, member->op_a.string );
          retval = crl_runtime_dispatch_function( member, functor, m_ctx, context );
          crl_debug("finished call <%s:%s( ... )>!\n", o->identifier, member->op_a.string );

          if( !retval )
            {
              Crl_Symbol_Init( retval );
            }
        }
      else
        {
          crl_error("member function <%s> to accessor of type <%s> is not defined!\n",
                    member->op_a.string, o->identifier );
          retval = NULL;
        }
      crl_branch_context * cc1 = crl_rr_context_pop( m_ctx, false );
      crl_branch_context * cc2 = crl_rr_context_pop( m_ctx, false );

      if( cc1 != (o->context) )
        {
          crl_fatal("context stack corruption!\n");
        }
      if( cc2 != (context->array[0]) )
        {
          crl_fatal("context stack corruption!\n");
        }
    }
  else
    {
      crl_fatal( "invalid semantic member type <0x%X>!\n",
                 member->type );
    }
  return retval;
}

crl_symbol_obj *
crl_runtime_access( crl_symbol_obj** op_a , crl_symbol_obj** op_b,
                    crl_context_table * context )
{
  crl_symbol_obj *opa, *opb, *retval= NULL;
  if( op_a && op_b ) { opa= *op_a; opb= *op_b; }
  else {
    crl_error("operands A or B are undefined!\n");
    return NULL;
  }

  crl_symbol_obj * t1 = crl_runtime_evaluate_expression( opa, context );
  crl_assert( t1->op_a_t == TYPE_OBJECT );

  retval = crl_runtime_obj_access( t1, opb, context);

  return retval;
}

crl_symbol_obj*
crl_rr_binop_dispatch( crl_symbol_obj** op_a , crl_symbol_obj** op_b,
                       crl_context_table * context, crl_opcode_t op )
{
  crl_symbol_obj *opa, *opb, *retval= NULL;
  if( op_a && op_b ) { opa= *op_a; opb= *op_b; }
  else {
    crl_error("operands A or B are undefined!\n");
    return NULL;
  }

  if( opa->type == SYMBOL_PRIMARY )
    {
      if( opb->type == SYMBOL_PRIMARY )
        {
          retval= crl_rr_math_dispatch( opa, opb, context, op );
        }
      else
        {
          crl_symbol_obj *t1= crl_runtime_expression_evaluator( opb, context );
          if( t1 ) { retval= crl_rr_binop_dispatch( op_a, &t1, context, op ); }
          else {
            crl_fatal("symbol undefined error!\n");
          }
          t1->n_ref--;
        }
    }
  else
    {
      if( opb->type == SYMBOL_PRIMARY )
        {
          crl_symbol_obj *t1= crl_runtime_expression_evaluator( opa, context );
          if( t1 ) { retval= crl_rr_binop_dispatch( &t1, op_b, context, op ); }
          else {
            crl_fatal("symbol undefined error!\n");
          }
          t1->n_ref--;
        }
      else
        {
          crl_symbol_obj *t1, *t2;
          t1= crl_runtime_expression_evaluator( opa, context );
          if( t1 )
            {
              t2= crl_runtime_expression_evaluator( opb, context );
              if( t2 ) { retval= crl_rr_binop_dispatch( &t1, &t2, context, op ); }
              else {
                crl_fatal("symbol undefined error!\n");
              }
            }
          else {
            crl_fatal("symbol undefined error!\n");
          }
          t1->n_ref--;
          t2->n_ref--;
        }
    }

  return retval;
}