Raw File
#include <bash/config.h>
#include <stdlib.h>
#include <bash/builtins.h>
#include <bash/shell.h>
#include <stdio.h>
#include <libguile.h>

static inline char*
scm_symbol_to_utf8_string(SCM symbol)
{
	SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
			SCM_ARG1, __func__, "symbol");
	return scm_to_utf8_stringn(scm_symbol_to_string(symbol), NULL);
}

static SCM dynamic_variables_alist = SCM_EOL;
static SCM
dynamic_value_body(void *data)
{
	struct variable* self = data;
	const char *varname = self->name;
	SCM symbol = scm_string_to_symbol(scm_from_utf8_string(varname));
	SCM thunk = scm_assq_ref(dynamic_variables_alist, symbol);
	SCM value = scm_call_0(thunk);
	char *newvalue = scm_to_utf8_stringn(value, NULL);

	free(self->value);
	self->value = newvalue;
	return SCM_UNDEFINED;
}

static SCM
dynamic_value_exception_handler(void *_unused, SCM key, SCM args)
{
	return scm_print_exception
		(scm_current_error_port(), SCM_BOOL_F, key, args);
}

static struct variable*
dynamic_value(struct variable *self)
{
	scm_internal_catch(SCM_BOOL_T, &dynamic_value_body, self,
			   &dynamic_value_exception_handler, NULL);
	return self;
}

static SCM
scm_bind_dynamic_variable(SCM symbol, SCM thunk)
{
	char *varname;
	struct variable *v;

	SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
			SCM_ARG1, __func__, "symbol");
	SCM_ASSERT_TYPE(scm_is_true(scm_thunk_p(thunk)), thunk,
			SCM_ARG2, __func__, "thunk");

	varname = scm_to_utf8_stringn(scm_symbol_to_string(symbol), NULL);
	v = bind_variable(varname, NULL, 0);
	v->dynamic_value = &dynamic_value;
	dynamic_variables_alist = scm_assq_set_x(dynamic_variables_alist, symbol, thunk);
	free(varname);
	return SCM_UNDEFINED;
}

static int
array_walk_function(ARRAY_ELEMENT *el, void *data)
{
	SCM *alist = data;
	SCM index = scm_from_int64(el->ind);
	SCM value = scm_from_utf8_string(el->value);
	*alist = scm_acons(index, value, *alist);
	return 0;
}

static SCM
scm_array_to_alist(SCM symbol)
{
	char *varname;
	ARRAY *array;
	struct variable *v;
	SCM alist = SCM_EOL;

	SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
			SCM_ARG1, __func__, "symbol");
	varname = scm_symbol_to_utf8_string(symbol);

	GET_ARRAY_FROM_VAR(varname, v, array);
	free(varname);

	if (array == NULL)
		return SCM_BOOL_F;
	array_walk(array, &array_walk_function, &alist);
	return scm_reverse(alist);
}


extern char **make_builtin_argv (WORD_LIST *, int *);

struct guile_builtin_state {
	int argc;    /* Formed by `make_builtin_argv' in `guile_builtin' */
	char *filename;
	char **argv;
	int retval; /* Passed back from do_guile_builtin */
};

static SCM
guile_builtin_body (void *data)
{
        const struct guile_builtin_state *state = data;
	return scm_c_primitive_load_path(state->filename);
}
static SCM
guile_builtin_exception_handler (void *data, SCM key, SCM args)
{
        struct guile_builtin_state *state = data;
        state->retval = EXECUTION_FAILURE;
	return scm_print_exception
	  (scm_current_error_port(), SCM_BOOL_F, key, args);
}

static inline void
scm_c_define_public_gsubr(const char *name, int req, int opt, int rest,
			  SCM (*fn)())
{
	scm_c_define_gsubr(name, req, opt, rest, fn);
	scm_c_export(name, NULL);
}

static
void init_bash_module(void *_unused)
{
	scm_c_define_public_gsubr("bind-dynamic-variable", 2, 0, 0,
				  &scm_bind_dynamic_variable);
	scm_c_define_public_gsubr("array->alist", 1, 0, 0,
				  &scm_array_to_alist);
}


static void*
do_guile_builtin (void *data)
{
	struct guile_builtin_state *state = data;
	scm_c_define_module("gnu bash internal", &init_bash_module, NULL);

	/* For Guile, argv[0] will be filename to be loaded. Not too useful, */
        /* but it is all about minimizing C codebase  */
	scm_set_program_arguments(state->argc, state->argv, state->filename);
        scm_internal_catch(SCM_BOOL_T, &guile_builtin_body, state,
                           &guile_builtin_exception_handler, state);
	return NULL;
}

static int
guile_builtin (WORD_LIST *list)
{
	struct guile_builtin_state state;
	int argc;
	char **argv;

	argv = make_builtin_argv(list, &argc);
	if (argc < 2) {
		builtin_error("not enough arguments.");
		builtin_usage();
		return EXECUTION_FAILURE;
	}
	state.filename = argv[1];
	state.argc = argc - 2;
	state.argv = argv + 2;
 	state.retval = EXECUTION_SUCCESS;
	scm_with_guile(do_guile_builtin, &state);

	return state.retval;
}

static char* const guile_doc[] = {
	"",
	"Load Guile code from file with access to (gnu bash) module",
	"to control Bash internals. Feel free to crash it all. ",
	"",
	"Return code 0, unless exception is thrown",
	NULL
};

struct builtin scm_struct = {
	.name = "scm",
	.function = guile_builtin,
	.flags = BUILTIN_ENABLED,
	.long_doc = guile_doc,
	.short_doc = "scm FILENAME [ARGS ...]",
	.handle = NULL
};
back to top