// s7Adapter.c -- s7 Scheme engine adapter for the broker.
//
// Natives are exposed through one generic dispatcher %calog-call plus a tiny Scheme
// wrapper per name: exposing "report" defines (report . a) => (apply %calog-call
// "report" a), so the dispatcher recovers the name from its first argument and the
// context from a hidden *calog-context* c-pointer, marshals the rest to CalogValueT, and
// dispatches through calogCall (honoring the actor route hook). Marshalling covers
// scalars, binary-safe strings, and aggregates both ways (out: a Scheme list, or a
// hash-table when keyed, so a record reads as (user "name"); in: a list or a hash-table
// iterated back into an aggregate). Functions cross both ways: a Scheme procedure out is
// a refcounted CalogFnT kept alive by s7_gc_protect; a foreign CalogFnT pushed in is an
// applicable c-object the script calls as (f ...).
//
// Error model: a native failure raises a Scheme error via s7_error. calogS7Run wraps the
// source in (catch #t (lambda () (eval-string ...)) handler) so both read and run errors
// report through calogS7Run's status rather than aborting; the handler records the failure
// out-of-band (context->errorFlag) instead of an in-band sentinel value, so a script that
// legitimately returns matching data is never mistaken for a caught error.

#define _POSIX_C_SOURCE 200809L

#include "s7Adapter.h"

#include "s7.h"

#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define S7_CONTEXT_VAR "*calog-context*"

// Wrapper source for calogS7Run: escaped script text goes in the single %s, the catch
// handler is the hidden global function below rather than in-band data, so success/failure
// is tracked out-of-band (context->errorFlag) and cannot collide with a script's own return
// value.
#define S7_RUN_WRAP_FMT "(catch #t (lambda () (eval-string \"%s\")) %%calog-catch)"

// Wrapper source for calogS7Expose: a variadic forwarder to the generic dispatcher.
#define S7_EXPOSE_FMT "(define (%s . a) (apply %%calog-call \"%s\" a))"

struct CalogS7T {
    s7_scheme *sc;
    CalogT    *broker;
    uint64_t   ctxId;
    s7_int     fnType;      // c-object type for a foreign CalogFnT pushed into Scheme (applicable + freed)
    bool       errorFlag;   // set by s7CatchHandler when calogS7Run's script raised
    char       errorText[CALOG_ERR_MSG_CAP];
};

// Backs a CalogFnT exported from this interpreter: the owning context, the protected
// procedure, and its gc-protect location (dropped on release).
typedef struct S7ExportT {
    CalogS7T    *context;
    s7_pointer   proc;
    unsigned int gcLoc;
} S7ExportT;

static int32_t     s7CallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void        s7CallableRelease(CalogFnT *callable);
static s7_pointer  s7CatchHandler(s7_scheme *sc, s7_pointer args);
static s7_pointer  s7DispatchNative(s7_scheme *sc, s7_pointer args);
static char       *s7EscapeSource(const char *source);
static int32_t     s7ExportValue(CalogS7T *context, s7_pointer proc, CalogFnT **out);
static s7_pointer  s7FinishInvoke(s7_scheme *sc, CalogS7T *context, CalogValueT *cargs, int32_t argCount, int32_t status, CalogValueT *result, const char *failureMessage);
static s7_pointer  s7ForeignApply(s7_scheme *sc, s7_pointer args);
static void        s7ForeignFree(void *value);
static s7_pointer  s7FromValue(CalogS7T *context, const CalogValueT *value, int32_t depth);
static int32_t     s7MarshalArgs(CalogS7T *context, s7_pointer rest, int32_t argCount, CalogValueT **outArgs);
static s7_pointer  s7MarshalError(s7_scheme *sc, int32_t status, const char *oomMessage, const char *typeMessage);
static s7_pointer  s7ResolveUnbound(s7_scheme *sc, s7_pointer args);
static int32_t     s7ToValue(CalogS7T *context, s7_pointer obj, CalogValueT *out, int32_t depth);


int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId) {
    CalogS7T *context;

    *out = NULL;
    context = (CalogS7T *)calloc(1, sizeof(*context));
    if (context == NULL) {
        return calogErrOomE;
    }
    context->sc = s7_init();
    if (context->sc == NULL) {
        free(context);
        return calogErrOomE;
    }
    context->broker = broker;
    context->ctxId  = ctxId;
    // Hidden globals: the context (so the dispatcher recovers its broker) and the
    // single generic native dispatcher.
    s7_define_variable(context->sc, S7_CONTEXT_VAR, s7_make_c_pointer(context->sc, context));
    s7_define_function(context->sc, "%calog-call", s7DispatchNative, 1, 0, true, "calog native dispatch");
    // Hidden catch handler used by calogS7Run: a real function (not in-band Scheme data),
    // so a script's own return value can never be confused with a caught error.
    s7_define_function(context->sc, "%calog-catch", s7CatchHandler, 2, 0, false, "calog catch handler");
    // Hidden wrapper used by s7CallableInvoke: catches a raising exported callback so its
    // failure can be reported through calogFnInvoke's status instead of being lost.
    s7_eval_c_string(context->sc,
        "(define (%calog-invoke proc a) "
        "(catch #t (lambda () (cons #t (apply proc a))) "
        "(lambda (tag . info) (cons #f (object->string (cons tag info))))))");
    // A c-object type for a foreign function pushed into Scheme: applicable via its ref
    // hook (so (f 2 3) invokes it) and released by its free hook.
    context->fnType = s7_make_c_type(context->sc, "calog-fn");
    s7_c_type_set_ref(context->sc, context->fnType, s7ForeignApply);
    s7_c_type_set_free(context->sc, context->fnType, s7ForeignFree);
    // Bare-name export resolution: when a symbol is unbound, *unbound-variable-hook* fires;
    // s7ResolveUnbound looks the name up in the export registry and, if found, sets the
    // hook's result so (exportedFn args) works without an explicit call().
    {
        s7_pointer resolver;
        resolver = s7_make_function(context->sc, "%calog-unbound", s7ResolveUnbound, 1, 0, false, "calog export resolver");
        s7_hook_set_functions(context->sc, s7_name_to_value(context->sc, "*unbound-variable-hook*"), s7_list(context->sc, 1, resolver));
    }
    *out = context;
    return calogOkE;
}


static int32_t s7CallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
    S7ExportT   *export;
    CalogS7T    *context;
    s7_scheme   *sc;
    s7_pointer   argList;
    s7_pointer   holder;
    s7_pointer   outcome;
    s7_pointer   message;
    unsigned int loc;
    int32_t      index;

    export  = (S7ExportT *)userData;
    context = export->context;
    sc      = context->sc;
    calogValueNil(result);
    // Build the argument list back-to-front so evaluation order is preserved; the holder
    // is gc-protected and updated after every cons so the growing list stays reachable
    // while a nested s7FromValue call allocates.
    holder  = s7_cons(sc, s7_nil(sc), s7_nil(sc));
    loc     = s7_gc_protect(sc, holder);
    argList = s7_nil(sc);
    for (index = argCount - 1; index >= 0; index--) {
        s7_pointer element;
        element = s7FromValue(context, &args[index], 0);
        argList = s7_cons(sc, element, argList);
        s7_set_car(holder, argList);
    }
    s7_gc_unprotect_at(sc, loc);
    // %calog-invoke wraps the call in its own catch, so a raising callback comes back as
    // (#f . message) instead of an uncaught error object indistinguishable from a value.
    outcome = s7_call(sc, s7_name_to_value(sc, "%calog-invoke"), s7_list(sc, 2, export->proc, argList));
    if (s7_is_eq(s7_car(outcome), s7_f(sc))) {
        message = s7_cdr(outcome);
        return calogFail(result, calogErrArgE, s7_is_string(message) ? s7_string(message) : "s7 callback failed");
    }
    return s7ToValue(context, s7_cdr(outcome), result, 0);
}


static void s7CallableRelease(CalogFnT *callable) {
    S7ExportT *export;

    export = (S7ExportT *)calogFnUserData(callable);
    s7_gc_unprotect_at(export->context->sc, export->gcLoc);
    free(export);
}


// Registered as the catch handler in S7_RUN_WRAP_FMT: (tag . info) is whatever the caught
// error raised. Recording the failure out-of-band (rather than returning an in-band
// sentinel value) means a script that legitimately returns matching data is never mistaken
// for a caught error.
static s7_pointer s7CatchHandler(s7_scheme *sc, s7_pointer args) {
    CalogS7T  *context;
    s7_pointer type;
    s7_pointer info;
    char      *text;

    context = (CalogS7T *)s7_c_pointer(s7_name_to_value(sc, S7_CONTEXT_VAR));
    type    = s7_car(args);
    info    = s7_cadr(args);
    context->errorFlag = true;
    text = s7_object_to_c_string(sc, s7_cons(sc, type, info));
    if (text != NULL) {
        snprintf(context->errorText, sizeof(context->errorText), "%s", text);
        free(text);
    } else {
        context->errorText[0] = '\0';
    }
    return s7_unspecified(sc);
}


void calogS7Destroy(CalogS7T *context) {
    if (context == NULL) {
        return;
    }
    if (context->sc != NULL) {
        s7_free(context->sc);
    }
    free(context);
}


// Common tail for s7DispatchNative and s7ForeignApply: free the marshalled C args, then
// convert the invocation outcome -- an s7_error on failure (using failureMessage as a
// fallback when the result carries no string), or the marshalled Scheme value on success.
static s7_pointer s7FinishInvoke(s7_scheme *sc, CalogS7T *context, CalogValueT *cargs, int32_t argCount, int32_t status, CalogValueT *result, const char *failureMessage) {
    s7_pointer sresult;
    int32_t    index;

    for (index = 0; index < argCount; index++) {
        calogValueFree(&cargs[index]);
    }
    free(cargs);
    if (status != calogOkE) {
        s7_pointer message;
        message = s7_make_string(sc, (result->type == calogStringE) ? result->as.s.bytes : failureMessage);
        calogValueFree(result);
        return s7_error(sc, s7_make_symbol(sc, "calog-error"), message);
    }
    sresult = s7FromValue(context, result, 0);
    calogValueFree(result);
    return sresult;
}


// Marshal a Scheme list (rest, of length argCount) into a freshly allocated CalogValueT
// array shared by s7DispatchNative and s7ForeignApply. On success *outArgs is the array
// (NULL when argCount is 0); on failure *outArgs is NULL and any elements already
// marshalled have been freed.
static int32_t s7MarshalArgs(CalogS7T *context, s7_pointer rest, int32_t argCount, CalogValueT **outArgs) {
    CalogValueT *cargs;
    s7_pointer   node;
    int32_t      index;
    int32_t      status;

    *outArgs = NULL;
    if (argCount == 0) {
        return calogOkE;
    }
    cargs = (CalogValueT *)calloc((size_t)argCount, sizeof(CalogValueT));
    if (cargs == NULL) {
        return calogErrOomE;
    }
    node = rest;
    for (index = 0; index < argCount; index++) {
        status = s7ToValue(context, s7_car(node), &cargs[index], 0);
        if (status != calogOkE) {
            int32_t cleanup;
            for (cleanup = 0; cleanup < index; cleanup++) {
                calogValueFree(&cargs[cleanup]);
            }
            free(cargs);
            return status;
        }
        node = s7_cdr(node);
    }
    *outArgs = cargs;
    return calogOkE;
}


// Raise the s7 error matching an s7MarshalArgs failure status.
static s7_pointer s7MarshalError(s7_scheme *sc, int32_t status, const char *oomMessage, const char *typeMessage) {
    if (status == calogErrOomE) {
        return s7_error(sc, s7_make_symbol(sc, "memory-error"), s7_make_string(sc, oomMessage));
    }
    return s7_error(sc, s7_make_symbol(sc, "wrong-type-arg"), s7_make_string(sc, typeMessage));
}


static s7_pointer s7DispatchNative(s7_scheme *sc, s7_pointer args) {
    CalogS7T    *context;
    s7_pointer   nameObj;
    const char  *name;
    s7_pointer   rest;
    CalogValueT *cargs;
    CalogValueT  result;
    int32_t      argCount;
    int32_t      status;

    context = (CalogS7T *)s7_c_pointer(s7_name_to_value(sc, S7_CONTEXT_VAR));
    nameObj = s7_car(args);
    if (!s7_is_string(nameObj)) {
        return s7_error(sc, s7_make_symbol(sc, "wrong-type-arg"), s7_make_string(sc, "calog native dispatch expects a name string"));
    }
    name     = s7_string(nameObj);
    rest     = s7_cdr(args);
    argCount = (int32_t)s7_list_length(sc, rest);
    status   = s7MarshalArgs(context, rest, argCount, &cargs);
    if (status != calogOkE) {
        return s7MarshalError(sc, status, "out of memory marshalling native arguments", "failed to marshal a native argument");
    }
    calogValueNil(&result);
    status = calogCall(context->broker, name, cargs, argCount, &result);
    return s7FinishInvoke(sc, context, cargs, argCount, status, &result, "native call failed");
}


// Escape a source string into the body of a Scheme string literal (backslash and
// double-quote get a leading backslash). Caller frees.
static char *s7EscapeSource(const char *source) {
    size_t inLen;
    size_t index;
    size_t out;
    char  *escaped;

    inLen   = strlen(source);
    escaped = (char *)malloc(inLen * 2 + 1);
    if (escaped == NULL) {
        return NULL;
    }
    out = 0;
    for (index = 0; index < inLen; index++) {
        char ch;
        ch = source[index];
        if (ch == '\\' || ch == '"') {
            escaped[out++] = '\\';
        }
        escaped[out++] = ch;
    }
    escaped[out] = '\0';
    return escaped;
}


int32_t calogS7Export(CalogS7T *context, const char *globalName, CalogFnT **out) {
    s7_scheme *sc;
    s7_pointer proc;

    sc   = context->sc;
    *out = NULL;
    proc = s7_name_to_value(sc, globalName);
    if (proc == s7_undefined(sc)) {
        return calogErrNotFoundE;
    }
    if (!s7_is_procedure(proc)) {
        return calogErrTypeE;
    }
    return s7ExportValue(context, proc, out);
}


static int32_t s7ExportValue(CalogS7T *context, s7_pointer proc, CalogFnT **out) {
    S7ExportT *export;
    int32_t    status;

    *out   = NULL;
    export = (S7ExportT *)malloc(sizeof(*export));
    if (export == NULL) {
        return calogErrOomE;
    }
    export->context = context;
    export->proc    = proc;
    export->gcLoc   = s7_gc_protect(context->sc, proc);   // keep it reachable
    status = calogFnCreate(out, context->broker, s7CallableInvoke, export, s7CallableRelease, context->ctxId);
    if (status != calogOkE) {
        s7_gc_unprotect_at(context->sc, export->gcLoc);
        free(export);
        return status;
    }
    return calogOkE;
}


int32_t calogS7Expose(CalogS7T *context, const char *name) {
    CalogEntryT *entry;
    char        *define;
    size_t       size;

    entry = calogLookup(context->broker, name);
    if (entry == NULL) {
        return calogErrNotFoundE;
    }
    // Define a variadic wrapper that forwards to the generic dispatcher by name. Size off
    // sizeof(S7_EXPOSE_FMT) (not a hand-picked constant) so a future edit to the format
    // string can't silently outgrow a stale slack value.
    size   = strlen(name) * 2 + sizeof(S7_EXPOSE_FMT);
    define = (char *)malloc(size);
    if (define == NULL) {
        return calogErrOomE;
    }
    snprintf(define, size, S7_EXPOSE_FMT, name, name);
    s7_eval_c_string(context->sc, define);
    free(define);
    return calogOkE;
}


// Applied when a foreign-function c-object is called: args is (obj arg1 arg2 ...), so the
// first element is the object itself. Marshal the rest, invoke, and return the result.
static s7_pointer s7ForeignApply(s7_scheme *sc, s7_pointer args) {
    CalogS7T    *context;
    CalogFnT    *callable;
    s7_pointer   rest;
    CalogValueT *cargs;
    CalogValueT  result;
    int32_t      argCount;
    int32_t      status;

    context  = (CalogS7T *)s7_c_pointer(s7_name_to_value(sc, S7_CONTEXT_VAR));
    callable = (CalogFnT *)s7_c_object_value(s7_car(args));
    rest     = s7_cdr(args);
    argCount = (int32_t)s7_list_length(sc, rest);
    status   = s7MarshalArgs(context, rest, argCount, &cargs);
    if (status != calogOkE) {
        return s7MarshalError(sc, status, "out of memory marshalling function-value args", "failed to marshal a function-value argument");
    }
    calogValueNil(&result);
    status = calogFnInvoke(callable, cargs, argCount, &result);
    return s7FinishInvoke(sc, context, cargs, argCount, status, &result, "function value failed");
}


// Free hook for that c-object: drop the reference the push took.
static void s7ForeignFree(void *value) {
    CalogFnT *callable;

    callable = (CalogFnT *)value;
    if (callable != NULL) {
        calogFnRelease(callable);
    }
}


static s7_pointer s7FromValue(CalogS7T *context, const CalogValueT *value, int32_t depth) {
    s7_scheme *sc;

    sc = context->sc;
    if (depth >= CALOG_MAX_DEPTH) {
        return s7_unspecified(sc);
    }
    switch (value->type) {
        case calogNilE:
            return s7_unspecified(sc);
        case calogBoolE:
            return s7_make_boolean(sc, value->as.b);
        case calogIntE:
            return s7_make_integer(sc, (s7_int)value->as.i);
        case calogRealE:
            return s7_make_real(sc, (s7_double)value->as.r);
        case calogStringE:
            return s7_make_string_with_length(sc, value->as.s.bytes, (s7_int)value->as.s.length);
        case calogAggE: {
            CalogAggT *aggregate;
            int64_t    index;
            aggregate = value->as.agg;
            // Anything keyed (or an explicit map) becomes a hash-table (applicable, so a
            // script reads (user "name")) with the sequence part at integer keys; a pure
            // sequence becomes a Scheme list.
            if (calogAggIsKeyed(aggregate)) {
                s7_pointer   table;
                s7_int       size;
                unsigned int loc;
                size  = (s7_int)(aggregate->arrayCount + aggregate->pairCount);
                table = s7_make_hash_table(sc, size > 0 ? size : 1);
                // Protect the table across the whole build: a large aggregate can allocate
                // past the GC's implicit "recent allocations" window, and the table's own
                // cell (allocated first) would otherwise be the first thing swept.
                loc = s7_gc_protect(sc, table);
                for (index = 0; index < aggregate->arrayCount; index++) {
                    s7_hash_table_set(sc, table, s7_make_integer(sc, (s7_int)index),
                                      s7FromValue(context, &aggregate->array[index], depth + 1));
                }
                for (index = 0; index < aggregate->pairCount; index++) {
                    const CalogValueT *key;
                    s7_pointer         keyObj;
                    key = &aggregate->pairs[index].key;
                    if (key->type == calogStringE) {
                        keyObj = s7_make_string_with_length(sc, key->as.s.bytes, (s7_int)key->as.s.length);
                    } else if (key->type == calogIntE) {
                        keyObj = s7_make_integer(sc, (s7_int)key->as.i);
                    } else {
                        continue;   // non-scalar key: drop the pair
                    }
                    s7_hash_table_set(sc, table, keyObj,
                                      s7FromValue(context, &aggregate->pairs[index].value, depth + 1));
                }
                s7_gc_unprotect_at(sc, loc);
                return table;
            } else {
                s7_pointer   list;
                s7_pointer   holder;
                unsigned int loc;
                // The growing list's head moves every iteration, so root it through a
                // protected holder pair updated after each cons rather than protecting a
                // pointer that goes stale.
                holder = s7_cons(sc, s7_nil(sc), s7_nil(sc));
                loc    = s7_gc_protect(sc, holder);
                list   = s7_nil(sc);
                for (index = aggregate->arrayCount - 1; index >= 0; index--) {
                    s7_pointer element;
                    element = s7FromValue(context, &aggregate->array[index], depth + 1);
                    list    = s7_cons(sc, element, list);
                    s7_set_car(holder, list);
                }
                s7_gc_unprotect_at(sc, loc);
                return list;
            }
        }
        case calogFnE: {
            // Wrap the foreign function in an applicable c-object; retain for its lifetime
            // (the free hook releases it).
            s7_pointer obj;
            obj = s7_make_c_object(sc, context->fnType, value->as.fn);
            calogFnRetain(value->as.fn);
            return obj;
        }
    }
    return s7_unspecified(sc);
}


int32_t calogS7Run(CalogS7T *context, const char *source) {
    s7_scheme *sc;
    char      *escaped;
    char      *wrapped;
    size_t     size;

    sc      = context->sc;
    escaped = s7EscapeSource(source);
    if (escaped == NULL) {
        return calogErrOomE;
    }
    // Size off sizeof(S7_RUN_WRAP_FMT) (not a hand-picked constant) so a future edit to the
    // wrapper text can't silently outgrow a stale slack value.
    size    = strlen(escaped) + sizeof(S7_RUN_WRAP_FMT);
    wrapped = (char *)malloc(size);
    if (wrapped == NULL) {
        free(escaped);
        return calogErrOomE;
    }
    // Catch read- and run-time errors so a bad script reports rather than aborts; the
    // handler is s7CatchHandler, which records failure in context->errorFlag rather than an
    // in-band value, so a script's own return data can never be mistaken for a caught error.
    snprintf(wrapped, size, S7_RUN_WRAP_FMT, escaped);
    free(escaped);
    context->errorFlag = false;
    s7_eval_c_string(sc, wrapped);
    free(wrapped);
    if (context->errorFlag) {
        fprintf(stderr, "s7 error: %s\n", context->errorText);
        return calogErrArgE;
    }
    return calogOkE;
}


static s7_pointer s7ResolveUnbound(s7_scheme *sc, s7_pointer args) {
    CalogS7T   *context;
    CalogValueT nameArg;
    CalogValueT result;
    s7_pointer  hookLet;
    s7_pointer  sym;
    const char *name;
    int32_t     status;

    // The hook passes its let; 'variable holds the unbound symbol, 'result is what we set.
    hookLet = s7_car(args);
    sym     = s7_let_ref(sc, hookLet, s7_make_symbol(sc, "variable"));
    if (!s7_is_symbol(sym)) {
        return s7_unspecified(sc);
    }
    name    = s7_symbol_name(sym);
    context = (CalogS7T *)s7_c_pointer(s7_name_to_value(sc, S7_CONTEXT_VAR));
    if (calogValueString(&nameArg, name, (int64_t)strlen(name)) != calogOkE) {
        return s7_unspecified(sc);
    }
    calogValueNil(&result);
    status = calogCall(context->broker, "__calogExportResolve", &nameArg, 1, &result);
    calogValueFree(&nameArg);
    if (status == calogOkE && result.type == calogFnE) {
        s7_let_set(sc, hookLet, s7_make_symbol(sc, "result"), s7FromValue(context, &result, 0));
    }
    calogValueFree(&result);
    return s7_unspecified(sc);
}


static int32_t s7ToValue(CalogS7T *context, s7_pointer obj, CalogValueT *out, int32_t depth) {
    s7_scheme *sc;

    sc = context->sc;
    calogValueNil(out);
    if (depth >= CALOG_MAX_DEPTH) {
        return calogErrDepthE;
    }
    if (s7_is_boolean(obj)) {
        calogValueBool(out, s7_boolean(sc, obj));
        return calogOkE;
    }
    if (s7_is_integer(obj)) {   // integers are also reals in Scheme, so test first
        calogValueInt(out, (int64_t)s7_integer(obj));
        return calogOkE;
    }
    if (s7_is_real(obj)) {
        calogValueReal(out, (double)s7_real(obj));
        return calogOkE;
    }
    if (s7_is_string(obj)) {
        return calogValueString(out, s7_string(obj), (int64_t)s7_string_length(obj));
    }
    if (s7_is_procedure(obj)) {
        CalogFnT *callable;
        int32_t   status;
        status = s7ExportValue(context, obj, &callable);
        if (status != calogOkE) {
            return status;
        }
        calogValueFn(out, callable);
        return calogOkE;
    }
    if (s7_is_hash_table(obj)) {
        CalogAggT   *aggregate;
        s7_pointer   iter;
        unsigned int loc;
        int32_t      status;
        status = calogAggCreate(&aggregate, calogMapE);
        if (status != calogOkE) {
            return status;
        }
        iter = s7_make_iterator(sc, obj);   // each iterate yields a (key . value) pair
        loc  = s7_gc_protect(sc, iter);
        while (!s7_iterator_is_at_end(sc, iter)) {
            s7_pointer  pair;
            CalogValueT key;
            CalogValueT value;
            pair = s7_iterate(sc, iter);   // a (key . value) cons, or a non-pair at end
            if (!s7_is_pair(pair)) {
                break;
            }
            status = s7ToValue(context, s7_car(pair), &key, depth + 1);
            if (status != calogOkE) {
                break;
            }
            status = s7ToValue(context, s7_cdr(pair), &value, depth + 1);
            if (status != calogOkE) {
                calogValueFree(&key);
                break;
            }
            status = calogAggSet(aggregate, &key, &value);
            if (status != calogOkE) {
                calogValueFree(&key);
                calogValueFree(&value);
                break;
            }
        }
        s7_gc_unprotect_at(sc, loc);
        if (status != calogOkE) {
            calogAggFree(aggregate);
            return status;
        }
        calogValueAgg(out, aggregate);
        return calogOkE;
    }
    if (s7_is_null(sc, obj)) {
        CalogAggT *aggregate;
        int32_t    status;
        status = calogAggCreate(&aggregate, calogListE);
        if (status != calogOkE) {
            return status;
        }
        calogValueAgg(out, aggregate);
        return calogOkE;
    }
    if (s7_is_pair(obj)) {
        CalogAggT *aggregate;
        s7_pointer node;
        int32_t    status;
        status = calogAggCreate(&aggregate, calogListE);
        if (status != calogOkE) {
            return status;
        }
        node = obj;
        while (s7_is_pair(node)) {
            CalogValueT element;
            status = s7ToValue(context, s7_car(node), &element, depth + 1);
            if (status != calogOkE) {
                calogAggFree(aggregate);
                return status;
            }
            status = calogAggPush(aggregate, &element);
            if (status != calogOkE) {
                calogValueFree(&element);
                calogAggFree(aggregate);
                return status;
            }
            node = s7_cdr(node);
        }
        calogValueAgg(out, aggregate);
        return calogOkE;
    }
    // #<unspecified>, eof, symbols, etc. -> nil.
    return calogOkE;
}