/*
 * This file is part of the beastie library.
 *
 * The 'utilities' here are a mixture of S7 helper functions and
 * non-S7 ones.  One would expect it'd be easy to separate these off
 * from each other, but when I tried it, that ended up requiring a
 * rather bigger rewrite than I expected, and having to separate
 * util.c into util-scheme.c and util-misc.c (or something), which
 * felt artificial.  Since it's part of the overall design that the S7
 * pointer is visible _everywhere_, there seems little real point to this.
 *
 * This file is part of Beastie <https://purl.org/nxg/dist/beastie>
 * SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
 * SPDX-License-Identifier: BSD-2-Clause
 */


#if __GNUC__
// when used with -std=c99, gcc doesn't define (eg) vasprintf unless
// this macro is defined (defining _ISO99_SOURCE happens in that case,
// but isn't sufficient to pull in vasprintf)
#ifndef _GNU_SOURCE
#define _GNU_SOURCE
#endif
#endif

#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include <ctype.h>

#include "util.h"

#include "config.h"

#ifndef BEASTIE_DEBUG
#define BEASTIE_DEBUG 0
#endif

/*
 * Produce an error message, and exit with a non-zero status.
 * If the first character of 'fmt' is '!', then abort instead.
 */
void error_exit(const char* fmt, ...)
{
    va_list ap;
    int abort_p = 0;
    const char* actual_fmt = fmt;

    va_start(ap, fmt);

    if (*fmt == '!') {
        abort_p = 1;
        actual_fmt = &fmt[1];
    }

    fprintf(stderr, "beastie: ");
    vfprintf(stderr, actual_fmt, ap);
    if (abort_p) {
        fprintf(stderr, " [this shouldn't happen]");
    }
    fprintf(stderr, "\n");
    va_end(ap);

    if (abort_p) {
        abort();                /* flushes and closes streams */
    } else {
        exit(1);
    }
};

static s7_pointer prepare_beastie_error_v(s7_scheme* sc, const char* fmt, va_list ap)
{
    char* msg;
    int status = vasprintf(&msg, fmt, ap);

    if (status < 0) {
        // make a noise!
        // (though if we're out of memory, then error_exit might fail, too)
        error_exit("Can't allocate space in return_beastie_error, for fmt <%s>", fmt);
    }

    s7_pointer scheme_msg = s7_make_string(sc, msg);

    free(msg);

    return scheme_msg;
}

s7_pointer prepare_beastie_error(s7_scheme* sc, const char* fmt, ...)
{
    va_list ap;
    va_start(ap, fmt);
    s7_pointer msg = prepare_beastie_error_v(sc, fmt, ap);
    va_end(ap);

    return msg;
}

s7_pointer return_beastie_error(s7_scheme* sc, const char* fmt, ...)
{
    va_list ap;
    va_start(ap, fmt);
    s7_pointer msg = prepare_beastie_error_v(sc, fmt, ap);
    va_end(ap);

    // this should match the behaviour of procedure beastie-error, which calls
    // (throw 'beastie msg alist), where the msg is a string, and
    // alist is an alist of possibly useful further information
    s7_pointer sym = s7_make_symbol(sc, "beastie"); // matches (beastie-error ...)
    s7_pointer arg = s7_list(sc, 2,
                             msg,
                             s7_nil(sc));

    return s7_error(sc, sym, arg);
    // doesn't return:
    // as with s7_error, this function's return type is only a convenience
}

// Gobble a va_list of s7_pointers into a s7_list.
// The va_list must be a list of s7_pointers terminated by NULL.
static s7_pointer ap2list(va_list ap)
{
    s7_pointer obj = va_arg(ap, s7_pointer);
    if (obj == NULL) {
        return GCP(s7_nil(S7));
    } else {
        return GCP(s7_cons(S7, obj, ap2list(ap)));
    }
}

// The scheme_* functions are conveninence wrappers of s7_* functions.
// All of these return their result wrapped in GCP(...)

// Return a list containing the given values.
// The arguments must be a list of s7_pointers terminated by NULL
// (not terminated by '0', which can be cast to something the wrong size)
s7_pointer scheme_make_list(s7_pointer v1, ...)
{
    va_list ap;

    va_start(ap, v1);
    s7_pointer args = ap2list(ap);
    va_end(ap);

    return GCP(s7_cons(S7, v1, args));
}

// this is s7_name_to_value, wrapped with a test which throws an error if the symbol is undefined
s7_pointer scheme_name_to_value(const char* sym)
{
    s7_pointer result = s7_name_to_value(S7, sym);
    if (s7_is_eqv(S7, result, s7_undefined(S7))) {
        s7_error(S7,
                 s7_make_symbol(S7, "beastie"),
                 s7_list(S7, 2,
                         s7_make_string(S7, "undefined symbol: ~s"),
                         s7_make_string(S7, sym)));
    }
    return GCP(result);
}

// scheme_eval("function-name", s7_pointer, s7_pointer, ..., NULL)
s7_pointer scheme_eval(const char* fnname, ...)
{
    va_list ap;

    s7_pointer fn = scheme_name_to_value(fnname);

    va_start(ap, fnname);
    s7_pointer args = ap2list(ap);
    va_end(ap);

#if BEASTIE_DEBUG
    fprintf(stderr, "scheme_eval: (%s", fnname);
    for (s7_pointer a = args; !s7_is_null(S7, a); a=s7_cdr(a)) {
        fprintf(stderr, " ");
        s7_write(S7, s7_car(a), s7_current_error_port(S7));
    }
    fprintf(stderr, ")\n");
#endif

    return GCP(s7_call(S7, fn, args));
}

s7_pointer scheme_eval_with_let(s7_pointer let, const char* fnname, ...)
{
    va_list ap;

    if (! s7_is_let(let)) {
        scheme_eval("beastie-error",
                    s7_make_string(S7, "scheme_eval_with_let: ~a is not a let"),
                    let,
                    NULL);
        // NOTREACHED
        return NULL;
    }

    s7_pointer fn = s7_let_ref(S7, let, s7_make_symbol(S7, fnname));
    if (fn == s7_undefined(S7)) {
        scheme_eval("beastie-error",
                    s7_make_string(S7, "scheme_eval_with_let: ~a undefined"),
                    s7_make_string(S7, fnname),
                    NULL);
        // NOTREACHED
        return NULL;
    }

    va_start(ap, fnname);
    s7_pointer args = ap2list(ap);
    va_end(ap);

    return GCP(s7_call(S7, fn, args));
}

s7_pointer scheme_symbol_value_ci(s7_pointer symbol)
{
    const char* s = s7_symbol_name(symbol);

    char* token = alloca(strlen(s)+1);
    char* d = token;
    for (; *s != '\0'; d++, s++) {
        *d = tolower(*s);
    }
    *d = '\0';

    return GCP(s7_symbol_value(S7, s7_make_symbol(S7, token)));
}

s7_pointer scheme_trimmed_string(const char* s)
{
    int l = strlen(s);
    if (l == 0) {
        return GCP(s7_make_string(S7, ""));
    } else {
        return scheme_trimmed_string_with_length(s, l);
    }
}
s7_pointer scheme_trimmed_string_with_length(const char* s, int l)
{
    s7_pointer rval;

    if (l <= 0) {
        rval = s7_make_string(S7, "");
        goto finished;          // JUMP OUT
    }

    const char* startp = s;
    const char* endp = &s[l];
    assert(endp > startp);

    while (isspace(*startp)) {
        startp++;
        if (startp == endp || *startp == '\0') {
            // end of string, one way or another, so...
            rval = s7_make_string(S7, "");
            goto finished;      // JUMP OUT
        }
    }

    // there is at least one non-whitespace character in the string, and startp<endp
    endp--;
    while (isspace(*endp)) endp--;
    assert (endp >= startp);
    rval = s7_make_string_with_length(S7, startp, endp-startp+1);

 finished:
    return GCP(rval);
}

#if 0
// This is pretty close to runtime.scm:basic-repl*, done by hand.
// Calling basic-repl* is neater
void basic_repl(void)
{
    s7_pointer error_handler = NULL;

    printf("1> ");
    s7_pointer in_sexp = s7_read(S7, s7_current_input_port(S7));

    for (int expr_count = 2;
         ! s7_is_eqv(S7, in_sexp, s7_eof_object(S7));
         expr_count++) {

        s7_call(S7,
                scheme_name_to_value("eval/catch/global"),
                s7_cons(S7, in_sexp, s7_nil(S7)));

        printf("%d> ", expr_count);
        in_sexp = s7_read(S7, s7_current_input_port(S7));
    }
}
#endif

#if 0
// We don't need this function (and if we did in future, we could
// probably do it more robustly by calling out to s7 (read)), but keep
// it around just in case.

// Read a single expression from stdin, and return it as a char*.
// The string must not be freed.
const char* scheme_read_expr_from_stdin(void)
{
    return scheme_read_expr(&getchar);
}

// Read a single expression from an input source given as a pointer to
// a function int(*)(void), and return it as a char*.
// The string must not be freed.
const char* scheme_read_expr(int (*read_char)(void))
{
    static StringBuilder builder = NULL;
    if (builder == NULL) {
        builder = make_stringbuilder();
    } else {
        stringbuilder_reset(builder);
    }

    enum {
        in_expr,                // looking for a matching close-bracket
        in_string,              // looking for a closing '"' (and spotting \")
        skipping_comment,       // looking for a newline
        skipping_whitespace,    // skipping multiple blanks
        scanning_initial_token, // looking for whitespace or '('
        scanning_initial_whitespace
    } state = scanning_initial_whitespace;
    int brace_level = 0;

    char n_unget = 0;
    int unget_char = 0;
#define UNGETC(c) if (n_unget != 0) {         \
        fprintf(stderr, "Two characters of pushback in scheme_read_expr!\n"); \
        return NULL;                                                       \
    } else {                                                            \
        unget_char = c;                                                 \
        n_unget = 1;                                                    \
    }
#define GETC (n_unget==0 ? (*read_char)() : (n_unget=0, unget_char))

    int still_scanning = 1;
    while (still_scanning) {
        int c = GETC;
        if (c == EOF) return NULL;

        int do_append_c = 1;
        switch (state) {
          case in_expr:
            switch (c) {
              case '(':
                brace_level++;
                break;
              case ')':
                if (brace_level == 0) {
                    fprintf(stderr, "stray right bracket (ignored)\n");
                    do_append_c = 0;
                } else {
                    brace_level--;
                    if (brace_level == 0) still_scanning = 0;
                }
                break;
              case '"':
                state = in_string;
                break;
              case ';':
                c = ' ';
                state = skipping_comment;
                break;

              case '\n': case '\r':
                c = ' ';
                state = skipping_whitespace;
                break;

              default:
                if (isspace(c)) {
                    c = ' ';
                    state = skipping_whitespace;
                }
                // otherwise do nothing, but leave do_append_c==1, so the character is appended
                break;
            }
            break;

          case in_string:
            switch (c) {
              case '\\':
                // the only thing we have to escape is '"',
                // to make sure that "...\"..." doesn't end the string
                stringbuilder_append_c(builder, '\\');
                c = GETC;  // doesn't matter what it is
                break;
              case '"':
                if (brace_level == 0) {
                    // this is an initial token
                    still_scanning = 0;
                } else {
                    state = in_expr;
                }
                break;
            }
            break;

          case skipping_comment:
            if (c == '\n' || c == '\r') {
                state = skipping_whitespace;
            }
            do_append_c = 0;
            break;

          case skipping_whitespace:
            if (isspace(c)) {
                do_append_c = 0;
            } else {
                UNGETC(c);
                do_append_c = 0;
                state = in_expr;
            }
            break;

          case scanning_initial_whitespace:
            if (isspace(c)) {
                do_append_c = 0;
            } else {
                switch (c) {
                  case '(':
                    state = in_expr;
                    brace_level++;
                    break;
                  case ')':
                    fprintf(stderr, "stray right bracket (ignored)\n");
                    do_append_c = 0;
                    break;
                  case '"':
                    state = in_string;
                    break;
                  case ';':
                    state = skipping_comment;
                    do_append_c = 0;
                    break;
                  default:
                    state = scanning_initial_token;
                    break;
                }
            }
            break;

          case scanning_initial_token:
            if (isspace(c)) {
                still_scanning = 0;
                do_append_c = 0;
            } else {
                switch (c) {
                  case '(':
                    UNGETC(c);
                    still_scanning = 0;
                    break;
                  case ')':
                    fprintf(stderr, "stray right bracket (ignored)\n");
                    do_append_c = 0;
                    still_scanning = 0;
                    break;
                  case '"':
                    UNGETC(c);
                    still_scanning = 0;
                }
            }
            break;

          default:
            assert(0);
        }

        if (do_append_c) stringbuilder_append_c(builder, c);
    }

    stringbuilder_terminate(builder);
    return builder->buf;
}
#endif

// Convenience function, for debugging
// s7w(string, s7_pointer, string) displays the s7_pointer prefixed and suffixed.
// s7w4 is a four-argument version, which has a fourth argument which
// is non-zero if the output is to go to stderr
void s7w4(const char* before, s7_pointer s, const char* after, int stderr_p)
{
    if (before) fprintf((stderr_p ? stderr : stdout), "%s", before);
    s7_display(S7, s, (stderr_p ? s7_current_error_port(S7) : s7_current_output_port(S7)));
    if (after) fprintf((stderr_p ? stderr : stdout), "%s", after);
}
void s7w(const char* before, s7_pointer s, const char* after)
{
    s7w4(before, s, after, 0);
}

// scheme_printf("scheme format string", s7_pointer..., NULL):
// call scheme FORMAT with the arguments.
// (this probably makes s7w() somewhat redundant)
void scheme_printf(const char* fmt, ...)
{
    s7_pointer fn = scheme_name_to_value("format");

    va_list ap;
    va_start(ap, fmt);
    s7_pointer args = ap2list(ap);
    va_end(ap);

    (void) s7_call(S7,
                   fn,
                   s7_cons(S7,
                           s7_t(S7),
                           s7_cons(S7, s7_make_string(S7, fmt), args)));
}

/*
 * Scan the input available from the scanner, until we find the
 * character 'endwith' at brace level 0.  The 'flags' argument is a
 * mask.  If `SCAN_INCLUDE_LAST` is set, then include the matching
 * 'endwith' character, otherwise leave it on the input.
 */
static const StringBuilder scan_to_matching_char_sb(int (*in)(void*), // read a character from a scanner
                                 void* scanner,    // the scanner
                                 int startline,    // the start line, for error reporting
                                 const char* startwith, // to be initially added to the result
                                 const char endwith,
                                 unsigned int flags)
{
    StringBuilder build_buffer = make_stringbuilder();

    if (startwith) stringbuilder_append_s(build_buffer, startwith);

    int level = 0;
    char keep_going = 1;
    char unexpected_eof = 0;
    while (keep_going) {
        int c = (*in)(scanner);
        //printf("c=%c (0x%x)\n", c, c);
        if (c <= 0) {
            unexpected_eof = 1;
            keep_going = 0;
        } else if (c == '\\') {
            // escape the following character -- pass both through
            stringbuilder_append_c(build_buffer, '\\');
            c = (*in)(scanner);
            if (c > 0) {
                stringbuilder_append_c(build_buffer, c);
            } else {
                unexpected_eof = 1;
                keep_going = 0;
            }
        } else if (c == endwith && level == 0) {
            if (flags & SCAN_INCLUDE_LAST) stringbuilder_append_c(build_buffer, c);
            keep_going = 0;
        } else {
            switch (c) {
              case '{':
                level++;
                break;
              case '}':
                level--;
                break;
            }
            stringbuilder_append_c(build_buffer, c);
        }
    }

    if (unexpected_eof) {
        const char fmt[] = "Unexpected end of input in balanced braces starting on line %d";
        // four-byte ints occupy a maximum of 10 digits
        static const size_t buflen = sizeof(fmt)+10;
        char buf[buflen];
        snprintf(buf, buflen, fmt, startline);
        // throw an error, so that we break off the parse
        // (as long as we want this to be callable from a lex-foo
        // program, we can't reply on beastie-error being present)
        s7_error(S7,
                 s7_make_symbol(S7, "beastie"),
                 s7_cons(S7, s7_make_string(S7, buf), s7_nil(S7)));
    }

    return build_buffer;
}

// Wrap scan_to_matching_char_sb for s7
s7_pointer scan_to_matching_char(int (*in)(void*), // read a character from a scanner
                                 void* scanner,    // the scanner
                                 int startline,    // the start line, for error reporting
                                 const char* startwith, // to be initially added to the result
                                 const char endwith,
                                 unsigned int flags)
{
    StringBuilder sb = scan_to_matching_char_sb(in, scanner, startline, startwith, endwith, flags);
    s7_pointer rval = GCP(s7_make_string_with_length(S7, sb->buf, sb->len));
    stringbuilder_free(sb);
    return rval;
}

// StringBuilder functions
#define SBVALID(b) assert(b->buf != NULL && b->len <= b->alloc)
StringBuilder make_stringbuilder_with_size(size_t initial_alloc)
{
    StringBuilder b;

    if ((b = (StringBuilder)malloc(sizeof(struct append_buffer))) == NULL) {
        error_exit("Can't allocate space for append_buffer");
    }
    b->alloc = initial_alloc;
    b->len = 0;
    if ((b->buf = (char*)malloc(b->alloc)) == NULL) {
        error_exit("Can't allocate space for append_buffer");
    }
    SBVALID(b);
    return b;
}
StringBuilder make_stringbuilder(void)
{
    return make_stringbuilder_with_size(128);
}

// StringBuilder make_stringbuilder_with_content(const char* s, size_t slen)
// {
//     StringBuilder b;

//     if ((b = (StringBuilder)malloc(sizeof(struct append_buffer))) == NULL) {
//         error_exit("Can't allocate space for append_buffer");
//     }

//     size_t blen = 64;
//     while (blen <= slen) {
//         if (blen >= SIZE_MAX/2) error_exit("slen=%zd too big: maximum is %zd", slen, SIZE_MAX/2);
//         blen *= 2;
//     }
//     if ((b->buf = (char*)malloc(blen)) == NULL) {
//         error_exit("Can't allocate %zd bytes for append_buffer", blen);
//     }
//     b->alloc = blen;

//     if (s != NULL && slen > 0) {
//         memcpy(b->buf, s, slen);
//         b->len = slen;
//     } else {
//         b->len = 0;
//     }
//     SBVALID(b);
//     return b;
// }

// append a character to the buffer
StringBuilder stringbuilder_append_c(StringBuilder buf, char b)
{
    if (buf->len >= buf->alloc) { // shouldn't ever be '>', but...
        buf->alloc *= 2;
        if ((buf->buf = (char*)realloc((void*)buf->buf, buf->alloc)) == NULL) {
            error_exit("Can't reallocate space for stringbuilder_append_c");
        }
    }
    buf->buf[buf->len++] = b;
    SBVALID(buf);
    return buf;
}

// append a string+length to the buffer
StringBuilder stringbuilder_append_sn(StringBuilder buf, const char* b, size_t blen)
{
    size_t newlen = buf->len + blen;
    if (newlen >= buf->alloc) {
        while (buf->alloc < newlen) {
            buf->alloc *= 2;
        }
        if ((buf->buf = (char*)realloc((void*)buf->buf, buf->alloc)) == NULL) {
            error_exit("Can't reallocate space for append_to_buffer_n");
        }
    }
    memcpy(&(buf->buf[buf->len]), b, blen);
    buf->len += blen;
    SBVALID(buf);
    return buf;
}

// append one stringbuilder to another
StringBuilder stringbuilder_append_sb(StringBuilder buf, StringBuilder extra)
{
    return stringbuilder_append_sn(buf, extra->buf, extra->len);
}

// append a null-terminated string to the buffer
StringBuilder stringbuilder_append_s(StringBuilder buf, const char* s)
{
    return stringbuilder_append_sn(buf, s, strlen(s));
}

StringBuilder stringbuilder_printf(StringBuilder buf, const char* fmt, ...)
{
    char* result;

    va_list ap;
    va_start(ap, fmt);
    if (vasprintf(&result, fmt, ap) < 0) {
        // make a noise about this
        error_exit("Can't allocate space in stringbuilder_printf, for fmt <%s>", fmt);
    }
    va_end(ap);

    StringBuilder rval = stringbuilder_append_s(buf, result);

    free(result);
    return rval;
}

#if 0
// more roundabout, but... is vasprintf available everywhere?
StringBuilder stringbuilder_printf(StringBuilder buf, const char* fmt, ...)
{
    int written_ok;

    do {
        va_list ap;
        va_start(ap, fmt);
        size_t avail = buf->alloc - buf->len;
        size_t nwritten = vsnprintf(&buf->buf[buf->len], avail, fmt, ap);
        va_end(ap);

        if (nwritten <= avail) {
            written_ok = 1;
            buf->len += nwritten;
        } else {
            buf->alloc *= 2;
            if ((buf->buf = (char*)realloc((void*)buf->buf, buf->alloc)) == NULL) {
                error_exit("Can't reallocate space for stringbuilder_printf");
            }
            written_ok = 0;
        }
    } while (! written_ok);

    SBVALID(buf);
    return buf;
}
#endif

// Append a '\0' to the buffer, without incrementing the length
StringBuilder stringbuilder_terminate(StringBuilder buf)
{
    stringbuilder_append_c(buf, '\0');
    buf->len--;
    return buf;
}

// reset the buffer's length to zero, without doing any re/deallocation
StringBuilder stringbuilder_reset(StringBuilder buf)
{
    buf->len = 0;
    return buf;
}

void stringbuilder_free(StringBuilder buf)
{
    if (buf != NULL) {
        assert(buf->buf != NULL);
        free(buf->buf);
        free(buf);
    }
}
