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"
26 evaluate_args (SCM delayed_argument, SCM args, bool pure, int start, int end)
28 SCM new_args = SCM_EOL;
29 SCM *tail = &new_args;
30 for (SCM s = args; scm_is_pair (s); s = scm_cdr (s))
32 *tail = scm_cons (evaluate_with_simple_closure (delayed_argument, scm_car (s),
35 if (scm_car (*tail) == SCM_UNSPECIFIED)
36 return SCM_UNSPECIFIED;
37 tail = SCM_CDRLOC (*tail);
44 evaluate_with_simple_closure (SCM delayed_argument,
50 if (Simple_closure *sc = Simple_closure::unsmob (expr))
52 SCM inside = sc->expression ();
53 SCM proc = !pure && Unpure_pure_container::is_smob (scm_car (inside))
54 ? Unpure_pure_container::unsmob (scm_car (inside))->unpure_part ()
56 SCM args = scm_cons (delayed_argument,
57 evaluate_args (delayed_argument, scm_cdr (inside),
59 if (scm_cdr (args) == SCM_UNSPECIFIED)
60 return SCM_UNSPECIFIED;
62 return call_pure_function (proc, args, start, end);
63 return scm_apply_0 (proc, args);
65 else if (!scm_is_pair (expr))
67 else if (scm_car (expr) == ly_symbol2scm ("quote"))
68 return scm_cadr (expr);
69 else if (Unpure_pure_container::is_smob (scm_car (expr))
70 || ly_is_procedure (scm_car (expr)))
72 SCM proc = !pure && Unpure_pure_container::is_smob (scm_car (expr))
73 ? Unpure_pure_container::unsmob (scm_car (expr))->unpure_part ()
75 SCM args = evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end);
76 if (args == SCM_UNSPECIFIED)
77 return SCM_UNSPECIFIED;
79 return call_pure_function (proc, args, start, end);
80 return scm_apply_0 (proc, args);
83 // ugh. deviation from standard. Should print error?
84 return evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end);
90 const char Simple_closure::type_p_name_[] = "ly:simple-closure?";
92 LY_DEFINE (ly_make_simple_closure, "ly:make-simple-closure",
94 "Make a simple closure. @var{expr} should be form of"
95 " @code{(@var{func} @var{a1} @var{a2} @dots{})}, and will be"
96 " invoked as @code{(@var{func} @var{delayed-arg} @var{a1}"
97 " @var{a2} @dots{})}.")
99 return Simple_closure::make_smob (expr);
102 LY_DEFINE (ly_eval_simple_closure, "ly:eval-simple-closure",
103 2, 2, 0, (SCM delayed, SCM closure, SCM scm_start, SCM scm_end),
104 "Evaluate a simple @var{closure} with the given @var{delayed}"
105 " argument. If @var{scm-start} and @var{scm-end} are defined,"
106 " evaluate it purely with those start and end points.")
108 LY_ASSERT_SMOB (Simple_closure, closure, 2);
109 bool pure = (scm_is_number (scm_start) && scm_is_number (scm_end));
110 int start = robust_scm2int (scm_start, 0);
111 int end = robust_scm2int (scm_end, 0);
112 SCM expr = Simple_closure::unsmob (closure)->expression ();
113 return evaluate_with_simple_closure (delayed, expr, pure, start, end);
117 Simple_closure::print_smob (SCM port, scm_print_state *)
119 scm_puts ("#<simple-closure ", port);
120 scm_display (expression (), port);
121 scm_puts (" >", port);