source: to-imperative/trunk/library/Convert/to_int.cc @ 730

// $Source$
// $Revision: 730 $
// $Date: 2003-05-16 07:37:44 +0000 (Fri, 16 May 2003) $
// $Author: luba $

#include <rf_core.hh>

namespace refal
{

using namespace rfrt;
using namespace rftype;

namespace Convert
{

RF_FUNC (To_m_Int, (RF_ARG e_Exp), (RF_RES s_Int))
  uintptr_t len = 0;
  int flag = 0;

  Term* t = e_Exp.get_first();

  if (t->get_type() == type_char) {
    if (((Char*)t)->to_wchar_t() == '-') {
      flag = -1; t++;
    }
    else
      if (((Char*)t)->to_wchar_t() == '+') {
        flag = 1; t++;
      }
  };

  if ((t->get_type() == type_word) )
    if (((Word*)t)->is_number() == -1)
       flag = -1;
    else
    if(((Word*)t)->is_number() == 1)
      flag = 1;
    else
    retfail;


  if (t->get_type() == type_short_int)
    t++;

  for (; t < e_Exp.get_last(); t++) {
    if (t->get_type() == type_char && ((Char*)t)->is_digit()) 
      if (len > UINTPTR_MAX - 1)
        RF_LIB_ERROR("Argument too large for conversion");
      else
        len += 1;
    else
      if (t->get_type() == type_short_int) {
        if (((ShortInt*)t)->to_int() < 0)
          retfail;
        else {
          size_t num_len = ((ShortInt*)t)->get_char_len();
          if (len > UINTPTR_MAX - num_len)
            RF_LIB_ERROR("Argument too large for conversion");
          else
            len += num_len; 
        }
      }
    else
      if (t->get_type() == type_word){
        size_t word_len = ((Word*)t)->get_len();
        if (len > UINTPTR_MAX - word_len)
          RF_LIB_ERROR("Argument too large for conversion");
        else
          len += word_len;
      }
    else
      retfail;
  };

  if (len >= ShortInt::max_len)
    RF_LIB_ERROR("Argument too large for conversion");

  s_Int = ShortInt::create_expr(e_Exp, flag);
 
RF_END
}
}