guile.c

   1 /* GNU Guile interface for GNU Make.
   2 Copyright (C) 2011-2012 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 "make.h"
  18 #include "debug.h"
  19 #include "dep.h"
  20 #include "variable.h"
  21
  22 #include <libguile.h>
  23
  24 static SCM make_mod = SCM_EOL;
  25 static SCM obj_to_str = SCM_EOL;
  26
  27 /* Convert an SCM object into a string.  */
  28 static char *
  29 cvt_scm_to_str (SCM obj)
  30 {
  31   return scm_to_locale_string (scm_call_1 (obj_to_str, obj));
  32 }
  33
  34 /* Perform the GNU make expansion function.  */
  35 static SCM
  36 guile_expand_wrapper (SCM obj)
  37 {
  38   char *str = cvt_scm_to_str (obj);
  39   SCM ret;
  40   char *res;
  41
  42   DB (DB_BASIC, (_("guile: Expanding '%s'\n"), str));
  43   res = allocated_variable_expand (str);
  44   ret = scm_from_locale_string (res);
  45
  46   free (str);
  47   free (res);
  48
  49   return ret;
  50 }
  51
  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)
  55 {
  56 /* Ingest the predefined Guile module for GNU make.  */
  57 #include "gmk-default.h"
  58
  59   /* Register a subr for GNU make's eval capability.  */
  60   scm_c_define_gsubr ("gmk-expand", 1, 0, 0, guile_expand_wrapper);
  61
  62   /* Define the rest of the module.  */
  63   scm_c_eval_string (GUILE_module_defn);
  64 }
  65
  66 /* Initialize the GNU make Guile module.  */
  67 static void *
  68 guile_init (void *arg UNUSED)
  69 {
  70   /* Define the module.  */
  71   make_mod = scm_c_define_module ("gnu make", guile_define_module, NULL);
  72
  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"));
  75
  76   /* Import the GNU make module exports into the generic space.  */
  77   scm_c_eval_string ("(use-modules (gnu make))");
  78
  79   return NULL;
  80 }
  81
  82 static void *
  83 internal_guile_eval (void *arg)
  84 {
  85   return cvt_scm_to_str (scm_c_eval_string (arg));
  86 }
  87
  88 /* This is the function registered with make  */
  89 static char *
  90 func_guile (char *o, char **argv, const char *funcname UNUSED)
  91 {
  92   if (argv[0] && argv[0][0] != '\0')
  93     {
  94       char *str = scm_with_guile (internal_guile_eval, argv[0]);
  95       if (str)
  96         {
  97           o = variable_buffer_output (o, str, strlen (str));
  98           free (str);
  99         }
 100     }
 101
 102   return o;
 103 }
 104
 105 /* ----- Public interface ----- */
 106
 107 /* We could send the flocp to define_new_function(), but since guile is
 108    "kind of" built-in, that didn't seem so useful.  */
 109 int
 110 guile_gmake_setup (const struct floc *flocp UNUSED)
 111 {
 112   /* Initialize the Guile interpreter.  */
 113   scm_with_guile (guile_init, NULL);
 114
 115   /* Create a make function "guile".  */
 116   define_new_function (NILF, "guile", 0, 1, 1, func_guile);
 117
 118   return 1;
 119 }