X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic-function.cc;h=c252291736cae35e659efc07ea6659742f2e0947;hb=a6a51abfd0195a3cf7d6ea095cf69808852f21ce;hp=d093f25a9581a63045c3c6ca060668484f1427a9;hpb=38d7d319eabc906e82fb42002678c6d42a23b6f7;p=lilypond.git diff --git a/lily/music-function.cc b/lily/music-function.cc index d093f25a95..c252291736 100644 --- a/lily/music-function.cc +++ b/lily/music-function.cc @@ -1,62 +1,157 @@ /* - 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 - (c) 2004--2009 Han-Wen Nienhuys + 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 . */ #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 ("#", 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 (arg)) + { + if (clone) + { + m = m->clone (); + arg = m->unprotect (); + } + if (Input *in = unsmob (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 +// : +// 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); -