AI_Slop/calog
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
calog/src/s7/s7Adapter.c

696 lines
26 KiB
C
Raw Blame History

// 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;
}
Reference in a new issue View git blame Copy permalink