From 77dc01559db378d5a1db36376cd6bbbbebf877b7 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Sat, 4 Jul 2015 16:31:47 +0200
Subject: [PATCH] input.cc: implement with_location (SCM loc, SCM proc, ...)

---
 lily/include/input.hh |   8 ++++
 lily/input.cc         | 102 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 110 insertions(+)

diff --git a/lily/include/input.hh b/lily/include/input.hh
index 7177baad0a..b77db2d66f 100644
--- a/lily/include/input.hh
+++ b/lily/include/input.hh
@@ -73,4 +73,12 @@ protected:
 
 extern Input dummy_input_global;
 
+// The parser calls syntax functions with a lot of arguments
+SCM with_location (SCM loc, SCM proc);
+SCM with_location (SCM loc, SCM proc, SCM);
+SCM with_location (SCM loc, SCM proc, SCM, SCM);
+SCM with_location (SCM loc, SCM proc, SCM, SCM, SCM);
+SCM with_location (SCM loc, SCM proc, SCM, SCM, SCM, SCM);
+SCM with_location (SCM loc, SCM proc, SCM, SCM, SCM, SCM, SCM);
+
 #endif // INPUT_HH
diff --git a/lily/input.cc b/lily/input.cc
index adf0e227ad..b6aed9e2d1 100644
--- a/lily/input.cc
+++ b/lily/input.cc
@@ -23,6 +23,7 @@
 using namespace std;
 
 #include "international.hh"
+#include "lily-imports.hh"
 #include "program-option.hh"
 #include "source-file.hh"
 #include "sources.hh"
@@ -218,3 +219,104 @@ Input::end () const
 {
   return end_;
 }
+
+static SCM
+with_location_hook_0 (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_call_0 (args[0]);
+}
+
+SCM
+with_location (SCM loc, SCM proc)
+{
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_0,
+                           static_cast <void *> (&proc));
+}
+
+static SCM
+with_location_hook_1 (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_call_1 (args[0], args[1]);
+}
+
+SCM
+with_location (SCM loc, SCM proc, SCM arg1)
+{
+  SCM args[] = { proc, arg1 };
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_1,
+                           static_cast <void *> (&args));
+}
+
+static SCM
+with_location_hook_2 (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_call_2 (args[0], args[1], args[2]);
+}
+
+SCM
+with_location (SCM loc, SCM proc, SCM arg1, SCM arg2)
+{
+  SCM args[] = { proc, arg1, arg2 };
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_2,
+                           static_cast <void *> (&args));
+}
+
+static SCM
+with_location_hook_3 (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_call_3 (args[0], args[1], args[2], args[3]);
+}
+
+SCM
+with_location (SCM loc, SCM proc, SCM arg1, SCM arg2, SCM arg3)
+{
+  SCM args[] = { proc, arg1, arg2, arg3 };
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_3,
+                           static_cast <void *> (&args));
+}
+
+static SCM
+with_location_hook_4 (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_call_4 (args[0], args[1], args[2], args[3], args[4]);
+}
+
+SCM
+with_location (SCM loc, SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
+{
+  SCM args[] = { proc, arg1, arg2, arg3, arg4 };
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_4,
+                           static_cast <void *> (&args));
+}
+
+static SCM
+with_location_hook_n (void *it)
+{
+  SCM *args = static_cast <SCM *> (it);
+  return scm_apply_0 (args[0], args[1]);
+}
+
+SCM
+with_location (SCM loc, SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5)
+{
+  SCM args[] = { proc, scm_list_5 (arg1, arg2, arg3, arg4, arg5) };
+  return scm_c_with_fluid (Lily::f_location,
+                           unsmob<Input> (loc) ? loc : SCM_BOOL_F,
+                           with_location_hook_n,
+                           static_cast <void *> (&args));
+}
-- 
2.39.5