1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
/*
This file is part of LilyPond, the GNU music typesetter.
Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
LilyPond is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
LilyPond is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
*/
#include "parse-scm.hh"
#include <cstdio>
using namespace std;
#include "lily-parser.hh"
#include "lily-lexer.hh"
#include "international.hh"
#include "main.hh"
#include "paper-book.hh"
#include "source-file.hh"
#include "lily-imports.hh"
/* Pass string to scm parser, read one expression.
Return result value and #chars read.
Thanks to Gary Houston <ghouston@freewire.co.uk> */
SCM
internal_ly_parse_scm (Parse_start *ps)
{
Input &hi = ps->location_;
Source_file *sf = hi.get_source_file ();
SCM port = sf->get_port ();
long off = hi.start () - sf->c_str ();
scm_seek (port, scm_from_long (off), scm_from_long (SEEK_SET));
SCM from = scm_ftell (port);
scm_set_port_line_x (port, scm_from_int (hi.line_number () - 1));
scm_set_port_column_x (port, scm_from_int (hi.column_number () - 1));
bool multiple = ly_is_equal (scm_peek_char (port), SCM_MAKE_CHAR ('@'));
if (multiple)
(void) scm_read_char (port);
SCM form = scm_read (port);
SCM to = scm_ftell (port);
hi.set (hi.get_source_file (),
hi.start (),
hi.start () + scm_to_int (scm_difference (to, from)));
if (!SCM_EOF_OBJECT_P (form))
{
if (ps->parser_->lexer_->top_input ())
{
// Find any precompiled form.
SCM c = scm_assv_ref (ps->parser_->closures_, from);
if (scm_is_true (c))
// Replace form with a call to previously compiled closure
form = scm_list_1 (c);
}
if (multiple)
form = scm_list_3 (ly_symbol2scm ("apply"),
ly_symbol2scm ("values"),
form);
return form;
}
/* Don't close the port here; if we re-enter this function via a
continuation, then the next time we enter it, we'll get an error.
It's a string port anyway, so there's no advantage to closing it
early. */
// scm_close_port (port);
return SCM_UNDEFINED;
}
SCM
internal_ly_eval_scm (Parse_start *ps)
{
if (ps->safe_)
{
static SCM module = SCM_BOOL_F;
if (scm_is_false (module))
{
module = scm_gc_protect_object (Lily::make_safe_lilypond_module ());
}
return scm_eval (ps->form_, module);
}
return scm_primitive_eval (ps->form_);
}
SCM
catch_protected_parse_body (void *p)
{
return internal_ly_parse_scm (static_cast<Parse_start *> (p));
}
SCM
catch_protected_eval_body (void *p)
{
return internal_ly_eval_scm (static_cast<Parse_start *> (p));
}
SCM
parse_handler (void *data, SCM /*tag*/, SCM args)
{
Parse_start *ps = (Parse_start *) data;
ps->location_.non_fatal_error
(_ ("GUILE signaled an error for the expression beginning here"));
if (scm_ilength (args) > 2)
scm_display_error_message (scm_cadr (args), scm_caddr (args), scm_current_error_port ());
return SCM_UNDEFINED;
}
SCM
protected_ly_parse_scm (Parse_start *ps)
{
/*
Catch #t : catch all Scheme level errors.
*/
return scm_internal_catch (SCM_BOOL_T,
catch_protected_parse_body,
(void *) ps,
&parse_handler, (void *) ps);
}
SCM
protected_ly_eval_scm (void *ps)
{
/*
Catch #t : catch all Scheme level errors.
*/
return scm_internal_catch (SCM_BOOL_T,
catch_protected_eval_body,
ps,
&parse_handler, ps);
}
bool parse_protect_global = true;
bool parsed_objects_should_be_dead = false;
/* Try parsing. Upon failure return SCM_UNDEFINED. */
SCM
ly_parse_scm (Input &i, bool safe, Lily_parser *parser)
{
Parse_start ps (SCM_UNDEFINED, i, safe, parser);
SCM ans = parse_protect_global ? protected_ly_parse_scm (&ps)
: internal_ly_parse_scm (&ps);
return ans;
}
SCM
ly_eval_scm (SCM form, Input i, bool safe, Lily_parser *parser)
{
Parse_start ps (form, i, safe, parser);
SCM ans = scm_c_with_fluid
(Lily::f_location,
i.smobbed_copy (),
parse_protect_global ? protected_ly_eval_scm
: catch_protected_eval_body, (void *) &ps);
scm_remember_upto_here_1 (form);
return ans;
}
|
