[3138] | 1 | /* GNU Guile interface for GNU Make.
|
---|
| 2 | Copyright (C) 2011-2016 Free Software Foundation, Inc.
|
---|
| 3 | This file is part of GNU Make.
|
---|
| 4 |
|
---|
| 5 | GNU Make is free software; you can redistribute it and/or modify it under the
|
---|
| 6 | terms of the GNU General Public License as published by the Free Software
|
---|
| 7 | Foundation; either version 3 of the License, or (at your option) any later
|
---|
| 8 | version.
|
---|
| 9 |
|
---|
| 10 | GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY
|
---|
| 11 | WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
---|
| 12 | A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
---|
| 13 |
|
---|
| 14 | You should have received a copy of the GNU General Public License along with
|
---|
| 15 | this program. If not, see <http://www.gnu.org/licenses/>. */
|
---|
| 16 |
|
---|
| 17 | #include "makeint.h"
|
---|
| 18 |
|
---|
| 19 | #ifdef HAVE_GUILE
|
---|
| 20 |
|
---|
| 21 | #include "gnumake.h"
|
---|
| 22 |
|
---|
| 23 | #include "debug.h"
|
---|
| 24 | #include "filedef.h"
|
---|
| 25 | #include "dep.h"
|
---|
| 26 | #include "variable.h"
|
---|
| 27 |
|
---|
| 28 | #include <libguile.h>
|
---|
| 29 |
|
---|
| 30 | /* Pre-2.0 versions of Guile don't have a typedef for gsubr function types. */
|
---|
| 31 | #if SCM_MAJOR_VERSION < 2
|
---|
| 32 | # define GSUBR_TYPE SCM (*) ()
|
---|
| 33 | /* Guile 1.x doesn't really support i18n. */
|
---|
| 34 | # define EVAL_STRING(_s) scm_c_eval_string (_s)
|
---|
| 35 | #else
|
---|
| 36 | # define GSUBR_TYPE scm_t_subr
|
---|
| 37 | # define EVAL_STRING(_s) scm_eval_string (scm_from_utf8_string (_s))
|
---|
| 38 | #endif
|
---|
| 39 |
|
---|
| 40 | static SCM make_mod = SCM_EOL;
|
---|
| 41 | static SCM obj_to_str = SCM_EOL;
|
---|
| 42 |
|
---|
| 43 | /* Convert an SCM object into a string. */
|
---|
| 44 | static char *
|
---|
| 45 | cvt_scm_to_str (SCM obj)
|
---|
| 46 | {
|
---|
| 47 | return scm_to_locale_string (scm_call_1 (obj_to_str, obj));
|
---|
| 48 | }
|
---|
| 49 |
|
---|
| 50 | /* Perform the GNU make expansion function. */
|
---|
| 51 | static SCM
|
---|
| 52 | guile_expand_wrapper (SCM obj)
|
---|
| 53 | {
|
---|
| 54 | char *str = cvt_scm_to_str (obj);
|
---|
| 55 | SCM ret;
|
---|
| 56 | char *res;
|
---|
| 57 |
|
---|
| 58 | DB (DB_BASIC, (_("guile: Expanding '%s'\n"), str));
|
---|
| 59 | res = gmk_expand (str);
|
---|
| 60 | ret = scm_from_locale_string (res);
|
---|
| 61 |
|
---|
| 62 | free (str);
|
---|
| 63 | free (res);
|
---|
| 64 |
|
---|
| 65 | return ret;
|
---|
| 66 | }
|
---|
| 67 |
|
---|
| 68 | /* Perform the GNU make eval function. */
|
---|
| 69 | static SCM
|
---|
| 70 | guile_eval_wrapper (SCM obj)
|
---|
| 71 | {
|
---|
| 72 | char *str = cvt_scm_to_str (obj);
|
---|
| 73 |
|
---|
| 74 | DB (DB_BASIC, (_("guile: Evaluating '%s'\n"), str));
|
---|
| 75 | gmk_eval (str, 0);
|
---|
| 76 |
|
---|
| 77 | return SCM_BOOL_F;
|
---|
| 78 | }
|
---|
| 79 |
|
---|
| 80 | /* Invoked by scm_c_define_module(), in the context of the GNU make module. */
|
---|
| 81 | static void
|
---|
| 82 | guile_define_module (void *data UNUSED)
|
---|
| 83 | {
|
---|
| 84 | /* Ingest the predefined Guile module for GNU make. */
|
---|
| 85 | #include "gmk-default.h"
|
---|
| 86 |
|
---|
| 87 | /* Register a subr for GNU make's eval capability. */
|
---|
| 88 | scm_c_define_gsubr ("gmk-expand", 1, 0, 0, (GSUBR_TYPE) guile_expand_wrapper);
|
---|
| 89 |
|
---|
| 90 | /* Register a subr for GNU make's eval capability. */
|
---|
| 91 | scm_c_define_gsubr ("gmk-eval", 1, 0, 0, (GSUBR_TYPE) guile_eval_wrapper);
|
---|
| 92 |
|
---|
| 93 | /* Define the rest of the module. */
|
---|
| 94 | scm_c_eval_string (GUILE_module_defn);
|
---|
| 95 | }
|
---|
| 96 |
|
---|
| 97 | /* Initialize the GNU make Guile module. */
|
---|
| 98 | static void *
|
---|
| 99 | guile_init (void *arg UNUSED)
|
---|
| 100 | {
|
---|
| 101 | /* Define the module. */
|
---|
| 102 | make_mod = scm_c_define_module ("gnu make", guile_define_module, NULL);
|
---|
| 103 |
|
---|
| 104 | /* Get a reference to the object-to-string translator, for later. */
|
---|
| 105 | obj_to_str = scm_variable_ref (scm_c_module_lookup (make_mod, "obj-to-str"));
|
---|
| 106 |
|
---|
| 107 | /* Import the GNU make module exports into the generic space. */
|
---|
| 108 | scm_c_eval_string ("(use-modules (gnu make))");
|
---|
| 109 |
|
---|
| 110 | return NULL;
|
---|
| 111 | }
|
---|
| 112 |
|
---|
| 113 | static void *
|
---|
| 114 | internal_guile_eval (void *arg)
|
---|
| 115 | {
|
---|
| 116 | return cvt_scm_to_str (EVAL_STRING (arg));
|
---|
| 117 | }
|
---|
| 118 |
|
---|
| 119 | /* This is the function registered with make */
|
---|
| 120 | static char *
|
---|
| 121 | func_guile (const char *funcname UNUSED, unsigned int argc UNUSED, char **argv)
|
---|
| 122 | {
|
---|
| 123 | static int init = 0;
|
---|
| 124 |
|
---|
| 125 | if (! init)
|
---|
| 126 | {
|
---|
| 127 | /* Initialize the Guile interpreter. */
|
---|
| 128 | scm_with_guile (guile_init, NULL);
|
---|
| 129 | init = 1;
|
---|
| 130 | }
|
---|
| 131 |
|
---|
| 132 | if (argv[0] && argv[0][0] != '\0')
|
---|
| 133 | return scm_with_guile (internal_guile_eval, argv[0]);
|
---|
| 134 |
|
---|
| 135 | return NULL;
|
---|
| 136 | }
|
---|
| 137 |
|
---|
| 138 | /* ----- Public interface ----- */
|
---|
| 139 |
|
---|
| 140 | /* We could send the flocp to define_new_function(), but since guile is
|
---|
| 141 | "kind of" built-in, that didn't seem so useful. */
|
---|
| 142 | int
|
---|
| 143 | guile_gmake_setup (const floc *flocp UNUSED)
|
---|
| 144 | {
|
---|
| 145 | /* Create a make function "guile". */
|
---|
| 146 | gmk_add_function ("guile", func_guile, 0, 1, GMK_FUNC_DEFAULT);
|
---|
| 147 |
|
---|
| 148 | return 1;
|
---|
| 149 | }
|
---|
| 150 |
|
---|
| 151 | #else
|
---|
| 152 |
|
---|
| 153 | int
|
---|
| 154 | guile_gmake_setup (const floc *flocp UNUSED)
|
---|
| 155 | {
|
---|
| 156 | return 1;
|
---|
| 157 | }
|
---|
| 158 |
|
---|
| 159 | #endif
|
---|