Exemple #1
0
static void add_use_markers(FILE *in, FILE *out) {
    char *line;
    int incode = 0;
    LineOut info; info.line = (char *)0; info.out = out;
    
    while ((line = getline_noweb(in)) != NULL) {
        if (is_begin(line, "code") || showquotes && is_keyword(line, "quote"))
            incode = 1;
        else if (is_end(line, "code") || is_keyword(line, "endquote"))
            incode = 0;
        if (is_keyword(line, "text") && incode) {
            info.line = line + 6; /* skip "@text " */
            search_for_ident(nwindex, line, write_index_use, &info);
            if (*info.line && *info.line != '\n') 
                fprintf(out, "@text %s", info.line);    /* has newline */
        } else
            fprintf(out, "%s", line);
    }       
}
Exemple #2
0
data_t *eval(const data_t *exp, data_t *env) {
	if(eval_plz_die) {
		eval_plz_die = 0;
		ExitThread(0);
	}

	if(is_self_evaluating(exp))
		return (data_t*)exp;
	if(is_variable(exp))
		return lookup_variable_value(exp, env);
	if(is_quoted_expression(exp))
		return get_text_of_quotation(exp);
	if(is_assignment(exp))
		return eval_assignment(exp, env);
	if(is_definition(exp))
		return eval_definition(exp, env);
	if(is_if(exp))
		return eval_if(exp, env);
	if(is_lambda(exp))
		return make_procedure(get_lambda_parameters(exp), get_lambda_body(exp), env);
	if(is_begin(exp))
		return eval_sequence(get_begin_actions(exp), env);
	if(is_cond(exp))
		return eval(cond_to_if(exp), env);
	if(is_letrec(exp))
		return eval(letrec_to_let(exp), env);
	if(is_let_star(exp))
		return eval(let_star_to_nested_lets(exp), env);
	if(is_let(exp))
		return eval(let_to_combination(exp), env);
	if(is_application(exp))		
		return apply(
			eval(get_operator(exp), env),
			get_list_of_values(get_operands(exp), env));
	
	printf("Unknown expression type -- EVAL '");
	return make_symbol("error");
}
Exemple #3
0
object *eval(object *exp, object *env) {

    object *procedure;
    object *arguments;
    object *result;
    bool tailcall = false;

    do {

        if (is_self_evaluating(exp))
            return exp;

        if (is_variable(exp))
            return lookup_variable_value(exp, env);

        if (is_quoted(exp))
            return text_of_quotation(exp);

        if (is_assignment(exp))
            return eval_assignment(exp, env);

        if (is_definition(exp))
            return eval_definition(exp, env);

        if (is_if(exp)) {
            exp = is_true(eval(if_predicate(exp), env)) ? if_consequent(exp) : if_alternative(exp);
            tailcall = true;
            continue;
        }

        if (is_lambda(exp))
            return make_compound_proc(lambda_parameters(exp), lambda_body(exp), env);

        if (is_begin(exp)) {
            exp = begin_actions(exp);
            while (!is_last_exp(exp)) {
                eval(first_exp(exp), env);
                exp = rest_exps(exp);
            }
            exp = first_exp(exp);
            tailcall = true;
            continue;
        }

        if (is_cond(exp)) {
            exp = cond_to_if(exp);
            tailcall = true;
            continue;
        }

        if (is_let(exp)) {
            exp = let_to_application(exp);
            tailcall = true;
            continue;
        }

        if (is_and(exp)) {
            exp = and_tests(exp);
            if (is_empty(exp))
                 return make_boolean(true);
            while (!is_last_exp(exp)) {
                result = eval(first_exp(exp), env);
                if (is_false(result))
                    return result;
                exp = rest_exps(exp);
            }
            exp = first_exp(exp);
            tailcall = true;
            continue;
        }

        if (is_or(exp)) {
            exp = or_tests(exp);
            if (is_empty(exp)) {
                return make_boolean(false);
            }
            while (!is_last_exp(exp)) {
                result = eval(first_exp(exp), env);
                if (is_true(result))
                    return result;
                exp = rest_exps(exp);
            }
            exp = first_exp(exp);
            tailcall = true;
            continue;
        }

        if (is_application(exp)) {

            procedure = eval(operator(exp), env);
            arguments = list_of_values(operands(exp), env);

            if (is_primitive_proc(procedure) && procedure->data.primitive_proc.fn == eval_proc) {
                exp = eval_expression(arguments);
                env = eval_environment(arguments);
                tailcall = true;
                continue;
            }

            if (is_primitive_proc(procedure) && procedure->data.primitive_proc.fn == apply_proc) {
                procedure = apply_operator(arguments);
                arguments = apply_operands(arguments);
            }

            if (is_primitive_proc(procedure))
                return (procedure->data.primitive_proc.fn)(arguments);

            if (is_compound_proc(procedure)) {
                env = extend_environment(procedure->data.compound_proc.parameters, arguments, procedure->data.compound_proc.env);
                exp = make_begin(procedure->data.compound_proc.body);
                tailcall = true;
                continue;
            }

            return make_error(342, "unknown procedure type");
        } // is_application()

    } while (tailcall);

    fprintf(stderr, "cannot eval unknown expression type\n");
    exit(EXIT_FAILURE);
}
Exemple #4
0
object *bs_eval(object *exp, object *env)
{
tailcall:
    if (is_empty_list(exp)) {
        error("unable to evaluate empty list");
    } else if (is_self_evaluating(exp)) {
        return exp;
    } else if (is_variable(exp)) {
        return lookup_variable_value(exp, env);
    } else if (is_quoted(exp)) {
        return quoted_expression(exp);
    } else if (is_assignment(exp)) {
        return eval_assignment(exp, env);
    } else if (is_definition(exp)) {
        return eval_definition(exp, env);
    } else if (is_if(exp)) {
        if (is_true(bs_eval(if_predicate(exp), env))) {
            exp = if_consequent(exp);
        } else {
            exp = if_alternate(exp);
        }
        goto tailcall;
    } else if (is_lambda(exp)) {
        return make_compound_proc(lambda_parameters(exp),
                lambda_body(exp),
                env);
    } else if (is_begin(exp)) {
        exp = begin_actions(exp);
        if (is_empty_list(exp)) {
            error("empty begin block");
        }
        while (!is_empty_list(cdr(exp))) {
            bs_eval(car(exp), env);
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_cond(exp)) {
        exp = cond_to_if(exp);
        goto tailcall;
    } else if (is_let(exp)) {
        exp = let_to_application(exp);
        goto tailcall;
    } else if (is_and(exp)) {
        exp = and_tests(exp);
        if (is_empty_list(exp)) {
            return get_boolean(1);
        }
        object *result;
        while (!is_empty_list(cdr(exp))) {
            result = bs_eval(car(exp), env);
            if (is_false(result)) {
                return result;
            }
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_or(exp)) {
        exp = or_tests(exp);
        if (is_empty_list(exp)) {
            return get_boolean(0);
        }
        object *result;
        while (!is_empty_list(cdr(exp))) {
            result = bs_eval(car(exp), env);
            if (is_true(result)) {
                return result;
            }
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_application(exp)) {
        object *procedure = bs_eval(application_operator(exp), env);
        object *parameters = eval_parameters(application_operands(exp), env);

        // handle eval specially for tailcall requirement.
        if (is_primitive_proc(procedure) &&
                procedure->value.primitive_proc == eval_proc) {
            exp = eval_expression(parameters);
            env = eval_environment(parameters);
            goto tailcall;
        }

        // handle apply specially for tailcall requirement.
        if (is_primitive_proc(procedure) &&
                procedure->value.primitive_proc == apply_proc) {
            procedure = apply_operator(parameters);
            parameters = apply_operands(parameters);
        }

        if (is_primitive_proc(procedure)) {
            return (procedure->value.primitive_proc)(parameters);
        } else if (is_compound_proc(procedure)) {
            env = extend_environment(
                    procedure->value.compound_proc.parameters,
                    parameters,
                    procedure->value.compound_proc.env);
            exp = make_begin(procedure->value.compound_proc.body);
            goto tailcall;
        } else {
            error("unable to apply unknown procedure type");
        }
    } else {
        error("unable to evaluate expression");
    }
}
typename SortedVectorMapRow<V>::const_iterator*
SortedVectorMapRow<V>::const_iterator::operator--(int unused) {
  CHECK(!is_begin());
  curr_--;
  return this;
}
Exemple #6
0
static pSlipObject slip_eval(pSlip gd, pSlipObject exp, pSlipEnvironment env)
{
	pSlipObject proc;
	pSlipObject args;

	tailcall:
	if (is_self_evaluating(exp) == S_TRUE)
	{
		return exp;
	}
	else if (is_variable(exp) == S_TRUE)
	{
		return lookup_variable_value(gd, exp, env);
	}
	else if (is_quoted(gd, exp) == S_TRUE)
	{
		return text_of_quotation(exp);
	}
	else if (is_assignment(gd, exp) == S_TRUE)
	{
		return eval_assignment(gd, exp, env);
	}
	else if (is_definition(gd, exp) == S_TRUE)
	{
		return eval_definition(gd, exp, env);
	}
	else if (is_if(gd, exp) == S_TRUE)
	{
		exp = is_true(gd, slip_eval(gd, if_predicate(exp), env)) == S_TRUE ? if_consequent(exp) : if_alternative(gd, exp);
		goto tailcall;
	}
	else if (is_lambda(gd, exp) == S_TRUE)
	{
		return s_NewCompoundProc(gd, lambda_parameters(exp), lambda_body(exp), env);
	}
	else if (is_begin(gd, exp) == S_TRUE)
	{
		exp = begin_actions(exp);
		while (!is_last_exp(gd, exp))
		{
			slip_eval(gd, first_exp(exp), env);
			exp = rest_exps(exp);
		}
		exp = first_exp(exp);
		goto tailcall;
	}
	else if (is_cond(gd, exp) == S_TRUE)
	{
		exp = cond_to_if(gd, exp);
		goto tailcall;
	}
	else if (is_let(gd, exp) == S_TRUE)
	{
		exp = let_to_application(gd, exp);
		goto tailcall;
	}
	else if (is_application(exp) == S_TRUE)
	{
		proc = slip_eval(gd, slip_operator(exp), env);
		if (proc == NULL)
			return gd->singleton_False;

		if (proc->type == eType_PRIMITIVE_PROC || proc->type == eType_COMPOUND_PROC)
		{
			args = list_of_values(gd, operands(exp), env);
			if (args == NULL)
				return gd->singleton_False;

			if (sIsObject_PrimitiveProc(proc) == S_TRUE)
			{
				return proc->data.prim_proc.func(gd, args);
			}
			else if (sIsObject_CompoundProc(proc) == S_TRUE)
			{
				env = setup_environment(gd, proc->data.comp_proc.env, proc->data.comp_proc.params, args);
				exp = make_begin(gd, proc->data.comp_proc.code);
				goto tailcall;
			}
			else
			{
				throw_error(gd, "unknown procedure type\n");
				return gd->singleton_False;
			}
		}
		else
			return proc;
	}
	else
	{
		throw_error(gd, "cannot eval unknown expression type\n");
		return NULL;
	}

	throw_error(gd, "what??\n");
	return NULL;
}
Exemple #7
0
typename SparseRow<V>::const_iterator*
SparseRow<V>::const_iterator::operator--(int unused) {
  CHECK(!is_begin());
  it_--;
  return this;
}
Exemple #8
0
///////////////////////////////////////////////////////////////////
//eval
//requires two arguments:exp & tail_context
///////////////////////////////////////////////////////////////////
cellpoint eval(void)
{
	if (is_true(is_self_evaluating(args_ref(1)))){
		reg = args_ref(1);
	}else if (is_true(is_variable(args_ref(1)))){
		reg = args_ref(1);
		args_push(current_env);
		args_push(reg);
		reg = lookup_var_val();
	}else if (is_true(is_quoted(args_ref(1)))){
		args_push(args_ref(1));
		reg = quotation_text();
	}else if (is_true(is_assignment(args_ref(1)))){
		args_push(args_ref(1));
		reg = eval_assignment();
	}else if (is_true(is_definition(args_ref(1)))){
		args_push(args_ref(1));
		reg = eval_definition();
	}else if (is_true(is_if(args_ref(1)))){
		//eval if expression with the second argument (tail_context)
		reg = args_ref(1);
		args_push(args_ref(2));
		args_push(reg);
		reg = eval_if();
	}else if (is_true(is_lambda(args_ref(1)))){
		args_push(args_ref(1));
		reg = eval_lambda();
	}else if (is_true(is_begin(args_ref(1)))){
		args_push(args_ref(1));
		reg = begin_actions();
		//eval the actions of begin exp with the second argument (tail_context)
		args_push(args_ref(2));
		args_push(reg);
		reg = eval_sequence();
	}else if (is_true(is_cond(args_ref(1)))){
		args_push(args_ref(1));
		reg = cond_2_if();
		//eval the exp with the second argument (tail_context)
		args_push(args_ref(2));
		args_push(reg);
		reg = eval();
	}else if (is_true(is_and(args_ref(1)))){
		reg = args_ref(1);
		args_push(args_ref(2));
		args_push(reg);
		reg = eval_and();
	}else if (is_true(is_or(args_ref(1)))){
		reg = args_ref(1);
		args_push(args_ref(2));
		args_push(reg);
		reg = eval_or();
	}else if (is_true(is_let(args_ref(1)))){
		//convert let to combination
		args_push(args_ref(1));
		reg = let_2_combination();
		//evals the combination
		args_push(args_ref(2));
		args_push(reg);
		reg = eval();
	}else if (is_true(is_letstar(args_ref(1)))){
		//convert let* to nested lets
		args_push(args_ref(1));
		reg = letstar_2_nested_lets();
		//evals the nested lets
		args_push(args_ref(2));
		args_push(reg);
		reg = eval();
	}else if (is_true(is_application(args_ref(1)))){
		//computes operator
		args_push(args_ref(1));
		reg = operator();
		args_push(a_false);
		args_push(reg);
		reg = eval();
		stack_push(&vars_stack, reg);
		//computes operands
		args_push(args_ref(1));
		reg = operands();
		args_push(reg);
		reg = list_of_values();
		//calls apply with the second argument (tail_context)
		args_push(args_ref(2));
		args_push(reg);
		args_push(stack_pop(&vars_stack));
		reg = apply();
	}else {
		printf("Unknown expression type -- EVAL\n");
		error_handler();
	}
	args_pop(2);
	return reg;
}