// ------------------------------------------------------------
//  Copyright (C) 2002-2003 Michael Zeilfelder
//  e-mail: info@michaelzeilfelder.de
//
//  This program is published under the terms of the GNU
//  General Public License version 2 as published by the Free
//  Software Foundation.
// ------------------------------------------------------------
#include "Lisp.h"
#include <sstream>

// ------------------------------------------------------------
void Token::Set(const string str_)
{
    m_str = str_;
    m_isNumber = CheckForNumber(str_);
}

// ------------------------------------------------------------
double Token::GetNumber()
{
    return atof( (const char*)m_str.c_str() );
}

// ------------------------------------------------------------
bool Token::CheckForNumber(const string& str_)
{
    unsigned int i = 0;

    if ( str_.empty() )
        return false;

    if ( str_[i] == '+' || str_[i] == '-')
    {
        if ( str_.size() == 1 )
            return false;
        ++i;
    }
    while (     i < str_.size()
            &&  isdigit(str_[i]))
    {
        ++i;
    }
    if ( i == str_.size() )
        return true;    // integer

    if ( m_str[i] != '.' )
        return false;
    ++i;
    while ( i < str_.size() )
    {
        if ( !isdigit(str_[i]) )
            return false;
        ++i;
    }

    return true;        // float
}

// ------------------------------------------------------------
LispInterpreter::LispInterpreter()
    : m_tree(NULL)
{
    AddSpecialFunction("QUOTE", LispQuote);
    AddSpecialFunction("SETF", LispSetf);
    AddSpecialFunction("DEFUN", LispDefun);
    AddFunction("CAR", LispCar);
    AddFunction("FIRST", LispCar);
    AddFunction("CDR", LispCdr);
    AddFunction("REST", LispCdr);
    AddFunction("CONS", LispCons);
    AddFunction("EVAL", LispEval);
    AddFunction("+", LispAdd);
    AddFunction("-", LispSub);
    AddFunction("*", LispMul);
    AddFunction("/", LispDiv);
}

// ------------------------------------------------------------
LispInterpreter::~LispInterpreter()
{
    list<LispFunction*>::iterator it = m_functions.begin();
    for (; it != m_functions.end(); it++ )
    {
        delete *it;
    }
    it = m_specialFunctions.begin();
    for (; it != m_specialFunctions.end(); it++ )
    {
        delete *it;
    }
}

// ------------------------------------------------------------
void LispInterpreter::Tokenize(const string& str_)
{
    m_tokens.clear();
    TokenizeRek( str_);
}
// ------------------------------------------------------------
void LispInterpreter::TokenizeRek(const string& str_)
{
    istringstream istr(str_);
    string w;
    string::size_type p;

    while (istr>>w)
    {
        // convert string to upper chars
        for (unsigned int a=0; a < w.size(); a++ )
        {
            w.at(a) = toupper(w.at(a));
        }
        p = w.find_first_of("()'");
        if ( p != string::npos )
        {
            if ( p > 0)
            {
                m_tokens.push_back( Token(w.substr(0, p)) );
            }
            m_tokens.push_back( Token(string(1, w.at(p))) );
            if ( (p+1) < w.size() )
            {
                TokenizeRek( w.substr(p+1) );
            }
        }
        else
        {
            m_tokens.push_back(Token(w));
        }
    }
}

// ------------------------------------------------------------
void LispInterpreter::ShowTokens()
{
    list<Token>::iterator it = m_tokens.begin();
    int i=0;

    for ( ; it != m_tokens.end(); ++it,++i )
    {
        cout << i << ". " << it->Get();
        cout << endl;
    }
}

// ------------------------------------------------------------
void LispInterpreter::Parse()
{
    // TODO... remove old tree
    m_tree = NULL;
    list<Token>::iterator it = m_tokens.begin();
    m_tree = Parse( it );
}

// ------------------------------------------------------------
LispNode* LispInterpreter::Parse( list<Token>::iterator &it_)
{
    if ( it_ == m_tokens.end() )
    {
        return NULL;
    }

    if ( it_->Get().compare("(") == 0 )
    {
        ++it_;
        if ( it_ == m_tokens.end() )
            return NULL;
        if ( (it_)->Get().compare(")") == 0 )
        {
            return NULL;
        }
        LispNode * node = Parse(it_);

        return Cons( node, ParseRest(++it_) );
    }
    else if ( it_->IsNumber() )
    {
        return MakeNumber( it_->GetNumber() );
    }
    else
    {
        return MakeSymbol( it_->Get() );
    }

    // should never reach this
    return NULL;
}

// ------------------------------------------------------------
LispNode* LispInterpreter::ParseRest(list<Token>::iterator &it_)
{
    if ( it_ == m_tokens.end() )
        return NULL;
    if ( it_->Get().compare(")") == 0 )
    {
        return NULL;
    }

    LispNode * node = Parse(it_);
    return Cons( node, ParseRest(++it_) );
}

// ------------------------------------------------------------
void LispInterpreter::Evaluate()
{
    m_tree = Eval( m_tree );
}

// ------------------------------------------------------------
LispNode* LispInterpreter::Eval(LispNode * node_)
{
//    Print(_node);

    if ( !node_)
        return NULL;

    if ( node_->m_type == NT_NUMBER )
        return node_;
    if ( node_->m_type == NT_SYMBOL )
    {
        LispNode * n = FindVar( (LispSymbol*)node_);
        if ( !n )
        {
            cerr << "error: Undefined variable " << ((LispSymbol*)node_)->m_symbol << endl;
            return NULL;
        }
        return n;
    }

    if ( node_->m_type == NT_CELL )
    {
        LispNode * fn = Car(node_);
        LispNode * rest = Cdr(node_);
        LispNode * args = NULL;

        if ( !fn || fn->m_type != NT_SYMBOL )
        {
            cout << "error: function expected" << endl;
            return NULL;
        }

        LispFunction* function = NULL;

        if ( (function = FindSpecialFunction( ((LispSymbol*)fn)->m_symbol )) )
        {
            args = rest;
        }
        else if ( (function = FindFunction( ((LispSymbol*)fn)->m_symbol)) )
        {
            // TODO... there should be another fast solution
            LispNode ** fake;
            args = Eval(Car(rest));
            if ( args )
                args = Cons( args, NULL);
            fake = &(((LispCell*)args)->m_rest);

            rest = Cdr( rest );
            while ( rest )
            {
                *fake = Cons( Eval(Car(rest)), NULL);
                fake = &(((LispCell*)(*fake))->m_rest);
                rest = Cdr( rest );
            }
        }

        if ( function )
        {
            return function->Call(*this, args);
        }

        cerr << "Unknown function " << ((LispSymbol*)fn)->m_symbol << endl;
        return NULL;
    }

    return NULL;
}

// ------------------------------------------------------------
void LispInterpreter::Print()
{
    Print( m_tree );
    cout << endl;
}

// ------------------------------------------------------------
void LispInterpreter::Print(LispNode * expr_)
{
    if ( !expr_)
        return;

    switch( expr_->m_type )
    {
        case NT_NUMBER:
            cout << ((LispNumber*)expr_)->m_val << " ";
            break;
        case NT_SYMBOL:
            cout << ((LispSymbol*)expr_)->m_symbol << " ";
            break;
        case NT_CELL:
            cout << "(";
            while ( expr_ && expr_->m_type == NT_CELL )
            {
                Print( Car(expr_) );
                expr_ = Cdr(expr_);
            }
            if ( expr_ != NULL )
            {
                cout << ". ";
                Print(expr_);
            }
            cout << ")";
            break;
    }
}

// ------------------------------------------------------------
LispFunction* LispInterpreter::FindFunction( string name_)
{
    list<LispFunction*>::iterator it = m_functions.begin();
    while (it != m_functions.end() )
    {
        if ( (*it)->IsName(name_) )
            return *it;
        ++it;
    }

    // not found
    return NULL;
}

// ------------------------------------------------------------
LispFunction* LispInterpreter::FindSpecialFunction( string name_)
{
    list<LispFunction*>::iterator it = m_specialFunctions.begin();
    while (it != m_specialFunctions.end() )
    {
        if ( (*it)->IsName(name_) )
            return *it;
        ++it;
    }

    // not found
    return NULL;
}

// ------------------------------------------------------------
void LispInterpreter::AddFunction( string name_, LispCallPtr fn_ )
{
    m_functions.push_back( new LispFunction(name_,fn_) );
}

// ------------------------------------------------------------
void LispInterpreter::AddSpecialFunction( string name_, LispCallPtr fn_ )
{
    m_specialFunctions.push_back( new LispFunction(name_,fn_) );
}

// ------------------------------------------------------------
LispNode* LispInterpreter::FindVar(LispSymbol *symbol_)
{
    varsmap::iterator it = m_vars.find( symbol_->m_symbol);
    if ( it == m_vars.end() )
    {
        return NULL;
    }

    return it->second;
}
