Ejemplo n.º 1
0
List arr2list(int *arr, int len)
{
    List ls = make_nil();
    for (int i = 0; i < len; i++)
        ls = list_append(ls, arr[i]);
    return ls;
}
Ejemplo n.º 2
0
list map(int (*pf)(int), const list p)
{
    list ls = make_nil();
    for (node *q = p; q != NULL; q = q->next) {
        list_append(&ls, (*pf)(q->val));
    }
    return ls;
}
Ejemplo n.º 3
0
ExprPtr Cell::cdr()
{
	if (is_nil()) {
		return make_nil();
	}

	return m_cdr;
}
Ejemplo n.º 4
0
list filter(bool (*pf)(int), const list p)
{
    list ls = make_nil();
    for (node *q = p; q != NULL; q = q->next) {
        if ((*pf)(q->val))
            list_append(&ls, q->val);
    }
    return ls;
}
Ejemplo n.º 5
0
list list_copy(const list p)
{
    list ls = make_nil();
    for (node *q = p; q != NULL; q = q->next) {
        node *pnew = copy_node(q);
        append_node(&ls, pnew);
    }
    return ls;
}
Ejemplo n.º 6
0
Archivo: parse.c Proyecto: GJDuck/SMCHR
/*
 * Initialise the parser.
 */
extern void parse_init(void)
{
    name_t entry;
    entry = name_lookup("false");
    entry->val = term_boolean(make_boolean(false));
    entry = name_lookup("inf");
    entry->val = term_num(make_num(1.0/0.0));
    entry = name_lookup("nil");
    entry->val = term_nil(make_nil());
    entry = name_lookup("true");
    entry->val = term_boolean(make_boolean(true));
}
Ejemplo n.º 7
0
list make_list(int len, ...)
{
    list ls = make_nil();
    va_list ip;
    int ival;
    va_start(ip, len);
    for (int i = 0; i < len; i++) {
        ival = va_arg(ip, int);
        list_append(&ls, ival);
    }
    va_end(ip);
    return ls;
}
Ejemplo n.º 8
0
list srange(int a, int b, int step)
{
    list ls = make_nil();
    if (a >= b)
        return ls;
    ls->length = b - a;
    ls->body = make_node(a);
    node *q = ls->body;
    for (int i = a + step; i < b; i++) {
        node *pnew = make_node(i);
        q->next = pnew;
        q = q->next;
    }
    return ls;
}
Ejemplo n.º 9
0
list arr2list(int *arr, int len)
{
    if (len < 0) {
        fprintf(stderr, "arr2list: negative index.\n");
        exit(EXIT_WRONG_ARG);
    }
    list ls = make_nil();
    ls->length = len;
    if (len == 0)
        return ls;
    ls->body = make_node(arr[0]);
    node *q = ls->body;
    for (int i = 1; i < len; i++) {
        node *pnew = make_node(arr[i]);
        q->next = pnew;
        q = q->next;
    }
    return ls;
}
Ejemplo n.º 10
0
Value * evaluate(Environment *env, Value *expr) {

    EvaluationContext *ctx;
    Value *temp, *result;

    Value *operator;
    Value *operand_val, *operand_cons;
    Value *operands, *operands_end, *nil_value;
    int num_operands;

    /* Set up a new evaluation context and record our local variables, so that
     * the garbage-collector can see any temporary values we use.
     */
    ctx = push_new_evalctx(env, expr);
    evalctx_register(&temp);
    evalctx_register(&result);
    evalctx_register(&operator);
    evalctx_register(&operand_val);
    evalctx_register(&operand_cons);
    evalctx_register(&operands);
    evalctx_register(&operands_end);
    evalctx_register(&nil_value);

#ifdef VERBOSE_EVAL
    printf("\nEvaluating expression:  ");
    print_value(stdout, expr);
    printf("\n");
#endif

    /* If this is a special form, evaluate it.  Otherwise, this function will
     * simply pass the input through to the result.
     */
    result = eval_special_form(env, expr);
    if (result != expr)
        goto Done;    /* It was a special form. */

    /*
     * If the input is an atom, we need to resolve it to a value, using the
     * current environment.
     */

    if (is_atom(expr)) {
        /* Treat the atom as a name - resolve it to a value. */
        result = resolve_binding(env, expr->string_val);
        if (result == NULL) {
            result = make_error("couldn't resolve name \"%s\" to a value!",
                expr->string_val);
        }

        goto Done;
    }

    /*
     * If the input isn't an atom and isn't a cons-pair, then assume it's a
     * value that doesn't need evaluating, and just return it.
     */

    if (!is_cons_pair(expr)) {
        result = expr;
        goto Done;
    }

    /*
     * Evaluate operator into a lambda expression.
     */

    temp = get_car(expr);

    operator = evaluate(env, temp);
    if (is_error(operator)) {
        result = operator;
        goto Done;
    }
    if (!is_lambda(operator)) {
        result = make_error("operator is not a valid lambda expression");
        goto Done;
    }

#ifdef VERBOSE_EVAL
    printf("Operator:  ");
    print_value(stdout, operator);
    printf("\n");
#endif

    /*
     * Evaluate each operand into a value, and build a list up of the values.
     */

#ifdef VERBOSE_EVAL
    printf("Starting evaluation of operands.\n");
#endif

    num_operands = 0;
    operands_end = NULL;
    operands = nil_value = make_nil();

    temp = get_cdr(expr);
    while (is_cons_pair(temp)) {
        Value *raw_operand;

        num_operands++;

        /* This is the raw unevaluated value. */
        raw_operand = get_car(temp);

        /* Evaluate the raw input into a value. */

        operand_val = evaluate(env, raw_operand);
        if (is_error(operand_val)) {
            result = operand_val;
            goto Done;
        }

        operand_cons = make_cons(operand_val, nil_value);
        if (operands_end != NULL)
            set_cdr(operands_end, operand_cons);
        else
            operands = operand_cons;

        operands_end = operand_cons;

        temp = get_cdr(temp);
    }

    /*
     * Apply the operator to the operands, to generate a result.
     */

    if (operator->lambda_val->native_impl) {
        /* Native lambdas don't need an environment created for them.  Rather,
         * we just pass the list of arguments to the native function, and it
         * processes the arguments as needed.
         */
        result = operator->lambda_val->func(num_operands, operands);
    }
    else {
        /* These don't need registered on the explicit stack.  (I hope.) */
        Environment *child_env;
        Value *body_iter;

        /* It's an interpreted lambda.  Create a child environment, then
         * populate it with values based on the lambda's argument-specification
         * and the input operands.
         */
        child_env = make_environment(operator->lambda_val->parent_env);
        temp = bind_arguments(child_env, operator->lambda_val, operands);
        if (is_error(temp)) {
            result = temp;
            goto Done;
        }

        /* Evaluate each expression in the lambda, using the child environment.
         * The result of the last expression is the result of the lambda.
         */
        body_iter = operator->lambda_val->body;
        do {
            result = evaluate(child_env, get_car(body_iter));
            body_iter = get_cdr(body_iter);
        }
        while (!is_nil(body_iter));
    }

Done:

#ifdef VERBOSE_EVAL
    printf("Result:  ");
    print_value(stdout, result);
    printf("\n\n");
#endif

    /* Record the result and then perform garbage-collection. */
    pop_evalctx(result);
    collect_garbage();

    return result;
}