/*
This file is part of LilyPond, the GNU music typesetter.
- Copyright (C) 2011--2014 Mike Solomon <mike@mikesolomon.org>
+ Copyright (C) 2011--2015 Mike Solomon <mike@mikesolomon.org>
LilyPond is free software: you can redistribute it and/or modify
*/
#include "unpure-pure-container.hh"
-#include "grob.hh"
-
-// Reroutes a call to the contained function after dropping last two
-// arguments. Used for applying an "unpure" function in a "pure"
+// Reroutes a call to the contained function after dropping second and
+// third argument. Used for applying an "unpure" function in a "pure"
// context.
class Unpure_pure_call : public Smob1<Unpure_pure_call>
{
public:
- LY_DECLARE_SMOB_PROC (2, 0, 1, (SCM self, SCM arg1, SCM arg2, SCM rest))
+ // Smob procedures unfortunately can only take at most 3 SCM
+ // arguments. Otherwise we could use a "3, 0, 1" call signature and
+ // not require an argument count check of our own.
+ LY_DECLARE_SMOB_PROC (&Unpure_pure_call::call, 2, 0, 1)
+ SCM call (SCM arg1, SCM, SCM rest)
{
- return scm_apply_0 (Unpure_pure_call::unsmob (self)->scm1 (),
- scm_call_2 (ly_lily_module_constant ("drop-right"),
- scm_cons2 (arg1, arg2, rest),
- scm_from_int (2)));
+ if (!scm_is_pair (rest))
+ scm_wrong_num_args (scm1 ());
+ return scm_apply_1 (scm1 (), arg1, scm_cdr (rest));
}
};
: scm2 ();
}
-const char Unpure_pure_container::type_p_name_[] = "ly:unpure-pure-container?";
+const char * const Unpure_pure_container::type_p_name_ = "ly:unpure-pure-container?";
LY_DEFINE (ly_make_unpure_pure_container, "ly:make-unpure-pure-container",
1, 1, 0, (SCM unpure, SCM pure),
"Return the unpure part of @var{pc}.")
{
LY_ASSERT_SMOB (Unpure_pure_container, pc, 1);
- return Unpure_pure_container::unsmob (pc)->unpure_part ();
+ return unsmob<Unpure_pure_container> (pc)->unpure_part ();
}
LY_DEFINE (ly_unpure_pure_container_pure_part, "ly:unpure-pure-container-pure-part",
"Return the pure part of @var{pc}.")
{
LY_ASSERT_SMOB (Unpure_pure_container, pc, 1);
- return Unpure_pure_container::unsmob (pc)->pure_part ();
+ return unsmob<Unpure_pure_container> (pc)->pure_part ();
}
int
-Unpure_pure_container::print_smob (SCM port, scm_print_state *)
+Unpure_pure_container::print_smob (SCM port, scm_print_state *) const
{
scm_puts ("#<unpure-pure-container ", port);
scm_display (unpure_part (), port);
scm_puts (" >", port);
return 1;
}
+
+LY_DEFINE (ly_pure_call, "ly:pure-call",
+ 4, 0, 1, (SCM data, SCM grob, SCM start, SCM end, SCM rest),
+ "Convert property @var{data} (unpure-pure container or procedure)"
+ " to value in a pure context defined by @var{grob},"
+ " @var{start}, @var{end}, and possibly @var{rest} arguments.")
+{
+ if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (data))
+ {
+ // Avoid gratuitous creation of an Unpure_pure_call
+ if (upc->is_unchanging ())
+ data = upc->unpure_part ();
+ else
+ {
+ data = upc->pure_part ();
+ if (ly_is_procedure (data))
+ return scm_apply_3 (data, grob, start, end, rest);
+ return data;
+ }
+ }
+ if (ly_is_procedure (data))
+ return scm_apply_1 (data, grob, rest);
+ return data;
+}
+
+LY_DEFINE (ly_unpure_call, "ly:unpure-call",
+ 2, 0, 1, (SCM data, SCM grob, SCM rest),
+ "Convert property @var{data} (unpure-pure container or procedure)"
+ " to value in an unpure context defined by @var{grob}"
+ " and possibly @var{rest} arguments.")
+{
+ if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (data))
+ data = upc->unpure_part ();
+ if (ly_is_procedure (data))
+ return scm_apply_1 (data, grob, rest);
+ return data;
+}