src/scm.c

   1 #include <bash/config.h>
   2 #include <stdlib.h>
   3 #include <bash/builtins.h>
   4 #include <bash/shell.h>
   5 #include <stdio.h>
   6 #include <libguile.h>
   7
   8 static inline char*
   9 scm_symbol_to_utf8_string(SCM symbol)
  10 {
  11         SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
  12                         SCM_ARG1, __func__, "symbol");
  13         return scm_to_utf8_stringn(scm_symbol_to_string(symbol), NULL);
  14 }
  15
  16 static SCM dynamic_variables_alist = SCM_EOL;
  17 static SCM
  18 dynamic_value_body(void *data)
  19 {
  20         struct variable* self = data;
  21         const char *varname = self->name;
  22         SCM symbol = scm_string_to_symbol(scm_from_utf8_string(varname));
  23         SCM thunk = scm_assq_ref(dynamic_variables_alist, symbol);
  24         SCM value = scm_call_0(thunk);
  25         char *newvalue = scm_to_utf8_stringn(value, NULL);
  26
  27         free(self->value);
  28         self->value = newvalue;
  29         return SCM_UNDEFINED;
  30 }
  31
  32 static SCM
  33 dynamic_value_exception_handler(void *_unused, SCM key, SCM args)
  34 {
  35         return scm_print_exception
  36                 (scm_current_error_port(), SCM_BOOL_F, key, args);
  37 }
  38
  39 static struct variable*
  40 dynamic_value(struct variable *self)
  41 {
  42         scm_internal_catch(SCM_BOOL_T, &dynamic_value_body, self,
  43                            &dynamic_value_exception_handler, NULL);
  44         return self;
  45 }
  46
  47 static SCM
  48 scm_bind_dynamic_variable(SCM symbol, SCM thunk)
  49 {
  50         char *varname;
  51         struct variable *v;
  52
  53         SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
  54                         SCM_ARG1, __func__, "symbol");
  55         SCM_ASSERT_TYPE(scm_is_true(scm_thunk_p(thunk)), thunk,
  56                         SCM_ARG2, __func__, "thunk");
  57
  58         varname = scm_to_utf8_stringn(scm_symbol_to_string(symbol), NULL);
  59         v = bind_variable(varname, NULL, 0);
  60         v->dynamic_value = &dynamic_value;
  61         dynamic_variables_alist = scm_assq_set_x(dynamic_variables_alist, symbol, thunk);
  62         free(varname);
  63         return SCM_UNDEFINED;
  64 }
  65
  66 static int
  67 array_walk_function(ARRAY_ELEMENT *el, void *data)
  68 {
  69         SCM *alist = data;
  70         SCM index = scm_from_int64(el->ind);
  71         SCM value = scm_from_utf8_string(el->value);
  72         *alist = scm_acons(index, value, *alist);
  73         return 0;
  74 }
  75
  76 static SCM
  77 scm_array_to_alist(SCM symbol)
  78 {
  79         char *varname;
  80         ARRAY *array;
  81         struct variable *v;
  82         SCM alist = SCM_EOL;
  83
  84         SCM_ASSERT_TYPE(scm_is_symbol(symbol), symbol,
  85                         SCM_ARG1, __func__, "symbol");
  86         varname = scm_symbol_to_utf8_string(symbol);
  87
  88         GET_ARRAY_FROM_VAR(varname, v, array);
  89         free(varname);
  90
  91         if (array == NULL)
  92                 return SCM_BOOL_F;
  93         array_walk(array, &array_walk_function, &alist);
  94         return scm_reverse(alist);
  95 }
  96
  97
  98 extern char **make_builtin_argv (WORD_LIST *, int *);
  99
 100 struct guile_builtin_state {
 101         int argc;    /* Formed by `make_builtin_argv' in `guile_builtin' */
 102         char *filename;
 103         char **argv;
 104         int retval; /* Passed back from do_guile_builtin */
 105 };
 106
 107 static SCM
 108 guile_builtin_body (void *data)
 109 {
 110         const struct guile_builtin_state *state = data;
 111         return scm_c_primitive_load_path(state->filename);
 112 }
 113 static SCM
 114 guile_builtin_exception_handler (void *data, SCM key, SCM args)
 115 {
 116         struct guile_builtin_state *state = data;
 117         state->retval = EXECUTION_FAILURE;
 118         return scm_print_exception
 119           (scm_current_error_port(), SCM_BOOL_F, key, args);
 120 }
 121
 122 static inline void
 123 scm_c_define_public_gsubr(const char *name, int req, int opt, int rest,
 124                           SCM (*fn)())
 125 {
 126         scm_c_define_gsubr(name, req, opt, rest, fn);
 127         scm_c_export(name, NULL);
 128 }
 129
 130 static
 131 void init_bash_module(void *_unused)
 132 {
 133         scm_c_define_public_gsubr("bind-dynamic-variable", 2, 0, 0,
 134                                   &scm_bind_dynamic_variable);
 135         scm_c_define_public_gsubr("array->alist", 1, 0, 0,
 136                                   &scm_array_to_alist);
 137 }
 138
 139
 140 static void*
 141 do_guile_builtin (void *data)
 142 {
 143         struct guile_builtin_state *state = data;
 144         scm_c_define_module("gnu bash internal", &init_bash_module, NULL);
 145
 146         /* For Guile, argv[0] will be filename to be loaded. Not too useful, */
 147         /* but it is all about minimizing C codebase  */
 148         scm_set_program_arguments(state->argc, state->argv, state->filename);
 149         scm_internal_catch(SCM_BOOL_T, &guile_builtin_body, state,
 150                            &guile_builtin_exception_handler, state);
 151         return NULL;
 152 }
 153
 154 static int
 155 guile_builtin (WORD_LIST *list)
 156 {
 157         struct guile_builtin_state state;
 158         int argc;
 159         char **argv;
 160
 161         argv = make_builtin_argv(list, &argc);
 162         if (argc < 2) {
 163                 builtin_error("not enough arguments.");
 164                 builtin_usage();
 165                 return EXECUTION_FAILURE;
 166         }
 167         state.filename = argv[1];
 168         state.argc = argc - 2;
 169         state.argv = argv + 2;
 170         state.retval = EXECUTION_SUCCESS;
 171         scm_with_guile(do_guile_builtin, &state);
 172
 173         return state.retval;
 174 }
 175
 176 static char* const guile_doc[] = {
 177         "",
 178         "Load Guile code from file with access to (gnu bash) module",
 179         "to control Bash internals. Feel free to crash it all. ",
 180         "",
 181         "Return code 0, unless exception is thrown",
 182         NULL
 183 };
 184
 185 struct builtin scm_struct = {
 186         .name = "scm",
 187         .function = guile_builtin,
 188         .flags = BUILTIN_ENABLED,
 189         .long_doc = guile_doc,
 190         .short_doc = "scm FILENAME [ARGS ...]",
 191         .handle = NULL
 192 };