/*
- music-function.cc -- implement music_function
+ This file is part of LilyPond, the GNU music typesetter.
- source file of the GNU LilyPond music typesetter
+ Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
- (c) 2004--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ LilyPond is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ LilyPond is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
*/
#include "music-function.hh"
-
+#include "lily-parser.hh"
+#include "input.hh"
#include "music.hh"
+#include "fluid.hh"
+#include "lily-imports.hh"
-static scm_t_bits music_function_tag;
+const char * const Music_function::type_p_name_ = "ly:music-function?";
/* Print a textual represenation of the smob to a given port. */
-static int
-print_music_function (SCM b, SCM port, scm_print_state *)
+int
+Music_function::print_smob (SCM port, scm_print_state *) const
{
- SCM value = SCM_CELL_OBJECT_1 (b);
-
scm_puts ("#<Music function ", port);
- scm_write (value, port);
+ scm_write (get_function (), port);
scm_puts (">", port);
/* Non-zero means success. */
return 1;
}
-bool
-is_music_function (SCM music_function)
-{
- return (SCM_NIMP (music_function) && SCM_CELL_TYPE (music_function) == music_function_tag);
-}
+// Used for attaching location information to music expressions in
+// default arguments and return values. Music expressions taken from
+// the call signature need to be cloned since they are not suitable
+// for multiple use.
-SCM
-get_music_function_transform (SCM music_function)
+static SCM
+with_loc (SCM arg, Fluid &loc, bool clone = true)
{
- if (!is_music_function (music_function))
- return SCM_UNDEFINED;
-
- return SCM_CELL_OBJECT_1 (music_function);
+ if (Music *m = unsmob<Music> (arg))
+ {
+ if (clone)
+ {
+ m = m->clone ();
+ arg = m->unprotect ();
+ }
+ if (Input *in = unsmob<Input> (loc))
+ m->set_spot (*in);
+ }
+ return arg;
}
-static void
-init_music_function (void)
-{
- music_function_tag = scm_make_smob_type ("music-function", 0);
- scm_set_smob_mark (music_function_tag, scm_markcdr);
- scm_set_smob_print (music_function_tag, print_music_function);
-}
+// A music function call implies walking through the call signature
+// and matching the actual argument list to the signature. This
+// process is not 1:1 due to the possible presence of optional
+// arguments which are handled quite differently from how GUILE/Scheme
+// usually deal with optional arguments.
+//
+// The argument matching here intentionally closely tracks the
+// semantics of calls via the LilyPond parser as described in
+// <URL:lilypond.org/doc/Documentation/extending/scheme-function-usage>:
+// if an optional argument predicate does not match the next argument
+// from the actual argument list, the default given in the call
+// signature is used instead and all following optional arguments are
+// unconditionally substituted in a similar manner.
+//
+// This skipping of optional arguments can be explicitly initiated by
+// using \default in LilyPond. The respective value to use for a call
+// via Scheme is *unspecified*.
SCM
-make_music_function (SCM signature, SCM func)
+Music_function::call (SCM rest)
{
- scm_set_object_property_x (func, ly_symbol2scm ("music-function-signature"),
- signature);
-
- SCM_RETURN_NEWSMOB (music_function_tag, func);
+ Fluid location (Lily::f_location);
+
+ // (car (ly:music-signature self_scm())) is the return type, skip it
+ SCM signature = scm_cdr (get_signature ());
+
+ // The main loop just processes the signature in sequence, and the
+ // resulting actual arguments are accumulated in reverse order in args
+
+ SCM args = SCM_EOL;
+
+ while (scm_is_pair (rest) && scm_is_pair (signature))
+ {
+ SCM arg = scm_car (rest);
+ SCM pred = scm_car (signature);
+ if (!scm_is_pair (pred))
+ {
+ // non-optional argument
+ if (scm_is_false (scm_call_1 (pred, arg)))
+ {
+ Syntax::argument_error (scm_oneplus (scm_length (args)),
+ pred, arg);
+ SCM val = scm_car (get_signature ());
+ val = scm_is_pair (val) ? scm_cdr (val) : SCM_BOOL_F;
+ return with_loc (val, location);
+ }
+ }
+ // If the predicate is not a function but a pair, it
+ // signifies an optional argument. This is not quite the
+ // form declared to define-music-function (which is always
+ // a proper list) but a pair of predicate function and
+ // default value.
+ //
+ // Fall through to default argument processing when optional
+ // argument predicate matches
+ else if (scm_is_false (scm_call_1 (scm_car (pred), arg)))
+ {
+ // optional argument, non-match
+ // *unspecified* is the same as an explicit \default: skip it
+ if (scm_is_eq (arg, SCM_UNSPECIFIED))
+ rest = scm_cdr (rest);
+ // Replace this and all following optional arguments with
+ // their defaults:
+ do {
+ args = scm_cons (with_loc (scm_cdr (pred), location), args);
+ signature = scm_cdr (signature);
+ if (!scm_is_pair (signature))
+ break;
+ pred = scm_car (signature);
+ } while (scm_is_pair (pred));
+ continue;
+ }
+ // Normal processing of accepted argument
+ signature = scm_cdr (signature);
+ args = scm_cons (arg, args);
+ rest = scm_cdr (rest);
+ }
+
+ if (scm_is_pair (rest) || scm_is_pair (signature))
+ scm_wrong_num_args (self_scm ());
+
+ SCM res = scm_apply_0 (get_function (), scm_reverse_x (args, SCM_EOL));
+
+ SCM pred = scm_car (get_signature ());
+ // The return type predicate may have the form of a pair in which
+ // the car is the actual predicate and the cdr is the surrogate
+ // return value in the error case, to be extracted by
+ // music-function-call-error.
+ if (scm_is_pair (pred))
+ pred = scm_car (pred);
+
+ if (scm_is_true (scm_call_1 (pred, res)))
+ return with_loc (res, location, false);
+
+ return Syntax::music_function_call_error (self_scm (), res);
}
-
-ADD_SCM_INIT_FUNC (music_function_tag, init_music_function);
-
projects / lilypond.git / blobdiff