lcont.cpp

Go to the documentation of this file.

// +-------------------------------------------------------------------------+
// |               I__n__t__e__L__i__b           0.6.10 development          |
// | Copyright (c) Andrey Vikt. Stolyarov <crocodil_AT_croco.net> 2000-2007. |
// |                                                                         |
// | This is free software. The library part is available under              |
// |                               GNU LESSER GENERAL PUBLIC LICENSE v.2.1.  |
// | GNU LGPL v2.1 is found in docs/gnu_gpl2.txt,  or at  http://www.gnu.org |
// |     Please see also docs/readme.txt and visit http://www.intelib.org    |
// |                                                                         |
// | !!! THERE IS NO WARRANTY OF ANY KIND, NEITHER EXPRESSED NOR IMPLIED !!! |
// +-------------------------------------------------------------------------+




#include "../sexpress/iexcept.hpp"
#include "../sexpress/sstring.hpp"
#include "lisp.hpp"
#include "lcont.hpp"
#include "lsymbol.hpp"
#include "llambda.hpp"



IntelibTypeId LExpressionContext::TypeId(&SExpression::TypeId, false);

LExpressionContext::LExpressionContext()
    : SExpression(TypeId)
{}

LExpressionContext::LExpressionContext(LContextRef a_prev)
    : SExpression(TypeId), prev(a_prev)
{}

LExpressionContext::~LExpressionContext()
{}

void LExpressionContext::AddBinding(const LExpressionSymbol *symb,
                                    const SReference& val)
{
    (*valtbl.AddBinding((unsigned long)symb)) = val;
}

SReference*
LExpressionContext::GetBinding(const LExpressionSymbol *symb) const
{
    SReference *res = valtbl.GetBinding((unsigned long)symb);
    if(res) return res;
    if(prev.GetPtr()) {
        return prev->GetBinding(symb);
    } else {
        return 0;
    }
}

SReference*
LExpressionContext::ProvideBinding(const LExpressionSymbol *symb)
{
    SReference *res = GetBinding(symb);
    if(!res) res = valtbl.AddBinding((unsigned long)symb);
    return res;
}

void LExpressionContext::AddFunBinding(const LExpressionSymbol *symb,
                                       const SReference& val)
{
    (*funtbl.AddBinding((unsigned long)symb)) = val;
}

SReference*
LExpressionContext::GetFunBinding(const LExpressionSymbol *symb) const
{
    SReference *res = funtbl.GetBinding((unsigned long)symb);
    if(res) return res;
    if(prev.GetPtr()) {
        return prev->GetFunBinding(symb);
    } else {
        return 0;
    }
}

SReference*
LExpressionContext::ProvideFunBinding(const LExpressionSymbol *symb)
{
    SReference *res = GetBinding(symb);
    if(!res) res = funtbl.AddBinding((unsigned long)symb);
    return res;
}


SReference LExpressionContext::GetAllSymbols() const
{
    SReference ret;
    if(prev.GetPtr()) {
        ret = prev->GetAllSymbols();
    } else {
        ret = *PTheEmptyList;
    }
    //
    {
        IntelibBindTable::Iterator iter(valtbl);
        unsigned long key;
        SReference t;
        while(iter.GetNext(key, t)) {
            ret = SReference((LExpressionSymbol*)key, ret);
        }
    }
    //
    {
        IntelibBindTable::Iterator iter(funtbl);
        unsigned long key;
        SReference t;
        while(iter.GetNext(key, t)) {
            ret = SReference((LExpressionSymbol*)key, ret);
        }
    }
    return ret;
}

SString LExpressionContext::TextRepresentation() const
{
    return "#<LISP-CONTEXT>";
}


void LispContinuation::CustomCommand(int opcode, const SReference& param)
{
    switch(opcode) {
        case take_result_as_form: {
            SReference r;
            PopResult(r);
            PushTodo(just_evaluate, r);
            break;
        }
        case duplicate_last_result: {
            SReference r;
            PopResult(r);
            PushResult(r);
            PushResult(r);
            break;
        }
        default:
                // this will just throw an exception
            IntelibContinuation::CustomCommand(opcode, param);
    }
}

void LispContinuation::JustEvaluate(const SReference& expr)
{
    if(!expr.GetPtr()) throw IntelibX_unexpected_unbound_value();
    const IntelibTypeId *t;
    for(t=&(expr->TermType()); t; t=t->Prev()) {
        if(*t == SExpressionCons::TypeId) {
            EvaluateForm(static_cast<SExpressionCons*>(expr.GetPtr()));
            return;
        } else
        if(*t == LExpressionSymbol::TypeId) {
            LExpressionSymbol *sym =
                static_cast<LExpressionSymbol*>(expr.GetPtr());
            if(sym->IsDynamic()) {
                if(sym->IsConstant()) {
                    RegularReturn(sym->GetDynamicValue());
                } else {
                    ReferenceReturn(sym->GetDynamicValueRef(), expr);
                }
            } else {
                SReference &res = GetSymbolValue(sym); 
                if(!res.GetPtr())
                    throw IntelibX_lisp_symbol_has_no_value(expr);
                ReferenceReturn(res, expr);
            }
            return;
        }
    }
    // no parent means that it's a regular constant...
    // it is always self-evaluated
    PushResult(expr);
}

#if 0
void LispContinuation::DoFunctionCall(const SReference &fun_ref,
                                     int paramscount,
                                     const SReference *paramsvector)
{
    LExpressionFunction *fun =
        fun_ref.DynamicCastGetPtr<LExpressionFunction>();
    if(!fun) {
        throw IntelibX_lisp_not_a_function(fun_ref);
    }
    fun->Apply(paramscount, paramsvector, *this);
}
#endif

// not static because is used by LFunctionFunction
LReference RetrieveFunctionObject(LReference from, 
                                  const LContextRef &lc) 
{
    const LExpressionSymbol *symb =
        from.DynamicCastGetPtr<LExpressionSymbol>();
    if(symb) {
        const SReference *tmp = 0; 
        if(lc.GetPtr())
            tmp = lc->GetFunBinding(symb);
        if(!tmp || !tmp->GetPtr())
            tmp = &symb->GetFunction();
        if(tmp->GetPtr()) {
            return *tmp;
        }
        throw IntelibX_no_associated_function(from);
    }

    SExpressionCons *dp = 
        from.DynamicCastGetPtr<SExpressionCons>();
    if(dp) {
        if(dp->Car() == *PTheLispSymbolLambda) {
            LReference tmp = dp->Cdr(); 
            return LReference(new LExpressionLambda(lc, tmp.Car(), 
                                                    tmp.Cdr()));
        }
        throw IntelibX_no_associated_function(from);
    }      
    
    SExpressionFunction *fn = from.DynamicCastGetPtr<SExpressionFunction>();
    if(fn) return from;

    SExpressionForm *frm = from.DynamicCastGetPtr<SExpressionForm>();
    if(frm) return frm;

    throw IntelibX_no_associated_function(from);
}

void LispContinuation::EvaluateForm(SExpressionCons *form)
{
    LReference fun = RetrieveFunctionObject(form->Car(), GetContext());
    SExpressionForm *f = fun.DynamicCastGetPtr<SExpressionForm>();
    if(f) { // special symbol
        f->Call(form->Cdr(), *this);
    } else {
        PushResult(fun);
        SExpressionCons *cdr =
            form->Cdr().DynamicCastGetPtr<SExpressionCons>();
        if(cdr) {
            PlaceFormToStack(cdr, 1);
        } else {
            PushTodo(0);
        }
    }
}

SReference& LispContinuation::GetSymbolValue(LExpressionSymbol *sym) const
{
    SReference *lexval = 0;
    if(GetContext().GetPtr()) {
        lexval = GetContext()->GetBinding(sym);
    }
    if(lexval)
        return *lexval;
    else
        return sym->GetDynamicValueRef();
}

IntelibX_lisp_not_a_function::
IntelibX_lisp_not_a_function(SReference a_param) 
    : IntelibX("lisp: not a function", a_param) {}

IntelibX_lisp_not_a_context::
IntelibX_lisp_not_a_context(SReference a_param) 
    : IntelibX("lisp: not a context", a_param) {}

IntelibX_lisp_symbol_has_no_value::
IntelibX_lisp_symbol_has_no_value(SReference a_param) 
    : IntelibX("lisp: symbol has no value", a_param) {}

IntelibX_no_associated_function::
IntelibX_no_associated_function(SReference a_param) 
    : IntelibX("No associated function", a_param) {}

---