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 23 matching lines...) Expand all Loading... |
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 | 42 |
43 // Start of the to-be-parsed form. | 43 // Start of the to-be-parsed form. |
44 const Input *start_; | 44 Input start_; |
45 | 45 |
46 // Output: full extent of the parsed form. | 46 // Output: full extent of the parsed form. |
47 Input parsed_; | 47 Input parsed_; |
48 bool safe_; | 48 bool safe_; |
49 Lily_parser *parser_; | 49 Lily_parser *parser_; |
50 | 50 |
51 Parse_start (SCM form, const Input &start, bool safe, Lily_parser *parser) : | 51 Parse_start (SCM form, const Input &start, bool safe, Lily_parser *parser) : |
52 form_ (form), start_ (&start), safe_ (safe), parser_ (parser) | 52 form_ (form), start_ (start), safe_ (safe), parser_ (parser) |
53 { | 53 { |
54 } | 54 } |
55 | 55 |
56 static SCM handle_error(void *data, SCM /*tag*/, SCM args) | 56 static SCM handle_error(void *data, SCM /*tag*/, SCM args) |
57 { | 57 { |
58 Parse_start *ps = (Parse_start *) data; | 58 Parse_start *ps = (Parse_start *) data; |
59 | 59 |
60 ps->start_->non_fatal_error | 60 ps->start_.non_fatal_error |
61 (_ ("GUILE signaled an error for the expression beginning here")); | 61 (_ ("GUILE signaled an error for the expression beginning here")); |
62 | 62 |
63 if (scm_ilength (args) > 2) | 63 if (scm_ilength (args) > 2) |
64 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 ()); |
65 | 65 |
66 return SCM_UNDEFINED; | 66 return SCM_UNDEFINED; |
67 } | 67 } |
68 }; | 68 }; |
69 | 69 |
70 /* Pass string to scm parser, read one expression. | 70 /* Pass string to scm parser, read one expression. |
71 Return result value and #chars read. | 71 Return result value and #chars read. |
72 | 72 |
73 Thanks to Gary Houston <ghouston@freewire.co.uk> */ | 73 Thanks to Gary Houston <ghouston@freewire.co.uk> */ |
74 SCM | 74 SCM |
75 internal_parse_embedded_scheme (Parse_start *ps) | 75 internal_parse_embedded_scheme (Parse_start *ps) |
76 { | 76 { |
77 const Input *hi = ps->start_; | 77 Source_file *sf = ps->start_.get_source_file (); |
78 Source_file *sf = hi->get_source_file (); | |
79 SCM port = sf->get_port (); | 78 SCM port = sf->get_port (); |
80 | 79 |
81 long off = hi->start () - sf->c_str (); | 80 long off = ps->start_.start () - sf->c_str (); |
82 | 81 |
83 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)); |
84 SCM from = scm_ftell (port); | 83 SCM from = scm_ftell (port); |
85 | 84 |
86 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)); |
87 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
)); |
88 | 87 |
89 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 ('@')); |
90 | 89 |
91 if (multiple) | 90 if (multiple) |
92 (void) scm_read_char (port); | 91 (void) scm_read_char (port); |
93 | 92 |
94 SCM form = scm_read (port); | 93 SCM form = scm_read (port); |
95 SCM to = scm_ftell (port); | 94 SCM to = scm_ftell (port); |
96 | 95 |
97 ps->parsed_.set (hi->get_source_file (), | 96 ps->parsed_.set (ps->start_.get_source_file (), |
98 hi->start (), | 97 ps->start_.start (), |
99 hi->start () + scm_to_int (scm_difference (to, from))); | 98 ps->start_.start () + scm_to_int (scm_difference (to, from)))
; |
100 | 99 |
101 if (!SCM_EOF_OBJECT_P (form)) | 100 if (!SCM_EOF_OBJECT_P (form)) |
102 { | 101 { |
103 if (ps->parser_->lexer_->top_input ()) | 102 if (ps->parser_->lexer_->top_input ()) |
104 { | 103 { |
105 // Find any precompiled form. | 104 // Find any precompiled form. |
106 SCM c = scm_assv_ref (ps->parser_->closures_, from); | 105 SCM c = scm_assv_ref (ps->parser_->closures_, from); |
107 if (scm_is_true (c)) | 106 if (scm_is_true (c)) |
108 // Replace form with a call to previously compiled closure | 107 // Replace form with a call to previously compiled closure |
109 form = scm_list_1 (c); | 108 form = scm_list_1 (c); |
(...skipping 84 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
194 | 193 |
195 SCM ans = scm_c_with_fluid | 194 SCM ans = scm_c_with_fluid |
196 (Lily::f_location, | 195 (Lily::f_location, |
197 ps.parsed_.smobbed_copy (), | 196 ps.parsed_.smobbed_copy (), |
198 parse_protect_global ? protected_evaluate_scheme_form | 197 parse_protect_global ? protected_evaluate_scheme_form |
199 : evaluate_scheme_form_void, (void *) &ps); | 198 : evaluate_scheme_form_void, (void *) &ps); |
200 | 199 |
201 scm_remember_upto_here_1 (form); | 200 scm_remember_upto_here_1 (form); |
202 return ans; | 201 return ans; |
203 } | 202 } |
LEFT | RIGHT |