Mercurial > lbo > hg > ylisp
view src/built-ins.c @ 182:8cd4314a144f
big cleanup for rewrite of execution logic
author | Lewin Bormann <lbo@spheniscida.de> |
---|---|
date | Fri, 27 Sep 2019 14:33:38 +0200 |
parents | 3ec2b2edb977 |
children | 263256062455 |
line wrap: on
line source
#include "built-ins.h" #include <assert.h> #include "value.h" #include "base/str.h" // TODO: Write standard library! static FILE* output_handle = NULL; void ybuiltin_set_output(FILE* out) { output_handle = out; } /** * @brief Type of a built-in function called during execution. * * The functions return a yexpr_t of which the caller assumes ownership. */ typedef yexpr_t (*ybuiltin_fn)(yeval_state_t* state); struct ybuiltin_id_mapping { const char* id; YBUILTIN_TYPE builtin; }; static const struct ybuiltin_id_mapping YBUILTIN_ID_MAPPING[] = { {"undef", YBUILTIN_UNDEF}, {"for", YBUILTIN_FOR}, {"let", YBUILTIN_LET}, {"defn", YBUILTIN_DEFN}, {"+", YBUILTIN_PLUS}, {"-", YBUILTIN_MINUS}, {"*", YBUILTIN_MULT}, {"/", YBUILTIN_DIV}, {"if", YBUILTIN_IF}, {"print", YBUILTIN_PRINT}, {"==", YBUILTIN_EQ}, {"<", YBUILTIN_LT}, {"car", YBUILTIN_CAR}, {"cdr", YBUILTIN_CDR}, {"push", YBUILTIN_PUSH}, {"raise", YBUILTIN_RAISE}, {"recover", YBUILTIN_RECOVER}, {"_mkclsr", YBUILTIN_INTERNAL_MKCLSR}, }; static const char* YBUILTIN_ENUM_STR[] = { "BUILTIN:UNDEF", "BUILTIN:FOR", "BUILTIN:LET", "BUILTIN:DEFN", "BUILTIN:+", "BUILTIN:-", "BUILTIN:*", "BUILTIN:/", "BUILTIN:IF", "BUILTIN:PRINT", "BUILTIN:EQ", "BUILTIN:LT", "BUILTIN:CAR", "BUILTIN:CDR", "BUILTIN:PUSH", "BUILTIN:RAISE", "BUILTIN:RECOVER", "BUILTIN:_MKCLSR", }; /// Ownership of msg is transferred to this function, ownership of offending is /// not. static yexpr_t ybuiltin_type_error(YBUILTIN_TYPE self, ystr_t msg, yexpr_t* offending) { ystr_t fullmsg = ystr_new(NULL); ystr_t expr = yexpr_debug_str(offending); ystr_build(&fullmsg, "%s: %s: %s", ybuiltin_name(self), ystr_str(&msg), ystr_str(&expr)); yexpr_t exception = yexpr_new(); yexpr_set_exception(&exception, fullmsg); ystr_destroy(&expr); ystr_destroy(&msg); return exception; } /// Return the ID corresponding to the builtin name in the string or -1 if /// there is no such built-in. static YBUILTIN_TYPE ybuiltin_id(ystr_t* sym) { const size_t builtins = sizeof(YBUILTIN_ID_MAPPING) / sizeof(struct ybuiltin_id_mapping); for (size_t i = 0; i < builtins; i++) { if (0 == ystr_cmp_str(sym, YBUILTIN_ID_MAPPING[i].id)) { return YBUILTIN_ID_MAPPING[i].builtin; } } return -1; } /// Make a symbolic reference into a built-in reference, if possible. bool ybuiltin_translate(yexpr_t* expr) { if (expr->typ != YEXPR_REF) return false; if (yref_type(&expr->value.ref) != YREF_SYM) return false; YBUILTIN_TYPE bi = ybuiltin_id(&expr->value.ref.ref.sym); if (bi < 0) return false; yexpr_destroy(expr); yexpr_set_builtin(expr, bi); return true; } static void nothing(void){}; /// Return from a built-in function with a "bad expression" exception. #define BADEXPRFAIL(BUILTINTYPE, invalid_expr) \ return ybuiltin_type_error( \ YBUILTIN_##BUILTINTYPE, \ ystr_new("BUG: not a valid `" #BUILTINTYPE "`expression on stack"), \ &invalid_expr) /// Return from a built-in function with a "not enough arguments" exception. #define NOTENOUGHFAIL(BUILTINTYPE) \ return ybuiltin_type_error( \ YBUILTIN_##BUILTINTYPE, \ ystr_new("BUG: not enough arguments on call stack"), NULL); /// Return from a built-in function with a "type mismatch" exception. #define TYPEFAIL(BUILTINTYPE, invalid_expr, want) \ { \ yexpr_t exc = ybuiltin_type_error( \ YBUILTIN_##BUILTINTYPE, \ ystr_new("type mismatch for " #BUILTINTYPE "; want " want \ " received something else"), \ &invalid_expr); \ return exc; \ } /// Returns a YEXPR_UNDEF expression. TODO: Automatically add symbolic reference /// "undef". yexpr_t ybuiltin_fn_undef(yeval_state_t* state) { yvec_pop(&state->call_stack, NULL); return yexpr_new(); } /// Expects a list expression starting with built-in "for" on the stack. It is /// not modified. /// /// The list should follow this scheme: (BUILTIN:FOR ref iterated-items /// [expr...] expr) /// /// Returns a list of each of the last expressions in the for loop. If the last /// expression is an undefined value (`(undef)`), the value is not added to the /// resulting list. yexpr_t ybuiltin_fn_for(yeval_state_t* state) { #define _pattern "(for ref (item [...]) [exprs...] expr)" yexpr_t for_expr; yvec_t* for_list = &for_expr.value.list; size_t items = 0, counter = 0; yvec_t result; if (!yvec_pop(&state->call_stack, &for_expr)) NOTENOUGHFAIL(FOR); if (for_expr.typ != YEXPR_LIST) BADEXPRFAIL(FOR, for_expr); if (for_expr.value.list.len < 4) TYPEFAIL(FOR, for_expr, _pattern); yexpr_t* for_id = YVEC_AT(for_list, counter++, yexpr_t); if (for_id->typ != YEXPR_BUILTIN || for_id->value.builtin != YBUILTIN_FOR) TYPEFAIL(FOR, for_expr, _pattern); yexpr_t* for_ref = YVEC_AT(for_list, counter++, yexpr_t); if (for_ref->typ != YEXPR_REF) TYPEFAIL(FOR, for_expr, _pattern); yexpr_t* for_items = YVEC_AT(for_list, counter++, yexpr_t); if (for_items->typ != YEXPR_LIST) TYPEFAIL(FOR, for_expr, _pattern); items = for_items->value.list.len; YVEC_INIT(&result, items, yexpr_t); yvec_t* for_items_l = &for_items->value.list; // counter now points to the first expression. assert(counter == 3); // nested loop: first items, then exprs for (size_t item = 0; item < for_items_l->len; item++) { yexpr_t* expr = YVEC_AT(for_items_l, item, yexpr_t); yexpr_t evald = yeval(state, expr, false); yvalue_t value = {.typ = YVALUE_EXPR, .value.expr = evald}; // For each item, bind reference and execute body. yvalue_set(for_ref->value.ref, &value); yexpr_t exprs_result = yeval_list_return_last(state, for_list, counter); // Make deep copy of result yexpr_t expr_result_cp = yexpr_copy(&exprs_result); if (exprs_result.typ != YEXPR_UNDEF) YVEC_PUSH(&result, &expr_result_cp); yexpr_destroy(&exprs_result); yvalue_destroy(&value); } yexpr_t result_expr = yexpr_new(); yexpr_set_list(&result_expr, result); return result_expr; #undef _pattern } /// Expects a list expression starting with built-in "let" on the stack. It is /// not modified. /// /// Returns an UNDEF expression by default, or an EXCEPTION if something went /// wrong. yexpr_t ybuiltin_fn_let(yeval_state_t* state) { #define _pattern "(let ref [expr ...] expr)" #undef _pattern } /// Expects a list expression starting with built-in "+" on the stack. It is not /// modified. Returns a number expression or an exception. yexpr_t ybuiltin_fn_plus(yeval_state_t* state) { #define _pattern "(+ numeric-expr numeric-expr [numeric-expr ...])" yexpr_t plus; if (!yvec_pop(&state->call_stack, &plus)) NOTENOUGHFAIL(PLUS); if (plus.typ != YEXPR_LIST) BADEXPRFAIL(PLUS, plus); if (plus.value.list.len < 3) BADEXPRFAIL(PLUS, plus); yvec_t* plus_list = &plus.value.list; long long result = 0; for (size_t i = 1; i < plus_list->len; i++) { yexpr_t* expr = YVEC_AT(plus_list, i, yexpr_t); yexpr_t evald = yeval(state, expr, false); if (evald.typ != YEXPR_NUMBER) TYPEFAIL(PLUS, evald, _pattern); result += evald.value.n; yexpr_destroy(&evald); } yexpr_t result_expr = yexpr_new(); yexpr_set_number(&result_expr, result); return result_expr; #undef _pattern } /// Expects a list expression starting with built-in "-" on the stack. It is not /// modified. Returns a number expression or an exception. yexpr_t ybuiltin_fn_minus(yeval_state_t* state) { #define _pattern "(- numeric-expr numeric-expr [numeric-expr ...])" yexpr_t minus; if (!yvec_pop(&state->call_stack, &minus)) NOTENOUGHFAIL(MINUS); if (minus.typ != YEXPR_LIST) BADEXPRFAIL(MINUS, minus); if (minus.value.list.len < 3) BADEXPRFAIL(MINUS, minus); yvec_t* minus_list = &minus.value.list; long long result = 0; bool first = true; for (size_t i = 1; i < minus_list->len; i++) { yexpr_t* expr = YVEC_AT(minus_list, i, yexpr_t); yexpr_t evald = yeval(state, expr, false); if (evald.typ != YEXPR_NUMBER) TYPEFAIL(MINUS, evald, _pattern); if (first) { result += evald.value.n; first = false; } else { result -= evald.value.n; } yexpr_destroy(&evald); } yexpr_t result_expr = yexpr_new(); yexpr_set_number(&result_expr, result); return result_expr; #undef _pattern } /// Expects a list expression starting with built-in "*" on the stack. It is not /// modified. Returns a number expression or an exception. yexpr_t ybuiltin_fn_times(yeval_state_t* state) { #define _pattern "(* numeric-expr numeric-expr [numeric-expr ...])" yexpr_t times; if (!yvec_pop(&state->call_stack, ×)) NOTENOUGHFAIL(MULT); if (times.typ != YEXPR_LIST) BADEXPRFAIL(MULT, times); if (times.value.list.len < 3) BADEXPRFAIL(MULT, times); yvec_t* times_list = ×.value.list; long long result = 1; for (size_t i = 1; i < times_list->len; i++) { yexpr_t* expr = YVEC_AT(times_list, i, yexpr_t); yexpr_t evald = yeval(state, expr, false); if (evald.typ != YEXPR_NUMBER) TYPEFAIL(MULT, evald, _pattern); result *= evald.value.n; yexpr_destroy(&evald); } yexpr_t result_expr = yexpr_new(); yexpr_set_number(&result_expr, result); return result_expr; #undef _pattern } yexpr_t ybuiltin_fn_if(yeval_state_t* state) { #define _pattern \ "(if condition then-expr/(then-exprs) [else-expr/(else-exprs)])" yexpr_t if_expr; if (!yvec_pop(&state->call_stack, &if_expr)) NOTENOUGHFAIL(IF); if (if_expr.typ != YEXPR_LIST) BADEXPRFAIL(IF, if_expr); if (if_expr.value.list.len < 3) BADEXPRFAIL(IF, if_expr); yexpr_t* condition = YVEC_AT(&if_expr.value.list, 1, yexpr_t); yexpr_t* then_expr = YVEC_AT(&if_expr.value.list, 2, yexpr_t); yexpr_t* else_expr = NULL; if (if_expr.value.list.len > 3) else_expr = YVEC_AT(&if_expr.value.list, 3, yexpr_t); yexpr_t cond_result = yeval(state, condition, false); bool result = false; if (cond_result.typ == YEXPR_ATOM && yatom_get_or_add("true") == cond_result.value.atom) result = true; if (cond_result.typ == YEXPR_NUMBER && cond_result.value.n != 0) result = true; if (result) { if (then_expr->typ == YEXPR_LIST) return yeval_list_return_last(state, &then_expr->value.list, 0); return yeval(state, then_expr, false); } else if (else_expr != NULL) { if (else_expr->typ == YEXPR_LIST) return yeval_list_return_last(state, &else_expr->value.list, 0); return yeval(state, else_expr, false); } else { return yexpr_new(); } #undef _pattern } yexpr_t ybuiltin_fn_print(yeval_state_t* state) { #define _pattern "(print expr [expr...])" yexpr_t print; FILE* out = output_handle == NULL ? stdout : output_handle; if (!yvec_pop(&state->call_stack, &print)) NOTENOUGHFAIL(PRINT); if (print.typ != YEXPR_LIST) BADEXPRFAIL(PRINT, print); if (print.value.list.len < 1) BADEXPRFAIL(PRINT, print); for (size_t i = 1; i < print.value.list.len; i++) { yexpr_t evald = yeval(state, YVEC_AT(&print.value.list, i, yexpr_t), false); if (evald.typ == YEXPR_STRING) { fputs(ystr_str(&evald.value.str), out); goto cleanup_continue; } ystr_t repr = yexpr_debug_str(&evald); fputs(ystr_str(&repr), out); cleanup_continue: if (i != print.value.list.len - (size_t)1) fputc(' ', out); yexpr_destroy(&evald); ystr_destroy(&repr); } return yexpr_new(); #undef _pattern } yexpr_t ybuiltin_fn_eq(yeval_state_t* state) { #define _pattern "(== expr expr [expr...])" yexpr_t eq; if (!yvec_pop(&state->call_stack, &eq)) NOTENOUGHFAIL(EQ); if (eq.typ != YEXPR_LIST) BADEXPRFAIL(EQ, eq); if (eq.value.list.len < 3) BADEXPRFAIL(EQ, eq); yexpr_t* first = YVEC_AT(&eq.value.list, 1, yexpr_t); yexpr_t* second = YVEC_AT(&eq.value.list, 2, yexpr_t); yexpr_t firstevald = yeval(state, first, false); yexpr_t secondevald = yeval(state, second, false); bool equal = yexpr_equal(&firstevald, &secondevald); yexpr_destroy(&firstevald); yexpr_destroy(&secondevald); yexpr_t result = yexpr_new(); if (equal) yexpr_set_atom(&result, yatom_get_or_add("true")); else yexpr_set_atom(&result, yatom_get_or_add("false")); return result; #undef _pattern } yexpr_t ybuiltin_fn_mkclsr(yeval_state_t* state) { #define _pattern \ "(_mkclsr function-ref captured1 captured2 ...)" // Sets function-ref to a // yexpr_t of type // YEXPR_FUNC, with // captured values. // TODO: continue implementation #undef _pattern } /** * @brief Table of built-in functions, indexed by YBUILTIN_TYPE. * * TODO: write built-ins. */ static const ybuiltin_fn YBUILTIN_FNS[] = {ybuiltin_fn_undef, ybuiltin_fn_for, ybuiltin_fn_let, NULL, ybuiltin_fn_plus, ybuiltin_fn_minus, ybuiltin_fn_times, NULL, ybuiltin_fn_if, ybuiltin_fn_print, ybuiltin_fn_eq, NULL, NULL, NULL, NULL, NULL, NULL, ybuiltin_fn_mkclsr}; const char* ybuiltin_name(YBUILTIN_TYPE t) { assert(t * sizeof(const char*) < sizeof(YBUILTIN_ENUM_STR)); return YBUILTIN_ENUM_STR[t]; } yexpr_t ybuiltin_run(YBUILTIN_TYPE t, yeval_state_t* state) { assert((t * sizeof(ybuiltin_fn)) < sizeof(YBUILTIN_FNS)); return YBUILTIN_FNS[t](state); }