2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2005--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
7 LilyPond is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 LilyPond is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
20 #include "simple-closure.hh"
21 #include "unpure-pure-container.hh"
25 ADD_SMOB_INIT (Simple_closure);
28 evaluate_args (SCM delayed_argument, SCM args, bool pure, int start, int end)
30 SCM new_args = SCM_EOL;
31 SCM *tail = &new_args;
32 for (SCM s = args; scm_is_pair (s); s = scm_cdr (s))
34 *tail = scm_cons (evaluate_with_simple_closure (delayed_argument, scm_car (s),
37 if (scm_is_eq (scm_car (*tail), SCM_UNSPECIFIED))
38 return SCM_UNSPECIFIED;
39 tail = SCM_CDRLOC (*tail);
46 evaluate_with_simple_closure (SCM delayed_argument,
52 if (Simple_closure *sc = Simple_closure::unsmob (expr))
54 SCM inside = sc->expression ();
55 SCM proc = !pure && Unpure_pure_container::is_smob (scm_car (inside))
56 ? Unpure_pure_container::unsmob (scm_car (inside))->unpure_part ()
58 SCM args = scm_cons (delayed_argument,
59 evaluate_args (delayed_argument, scm_cdr (inside),
61 if (scm_is_eq (scm_cdr (args), SCM_UNSPECIFIED))
62 return SCM_UNSPECIFIED;
64 return call_pure_function (proc, args, start, end);
65 return scm_apply_0 (proc, args);
67 else if (!scm_is_pair (expr))
69 else if (scm_is_eq (scm_car (expr), ly_symbol2scm ("quote")))
70 return scm_cadr (expr);
71 else if (Unpure_pure_container::is_smob (scm_car (expr))
72 || ly_is_procedure (scm_car (expr)))
74 SCM proc = !pure && Unpure_pure_container::is_smob (scm_car (expr))
75 ? Unpure_pure_container::unsmob (scm_car (expr))->unpure_part ()
77 SCM args = evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end);
78 if (scm_is_eq (args, SCM_UNSPECIFIED))
79 return SCM_UNSPECIFIED;
81 return call_pure_function (proc, args, start, end);
82 return scm_apply_0 (proc, args);
85 // ugh. deviation from standard. Should print error?
86 return evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end);
92 const char Simple_closure::type_p_name_[] = "ly:simple-closure?";
94 LY_DEFINE (ly_make_simple_closure, "ly:make-simple-closure",
96 "Make a simple closure. @var{expr} should be form of"
97 " @code{(@var{func} @var{a1} @var{a2} @dots{})}, and will be"
98 " invoked as @code{(@var{func} @var{delayed-arg} @var{a1}"
99 " @var{a2} @dots{})}.")
101 return Simple_closure::make_smob (expr);
104 LY_DEFINE (ly_eval_simple_closure, "ly:eval-simple-closure",
105 2, 2, 0, (SCM delayed, SCM closure, SCM scm_start, SCM scm_end),
106 "Evaluate a simple @var{closure} with the given @var{delayed}"
107 " argument. If @var{scm-start} and @var{scm-end} are defined,"
108 " evaluate it purely with those start and end points.")
110 LY_ASSERT_SMOB (Simple_closure, closure, 2);
111 bool pure = (scm_is_number (scm_start) && scm_is_number (scm_end));
112 int start = robust_scm2int (scm_start, 0);
113 int end = robust_scm2int (scm_end, 0);
114 SCM expr = Simple_closure::unsmob (closure)->expression ();
115 return evaluate_with_simple_closure (delayed, expr, pure, start, end);
119 Simple_closure::print_smob (SCM port, scm_print_state *)
121 scm_puts ("#<simple-closure ", port);
122 scm_display (expression (), port);
123 scm_puts (" >", port);