コード例 #1
0
ファイル: sasl.C プロジェクト: Henry/BuddKaminInterpreters
void LazyFunction::apply(Expr& target, ListNode* args, Environment* rho)
{
    // number of args should match definition
    ListNode* anames = argNames_;
    if (anames->length() != args->length())
    {
        error("argument length mismatch");
        return;
    }

    // convert arguments into thunks
    ListNode* newargs = makeThunks(args, rho);

    // make new environment
    Environment* newrho = new Environment(anames, newargs, context_);

    // evaluate body in new environment
    if (body_())
    {
        body_()->eval(target, valueOps, newrho);
    }
    else
    {
        target = 0;
    }

    newrho = 0;
}
コード例 #2
0
ファイル: apl.C プロジェクト: Henry/BuddKaminInterpreters
/// APLCatenationFunctionApply
void CatenationFunction::applyOp
(
    Expr& target,
    APLValue* left,
    APLValue* right
)
{
    ListNode* lshape = left->shape();
    ListNode* rshape = right->shape();
    int llen = lshape->length();
    int rlen = rshape->length();
    if (llen <= 0 || (llen != rlen))
    {
        target = error("catenation conformability error");
        return;
    }

    // get the size of the last row in each structure
    int lrow, rrow;
    IntegerExpression* ie = lshape->at(llen - 1)->isInteger();
    if (ie)
    {
        lrow = ie->val();
    }
    else
    {
        lrow = 1;
    }
    ie = rshape->at(rlen - 1)->isInteger();
    if (ie)
    {
        rrow = ie->val();
    }
    else
    {
        rrow = 1;
    }

    // build up the new size
    int extent = lrow + rrow;
    ListNode* newShape =
    new ListNode(new IntegerExpression(extent), emptyList());
    llen = llen - 1;
    while (--llen >= 0)
    {
        newShape = new ListNode(lshape->at(llen), newShape);
        ie = lshape->at(llen)->isInteger();
        if (ie)
        {
            extent *= ie->val();
        }
    }

    APLValue* newval = new APLValue(newShape, extent);

    // now build the new values
    int i, index, lindex, rindex;
    index = lindex = rindex = 0;
    while (index < extent)
    {
        for (i = 0; i < lrow; i++)
        {
            newval->atPut(index++, left->at(lindex++));
        }
        for (i = 0; i < rrow; i++)
        {
            newval->atPut(index++, right->at(rindex++));
        }
    }

    target = newval;
}