root/trunk/orca/print.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 <time.h>
#include "os.h"
#include "ovalue.h"
#include "internal.h"


#define MOLD_NO_BRACES      1


static void form( OString* out, const OValue* val, int depth );
static void mold( OString* out, const OValue* val, int depth, int flags );



static char charStr[] = "#\"?\"";


static void append( OString* str, const char* cp, int len )
{ 
    if( (str->used + len) > str->avail )
        orArrayReserve( str, 1, str->used + len );
    memCpy( str->charArray + str->used, cp, len );
    str->used += len;
}


static void appendC( OString* str, const char* cp )
{
    int len;
    const char* it = cp;
    while( *it != '\0' )
        ++it;
    len = it - cp;
    orArrayReserve( str, 1, str->used + len );
    memCpy( str->charArray + str->used, cp, len );
    str->used += len;
}


static void append1( int c, OString* str )
{
    orArrayReserve( str, 1, str->used + 1 );
    str->charArray[ str->used ] = c;
    ++str->used;
}


static void indent( OString* str, int depth )
{
    while( depth > 0 )
    {
        append(str,"    ",4);
        --depth;
    }
}


static void appendInteger( OString* out, int32_t n )
{
    char* cp;
    orArrayReserve( out, 1, out->used + 16 );
    cp = out->charArray + out->used;
    strPrint( cp, "%d", n );
    while( *cp != '\0' )
        ++cp;
    out->used = cp - out->charArray;
}


#ifdef OR_CONFIG_HEX_TOKEN
static void appendHex( OString* out, int32_t n )
{
    char* cp;
    orArrayReserve( out, 1, out->used + 16 );
    cp = out->charArray + out->used;
    strPrint( cp, "$%x", n );
    while( *cp != '\0' )
        ++cp;
    out->used = cp - out->charArray;
}
#endif


static void appendDecimal( OString* out, double n )
{
    char* cp;
    orArrayReserve( out, 1, out->used + 16 );
    cp = out->charArray + out->used;
    strPrint( cp, "%g", n );
    while( *cp != '\0' )
        ++cp;
    out->used = cp - out->charArray;
}


static void appendNibble( OString* str, int n )
{
    n &= 0x0f;
    if( n < 10 )
        n += '0';
    else
        n += 'A' - 10;
    str->charArray[ str->used ] = n;
    ++str->used;
}


static void moldBinary( OString* out, const OValue* val )
{
    const uint8_t* bp;
    const uint8_t* end;
    OString* bin = orSTRING( val );

    append(out, "#{", 2);

    bp  = bin->byteArray + val->series.it;
    end = bin->byteArray + bin->used;

    orArrayReserve( out, 1, bin->used + ((end - bp) * 2) );

    while( bp != end )
    {
        appendNibble( out, *bp >> 4 );
        appendNibble( out, *bp );
        ++bp;
    }

    append1('}', out);
}


static void moldTuple( OString* out, const OValue* val )
{
    char* cp;
    const uint8_t* end;
    const uint8_t* bp = val->tuple;

    assert( val->argc >= 3 );

    orArrayReserve( out, 1, out->used + (4 * val->argc) );

    cp = out->charArray + out->used;
    strPrint( cp, "%d.%d.%d", bp[0], bp[1], bp[2] );
    while( *cp != '\0' )
        ++cp;

    end = bp + val->argc;
    bp += 3;
    while( bp != end )
    {
        strPrint( cp, ".%d", *bp++ );
        while( *cp != '\0' )
            ++cp;
    }

    out->used = cp - out->charArray;
}


static const char* _monthAbr[12] =
{
    "Jan", "Feb", "Mar", "Apr", "May", "Jun",
    "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
};


static char* append02d( char* cp, int n )
{
    *cp++ = '0' + (n / 10);
    *cp++ = '0' + (n % 10);
    return cp;
}


static void moldDate( OString* out, const OValue* val )
{
    struct tm* st;
    time_t tt;
    char* cp;
    const char* month;
    int year;
    int yc;

    tt = (time_t) orSeconds(val);
    st = localtime( &tt );

    orArrayReserve( out, 1, out->used + 22 );
    cp = out->charArray + out->used;

    cp = append02d( cp, st->tm_mday );
    *cp++ = '-';

    month = _monthAbr[ st->tm_mon ];
    *cp++ = *month++;
    *cp++ = *month++;
    *cp++ = *month++;
    *cp++ = '-';

    year = st->tm_year + 1900;
    yc = year / 1000;
    *cp++ = '0' + yc;
    year -= yc * 1000;
    yc = year / 100;
    *cp++ = '0' + yc;
    year -= yc * 100;
    *cp++ = '0' + year / 10;
    *cp++ = '0' + (year % 10);

    if( st->tm_hour || st->tm_min || st->tm_sec )
    {
        *cp++ = '/';
        cp = append02d( cp, st->tm_hour );
        *cp++ = ':';
        cp = append02d( cp, st->tm_min );
        *cp++ = ':';
        cp = append02d( cp, st->tm_sec );
    }

    out->used = cp - out->charArray;
}


static void moldTime( OString* out, const OValue* val )
{
    char* cp;

    orArrayReserve( out, 1, out->used + 32 );

    cp = out->charArray + out->used;
    strPrint( cp, "%f", orSeconds(val) );
    while( *cp != '\0' )
        ++cp;
    out->used = cp - out->charArray;
}


static void formList( OString* out, const OValue* val )
{
    if( val->series.it )
    {
        OBlock* blk = orBLOCK(val);
        OValue* it = blk->values + val->series.it;
        int first = 1;

        while( it->LIST_NEXT > 0 )
        {
            if( first )
                first = 0;
            else
                append1( ' ', out );
            mold( out, it + 1, 0, 0 );

            orListNextNode( blk, it );
        }
    }
}


#if defined(OR_CONFIG_MATH3D) || defined(OR_CONFIG_NUMBER_ARRAYS)
static void termBlock( OString* out )
{
    char* cp = out->charArray + out->used - 1;
    if( *cp == ' ' )
        *cp = ']';
    else
        append1( ']', out );
}
#endif


#ifdef OR_CONFIG_MATH3D
static void moldVec3( OString* out, const OValue* val )
{
    const float* it  = &val->vec3.x;
    const float* end;

    if( val->type == OT_VEC2 )
    {
        end = it + 2;
        append(out, "make vec2! [", 12);
    }
    else
    {
        end = it + 3;
        append(out, "make vec3! [", 12);
    }

    while( it != end )
    {
        appendDecimal( out, *it );
        append1( ' ', out );
        ++it;
    }
    termBlock( out );
}


static void moldMatrix( OString* out, const OValue* val )
{
    OString* arr = orSTRING(val);
    float* it  = arr->floats;
    float* end = it + 16;

    append(out, "make matrix! [", 14);
    while( it != end )
    {
        appendDecimal( out, *it );
        append1( ' ', out );
        ++it;
    }
    termBlock( out );
}
#endif


#ifdef OR_CONFIG_NUMBER_ARRAYS
static void moldDecArray( OString* out, OValue* val )
{
    OArray* arr = orDEC_ARRAY( val );
    int si = val->series.it;
    int used = arr->used - si;
    if( used > 0 )
    {
        double* it  = arr->decimals + si;
        double* end = it + used;

        append( out, "#[", 2 );
        while( it != end )
        {
            appendDecimal( out, *it );
            append1( ' ', out );
            ++it;
        }
        termBlock( out );
    }
    else
    {
        append( out, "#[]", 3 );
    }
}


static void moldIntArray( OString* out, OValue* val )
{
    OArray* arr = orINT_ARRAY( val );
    int si = val->series.it;
    int used = arr->used - si;
    if( used > 0 )
    {
        int32_t* it  = arr->integers + si;
        int32_t* end = it + used;

        append( out, "i#[", 3 );
        while( it != end )
        {
            appendInteger( out, *it );
            append1( ' ', out );
            ++it;
        }
        termBlock( out );
    }
    else
    {
        append( out, "i#[]", 4 );
    }
}
#endif


static void formObject( OString* out, const OContext* ctx, int depth )
{
    OBlock* wblk;
    OBlock* vblk;
    OValue* wval;
    OValue* it;
    OValue* end;

    wblk = orBlockPtr( ctx->wblkN );
    vblk = orBlockPtr( ctx->vblkN );

    wval = wblk->values;
    it  = vblk->values;
    end = it + vblk->used;

    // Skip self.
    if( it->type == OT_OBJECT && (it->ctx.vblkN == ctx->vblkN) )
    {
        ++wval;
        ++it;
    }

    while( it != end )
    {
        indent( out, depth );

        orAtomStr( orAtom(wval), out );
        append( out, ": ", 2 );

        // Mold gives us quotes around empty strings.
        // Need to check correct behavior of nested objects.
        mold( out, it, depth, 0 );

        append1( '\n', out );

        ++wval;
        ++it;
    }
}


static void writeErrorPosition( OString* out, const OValue* val )
{
    OValue* it;
    OValue* end;
    OBlock* blk;

    if( val->error.block )
    {
        append( out, "\n** Near:", 9 );

        blk = orBlockPtr( val->error.block );

        assert( blk->values );
        it  = blk->values + val->error.nearVal;
        end = blk->values + blk->used;

        if( it != end )
        {
            while( 1 )
            {
                append1( ' ', out );
                mold( out, it, 0, 0 );
                ++it;
                if( it == end )
                    break;
                if( it->flags & OR_FLAG_EOL )
                    break;
            }
        }
    }
}


static char* errorText[] =
{
    "Syntax",
    "Script",
    "Math",
    "Access",
    "Internal"
};


static void formError( OString* out, const OValue* val )
{
    switch( orErrorType(val) )
    {
        case OR_ERROR_SYNTAX:
        case OR_ERROR_MATH:
        case OR_ERROR_SCRIPT:
        case OR_ERROR_ACCESS:
        case OR_ERROR_INTERNAL:
        {
            OString* str = orSTRINGS + val->error.msg;

            append( out, "** ", 3 );
            appendC( out, errorText[ orErrorType(val) ] );
            append( out, " Error: ", 8 );
            append( out, str->charArray, str->used );

            writeErrorPosition( out, val );
        }
            break;

        case OR_ERROR_BREAK:
            appendC( out, "** Throw Error: Break" );
            break;

        case OR_ERROR_THROW:
        {
            appendC( out, "** Throw Error: No catch for throw: " );
            // NOTE: Using val+1 assumes val is only from orEnv->error.
            form( out, val + 1, 0 );

            writeErrorPosition( out, val );
        }
            break;

        case OR_ERROR_HALT:
            appendC( out, "** Throw Error: Halt" );
            break;

        default:
            appendC( out, "** Throw Error: Unknown type " );
            append1( '0' + (orErrorType(val) & 15), out );
            break;
    }
}


static void form( OString* out, const OValue* val, int depth )
{
    /*
    if( val->flags & OR_FLAG_EOL )
    {
        int d;
        append1('\n', out);
        for( d = 0; d < depth; ++d )
            append1( '\t', out );
    }
    */

    switch( val->type )
    {
        case OT_NONE:       append(out, "none", 4); break;

        case OT_DATATYPE:   appendC(out, orDatatypeName( val->index ));
                            break;

        case OT_REFINEMENT: orAtomStr( val->index, out );
                            break;

        case OT_WORD:
        case OT_LITWORD:
        case OT_SETWORD:    orAtomStr( orAtom(val), out );
                            break;

        case OT_STRING:
        case OT_ISSUE:
        case OT_FILE:       {
                            OString* str = orSTRING( val );
                            int n = val->series.it;
                            int used = str->used - n;
                            if( used > 0 )
                                append( out, str->charArray + n, used );
                            }
                            break;

        case OT_TAG:        {
                            OString* str = orSTRING( val );
                            append1('<', out);
                            append(out, str->charArray, str->used);
                            append1('>', out);
                            }
                            break;

        case OT_BITSET:     append(out, "make bitset! ", 13);
                            // Fall through to binary.

        case OT_BINARY:     moldBinary( out, val );
                            break;

        case OT_CHAR:       append1( orInt(val), out );
                            break;

        case OT_INTEGER:
#ifdef OR_CONFIG_HEX_TOKEN
            if( val->flags & OR_FLAG_HEX )
                appendHex( out, orInt(val) );
            else
#endif
            appendInteger( out, orInt(val) );
            break;

        case OT_DECIMAL:    appendDecimal( out, orDecimal(val) );
                            break;

        case OT_TUPLE:      moldTuple( out, val );
                            break;

        case OT_DATE:       moldDate( out, val );
                            break;

        case OT_TIME:       moldTime( out, val );
                            break;

        case OT_PAIR:       {
                            char* cp;
                            orArrayReserve( out, 1, out->used + 32 );
                            cp = out->charArray + out->used;
                            strPrint( cp, "%dx%d", val->pair[0], val->pair[1]);
                            while( *cp != '\0' )
                                ++cp;
                            out->used = cp - out->charArray;
                            }
                            break;

        case OT_LOGIC:      if( orInt(val) )
                                append( out, "true", 4 );
                            else
                                append( out, "false", 5 );
                            break;

        case OT_UNSET:      append(out, "unset", 5); break;

        case OT_PATH:
        case OT_SETPATH:
        case OT_LITPATH:
        {
            OBlock* path = orBlockPtr( val->index );
            OValue* vp  = path->values;
            OValue* end = vp + path->used;
            for( ; vp != end; ++vp )
            {
                if( vp != path->values )
                    append1( '/', out );
                form( out, vp, 0 );
            }
        }
            break;

        case OT_PAREN:
        case OT_BLOCK:
        {
            OBlock* blk = orBlockPtr( val->index );
            OValue* vp  = blk->values + val->series.it;
            OValue* end = blk->values + blk->used;

            if( vp != end )
            {
                while( 1 )
                {
                    form( out, vp, depth + 1 );
                    ++vp;
                    if( vp == end )
                        break;
                    append1( ' ', out );
                }
            }
        }
            break;

        case OT_OBJECT:
        case OT_PORT:
            formObject( out, &val->ctx, depth );
            //append( out, "?object?", 8 );
            break;

        case OT_LIST:
            formList( out, val );
            break;

        case OT_ERROR:
            formError( out, val );
            break;

        default:
            append1( '?', out );
            appendC( out, orDatatypeName( val->type ) );
            append1( '?', out );
            break;
    }
}


void orForm( OString* out, const OValue* val )
{
    form( out, val, 0 );
    if( out->used )
    {
        orTermCStr( out );
    }
}


static void mold( OString* out, const OValue* val, int depth, int mflags )
{
    /*
    if( val->flags & OR_FLAG_EOL )
    {
        int d;
        append1('\n', out);
        for( d = 0; d < depth; ++d )
            append1( '\t', out );
    }
    */

    switch( val->type )
    {
        case OT_NONE:       append(out, "none", 4); break;

        case OT_DATATYPE:   appendC(out, orDatatypeName( val->index ));
                            append1('!', out);
                            break;

        case OT_REFINEMENT: append1('/', out);
                            orAtomStr( val->index, out );
                            break;

        case OT_LITWORD:    append1('\'', out);
                            // fall through to OT_WORD

        case OT_WORD:       orAtomStr( orAtom(val), out );
                            break;

        case OT_SETWORD:    orAtomStr( orAtom(val), out );
                            append1(':', out);
                            break;

        case OT_GETWORD:    append1(':', out);
                            orAtomStr( orAtom(val), out );
                            break;

        case OT_ERROR:      {
                            OString* str = orSTRING( val );
                            append(out, str->charArray, str->used);
                            append1('\n', out);
                            }
                            break;

        case OT_TAG:        {
                            OString* str = orSTRING( val );
                            append1('<', out);
                            append(out, str->charArray, str->used);
                            append1('>', out);
                            }
                            break;

        case OT_STRING:
        {
            OString* str = orSTRING( val );
            int si = val->series.it;
            int used = str->used - si;
            if( used > 0 )
            {
                int newlines = 0;
                int quote = '{';
                if( used < 51 )
                {
                    char* ci  = str->charArray + si;
                    char* end = ci + used;
                    while( ci != end )
                    {
                        if( *ci == '"' )
                            break;
                        if( *ci == '\n' )
                        {
                            if( newlines == 3 )
                                break;
                            ++newlines;
                        }
                        ++ci;
                    }
                    if( ci == end )
                        quote = '"';
                }

                append1( quote, out );
#if 0
                append( out, str->charArray + si, used );
#else
                {
                    const char* put;
                    const char* cp  = str->charArray + si;
                    const char* end = cp + used;

#define PUT     if(cp != put) {append(out,put,cp - put);} put = cp + 1;

                    put = cp;
                    while( cp != end )
                    {
                        if( *cp == '^' )
                        {
                            PUT
                            append( out, "^^", 2 );
                        }
                        else if( *cp == '}' )
                        {
                            PUT
                            if( quote == '"' )
                                append1( '}', out );
                            else
                                append( out, "^}", 2 );
                        }
                        else if( *cp == '\n' )
                        {
                            PUT
                            if( quote == '"' )
                                append( out, "^/", 2 );
                            else
                                append1( '\n', out );
                        }
                        else if( *cp == '\t' )
                        {
                            PUT
                            append( out, "^-", 2 );
                        }
                        else if( *cp == '\0' )
                        {
                            PUT
                            append( out, "^@", 2 );
                        }
                        ++cp;
                    }
                    if( cp != put )
                        append( out, put, cp - put );
                }
#endif
                if( quote == '{' )
                    quote = '}';
                append1( quote, out );
            }
            else
            {
                append( out, "\"\"", 2 );
            }
        }
            break;

        case OT_ISSUE:      {
                            OString* str = orSTRING( val );
                            append1('#', out);
                            append(out, str->charArray, str->used);
                            }
                            break;

        case OT_FILE:       {
                            OString* str = orSTRING( val );
                            append1('%', out);
                            append(out, str->charArray, str->used);
                            }
                            break;

        case OT_BITSET:     append(out, "make bitset! ", 13);
                            // Fall through to binary.

        case OT_BINARY:
            moldBinary( out, val );
            break;

        case OT_CHAR:
            switch( orInt(val) )
            {
                case '^':
                    append( out, "#\"^^\"", 5 );
                    break;

                case '\n':
                    append( out, "#\"^/\"", 5 );
                    break;

                case '\t':
                    append( out, "#\"^-\"", 5 );
                    break;

                case '\0':
                    append( out, "#\"^@\"", 5 );
                    break;

                default:
                    charStr[2] = (char) orInt(val);
                    append(out, charStr, 4);
                    break;
            }
            break;

        case OT_INTEGER:
#ifdef OR_CONFIG_HEX_TOKEN
            if( val->flags & OR_FLAG_HEX )
                appendHex( out, orInt(val) );
            else
#endif
            appendInteger( out, orInt(val) );
            break;

        case OT_DECIMAL:    appendDecimal( out, orDecimal(val) );
                            break;

        case OT_TUPLE:      moldTuple( out, val );
                            break;

        case OT_DATE:       moldDate( out, val );
                            break;

        case OT_TIME:       moldTime( out, val );
                            break;

        case OT_PAIR:       {
                            char* cp;
                            orArrayReserve( out, 1, out->used + 32 );
                            cp = out->charArray + out->used;
                            strPrint( cp, "%dx%d", val->pair[0], val->pair[1]);
                            while( *cp != '\0' )
                                ++cp;
                            out->used = cp - out->charArray;
                            }
                            break;

        case OT_LOGIC:      if( orInt(val) )
                                append( out, "true", 4 );
                            else
                                append( out, "false", 5 );
                            break;

        case OT_UNSET:      append(out, "unset", 5); break;

        case OT_LITPATH:    append1( '!', out );
                            // Fall through to path.
        case