LEFT | RIGHT |
1 /* | 1 /* |
2 This file is part of LilyPond, the GNU music typesetter. | 2 This file is part of LilyPond, the GNU music typesetter. |
3 | 3 |
4 Copyright (C) 2004--2020 Han-Wen Nienhuys <hanwen@xs4all.nl> | 4 Copyright (C) 2004--2020 Han-Wen Nienhuys <hanwen@xs4all.nl> |
5 | 5 |
6 LilyPond is free software: you can redistribute it and/or modify | 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 | 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 | 8 the Free Software Foundation, either version 3 of the License, or |
9 (at your option) any later version. | 9 (at your option) any later version. |
10 | 10 |
(...skipping 21 matching lines...) Expand all Loading... |
32 // Catch stack traces on error. | 32 // Catch stack traces on error. |
33 bool parse_protect_global = true; | 33 bool parse_protect_global = true; |
34 | 34 |
35 | 35 |
36 // Input to parsing and evaluation Scheme. We have to group these so | 36 // Input to parsing and evaluation Scheme. We have to group these so |
37 // we can pass them as a void* through GUILE. | 37 // we can pass them as a void* through GUILE. |
38 struct Parse_start | 38 struct Parse_start |
39 { | 39 { |
40 // Holds the SCM expression to be evaluated; unused for parsing. | 40 // Holds the SCM expression to be evaluated; unused for parsing. |
41 SCM form_; | 41 SCM form_; |
42 Input *location_; | 42 |
| 43 // Start of the to-be-parsed form. |
| 44 Input start_; |
| 45 |
| 46 // Output: full extent of the parsed form. |
| 47 Input parsed_; |
43 bool safe_; | 48 bool safe_; |
44 Lily_parser *parser_; | 49 Lily_parser *parser_; |
45 | 50 |
46 Parse_start (SCM form, Input *location, bool safe, Lily_parser *parser) : | 51 Parse_start (SCM form, const Input &start, bool safe, Lily_parser *parser) : |
47 form_ (form), location_ (location), safe_ (safe), parser_ (parser) | 52 form_ (form), start_ (start), safe_ (safe), parser_ (parser) |
48 { | 53 { |
49 } | 54 } |
50 | 55 |
51 static SCM handle_error(void *data, SCM /*tag*/, SCM args) | 56 static SCM handle_error(void *data, SCM /*tag*/, SCM args) |
52 { | 57 { |
53 Parse_start *ps = (Parse_start *) data; | 58 Parse_start *ps = (Parse_start *) data; |
54 | 59 |
55 ps->location_->non_fatal_error | 60 ps->start_.non_fatal_error |
56 (_ ("GUILE signaled an error for the expression beginning here")); | 61 (_ ("GUILE signaled an error for the expression beginning here")); |
57 | 62 |
58 if (scm_ilength (args) > 2) | 63 if (scm_ilength (args) > 2) |
59 scm_display_error_message (scm_cadr (args), scm_caddr (args), scm_current_
error_port ()); | 64 scm_display_error_message (scm_cadr (args), scm_caddr (args), scm_current_
error_port ()); |
60 | 65 |
61 return SCM_UNDEFINED; | 66 return SCM_UNDEFINED; |
62 } | 67 } |
63 }; | 68 }; |
64 | 69 |
65 /* Pass string to scm parser, read one expression. | 70 /* Pass string to scm parser, read one expression. |
66 Return result value and #chars read. | 71 Return result value and #chars read. |
67 | 72 |
68 Thanks to Gary Houston <ghouston@freewire.co.uk> */ | 73 Thanks to Gary Houston <ghouston@freewire.co.uk> */ |
69 SCM | 74 SCM |
70 internal_parse_embedded_scheme (Parse_start *ps) | 75 internal_parse_embedded_scheme (Parse_start *ps) |
71 { | 76 { |
72 Input *hi = ps->location_; | 77 Source_file *sf = ps->start_.get_source_file (); |
73 Source_file *sf = hi->get_source_file (); | |
74 SCM port = sf->get_port (); | 78 SCM port = sf->get_port (); |
75 | 79 |
76 long off = hi->start () - sf->c_str (); | 80 long off = ps->start_.start () - sf->c_str (); |
77 | 81 |
78 scm_seek (port, scm_from_long (off), scm_from_long (SEEK_SET)); | 82 scm_seek (port, scm_from_long (off), scm_from_long (SEEK_SET)); |
79 SCM from = scm_ftell (port); | 83 SCM from = scm_ftell (port); |
80 | 84 |
81 scm_set_port_line_x (port, scm_from_ssize_t (hi->line_number () - 1)); | 85 scm_set_port_line_x (port, scm_from_ssize_t (ps->start_.line_number () - 1)); |
82 scm_set_port_column_x (port, scm_from_ssize_t (hi->column_number () - 1)); | 86 scm_set_port_column_x (port, scm_from_ssize_t (ps->start_.column_number () - 1
)); |
83 | 87 |
84 bool multiple = ly_is_equal (scm_peek_char (port), SCM_MAKE_CHAR ('@')); | 88 bool multiple = ly_is_equal (scm_peek_char (port), SCM_MAKE_CHAR ('@')); |
85 | 89 |
86 if (multiple) | 90 if (multiple) |
87 (void) scm_read_char (port); | 91 (void) scm_read_char (port); |
88 | 92 |
89 SCM form = scm_read (port); | 93 SCM form = scm_read (port); |
90 SCM to = scm_ftell (port); | 94 SCM to = scm_ftell (port); |
91 | 95 |
92 hi->set (hi->get_source_file (), | 96 ps->parsed_.set (ps->start_.get_source_file (), |
93 hi->start (), | 97 ps->start_.start (), |
94 hi->start () + scm_to_int (scm_difference (to, from))); | 98 ps->start_.start () + scm_to_int (scm_difference (to, from)))
; |
95 | 99 |
96 if (!SCM_EOF_OBJECT_P (form)) | 100 if (!SCM_EOF_OBJECT_P (form)) |
97 { | 101 { |
98 if (ps->parser_->lexer_->top_input ()) | 102 if (ps->parser_->lexer_->top_input ()) |
99 { | 103 { |
100 // Find any precompiled form. | 104 // Find any precompiled form. |
101 SCM c = scm_assv_ref (ps->parser_->closures_, from); | 105 SCM c = scm_assv_ref (ps->parser_->closures_, from); |
102 if (scm_is_true (c)) | 106 if (scm_is_true (c)) |
103 // Replace form with a call to previously compiled closure | 107 // Replace form with a call to previously compiled closure |
104 form = scm_list_1 (c); | 108 form = scm_list_1 (c); |
105 } | 109 } |
106 if (multiple) | 110 if (multiple) |
107 form = scm_list_3 (ly_symbol2scm ("apply"), | 111 form = scm_list_3 (ly_symbol2scm ("apply"), |
108 ly_symbol2scm ("values"), | 112 ly_symbol2scm ("values"), |
109 form); | 113 form); |
110 return form; | 114 return form; |
111 } | 115 } |
112 | 116 |
113 /* Don't close the port here; if we re-enter this function via a | |
114 continuation, then the next time we enter it, we'll get an error. | |
115 It's a string port anyway, so there's no advantage to closing it | |
116 early. */ | |
117 // scm_close_port (port); | |
118 | |
119 return SCM_UNDEFINED; | 117 return SCM_UNDEFINED; |
120 } | 118 } |
121 | 119 |
122 SCM | 120 SCM |
123 parse_embedded_scheme_void (void *p) | 121 parse_embedded_scheme_void (void *p) |
124 { | 122 { |
125 return internal_parse_embedded_scheme (static_cast<Parse_start *> (p)); | 123 return internal_parse_embedded_scheme (static_cast<Parse_start *> (p)); |
126 } | 124 } |
127 | 125 |
128 SCM | 126 SCM |
129 protected_parse_embedded_scheme (Parse_start *ps) | 127 protected_parse_embedded_scheme (Parse_start *ps) |
130 { | 128 { |
131 // Catch #t : catch all Scheme level errors. | 129 // Catch #t : catch all Scheme level errors. |
132 return scm_internal_catch (SCM_BOOL_T, | 130 return scm_internal_catch (SCM_BOOL_T, |
133 parse_embedded_scheme_void, | 131 parse_embedded_scheme_void, |
134 (void *) ps, | 132 (void *) ps, |
135 &Parse_start::handle_error, (void *) ps); | 133 &Parse_start::handle_error, (void *) ps); |
136 } | 134 } |
137 | 135 |
138 // Try parsing. Upon failure return SCM_UNDEFINED. | 136 // Try parsing. Upon failure return SCM_UNDEFINED. Upon success, set |
139 SCM | 137 // parsed_output to the cover the entire form. parsed_output may not |
140 parse_embedded_scheme (Input *i, bool safe, Lily_parser *parser) | 138 // be null. |
141 { | 139 SCM |
142 Parse_start ps (SCM_UNDEFINED, i, safe, parser); | 140 parse_embedded_scheme (const Input &start, bool safe, Lily_parser *parser, Input
*parsed_output) |
143 | 141 { |
144 return parse_protect_global | 142 Parse_start ps (SCM_UNDEFINED, start, safe, parser); |
| 143 |
| 144 SCM result = parse_protect_global |
145 ? protected_parse_embedded_scheme (&ps) | 145 ? protected_parse_embedded_scheme (&ps) |
146 : internal_parse_embedded_scheme (&ps); | 146 : internal_parse_embedded_scheme (&ps); |
| 147 |
| 148 *parsed_output = ps.parsed_; |
| 149 return result; |
147 } | 150 } |
148 | 151 |
149 // EVALUATION | 152 // EVALUATION |
150 | 153 |
151 SCM | 154 SCM |
152 evaluate_scheme_form (Parse_start *ps) | 155 evaluate_scheme_form (Parse_start *ps) |
153 { | 156 { |
154 if (ps->safe_) | 157 if (ps->safe_) |
155 { | 158 { |
156 static SCM module = SCM_BOOL_F; | 159 static SCM module = SCM_BOOL_F; |
(...skipping 20 matching lines...) Expand all Loading... |
177 /* | 180 /* |
178 Catch #t : catch all Scheme level errors. | 181 Catch #t : catch all Scheme level errors. |
179 */ | 182 */ |
180 return scm_internal_catch (SCM_BOOL_T, | 183 return scm_internal_catch (SCM_BOOL_T, |
181 evaluate_scheme_form_void, | 184 evaluate_scheme_form_void, |
182 ps, | 185 ps, |
183 &Parse_start::handle_error, ps); | 186 &Parse_start::handle_error, ps); |
184 } | 187 } |
185 | 188 |
186 SCM | 189 SCM |
187 evaluate_embedded_scheme (SCM form, Input i, bool safe, Lily_parser *parser) | 190 evaluate_embedded_scheme (SCM form, Input const &start, bool safe, Lily_parser *
parser) |
188 { | 191 { |
189 Parse_start ps (form, &i, safe, parser); | 192 Parse_start ps (form, start, safe, parser); |
190 | 193 |
191 SCM ans = scm_c_with_fluid | 194 SCM ans = scm_c_with_fluid |
192 (Lily::f_location, | 195 (Lily::f_location, |
193 i.smobbed_copy (), | 196 ps.parsed_.smobbed_copy (), |
194 parse_protect_global ? protected_evaluate_scheme_form | 197 parse_protect_global ? protected_evaluate_scheme_form |
195 : evaluate_scheme_form_void, (void *) &ps); | 198 : evaluate_scheme_form_void, (void *) &ps); |
196 | 199 |
197 scm_remember_upto_here_1 (form); | 200 scm_remember_upto_here_1 (form); |
198 return ans; | 201 return ans; |
199 } | 202 } |
LEFT | RIGHT |