/* evaluators */ sexp eval_begin(sexp actions, sexp env) { if (is_null(actions)) return EOL; while (!is_null(pair_cdr(actions))) { eval_object(pair_car(actions), env); actions = pair_cdr(actions); } return eval_object(pair_car(actions), env); }
sexp eval_arguments(sexp arguments, sexp env) { if (is_null(arguments)) return EOL; else { sexp first = pair_car(arguments); return make_pair(eval_object(first, env), eval_arguments(pair_cdr(arguments), env)); } }
int main(int argc, char **argv) { krb5_error_code ret; int optidx = 0; setprogname(argv[0]); ret = krb5_init_context(&kdc_context); if (ret == KRB5_CONFIG_BADFORMAT) errx (1, "krb5_init_context failed to parse configuration file"); else if (ret) errx (1, "krb5_init_context failed: %d", ret); ret = krb5_kt_register(kdc_context, &hdb_kt_ops); if (ret) errx (1, "krb5_kt_register(HDB) failed: %d", ret); kdc_config = configure(kdc_context, argc, argv, &optidx); argc -= optidx; argv += optidx; if (argc == 0) errx(1, "missing operations"); krb5_plugin_register(kdc_context, PLUGIN_TYPE_DATA, KRB5_PLUGIN_SEND_TO_KDC, &send_to_kdc); { void *buf; size_t size; heim_object_t o; if (rk_undumpdata(argv[0], &buf, &size)) errx(1, "undumpdata: %s", argv[0]); o = heim_json_create_with_bytes(buf, size, 10, 0, NULL); free(buf); if (o == NULL) errx(1, "heim_json"); /* * do the work here */ eval_object(o); heim_release(o); } krb5_free_context(kdc_context); return 0; }
int main(int argc, char *argv[]) { char *cases[] = { /* "(+. 1.1 1.2)", */ /* "(integer->float 123)", */ /* "(& 5 7)", */ /* "'hello", */ /* "-", */ /* "(define a (string->in-port \"abc\"))", */ /* "(read-string-in-port-char a)", */ /* "(+i 1 2)", */ /* "(*i 3 4)", */ /* "(quotient 10 3)", */ /* "(remainder 10 3)", */ /* "(= 1 2)", */ /* "(> 4 5)", */ /* "(& 5 7)", */ /* "(| 5 7)", */ /* "(~ 5)", */ /* "(eq? 'hello 'hello)", */ /* "(eq? 1 1)", */ /* "(eq? (string->symbol \"hello\") 'hello)", */ /* "(type-of 'hello)", */ /* "type-of", */ /* "#\\a", */ /* "(type-of #\\a)", */ /* "(define a #(1 2 3))", */ /* "#\\汉", */ /* "(set! a 123)", */ "(string-ref \"汉字\" 0)", }; init_impl(); /* printf("Address of `-': %p\n", &primitive_procs[1]); */ for (int i = 0; i < sizeof(cases) / sizeof(char *); i++) { FILE *stream = fmemopen(cases[i], strlen(cases[i]), "r"); sexp in_port = make_file_in_port(stream); /* inc_ref_count(in_port); */ printf(">> %s\n=> ", cases[i]); sexp value = read_object(in_port); if (is_eof(value)) break; /* inc_ref_count(input); */ value = eval_object(value, repl_environment); /* if (!is_self_eval(input)) */ /* inc_ref_count(value); */ write_object(value, scm_out_port); putchar('\n'); } /* write_object(make_wstring("汉"), scm_out_port); */ /* trigger_gc(); */ return 0; }
sexp eval_application(sexp operator, sexp operands) { if (is_primitive(operator)) return (primitive_C_proc(operator))(operands); if (is_compound(operator)) { sexp body = compound_proc_body(operator); sexp vars = compound_proc_parameters(operator); sexp def_env = compound_proc_environment(operator); sexp object = make_pair(S("begin"), body); sexp env = extend_environment(vars, operands, def_env); return eval_object(object, env); } fprintf(stderr, "Unknown operator type %d\n", operator->type); exit(1); }
static void eval_repeat(heim_dict_t o) { heim_object_t or = heim_dict_get_value(o, HSTR("value")); heim_number_t n = heim_dict_get_value(o, HSTR("num")); int i, num; struct perf perf; perf_start(&perf); heim_assert(or != NULL, "value missing"); heim_assert(n != NULL, "num missing"); num = heim_number_get_int(n); heim_assert(num >= 0, "num >= 0"); for (i = 0; i < num; i++) eval_object(or); perf_stop(&perf); }
static void eval_array_element(heim_object_t o, void *ptr, int *stop) { eval_object(o); }
sexp eval_object(sexp object, sexp environment) { tail_loop: if (is_quote_form(object)) return quotation_text(object); if (is_variable_form(object)) return get_variable_value(object, environment); if (is_define_form(object)) { /* sexp value = eval_object(definition_value(object), environment); */ /* add_binding(definition_variable(object), value, environment); */ /* return value; */ return eval_object(define2set(object), environment); } if (is_assignment_form(object)) { sexp value = eval_object(assignment_value(object), environment); set_binding(assignment_variable(object), value, environment); return value; } if (is_if_form(object)) { sexp test_part = if_test_part(object); sexp then_part = if_then_part(object); sexp else_part = if_else_part(object); if (!is_false(eval_object(test_part, environment))) { object = then_part; } else { object = else_part; } goto tail_loop; } if (is_lambda_form(object)) { sexp parameters = lambda_parameters(object); sexp body = lambda_body(object); return make_lambda_procedure(parameters, body, environment); } if (is_begin_form(object)) { return eval_begin(object, environment); } if (is_cond_form(object)) { object = cond2if(object); goto tail_loop; } if (is_let_form(object)) { object = let2lambda(object); goto tail_loop; } if (is_and_form(object)) { sexp tests = and_tests(object); if (is_null(tests)) return make_true(); while (is_pair(pair_cdr(tests))) { sexp result = eval_object(pair_car(tests), environment); if (is_false(result)) return make_false(); tests = pair_cdr(tests); } return eval_object(pair_car(tests), environment); } if (is_or_form(object)) { sexp tests = or_tests(object); if (is_null(tests)) return make_false(); while (is_pair(pair_cdr(tests))) { sexp result = eval_object(pair_car(tests), environment); if (!is_false(result)) return result; tests = pair_cdr(tests); } return eval_object(pair_car(tests), environment); } if (is_macro_form(object)) { sexp pars = macro_parameters(object); sexp body = macro_body(object); return make_macro_procedure(pars, body, environment); } if (is_application_form(object)) { sexp operator = application_operator(object); sexp operands = application_operands(object); operator = eval_object(operator, environment); if (!is_function(operator) && !is_macro(operator)) { fprintf(stderr, "Illegal functional object "); write_object(operator, make_file_out_port(stderr)); fprintf(stderr, " from "); write_object(pair_car(object), make_file_out_port(stderr)); fputc('\n', stderr); exit(1); } /* Expand the macro before evaluating arguments */ if (is_macro(operator)) { sexp body = macro_proc_body(operator); sexp vars = macro_proc_pars(operator); sexp def_env = macro_proc_env(operator); sexp object = make_pair(S("begin"), body); sexp env = extend_environment(vars, operands, def_env); sexp exp = eval_object(object, env); return eval_object(exp, environment); } operands = eval_arguments(operands, environment); /* if (is_apply(operator)) { */ /* operator = pair_car(operands); */ /* operands = apply_operands_conc(pair_cdr(operands)); */ /* } */ if (is_eval(operator)) { environment = pair_cadr(operands); object = pair_car(operands); goto tail_loop; } return eval_application(operator, operands); } else return object; }