2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 LilyPond is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 LilyPond is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
20 #include "music-function.hh"
21 #include "lily-parser.hh"
25 #include "lily-imports.hh"
27 const char Music_function::type_p_name_[] = "ly:music-function?";
29 /* Print a textual represenation of the smob to a given port. */
31 Music_function::print_smob (SCM port, scm_print_state *) const
33 scm_puts ("#<Music function ", port);
34 scm_write (get_function (), port);
37 /* Non-zero means success. */
41 // Used for attaching location information to music expressions in
42 // default arguments and return values. Music expressions taken from
43 // the call signature need to be cloned since they are not suitable
47 with_loc (SCM arg, Fluid &loc, bool clone = true)
49 if (Music *m = unsmob<Music> (arg))
54 arg = m->unprotect ();
56 if (Input *in = unsmob<Input> (loc))
62 // A music function call implies walking through the call signature
63 // and matching the actual argument list to the signature. This
64 // process is not 1:1 due to the possible presence of optional
65 // arguments which are handled quite differently from how GUILE/Scheme
66 // usually deal with optional arguments.
68 // The argument matching here intentionally closely tracks the
69 // semantics of calls via the LilyPond parser as described in
70 // <URL:lilypond.org/doc/Documentation/extending/scheme-function-usage>:
71 // if an optional argument predicate does not match the next argument
72 // from the actual argument list, the default given in the call
73 // signature is used instead and all following optional arguments are
74 // unconditionally substituted in a similar manner.
76 // This skipping of optional arguments can be explicitly initiated by
77 // using \default in LilyPond. The respective value to use for a call
78 // via Scheme is *unspecified*.
81 Music_function::call (SCM rest)
83 Fluid location (Lily::f_location);
85 // (car (ly:music-signature self_scm())) is the return type, skip it
86 SCM signature = scm_cdr (get_signature ());
88 // In order to keep the loop structure and particularly the handling
89 // of terminating conditions reasonably straightforward and avoid
90 // scattering the code around, we don't use a separate loop when
91 // skipping optional arguments. Instead we use "skipping" to
92 // indicate whether we are currently filling in optional arguments
93 // from their defaults.
94 bool skipping = false;
96 // The main loop just processes the signature in sequence, and the
97 // resulting actual arguments are accumulated in reverse order in args
101 for (; scm_is_pair (signature); signature = scm_cdr (signature))
103 SCM pred = scm_car (signature);
105 if (scm_is_pair (pred))
107 // If the predicate is not a function but a pair, it
108 // signifies an optional argument. This is not quite the
109 // form declared to define-music-function (which is always
110 // a proper list) but a pair of predicate function and
115 if (!scm_is_pair (rest))
116 scm_wrong_num_args (self_scm ());
118 SCM arg = scm_car (rest);
119 if (scm_is_true (scm_call_1 (scm_car (pred), arg)))
121 args = scm_cons (arg, args);
122 rest = scm_cdr (rest);
126 // Remove at most one tentative "\default"
127 if (scm_is_eq (SCM_UNSPECIFIED, arg))
128 rest = scm_cdr (rest);
130 args = scm_cons (with_loc (scm_cdr (pred), location), args);
134 // We have a mandatory argument here.
137 if (!scm_is_pair (rest))
138 scm_wrong_num_args (self_scm ());
140 SCM arg = scm_car (rest);
141 rest = scm_cdr (rest);
142 args = scm_cons (arg, args);
144 if (scm_is_false (scm_call_1 (pred, arg)))
146 Syntax::argument_error (scm_length (args),
148 SCM val = scm_car (get_signature ());
149 val = scm_is_pair (val) ? scm_cdr (val) : SCM_BOOL_F;
150 return with_loc (val, location);
154 if (scm_is_pair (rest))
155 scm_wrong_num_args (self_scm ());
157 SCM res = scm_apply_0 (get_function (), scm_reverse_x (args, SCM_EOL));
159 SCM pred = scm_car (get_signature ());
160 // The return type predicate may have the form of a pair in which
161 // the car is the actual predicate and the cdr is the surrogate
162 // return value in the error case, to be extracted by
163 // music-function-call-error.
164 if (scm_is_pair (pred))
165 pred = scm_car (pred);
167 if (scm_is_true (scm_call_1 (pred, res)))
168 return with_loc (res, location, false);
170 return Syntax::music_function_call_error (self_scm (), res);