X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fmusic-function.cc;h=c252291736cae35e659efc07ea6659742f2e0947;hb=5d84bfad4626892bcffd05adcced53c8a2329047;hp=b9159fe3a74b7e08f5a72e243adbee87f6b93c5e;hpb=2f0c6eb19208485a86d3416db3f3640a1d54752a;p=lilypond.git diff --git a/lily/music-function.cc b/lily/music-function.cc index b9159fe3a7..c252291736 100644 --- a/lily/music-function.cc +++ b/lily/music-function.cc @@ -1,7 +1,7 @@ /* This file is part of LilyPond, the GNU music typesetter. - Copyright (C) 2004--2012 Han-Wen Nienhuys + Copyright (C) 2004--2015 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 @@ -18,71 +18,140 @@ */ #include "music-function.hh" - +#include "lily-parser.hh" +#include "input.hh" #include "music.hh" -#include "ly-smobs.icc" - -class Musicfunction { - DECLARE_SIMPLE_SMOBS (Musicfunction); - SCM signature_; - SCM function_; -public: - Musicfunction (SCM signature, SCM function): - signature_(signature), function_(function) { } - SCM get_function () { return function_; } - SCM get_signature () { return signature_; } -}; - -IMPLEMENT_SIMPLE_SMOBS (Musicfunction); -IMPLEMENT_DEFAULT_EQUAL_P (Musicfunction); +#include "fluid.hh" +#include "lily-imports.hh" + +const char * const Music_function::type_p_name_ = "ly:music-function?"; /* Print a textual represenation of the smob to a given port. */ int -Musicfunction::print_smob (SCM b, SCM port, scm_print_state *) +Music_function::print_smob (SCM port, scm_print_state *) const { scm_puts ("#get_function (), port); + scm_write (get_function (), port); scm_puts (">", port); /* Non-zero means success. */ return 1; } -bool -is_music_function (SCM music_function) -{ - return Musicfunction::unsmob (music_function); -} - -SCM -get_music_function_transform (SCM music_function) -{ - if (!is_music_function (music_function)) - return SCM_UNDEFINED; - - return Musicfunction::unsmob (music_function)->get_function (); -} +// 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 -make_music_function (SCM signature, SCM func) +static SCM +with_loc (SCM arg, Fluid &loc, bool clone = true) { - return Musicfunction (signature, func).smobbed_copy (); + if (Music *m = unsmob (arg)) + { + if (clone) + { + m = m->clone (); + arg = m->unprotect (); + } + if (Input *in = unsmob (loc)) + m->set_spot (*in); + } + return arg; } -SCM -get_music_function_signature (SCM music_function) -{ - if (!is_music_function (music_function)) - return SCM_UNDEFINED; - - return Musicfunction::unsmob (music_function)->get_signature (); -} +// 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 -Musicfunction::mark_smob (SCM s) +Music_function::call (SCM rest) { - Musicfunction *p = Musicfunction::unsmob (s); - scm_gc_mark (p->signature_); - ASSERT_LIVE_IS_ALLOWED (s); - return p->function_; + 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); }