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"
26 const char Music_function::type_p_name_[] = "ly:music-function?";
28 /* Print a textual represenation of the smob to a given port. */
30 Music_function::print_smob (SCM port, scm_print_state *)
32 scm_puts ("#<Music function ", port);
33 scm_write (get_function (), port);
36 /* Non-zero means success. */
40 // Used for attaching location information to music expressions in
41 // default arguments and return values. Music expressions taken from
42 // the call signature need to be cloned since they are not suitable
46 with_loc (SCM arg, Fluid &loc, bool clone = true)
48 if (Music *m = unsmob<Music> (arg))
53 arg = m->unprotect ();
55 if (Input *in = unsmob<Input> (loc))
61 // A music function call implies walking through the call signature
62 // and matching the actual argument list to the signature. This
63 // process is not 1:1 due to the possible presence of optional
64 // arguments which are handled quite differently from how GUILE/Scheme
65 // usually deal with optional arguments.
67 // The argument matching here intentionally closely tracks the
68 // semantics of calls via the LilyPond parser as described in
69 // <URL:lilypond.org/doc/Documentation/extending/scheme-function-usage>:
70 // if an optional argument predicate does not match the next argument
71 // from the actual argument list, the default given in the call
72 // signature is used instead and all following optional arguments are
73 // unconditionally substituted in a similar manner.
75 // This skipping of optional arguments can be explicitly initiated by
76 // using \default in LilyPond. The respective value to use for a call
77 // via Scheme is *unspecified*.
80 Music_function::call (SCM rest)
82 Fluid location (ly_lily_module_constant ("%location"));
84 // (car (ly:music-signature self_scm())) is the return type, skip it
85 SCM signature = scm_cdr (get_signature ());
87 // In order to keep the loop structure and particularly the handling
88 // of terminating conditions reasonably straightforward and avoid
89 // scattering the code around, we don't use a separate loop when
90 // skipping optional arguments. Instead we use "skipping" to
91 // indicate whether we are currently filling in optional arguments
92 // from their defaults.
93 bool skipping = false;
95 // The main loop just processes the signature in sequence, and the
96 // resulting actual arguments are accumulated in reverse order in args
100 for (; scm_is_pair (signature); signature = scm_cdr (signature))
102 SCM pred = scm_car (signature);
104 if (scm_is_pair (pred))
106 // If the predicate is not a function but a pair, it
107 // signifies an optional argument. This is not quite the
108 // form declared to define-music-function (which is always
109 // a proper list) but a pair of predicate function and
114 if (!scm_is_pair (rest))
115 scm_wrong_num_args (self_scm ());
117 SCM arg = scm_car (rest);
118 if (scm_is_true (scm_call_1 (scm_car (pred), arg)))
120 args = scm_cons (arg, args);
121 rest = scm_cdr (rest);
125 // Remove at most one tentative "\default"
126 if (scm_is_eq (SCM_UNSPECIFIED, arg))
127 rest = scm_cdr (rest);
129 args = scm_cons (with_loc (scm_cdr (pred), location), args);
133 // We have a mandatory argument here.
136 if (!scm_is_pair (rest))
137 scm_wrong_num_args (self_scm ());
139 SCM arg = scm_car (rest);
140 rest = scm_cdr (rest);
141 args = scm_cons (arg, args);
143 if (scm_is_false (scm_call_1 (pred, arg)))
145 scm_call_4 (ly_lily_module_constant ("argument-error"),
147 scm_from_int (scm_ilength (args)),
149 SCM val = scm_car (get_signature ());
150 val = scm_is_pair (val) ? scm_cdr (val) : SCM_BOOL_F;
151 return with_loc (val, location);
155 if (scm_is_pair (rest))
156 scm_wrong_num_args (self_scm ());
158 SCM res = scm_apply_0 (get_function (), scm_reverse_x (args, SCM_EOL));
160 SCM pred = scm_car (get_signature ());
161 // The return type predicate may have the form of a pair in which
162 // the car is the actual predicate and the cdr is the surrogate
163 // return value in the error case, to be extracted by
164 // music-function-call-error.
165 if (scm_is_pair (pred))
166 pred = scm_car (pred);
168 if (scm_is_true (scm_call_1 (pred, res)))
169 return with_loc (res, location, false);
171 return scm_call_3 (ly_lily_module_constant ("music-function-call-error"),
172 location, self_scm (), res);