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 }