Re: Guile support in GNU make

[Ludovic Courtès]

Hi Paul,

With all my enthusiasm (and repulsion for an ugly Guile 2.0 bug on SPARC
waiting to be fixed), I came up with the following patch to illustrate
an addition that could be worthwhile.

One can write stuff like:

--8<---------------cut here---------------start------------->8---
%.y: %.z
        false

$(guile (pk (pattern-rules) #f))
$(guile (pk (map rule-targets (pattern-rules)) #f))
--8<---------------cut here---------------end--------------->8---

and it prints out:

--8<---------------cut here---------------start------------->8---
;;; ((#<rule cece60 ("%.y")>) #f)

;;; ((("%.y")) #f)
--8<---------------cut here---------------end--------------->8---

SMOBS for ‘dep’ and ‘commands’ could be added similarly, allowing for
nice makefile introspection and debugging.

WDYT?

Thanks,
Ludo’.

Index: Makefile.am
===================================================================
RCS file: /sources/make/make/Makefile.am,v
retrieving revision 2.62
diff -u -r2.62 Makefile.am
--- Makefile.am 16 Jan 2012 02:29:20 -0000      2.62
+++ Makefile.am 19 Jan 2012 22:06:58 -0000
@@ -46,7 +46,12 @@
                $(remote)
 
 if HAVE_GUILE
+  BUILT_SOURCES = guile.x
   make_SOURCES += guile.c
+
+.c.x:
+       $(GUILE_SNARF) -o $@ $< $(AM_CPPFLAGS) -I$(builddir) -I$(srcdir) \
+         $(GUILE_CFLAGS)
 endif
 
 EXTRA_make_SOURCES = vmsjobs.c remote-stub.c remote-cstms.c
Index: configure.in
===================================================================
RCS file: /sources/make/make/configure.in,v
retrieving revision 1.161
diff -u -r1.161 configure.in
--- configure.in        16 Jan 2012 02:29:22 -0000      1.161
+++ configure.in        19 Jan 2012 22:06:58 -0000
@@ -185,7 +185,8 @@
 ])
 
 AS_IF([test "$have_guile" = yes],
-      [AC_DEFINE([HAVE_GUILE], [1], [Embed GNU Guile support])])
+      [AC_PATH_PROG([GUILE_SNARF], [guile-snarf])
+       AC_DEFINE([HAVE_GUILE], [1], [Embed GNU Guile support])])
 
 AM_CONDITIONAL([HAVE_GUILE], [test "$have_guile" = yes])
 
Index: guile.c
===================================================================
RCS file: /sources/make/make/guile.c,v
retrieving revision 2.4
diff -u -r2.4 guile.c
--- guile.c     18 Jan 2012 13:31:11 -0000      2.4
+++ guile.c     19 Jan 2012 22:06:58 -0000
@@ -14,13 +14,103 @@
 You should have received a copy of the GNU General Public License along with
 this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
 #include "make.h"
 #include "debug.h"
 #include "dep.h"
+#include "rule.h"
 #include "variable.h"
 
 #include <libguile.h>
 
+
+
+SCM_SMOB (dependency, "dependency", 0);
+
+SCM_SMOB (rule, "rule", 0);
+
+
+SCM gmk_rule_targets (SCM);
+
+SCM_SMOB_PRINT (rule, print_rule, obj, port, pstate)
+{
+  /* XXX: On Guile < 2.0, use `scm_from_locale_string'.  */
+  scm_simple_format (port, scm_from_latin1_string ("#<rule ~a ~s>"),
+                    scm_list_2 (scm_number_to_string
+                                (scm_object_address (obj),
+                                 scm_from_int (16)),
+                                gmk_rule_targets (obj)));
+  return 1;
+}
+
+/* Return the SMOB corresponding to RULE.  */
+static SCM
+gmk_from_rule (struct rule *r)
+{
+  if (scm_is_false (r->smob))
+    /* Associate the new SMOB with R so that R only ever one associated SMOB,
+       which allows rules to be compared with `eq?'.  */
+    SCM_NEWSMOB (r->smob, rule, r);
+
+  return r->smob;
+}
+
+/* Return the C rule struct corresponding to OBJ.  */
+static struct rule *
+gmk_to_rule (SCM obj)
+{
+  SCM_ASSERT (SCM_SMOB_PREDICATE (rule, obj), obj, 0, "gmk_to_rule");
+
+  return (struct rule *) SCM_SMOB_DATA (obj);
+}
+
+SCM_DEFINE (gmk_rule_p, "rule?", 1, 0, 0,
+           (SCM obj),
+           "Return #t when @var{obj} is a rule.")
+#define FUNC_NAME s_gmk_rule_p
+{
+  return SCM_SMOB_PREDICATE (rule, obj);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (gmk_all_rules, "pattern-rules", 0, 0, 0,
+           (void),
+           "Return all the pattern rules of the current makefile.")
+#define FUNC_NAME s_gmk_all_rules
+{
+  SCM lst;
+  struct rule *r;
+
+  for (r = pattern_rules, lst = SCM_EOL;
+       r != NULL;
+       r = r->next)
+    lst = scm_cons (gmk_from_rule (r), lst);
+
+  return scm_reverse (lst);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (gmk_rule_targets, "rule-targets", 1, 0, 0,
+           (SCM obj),
+           "Return the list of targets of @var{rule}.")
+#define FUNC_NAME s_gmk_rule_targets
+{
+  int i;
+  SCM lst;
+  struct rule *r;
+
+  r = gmk_to_rule (obj);
+  for (i = 0, lst = SCM_EOL; i < r->num; i++)
+    lst = scm_cons (scm_from_locale_string (r->targets[i]), lst);
+
+  return scm_reverse (lst);
+}
+#undef FUNC_NAME
+
+
 static SCM make_mod = SCM_EOL;
 static SCM obj_to_str = SCM_EOL;
 
@@ -76,6 +166,8 @@
   /* Import the GNU make module exports into the generic space.  */
   scm_c_eval_string ("(use-modules (gnu make))");
 
+#include "guile.x"
+
   return NULL;
 }
 
Index: rule.c
===================================================================
RCS file: /sources/make/make/rule.c,v
retrieving revision 1.55
diff -u -r1.55 rule.c
--- rule.c      16 Jan 2012 02:29:23 -0000      1.55
+++ rule.c      19 Jan 2012 22:06:58 -0000
@@ -458,6 +458,9 @@
   r->targets = targets;
   r->suffixes = target_percents;
   r->lens = xmalloc (n * sizeof (unsigned int));
+#ifdef HAVE_GUILE
+  r->smob = SCM_BOOL_F;
+#endif
 
   for (i = 0; i < n; ++i)
     {
Index: rule.h
===================================================================
RCS file: /sources/make/make/rule.h,v
retrieving revision 1.19
diff -u -r1.19 rule.h
--- rule.h      16 Jan 2012 02:29:24 -0000      1.19
+++ rule.h      19 Jan 2012 22:06:58 -0000
@@ -17,6 +17,10 @@
 this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
+#ifdef HAVE_GUILE
+# include <libguile.h>
+#endif
+
 /* Structure used for pattern (implicit) rules.  */
 
 struct rule
@@ -30,6 +34,9 @@
     unsigned short num;         /* Number of targets.  */
     char terminal;             /* If terminal (double-colon).  */
     char in_use;               /* If in use by a parent pattern_search.  */
+#ifdef HAVE_GUILE
+    SCM smob;                  /* The corresponding SMOB or #f.  */
+#endif
   };
 
 /* For calling install_pattern_rule.  */