root/trunk/orca/series.c

/*============================================================================
    ORCA Interpreter
    Copyright (C) 2005-2006  Karl Robillard

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library 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
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
===========================================================================*/


#include "os.h"
#include "ovalue.h"
#include "charset.h"
#include "internal.h"


#define QUERY_TYPE(t) \
    int logic; \
    logic = (t) ? OR_TRUE : OR_FALSE; \
    orResult( OT_LOGIC, logic )


void orSeriesQNative( OValue* a1 )    { QUERY_TYPE(orIsSeries(a1->type)); }
void orAnyStringQNative( OValue* a1 ) { QUERY_TYPE(orIsString(a1->type)); }
void orAnyBlockQNative( OValue* a1 )  { QUERY_TYPE(orIsBlock(a1->type)); }
void orAnyWordQNative( OValue* a1 )   { QUERY_TYPE(orIsWord(a1->type)); }
void orIntegerQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_INTEGER); }
void orTagQNative( OValue* a1 )       { QUERY_TYPE(a1->type == OT_TAG); }

void orBinaryQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_BINARY); }
void orBitsetQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_BITSET); }
void orBlockQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_BLOCK); }
void orCharQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_CHAR); }
void orDatatypeQNative( OValue* a1 )  { QUERY_TYPE(a1->type == OT_DATATYPE); }
void orDecimalQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_DECIMAL); }
void orErrorQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_ERROR); }
void orFileQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_FILE); }
void orFunctionQNative( OValue* a1 )  { QUERY_TYPE(a1->type == OT_FUNCTION); }
void orGetWordQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_GETWORD); }
void orHashQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_HASH); }
void orIssueQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_ISSUE); }
void orListQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_LIST); }
void orLitPathQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_LITPATH); }
void orLitWordQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_LITWORD); }
void orLogicQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_LOGIC); }
void orNativeQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_NATIVE); }
void orNoneQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_NONE); }
void orNumberQNative( OValue* a1 )    { QUERY_TYPE(orIsNumber(a1->type)); }
void orObjectQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_OBJECT); }
void orOpQNative( OValue* a1 )        { QUERY_TYPE(a1->type == OT_OP); }
void orPairQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_PAIR); }
void orParenQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_PAREN); }
void orPathQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_PATH); }
void orRefinementQNative( OValue* a1 ){ QUERY_TYPE(a1->type == OT_REFINEMENT); }
void orSetPathQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_SETPATH); }
void orSetWordQNative( OValue* a1 )   { QUERY_TYPE(a1->type == OT_SETWORD); }
void orStringQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_STRING); }
void orTimeQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_TIME); }
void orTupleQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_TUPLE); }
void orUnsetQNative( OValue* a1 )     { QUERY_TYPE(a1->type == OT_UNSET); }
void orWordQNative( OValue* a1 )      { QUERY_TYPE(a1->type == OT_WORD); }

#ifdef OR_CONFIG_NUMBER_ARRAYS
void orDecArrQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_DEC_ARRAY); }
void orIntArrQNative( OValue* a1 )    { QUERY_TYPE(a1->type == OT_INT_ARRAY); }
#endif


/*
   Returns -1 if val is not a series.
*/
int orSeriesUsed( OValue* val )
{
    switch( val->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
            return orBLOCK(val)->used;
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
            return orSTRING(val)->used;

#ifdef OR_CONFIG_NUMBER_ARRAYS
        case OT_DEC_ARRAY:
            return orDEC_ARRAY(val)->used;
        case OT_INT_ARRAY:
            return orINT_ARRAY(val)->used;
#endif
    }
    return -1;
}


OR_NATIVE( orLengthQNative )
{
    int len;

    if( a1->type == OT_TUPLE )
    {
        len = a1->argc;
    }
    else if( a1->type == OT_LIST )
    {
        len = 0;
        if( a1->series.it )
        {
            OBlock* blk = orBLOCK(a1);
            OValue* it = blk->values + a1->series.it;
            while( it->LIST_NEXT > 0 )
            {
                ++len;
                orListNextNode( blk, it );
            }
        }
    }
    else
    {
        len = orSeriesUsed(a1);
        if( len > -1 )
            len -= a1->series.it;
    }

    orResult( OT_INTEGER, len );
    //orError( "length? expected series argument" );
}


OR_NATIVE( orHeadNative )
{
    if( a1->type == OT_LIST )
    {
        OBlock* blk = orBLOCK(a1);
        a1->series.it = blk->values->LIST_NEXT;
    }
    else if( orIsSeries(a1->type) )
        a1->series.it = 0;
    else
        orError( "head expected series argument" );
}


OR_NATIVE( orTailNative )
{
    if( a1->type == OT_LIST )
    {
        a1->series.it = LIST_TAIL;
    }
    else
    {
        int len = orSeriesUsed(a1);
        if( len > -1 )
            a1->series.it = len;
        else
            orError( "tail expected series argument" );
    }
}


OR_NATIVE( orBackNative )
{
    if( a1->type == OT_LIST )
    {
        OBlock* blk = orBLOCK(a1);
        OValue* it = blk->values + a1->series.it;
        if( it->LIST_PREV > 0 )
            a1->series.it = it->LIST_PREV;
    }
    else if( orIsSeries(a1->type) )
    {
        if( a1->series.it > 0 )
            --a1->series.it;
    }
    else
    {
        orError( "back expected series argument" );
    }
}


OR_NATIVE( orNextNative )
{
    if( a1->type == OT_LIST )
    {
        if( a1->series.it )
        {
            OBlock* blk = orBLOCK(a1);
            OValue* it = blk->values + a1->series.it;
            if( it->LIST_NEXT > 0 )
                a1->series.it = it->LIST_NEXT;
        }
    }
    else
    {
        int len = orSeriesUsed(a1);
        if( a1->series.it < len )
            ++a1->series.it;
    }
}


OR_NATIVE( orIndexQNative )
{
    if( a1->type == OT_LIST )
    {
        // TODO
    }
    else if( orIsSeries(a1->type) )
    {
        orResult( OT_INTEGER, a1->series.it + 1 );
        return;
    }
    orError( "index? expected series argument" );
}


OR_NATIVE( orHeadQNative  )
{
    int logic = OR_FALSE;

    if( a1->type == OT_LIST )
    {
        OBlock* blk = orBLOCK(a1);
        OValue* it = blk->values + a1->series.it;
        if( it->LIST_PREV == LIST_HEAD )
            logic = OR_TRUE;
    }
    else
    {
        if( a1->series.it == 0 )
            logic = OR_TRUE;
    }

    orResult( OT_LOGIC, logic );
}


OR_NATIVE( orTailQNative  )
{
    int logic = OR_FALSE;

    if( a1->type == OT_LIST )
    {
        if( a1->series.it == LIST_TAIL )
           logic = OR_TRUE;
    }
    else
    {
        int len = orSeriesUsed(a1);
        if( len > -1)
        {
            if( a1->series.it >= len )
               logic = OR_TRUE;
        }
    }

    orResult( OT_LOGIC, logic );
}


OR_NATIVE( orClearNative )
{
    switch( a1->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
        {
            OBlock* blk = orBLOCK(a1);
            if( a1->series.it < blk->used )
                blk->used = a1->series.it;
        }
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
        {
            OString* str = orSTRING(a1);
            if( a1->series.it < str->used )
                str->used = a1->series.it;
        }
            break;

        case OT_BITSET:
        {
            OString* str = orSTRING(a1);
            if( str->used )
                memSet( str->byteArray, 0, str->used );
        }
            break;

        case OT_LIST:
            // TODO
            break;

#ifdef OR_CONFIG_NUMBER_ARRAYS
        case OT_DEC_ARRAY:
        {
            OArray* arr = orDEC_ARRAY(a1);
            if( a1->series.it < arr->used )
                arr->used = a1->series.it;
        }
            break;

        case OT_INT_ARRAY:
        {
            OArray* arr = orINT_ARRAY(a1);
            if( a1->series.it < arr->used )
                arr->used = a1->series.it;
        }
            break;
#endif

        case OT_NONE:
            break;
    }
}


static void copyV( OValue* src, OValue* srcEnd, OValue* dest )
{
#if __WORDSIZE == 64
    uint64_t* it  = (uint64_t*) src;
    uint64_t* end = (uint64_t*) srcEnd;
    uint64_t* dst = (uint64_t*) dest;
    while( it != end )
    {
        *dst++ = *it++;
        *dst++ = *it++;
    }
#else
    uint32_t* it  = (uint32_t*) src;
    uint32_t* end = (uint32_t*) srcEnd;
    uint32_t* dst = (uint32_t*) dest;
    while( it != end )
    {
        *dst++ = *it++;
        *dst++ = *it++;
        *dst++ = *it++;
        *dst++ = *it++;
    }
#endif
}


static void copyReverseV( OValue* src, OValue* srcEnd, OValue* dest )
{
#if __WORDSIZE == 64
    uint64_t* it  = (uint64_t*) src;
    uint64_t* end = (uint64_t*) srcEnd;
    uint64_t* dst = (uint64_t*) dest;
    it  += 1;
    dst += 1;
    end += 1;
    while( it != end )
    {
        *dst-- = *it--;
        *dst-- = *it--;
    }
#else
    uint32_t* it  = (uint32_t*) src;
    uint32_t* end = (uint32_t*) srcEnd;
    uint32_t* dst = (uint32_t*) dest;
    it  += 3;
    dst += 3;
    end += 3;
    while( it != end )
    {
        *dst-- = *it--;
        *dst-- = *it--;
        *dst-- = *it--;
        *dst-- = *it--;
    }
#endif
}


static void copyReverseC( const char* src, const char* end, char* dest )
{
    while( src != end )
        *dest-- = *src--;
}


/*
   Inserts buf into a1.
*/
static void stringInsert( OValue* a1, const char* buf, int len )
{
    char* ipos;
    OString* s1 = orSTRING(a1);
    int used = s1->used;

    if( len > 0 )
    {
        orArrayReserve( s1, sizeof(char), used + len );

        // Must get ipos after orArrayReserve.
        ipos = orStrChars( s1, a1 );

        if( a1->series.it < used )
        {
            copyReverseC( s1->charArray + used - 1, ipos - 1,
                          s1->charArray + used + len - 1 );
        }

        memCpy( ipos, buf, len );

        s1->used += len;
        a1->series.it += len;
    }
}


extern void orListInsertValue( OBlock*, int nodeIndex, OValue* );


#define REF_INS_PART    a1+2
#define REF_INS_RANGE   a1+3
#define REF_INS_ONLY    a1+4

OR_NATIVE( orInsertNative )
{
    OValue* a2 = a1 + 1;

    switch( orType(a1) )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
            if( (orType(a2) != OT_BLOCK) || orRefineSet(REF_INS_ONLY) )
            {
                OValue* ipos;
                OBlock* s1 = orBLOCK(a1);
                int used = s1->used;

                orArrayReserve( s1, sizeof(OValue), used + 1 );

                // Must get ipos after orArrayReserve.
                ipos = s1->values + a1->series.it;

                copyReverseV( s1->values + used - 1, ipos - 1,
                              s1->values + used );
                ++s1->used;
                ++a1->series.it;
                *ipos = *a2;
            }
            else
            {
                OValue* ipos;
                OBlock* s1 = orBLOCK(a1);
                OBlock* s2 = orBLOCK(a2);
                int used = s1->used;
                int srcLen = s2->used - a2->series.it;

                orArrayReserve( s1, sizeof(OValue), used + srcLen );

                // Must get ipos after orArrayReserve.
                ipos = s1->values + a1->series.it;

                if( a1->series.it < used )
                {
                    copyReverseV( s1->values + used - 1, ipos - 1,
                                  s1->values + used + srcLen - 1 );
                }

                copyV( s2->values + a2->series.it,
                       s2->values + s2->used,
                       ipos );

                s1->used += srcLen;
                a1->series.it += srcLen;
            }
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
        {
            if( orIsBlock( orType(a2) ) )
            {
                OBlock* blk = orBLOCK(a2);
                if( blk->used )
                {
                    OString* tmp;
                    OValue* it  = blk->values + a2->series.it;
                    OValue* end = blk->values + blk->used;

                    assert( a2->series.it <= blk->used );

                    orRefPush( OT_BLOCK, a2->index );
                    tmp = orMakeString( 0 );
                    orRefPop( 1 );

                    while( it != end )
                    {
                        orForm( tmp, it );
                        ++it;
                    }

                    stringInsert( a1, tmp->charArray, tmp->used );

                    // Garbage collection will free the container later.
                    orArrayFree( tmp );
                }
                else
                {
                    return;
                }
            }
            else if( orIsString( orType(a2) ) )
            {
                OString* s2 = orSTRING(a2);
                stringInsert( a1, s2->charArray + a2->series.it,
                                  s2->used - a2->series.it );
            }
            else if( orIs(a2, OT_CHAR) )
            {
                char tmp = orInt(a2);
                stringInsert( a1, &tmp, 1 );
            }
            else if( orIs(a1, OT_STRING) )
            {
                // Result is string so mold whatever we haven't handled.
                orMold( orSTRING(a1), a2 );
            }
            else
            {
                goto badMatch;
            }
        }
            break;

        case OT_LIST:
            if( a1->series.it )
            {
                OBlock* lst = orBLOCK( a1 );
                OValue* node = lst->values + a1->series.it;

                if( node->LIST_PREV < 0 )
                    goto badList;

                if( (a2->type != OT_BLOCK) || orRefineSet(REF_INS_ONLY) )
                {
                    orListInsertValue( lst, a1->series.it, a2 );
                }
                else
                {
                    OBlock* blk = orBLOCK( a2 );
                    OValue* it  = blk->values + a2->series.it;
                    OValue* end = blk->values + blk->used;

                    while( it != end )
                    {
                        orListInsertValue( lst, a1->series.it, it );
                        ++it;
                    }
                }
            }
            else
            {
                goto badList;
            }
            break;

#ifdef OR_CONFIG_NUMBER_ARRAYS
        //TODO
#endif

        default:
            orError( "insert expected series argument" );
            break;
    }
    return;

badMatch:

    orError( "insert types (%s, %s) do not match",
             orDatatypeName(a1->type), orDatatypeName(a2->type) );
    return;

badList:

    orError( LIST_REMOVED_ERROR );
}


#define REF_RM_PART    a1+1
#define REF_RM_RANGE   a1+2

OR_NATIVE( orRemoveNative )
{
    int len;

    if( orRefineSet(REF_RM_PART) )
        len = orInt(REF_RM_RANGE);
    else
        len = 1;

    switch( a1->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
        {
            OBlock* arr = orBLOCK(a1);
            if( a1->series.it < arr->used )
                orArrayErase( arr, sizeof(OValue), a1->series.it, len );
        }
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
        {
            OString* arr = orSTRING(a1);
            if( a1->series.it < arr->used )
                orArrayErase( arr, sizeof(char), a1->series.it, len );
        }
            break;

#ifdef OR_CONFIG_NUMBER_ARRAYS
        case OT_DEC_ARRAY:
        {
            OArray* arr = orDEC_ARRAY(a1);
            if( a1->series.it < arr->used )
                orArrayErase( arr, sizeof(double), a1->series.it, len );
        }
            break;

        case OT_INT_ARRAY:
        {
            OArray* arr = orINT_ARRAY(a1);
            if( a1->series.it < arr->used )
                orArrayErase( arr, sizeof(int32_t), a1->series.it, len );
        }
            break;
#endif

        case OT_LIST:
        {
            OIndex  nextI;
            OValue* it;
            OBlock* blk = orBLOCK(a1);
            OValue* node = blk->values + a1->series.it;

            if( node->LIST_LINKED )
            {
                nextI = node->LIST_NEXT;

                it = blk->values + node->LIST_PREV;
                it->LIST_NEXT = node->LIST_NEXT;

                it = blk->values + node->LIST_NEXT;
                it->LIST_PREV = node->LIST_PREV;

                node->LIST_LINKED = 0;
                node->LIST_PREV = -1;
                node->LIST_NEXT = -1;

                node->LIST_FREE = blk->values->LIST_FREE;
                blk->values->LIST_FREE = a1->series.it;

                /*
                ++node;
                orSetTF( node, OT_UNSET );
                */

                // NOTE: If this is the last node in the block we can
                // optimize GC by moving blk->used down until a used node
                // is found.

                // Result.
                a1->series.it = nextI;
            }
            else
            {
                orError( LIST_REMOVED_ERROR );
            }
        }
            break;

        case OT_NONE:
            break;

        default:
            orError( "remove expected series argument" );
    }
}


/**
  n is zero based.
  Sets result to none and returns zero if index is invalid.
*/
int orPick( const OValue* ser, int n, OValue* result )
{
    switch( ser->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
        {
            OBlock* blk = orBLOCK( ser );
            n += ser->series.it;
            if( (n > -1) && (n < blk->used) )
            {
                orCopyV( result, blk->values[ n ] );
                return 1;
            }
        }
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        {
            OString* str = orSTRING( ser );
            n += ser->series.it;
            if( (n > -1) && (n < str->used) )
            {
                orSetTF( result, OT_CHAR );
                orInt(result) = str->charArray[ n ];
                return 1;
            }
        }
            break;

        case OT_BINARY:
        {
            OBinary* str = orSTRING( ser );
            n += ser->series.it;
            if( (n > -1) && (n < str->used) )
            {
                orSetTF( result, OT_INTEGER );
                orInt(result) = str->byteArray[ n ];
                return 1;
            }
        }
            break;

        case OT_PAIR:
            if( (n > -1) && (n < 2) )
            {
                orSetTF( result, OT_INTEGER );
                orInt(result) = ser->pair[ n ];
                return 1;
            }
            break;

        case OT_TUPLE:
            if( (n > -1) && (n < ser->argc) )
            {
                orSetTF( result, OT_INTEGER );
                orInt(result) = ser->tuple[ n ];
                return 1;
            }
            break;

        case OT_LIST:
            if( ser->series.it )
            {
                OBlock* blk = orBLOCK( ser );
                OValue* it = blk->values + ser->series.it;

                while( it->LIST_NEXT > 0 )
                {
                    if( n == 0 )
                    {
                        orCopyV( result, it[1] );
                        return 1;
                    }
                    --n;
                    orListNextNode( blk, it );
                }
            }
            break;

#ifdef OR_CONFIG_MATH3D
        case OT_VEC2:
        case OT_VEC3:
            if( (n > -1) && (n < 3) )
            {
                const float* fp = &ser->vec3.x;
                orSetTF( result, OT_DECIMAL );
                orDecimal(result) = (double) fp[ n ];
                return 1;
            }
            break;

        case OT_MATRIX:
            if( (n > -1) && (n < 16) )
            {
                OArray* arr = orSTRING( ser );
                orSetTF( result, OT_DECIMAL );
                orDecimal(result) = (double) arr->floats[ n ];
                return 1;
            }
            break;
#endif

#ifdef OR_CONFIG_NUMBER_ARRAYS
        case OT_DEC_ARRAY:
        {
            OArray* arr = orDEC_ARRAY( ser );
            n += ser->series.it;
            if( (n > -1) && (n < arr->used) )
            {
                orSetTF( result, OT_DECIMAL );
                orDecimal(result) = arr->decimals[ n ];
                return 1;
            }
        }
            break;

        case OT_INT_ARRAY:
        {
            OArray* arr = orINT_ARRAY( ser );
            n += ser->series.it;
            if( (n > -1) && (n < arr->used) )
            {
                orSetTF( result, OT_INTEGER );
                orInt(result) = arr->integers[ n ];
                return 1;
            }
        }
            break;
#endif
    }
    orSetTF( result, OT_NONE );
    return 0;
}


OR_NATIVE( orFirstNative )
{
    if( a1->type == OT_OBJECT )
    {
        // NOTE: REBOL does not bind these words.
        OBlock* blk = orCopyBlock( a1->ctx.wblkN, 0, 0 );
        orResultBLOCK( orBlockN(blk) );
    }
    else
    {
        orPick( a1, 0, a1 );
    }
}


OR_NATIVE( orSecondNative )
{
    orPick( a1, 1, a1 );
}


OR_NATIVE( orThirdNative )
{
    orPick( a1, 2, a1 );
}


OR_NATIVE( orLastNative )
{
    OValue* result = a1;

    switch( a1->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
        {
            OBlock* blk = orBLOCK(a1);
            if( (blk->used - a1->series.it) < 1 )
                break;
            orCopyV( result, blk->values[ blk->used - 1 ] );
        }
            return;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
        {
            OString* str = orSTRING(a1);
            if( (str->used - a1->series.it) < 1 )
                break;
            orSetTF( result, OT_CHAR );
            orInt(result) = str->charArray[ str->used - 1 ];
        }
            return;

        case OT_TUPLE:
            orResult( OT_INTEGER, a1->tuple[ a1->argc ] );
            return;

        /*
        case OT_BITSET:
            break;
        */

        case OT_LIST:
        {
            OBlock* blk = orBLOCK(a1);
            OValue* node = blk->values + LIST_TAIL;
            if( node->LIST_PREV != LIST_HEAD )
            {
                orCopyV( result, blk->values[ node->LIST_PREV + 1 ] );
                return;
            }
        }
            break;

#ifdef OR_CONFIG_NUMBER_ARRAYS
        case OT_DEC_ARRAY:
        {
            OArray* arr = orDEC_ARRAY(a1);
            if( (arr->used - a1->series.it) < 1 )
                break;
            orSetTF( result, OT_DECIMAL );
            orDecimal(result) = arr->decimals[ arr->used - 1 ];
        }
            return;

        case OT_INT_ARRAY:
        {
            OArray* arr = orINT_ARRAY(a1);
            if( (arr->used - a1->series.it) < 1 )
                break;
            orSetTF( result, OT_INTEGER );
            orInt(result) = arr->integers[ arr->used - 1 ];
        }
            return;
#endif
    }
    orError( "last series is empty" );
}


static void reverseV( OValue* it, OValue* end )
{
    OValue tmp;
    while( it < end )
    {
        tmp = *it;
        --end;
        *it++ = *end;
        *end = tmp;
    }
}


static void reverseC( char* it, char* end )
{
    int tmp;
    while( it < end )
    {
        tmp = *it;
        --end;
        *it++ = *end;
        *end = tmp;
    }
}


#define REF_REV_PART   a1+1
#define REF_REV_RANGE  a1+2

static int validRange( OValue* a1, int used )
{
    int range;

    if( orRefineSet( REF_REV_PART ) )
    {
        OValue* rval = REF_REV_RANGE;
        if( rval->type == OT_INTEGER )
            range = orInt(rval);
        else
            range = rval->series.it;

        if( range > used )
            return used;
    }
    else
    {
        range = used;
    }

    if( (range < 1) || (range < a1->series.it) )
    {
        orError( "Invalid range %d", range );
        return 0;
    }
    return range;
}


OR_NATIVE( orReverseNative )
{
    switch( a1->type )
    {
        case OT_BLOCK:
        case OT_PAREN:
        case OT_PATH:
        {
            int range;
            OBlock* blk = orBLOCK( a1 );
            range = validRange( a1, blk->used );
            if( range )
            {
                reverseV( blk->values + a1->series.it,
                          blk->values + range );
                a1->series.it = range;
            }
        }
            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:
        case OT_TAG:
        case OT_BINARY:
        {
            int range;
            OString* str = orSTRING( a1 );
            range = validRange( a1, str->used );
            if( range )
            {
                reverseC( str->charArray + a1->series.it,
                          str->charArray + range );
                a1->series.it = range;
            }
        }
            break;

        case OT_PAIR:
        {
            int tmp = a1->pair[0];
            a1->pair[0] = a1->pair[1];
            a1->pair[1] = tmp;
        }
            break;

        case OT_TUPLE:
            reverseC( (char*) a1->tuple, (char*) a1->tuple + a1->argc );
            break;
    }
}


OR_NATIVE( orSkipNative )
{
    int n;
    OValue* a2 = a1 + 1;
    int len = orSeriesUsed( a1 );
    if( len > -1 )
    {
        if( a2->type == OT_INTEGER )
            n = orInt(a2);
        else if( a2->type == OT_DECIMAL )
            n = (int) orDecimal(a2);
        else    // OT_LOGIC
            n = orInt(a2) ? 0 : 1;

        if( n )
        {
            n += a1->series.it;
            if( n < 0 )
                n = 0;
            else if( n > len )
                n = len;
            a1->series.it = n;
        }
        return;
    }
    orError( "skip expected series argument" );
}


OR_NATIVE( orAtNative )
{
    int n;
    int used;
    OValue* a2 = a1 + 1;

    if( a2->type == OT_LOGIC )
    {
        n = orInt(a2) ? 0 : 1;
    }