Create a new internal interface for defining new make functions.
[make.git] / guile.c
blobc32821a2cc97bea8358be0461e9d0e1db474ae58
1 /* GNU Guile interface for GNU Make.
2 Copyright (C) 2011, 2012 Free Software Foundation, Inc.
3 This file is part of GNU Make.
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.
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.
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/>. */
17 #include "make.h"
18 #include "debug.h"
19 #include "dep.h"
20 #include "variable.h"
22 #include <libguile.h>
24 static SCM make_mod = SCM_EOL;
25 static SCM obj_to_str = SCM_EOL;
27 /* Convert an SCM object into a string. */
28 static char *
29 cvt_scm_to_str (SCM obj)
31 return scm_to_locale_string (scm_call_1 (obj_to_str, obj));
34 /* Perform the GNU make expansion function. */
35 static SCM
36 guile_expand_wrapper (SCM obj)
38 char *str = cvt_scm_to_str (obj);
39 SCM ret;
40 char *res;
42 DB (DB_BASIC, (_("guile: Expanding '%s'\n"), str));
43 res = allocated_variable_expand (str);
44 ret = scm_from_locale_string (res);
46 free (str);
47 free (res);
49 return ret;
52 /* Invoked by scm_c_define_module(), in the context of the GNU make module. */
53 static void
54 guile_define_module (void *data UNUSED)
56 /* Ingest the predefined Guile module for GNU make. */
57 #include "gmk-default.h"
59 /* Register a subr for GNU make's eval capability. */
60 scm_c_define_gsubr ("gmk-expand", 1, 0, 0, guile_expand_wrapper);
62 /* Define the rest of the module. */
63 scm_c_eval_string (GUILE_module_defn);
66 /* Initialize the GNU make Guile module. */
67 static void *
68 guile_init (void *arg UNUSED)
70 /* Define the module. */
71 make_mod = scm_c_define_module ("gnu make", guile_define_module, NULL);
73 /* Get a reference to the object-to-string translator, for later. */
74 obj_to_str = scm_variable_ref (scm_c_module_lookup (make_mod, "obj-to-str"));
76 /* Import the GNU make module exports into the generic space. */
77 scm_c_eval_string ("(use-modules (gnu make))");
79 return NULL;
82 static void *
83 internal_guile_eval (void *arg)
85 return cvt_scm_to_str (scm_c_eval_string (arg));
88 /* This is the function registered with make */
89 static char *
90 func_guile (char *o, char **argv, const char *funcname UNUSED)
92 if (argv[0] && argv[0][0] != '\0')
94 char *str = scm_with_guile (internal_guile_eval, argv[0]);
95 o = variable_buffer_output (o, str, strlen (str));
96 free (str);
99 return o;
102 /* ----- Public interface ----- */
105 setup_guile ()
107 /* Initialize the Guile interpreter. */
108 scm_with_guile (guile_init, NULL);
110 /* Create a make function "guile". */
111 define_new_function (NILF, "guile", 0, 1, 1, func_guile);
113 /* Add 'guile' to the list of features. */
114 do_variable_definition (NILF, ".FEATURES", "guile", o_default, f_append, 0);
116 return 1;