[PATCH 3/5] Remove parser/location args from music function calls

[David Kastrup]

When a music function definition starts with a parameter named "parser",
a compatibility definition is created that recreates the parameters
from the fluid accessors (*parser*) and (*location*) when necessary.
---
 scm/ly-syntax-constructors.scm |  5 +++--
 scm/music-functions.scm        | 34 +++++++++++++++++++++++-----------
 2 files changed, 26 insertions(+), 13 deletions(-)

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 2d243ab..5d45ea5 100644
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -53,8 +53,9 @@
   (let* ((sig (ly:music-function-signature fun))
          (pred (if (pair? (car sig)) (caar sig) (car sig)))
          (good (proper-list? args))
-         (m (and good (apply (ly:music-function-extract fun)
-                             parser loc (reverse! args rest)))))
+         (m (and good (with-fluids ((%parser parser) (%location loc))
+                                   (apply (ly:music-function-extract fun)
+                                          (reverse! args rest))))))
     (if (and good (pred m))
         (begin
           (if (ly:music? m)
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 65f885b..9f43983 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -1067,21 +1067,28 @@ parameter of different type.
 predicates, to be used in case of a type error in arguments or
 result."
 
+  (define (has-parser/location? arg where)
+    (let loop ((arg arg))
+      (if (list? arg)
+          (any loop arg)
+          (memq arg where))))
   (define (currying-lambda args doc-string? body)
     (if (and (pair? args)
              (pair? (car args)))
         (currying-lambda (car args) doc-string?
                          `((lambda ,(cdr args) ,@body)))
-        `(lambda ,args
-           ,(format #f "~a\n~a" (cddr args) (or doc-string? ""))
-           ,@body)))
-
-  (set! signature (map (lambda (pred)
-                         (if (pair? pred)
-                             `(cons ,(car pred)
-                                    ,(and (pair? (cdr pred)) (cadr pred)))
-                             pred))
-                       (cons type signature)))
+        (let* ((compatibility? (if (list? args)
+                                   (= (length args) (+ 2 (length signature)))
+                                   (and (pair? args) (pair? (cdr args))
+                                        (eq? (car args) 'parser))))
+               (realargs (if compatibility? (cddr args) args)))
+          `(lambda ,realargs
+             ,(format #f "~a\n~a" realargs (or doc-string? ""))
+             ,@(if (and compatibility?
+                        (has-parser/location? body (take args 2)))
+                   `((let ((,(car args) (*parser*)) (,(cadr args) 
(*location*)))
+                       ,@body))
+                   body)))))
 
   (let ((docstring
          (and (pair? body) (pair? (cdr body))
@@ -1096,7 +1103,12 @@ result."
     ;; When the music function definition contains an i10n doc string,
     ;; (_i "doc string"), keep the literal string only
     `(ly:make-music-function
-      (list ,@signature)
+      (list ,@(map (lambda (pred)
+                     (if (pair? pred)
+                         `(cons ,(car pred)
+                                ,(and (pair? (cdr pred)) (cadr pred)))
+                         pred))
+                   (cons type signature)))
       ,(currying-lambda args docstring (if docstring (cdr body) body)))))
 
 (defmacro-public define-music-function rest
-- 
2.1.4