sforth/forth.hpp

/// sforth, an implementation of forth
/// Copyright (C) 2024  Clyne Sullivan <clyne@bitgloo.com>
///
/// This program is free software: you can redistribute it and/or modify it
/// under the terms of the GNU General Public License as published by the Free
/// Software Foundation, either version 3 of the License, or (at your option)
/// any later version.
///
/// This program is distributed in the hope that it will be useful, but WITHOUT
/// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
/// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
/// more details.
///
/// You should have received a copy of the GNU General Public License along
/// with this program.  If not, see <http://www.gnu.org/licenses/>.

#ifndef SFORTH_HPP
#define SFORTH_HPP

#include <algorithm>
#include <array>
#include <charconv>
#include <cstdint>
#include <cstddef>
#include <iterator>
#include <span>
#include <string_view>
#include <tuple>
#include <utility>

struct forth
{
    using cell = std::intptr_t;
    using addr = std::uintptr_t;
    using func = void (*)(void *);

    static constexpr bool enable_exceptions = true;
    static constexpr int data_size = 16;
    static constexpr int return_size = 16;

    static constexpr auto npos = std::string_view::npos;

    enum class error {
        init_error,
        parse_error,
        execute_error,
        dictionary_overflow,
        word_not_found,
        stack_underflow,
        stack_overflow,
        return_stack_underflow,
        return_stack_overflow,
        compile_only_word
    };

    template<error Err>
    static inline void assert(bool condition) {
        if constexpr (enable_exceptions) {
            if (!condition)
                throw Err;
        }
    }

    struct word_base {
        static constexpr addr immediate = 1 << 8;

        word_base *next;
        addr flags_len;

        auto name() const -> std::string_view {
            return {reinterpret_cast<const char *>(this + 1)};
        }

        auto body() -> func * {
            auto ptr = reinterpret_cast<std::uint8_t *>(this + 1) + (flags_len & 0xFF);
            return reinterpret_cast<func *>(ptr);
        }
    };

    void push(cell v) {
        assert<error::stack_overflow>(sp != dstack.begin());
        *--sp = v;
    }

    void push(cell v, auto... vs) {
        push(v); (push(vs), ...);
    }

    void rpush(func *v) {
        assert<error::return_stack_overflow>(rp != rstack.begin());
        *--rp = reinterpret_cast<cell>(v);
    }

    cell& top() {
        assert<error::stack_underflow>(sp != dstack.end());
        return *sp;
    }

    cell pop() {
        assert<error::stack_underflow>(sp != dstack.end());
        auto ret = *sp;
        *sp++ = -1;
        return ret;//*sp++;
    }

    auto rpop() -> func * {
        assert<error::return_stack_underflow>(rp != rstack.end());
        auto ret = reinterpret_cast<func *>(*rp);
        *rp++ = -1;
        return ret;
    }

    template<int N>
    auto pop() {
        static_assert(N > 0, "pop<N>() with N <= 0");

        auto t = std::tuple {pop()};
        if constexpr (N > 1)
            return std::tuple_cat(t, pop<N - 1>());
        else
            return t;
    }

    forth& add(std::string_view name, func entry = nullptr) {
        const auto namesz = (name.size() + 1 + sizeof(cell)) & ~(sizeof(cell) - 1);
        const auto size = (sizeof(word_base) + namesz) / sizeof(cell);

        assert<error::parse_error>(!name.empty());
        //assert<error::dictionary_overflow>(state->here + size < &dictionary.back());

        const auto h = std::exchange(here, here + size);
        auto w = new (h) word_base (nullptr, namesz);
        w->next = std::exchange(latest, w);
        std::copy(name.begin(), name.end(),
            reinterpret_cast<char *>(h) + sizeof(word_base));
        if (entry)
            *here++ = reinterpret_cast<cell>(entry);
        return *this;
    }

    forth& make_immediate() {
        latest->flags_len |= word_base::immediate;
        return *this;
    }

    void parse_line(std::string_view sv) {
        source = sv.data();
        sourcei = sv.find_first_not_of(" \t\r\n");

        while (sourcei != npos) {
            const auto word = parse();

            if (auto ent = get(word); !ent) {
                cell n;
                const auto [p, e] = std::from_chars(word.cbegin(), word.cend(), n);

                assert<error::word_not_found>(e == std::errc() && p == word.cend());

                push(n);

                if (compiling)
                    execute((*get("literal"))->body());
            } else {
                auto body = (*ent)->body();

                if (compiling && ((*ent)->flags_len & word_base::immediate) == 0) {
                    *here++ = reinterpret_cast<cell>(body);
                } else {
                    execute(body);
                }
            }
        }
    }

    auto parse() -> std::string_view {
        const std::string_view sv {source};

        const auto e = sv.find_first_of(" \t\r\n", sourcei);
        const auto word = e != npos ? sv.substr(sourcei, e - sourcei)
                                    : sv.substr(sourcei);
    
        sourcei = sv.find_first_not_of(" \t\r\n", e);
        return word;
    }

    void execute(func *body) {
        assert<error::execute_error>(body && *body);
        (*body)(body);
    }

    auto get(std::string_view sv) -> std::optional<word_base *> {
        for (auto lt = latest; lt; lt = lt->next) {
            if (sv == lt->name())
                return lt;
        }

        return {};
    }

    template<forth **fthp>
    static void prologue(func *body) {
        static auto& fth = **fthp;

        fth.rpush(fth.ip);

        for (fth.ip = body + 1; *fth.ip; fth.ip++)
            fth.execute(reinterpret_cast<func *>(*fth.ip));

        fth.ip = fth.rpop();
    }

    template<forth** fthp>
    static void initialize(cell *end_value)
    {
        assert<error::init_error>(*fthp);

        static auto& fth = **fthp;

        fth.end = end_value;
        fth
            .add("_d", [](auto) { fth.push(reinterpret_cast<cell>(&fth)); })
            //.add("[",    [](auto) { fth.compiling = false; }).make_immediate()
            //.add("]",    [](auto) { fth.compiling = true; })
            .add("immediate", [](auto) { fth.make_immediate(); }).make_immediate()
            .add("literal", [](auto) {
                static auto lit_impl = +[] {
                    auto ptr = reinterpret_cast<cell *>(++fth.ip);
                    fth.push(*ptr);
                };
                assert<error::compile_only_word>(fth.compiling);
                *fth.here++ = reinterpret_cast<cell>(&lit_impl);
                *fth.here++ = fth.pop();
            }).make_immediate()
            .add("@",    [](auto) { fth.push(*reinterpret_cast<cell *>(fth.pop())); })
            .add("!",    [](auto) {
                auto [p, v] = fth.pop<2>();
                *reinterpret_cast<cell *>(p) = v; })
            .add("swap", [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); })
            //.add("drop", [](auto) { fth.pop(); })
            //.add("dup",  [](auto) { fth.push(fth.top()); })
            //.add("rot",  [](auto) { auto [a, b, c] = fth.pop<3>(); fth.push(b, a, c); })
            .add("+",    [](auto) { fth.top() += fth.pop(); })
            .add("-",    [](auto) { fth.top() -= fth.pop(); })
            .add("*",    [](auto) { fth.top() *= fth.pop(); })
            .add("/",    [](auto) { fth.top() /= fth.pop(); })
            .add("and",  [](auto) { fth.top() &= fth.pop(); })
            .add("or",   [](auto) { fth.top() |= fth.pop(); })
            .add("xor",  [](auto) { fth.top() ^= fth.pop(); })
            .add("=",    [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() == v); })
            .add("<",    [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() < v); })
            .add("\'", [](auto) {
                auto w = fth.parse();

                if (auto g = fth.get(w); g)
                    fth.push(reinterpret_cast<cell>((*g)->body()));
                else
                    fth.push(0);
            })
            .add(":", [](auto) {
                auto w = fth.parse();
                fth.add(w);
                *fth.here++ = reinterpret_cast<cell>(forth::prologue<fthp>);
                fth.compiling = true;
            })
            .add(";", [](auto) {
                *fth.here++ = 0;
                fth.compiling = false;
            }).make_immediate()
            .add("\\", [](auto) {
                fth.sourcei = npos;
            }).make_immediate();
    }

    static auto error_string(error err) noexcept -> std::string_view {
        using enum error;
        switch (err) {
        case init_error:             return "init error";
        case parse_error:            return "parse error";
        case execute_error:          return "execute error";
        case dictionary_overflow:    return "dictionary overflow";
        case word_not_found:         return "word not found";
        case stack_underflow:        return "stack underflow";
        case stack_overflow:         return "stack overflow";
        case return_stack_underflow: return "return stack underflow";
        case return_stack_overflow:  return "return stack overflow";
        case compile_only_word:      return "compile only word";
        default:                     return "unknown error";
        }
    }

    constexpr forth() {
        sp = dstack.end();
        rp = rstack.end();
    }

    cell *sp;
    cell *rp;
    func *ip = nullptr;
    cell *here = reinterpret_cast<cell *>(this + 1);
    word_base *latest = nullptr;
    const char *source = nullptr;
    std::size_t sourcei = npos;
    cell compiling = false;
    cell *end = nullptr;
    std::array<cell, data_size> dstack;
    std::array<cell, return_size> rstack;
};

static_assert(offsetof(forth::word_base, flags_len) == 1 * sizeof(forth::cell));
static_assert(offsetof(forth, rp)        == 1 * sizeof(forth::cell));
static_assert(offsetof(forth, ip)        == 2 * sizeof(forth::cell));
static_assert(offsetof(forth, here)      == 3 * sizeof(forth::cell));
static_assert(offsetof(forth, latest)    == 4 * sizeof(forth::cell));
static_assert(offsetof(forth, source)    == 5 * sizeof(forth::cell));
static_assert(offsetof(forth, sourcei)   == 6 * sizeof(forth::cell));
static_assert(offsetof(forth, compiling) == 7 * sizeof(forth::cell));
static_assert(offsetof(forth, end)       == 8 * sizeof(forth::cell));

#endif // SFORTH_HPP