1 /* GNU Guile interface for GNU Make.
2 Copyright (C) 2011-2022 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 <https://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