]> git.donarmstrong.com Git - lilypond.git/blob - lily/music-function.cc
Merge remote-tracking branch 'origin/release/unstable' into HEAD
[lilypond.git] / lily / music-function.cc
1 /*
2   This file is part of LilyPond, the GNU music typesetter.
3
4   Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
5
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.
10
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.
15
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/>.
18 */
19
20 #include "music-function.hh"
21 #include "lily-parser.hh"
22 #include "input.hh"
23 #include "music.hh"
24 #include "fluid.hh"
25 #include "lily-imports.hh"
26
27 const char * const Music_function::type_p_name_ = "ly:music-function?";
28
29 /* Print a textual represenation of the smob to a given port.  */
30 int
31 Music_function::print_smob (SCM port, scm_print_state *) const
32 {
33   scm_puts ("#<Music function ", port);
34   scm_write (get_function (), port);
35   scm_puts (">", port);
36
37   /* Non-zero means success.  */
38   return 1;
39 }
40
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
44 // for multiple use.
45
46 static SCM
47 with_loc (SCM arg, Fluid &loc, bool clone = true)
48 {
49   if (Music *m = unsmob<Music> (arg))
50     {
51       if (clone)
52         {
53           m = m->clone ();
54           arg = m->unprotect ();
55         }
56       if (Input *in = unsmob<Input> (loc))
57         m->set_spot (*in);
58     }
59   return arg;
60 }
61
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.
67 //
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.
75 //
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*.
79
80 SCM
81 Music_function::call (SCM rest)
82 {
83   Fluid location (Lily::f_location);
84
85   // (car (ly:music-signature self_scm())) is the return type, skip it
86   SCM signature = scm_cdr (get_signature ());
87
88   // The main loop just processes the signature in sequence, and the
89   // resulting actual arguments are accumulated in reverse order in args
90
91   SCM args = SCM_EOL;
92
93   while (scm_is_pair (rest) && scm_is_pair (signature))
94     {
95       SCM arg = scm_car (rest);
96       SCM pred = scm_car (signature);
97       if (!scm_is_pair (pred))
98         {
99           // non-optional argument
100           if (scm_is_false (scm_call_1 (pred, arg)))
101             {
102               Syntax::argument_error (scm_oneplus (scm_length (args)),
103                                       pred, arg);
104               SCM val = scm_car (get_signature ());
105               val = scm_is_pair (val) ? scm_cdr (val) : SCM_BOOL_F;
106               return with_loc (val, location);
107             }
108         }
109       // If the predicate is not a function but a pair, it
110       // signifies an optional argument.  This is not quite the
111       // form declared to define-music-function (which is always
112       // a proper list) but a pair of predicate function and
113       // default value.
114       //
115       // Fall through to default argument processing when optional
116       // argument predicate matches
117       else if (scm_is_false (scm_call_1 (scm_car (pred), arg)))
118         {
119           // optional argument, non-match
120           // *unspecified* is the same as an explicit \default: skip it
121           if (scm_is_eq (arg, SCM_UNSPECIFIED))
122             rest = scm_cdr (rest);
123           // Replace this and all following optional arguments with
124           // their defaults:
125           do {
126             args = scm_cons (with_loc (scm_cdr (pred), location), args);
127             signature = scm_cdr (signature);
128             if (!scm_is_pair (signature))
129               break;
130             pred = scm_car (signature);
131           } while (scm_is_pair (pred));
132           continue;
133         }
134       // Normal processing of accepted argument
135       signature = scm_cdr (signature);
136       args = scm_cons (arg, args);
137       rest = scm_cdr (rest);
138     }
139
140   if (scm_is_pair (rest) || scm_is_pair (signature))
141     scm_wrong_num_args (self_scm ());
142
143   SCM res = scm_apply_0 (get_function (), scm_reverse_x (args, SCM_EOL));
144
145   SCM pred = scm_car (get_signature ());
146   // The return type predicate may have the form of a pair in which
147   // the car is the actual predicate and the cdr is the surrogate
148   // return value in the error case, to be extracted by
149   // music-function-call-error.
150   if (scm_is_pair (pred))
151     pred = scm_car (pred);
152
153   if (scm_is_true (scm_call_1 (pred, res)))
154     return with_loc (res, location, false);
155
156   return Syntax::music_function_call_error (self_scm (), res);
157 }