view src/built-ins.c @ 157:15825a4a3580

preprocess: Implement preprocessing with hacks for REPL
author Lewin Bormann <lbo@spheniscida.de>
date Tue, 03 Sep 2019 15:36:03 +0200
parents 88fec15abdbc
children 72a52494df50
line wrap: on
line source

#include "built-ins.h"

#include "value.h"

#include "base/str.h"

// TODO: Write standard library!

/**
 * @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},
};

static const char* YBUILTIN_ENUM_STR[] = {
   "BUILTIN:UNDEF", "BUILTIN:FOR", "BUILTIN:LET",  "BUILTIN:DEFN",
    "BUILTIN:+",     "BUILTIN:-",   "BUILTIN:*",    "BUILTIN:/",
    "BUILTIN:IF",    "BUILTIN:SEQ", "BUILTIN:EQ",   "BUILTIN:LT",
    "BUILTIN:CAR",   "BUILTIN:CDR", "BUILTIN:PUSH",
};

/// 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)"
    yexpr_t let, *ref;
    size_t counter = 0;
    yvec_t* letlist = &let.value.list;

    if (!yvec_pop(&state->call_stack, &let)) NOTENOUGHFAIL(LET);
    if (let.typ != YEXPR_LIST) BADEXPRFAIL(LET, let);
    if (let.value.list.len < 3) BADEXPRFAIL(LET, let);

    yexpr_t let_id = *YVEC_AT(letlist, counter++, yexpr_t);
    if (let_id.typ != YEXPR_BUILTIN || let_id.value.builtin != YBUILTIN_LET)
        BADEXPRFAIL(LET, let);

    ref = YVEC_AT(letlist, counter++, yexpr_t);
    if (ref->typ != YEXPR_REF) TYPEFAIL(LET, let, _pattern);

    assert(counter == 2);
    yvalue_t newvalue = {
        .typ = YVALUE_EXPR,
        .value.expr = yeval_list_return_last(state, letlist, counter)};
    yvalue_set(ref->value.ref, &newvalue);
    return yexpr_new();

#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, *expr, _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, *expr, _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, &times)) NOTENOUGHFAIL(MULT);
    if (times.typ != YEXPR_LIST) BADEXPRFAIL(MULT, times);
    if (times.value.list.len < 3) BADEXPRFAIL(MULT, times);

    yvec_t* times_list = &times.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, *expr, _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 = yexpr_new();

    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;

    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);
        ystr_t repr = yexpr_debug_str(&evald);
        fputs(ystr_str(&repr), stdout);
        fputc(' ', stdout);
        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 = yexpr_new();

    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
}

/**
 * @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};

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);
}