From 4778c7326d726f50f6ac541322006d6b90795945 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Wed, 23 Nov 2011 17:47:17 +0100 Subject: [PATCH] Record $ and # expressions inside of #{ #} for better correlation --- lily/include/lily-parser.hh | 6 +++--- lily/lily-parser-scheme.cc | 36 +++++++++++++++++++++++++------ lily/lily-parser.cc | 18 ++++++++++------ lily/parse-scm.cc | 22 +++++++++++-------- lily/source-file.cc | 15 ++++++++----- scm/parser-ly-from-scheme.scm | 40 +++++++++++++++++++++++------------ 6 files changed, 94 insertions(+), 43 deletions(-) diff --git a/lily/include/lily-parser.hh b/lily/include/lily-parser.hh index 0859f72d61..5d414c4602 100644 --- a/lily/include/lily-parser.hh +++ b/lily/include/lily-parser.hh @@ -48,14 +48,14 @@ public: Sources *sources_; Duration default_duration_; string output_basename_; - SCM local_environment_; + SCM closures_; int fatal_error_; int error_level_; bool ignore_version_b_; Lily_parser (Sources *sources); - Lily_parser (Lily_parser const &, SCM env = SCM_UNDEFINED); + Lily_parser (Lily_parser const &, SCM closures = SCM_EOL); DECLARE_SCHEME_CALLBACK (layout_description, ()); @@ -65,7 +65,7 @@ public: void include_string (string ly_code); void parse_file (string init, string name, string out_name); void parse_string (string ly_code); - SCM parse_string_expression (string ly_code); + SCM parse_string_expression (string ly_code, string filename, int line); void parser_error (string); void parser_error (Input const &, string); void set_yydebug (bool); diff --git a/lily/lily-parser-scheme.cc b/lily/lily-parser-scheme.cc index 596987dd1e..b433bf9ec4 100644 --- a/lily/lily-parser-scheme.cc +++ b/lily/lily-parser-scheme.cc @@ -146,12 +146,19 @@ LY_DEFINE (ly_parser_lexer, "ly:parser-lexer", } LY_DEFINE (ly_parser_clone, "ly:parser-clone", - 1, 1, 0, (SCM parser_smob, SCM local_environment), - "Return a clone of @var{parser-smob}.") + 1, 1, 0, (SCM parser_smob, SCM closures), + "Return a clone of @var{parser-smob}. An association list" +" of port positions to closures can be specified in @var{closures}" +" in order to have @code{$} and @code{#} interpreted in their original" +" lexical environment.") { LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); Lily_parser *parser = unsmob_lily_parser (parser_smob); - Lily_parser *clone = new Lily_parser (*parser, local_environment); + if (SCM_UNBNDP (closures)) + closures = SCM_EOL; + else + LY_ASSERT_TYPE (ly_is_list, closures, 2); + Lily_parser *clone = new Lily_parser (*parser, closures); return clone->unprotect (); } @@ -207,13 +214,29 @@ LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", } LY_DEFINE (ly_parse_string_expression, "ly:parse-string-expression", - 2, 0, 0, (SCM parser_smob, SCM ly_code), + 2, 2, 0, (SCM parser_smob, SCM ly_code, SCM filename, + SCM line), "Parse the string @var{ly-code} with @var{parser-smob}." -" Return the contained music expression.") +" Return the contained music expression." +" @var{filename} and @var{line} are optional source indicators.") { LY_ASSERT_SMOB (Lily_parser, parser_smob, 1); Lily_parser *parser = unsmob_lily_parser (parser_smob); LY_ASSERT_TYPE (scm_is_string, ly_code, 2); + string fn; + if (SCM_UNBNDP (filename)) + fn = ""; + else { + LY_ASSERT_TYPE (scm_is_string, filename, 3); + fn = ly_scm2string (filename); + } + int ln; + if (SCM_UNBNDP (line)) + ln = 0; + else { + LY_ASSERT_TYPE (scm_is_integer, line, 4); + ln = scm_to_int (line); + } if (!parser->lexer_->is_clean ()) { @@ -222,7 +245,8 @@ LY_DEFINE (ly_parse_string_expression, "ly:parse-string-expression", return SCM_UNSPECIFIED; } - return parser->parse_string_expression (ly_scm2string (ly_code)); + return parser->parse_string_expression (ly_scm2string (ly_code), + fn, ln); } LY_DEFINE (ly_parser_include_string, "ly:parser-include-string", diff --git a/lily/lily-parser.cc b/lily/lily-parser.cc index 557bc42696..8159c3dae7 100644 --- a/lily/lily-parser.cc +++ b/lily/lily-parser.cc @@ -32,6 +32,7 @@ #include "paper-book.hh" #include "parser.hh" #include "score.hh" +#include "source-file.hh" #include "sources.hh" #include "warn.hh" #include "program-option.hh" @@ -44,7 +45,7 @@ Lily_parser::Lily_parser (Sources *sources) sources_ = sources; default_duration_ = Duration (2, 0); error_level_ = 0; - local_environment_ = SCM_UNDEFINED; + closures_ = SCM_EOL; smobify_self (); @@ -52,14 +53,14 @@ Lily_parser::Lily_parser (Sources *sources) lexer_->unprotect (); } -Lily_parser::Lily_parser (Lily_parser const &src, SCM env) +Lily_parser::Lily_parser (Lily_parser const &src, SCM closures) { lexer_ = 0; sources_ = src.sources_; default_duration_ = src.default_duration_; error_level_ = 0; output_basename_ = src.output_basename_; - local_environment_ = env; + closures_ = closures; smobify_self (); if (src.lexer_) @@ -78,7 +79,7 @@ SCM Lily_parser::mark_smob (SCM s) { Lily_parser *parser = (Lily_parser *) SCM_CELL_WORD_1 (s); - scm_gc_mark (parser->local_environment_); + scm_gc_mark (parser->closures_); return (parser->lexer_) ? parser->lexer_->self_scm () : SCM_EOL; } @@ -154,16 +155,19 @@ Lily_parser::parse_string (string ly_code) } SCM -Lily_parser::parse_string_expression (string ly_code) +Lily_parser::parse_string_expression (string ly_code, string filename, + int line) { // TODO: use $parser lexer_->set_identifier (ly_symbol2scm ("parser"), self_scm ()); - lexer_->main_input_name_ = ""; + lexer_->main_input_name_ = filename; lexer_->is_main_input_ = true; lexer_->new_input (lexer_->main_input_name_, ly_code, sources_); - + if (line) { + lexer_->get_source_file ()->set_line (0, line); + } SCM mod = lexer_->set_current_scope (); lexer_->push_extra_token (EMBEDDED_LILY); do_yyparse (); diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc index 34e98e1375..1b0f167033 100644 --- a/lily/parse-scm.cc +++ b/lily/parse-scm.cc @@ -52,21 +52,25 @@ internal_ly_parse_scm (Parse_start *ps) SCM to = scm_ftell (port); ps->nchars = scm_to_int (to) - scm_to_int (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); + } + return scm_cons (form, make_input (ps->start_location_)); +} + /* 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); - if (!SCM_EOF_OBJECT_P (form)) { - if (ps->parser_->lexer_->top_input () - && scm_is_pair (ps->parser_->local_environment_)) { - form = scm_list_1 (scm_car (ps->parser_->local_environment_)); - ps->parser_->local_environment_ = scm_cdr (ps->parser_->local_environment_); - } - return scm_cons (form, make_input (ps->start_location_)); - } - return SCM_UNDEFINED; } diff --git a/lily/source-file.cc b/lily/source-file.cc index 041c046d2b..17e01dd453 100644 --- a/lily/source-file.cc +++ b/lily/source-file.cc @@ -317,7 +317,7 @@ Source_file::get_line (char const *pos_str0) const return 0; if (!newline_locations_.size ()) - return 1; + return 1 + line_offset_; /* this will find the '\n' character at the end of our line */ vsize lo = lower_bound (newline_locations_, @@ -331,10 +331,15 @@ Source_file::get_line (char const *pos_str0) const void Source_file::set_line (char const *pos_str0, int line) { - int current_line = get_line (pos_str0); - line_offset_ += line - current_line; - - assert (line == get_line (pos_str0)); + if (pos_str0) + { + int current_line = get_line (pos_str0); + line_offset_ += line - current_line; + + assert (line == get_line (pos_str0)); + } + else + line_offset_ = line; } int diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm index f96af9396d..f407a3dff0 100644 --- a/scm/parser-ly-from-scheme.scm +++ b/scm/parser-ly-from-scheme.scm @@ -21,24 +21,38 @@ from @var{port} and return the corresponding Scheme music expression. @samp{$} and @samp{#} introduce immediate and normal Scheme forms." (let* ((closures '()) + (filename (port-filename port)) + (line (port-line port)) (lily-string (call-with-output-string (lambda (out) - (do ((c (read-char port) (read-char port))) - ((and (char=? c #\#) - (char=? (peek-char port) #\})) ;; we stop when #} is encountered - (read-char port)) - ;; a #scheme or $scheme expression - (if (or (char=? c #\#) (char=? c #\$)) - (begin - (set! closures (cons (read port) closures)) - (format out "~a~s" c (car closures))) - ;; other characters - (display c out))))))) + (let ((copycat + (make-soft-port + (vector #f #f #f + (lambda () + (let ((x (read-char port))) + (write-char x out) + x)) #f) + "r"))) + (do ((c (read-char port) (read-char port))) + ((and (char=? c #\#) + (char=? (peek-char port) #\})) + ;; we stop when #} is encountered + (read-char port)) + (write-char c out) + ;; a #scheme or $scheme expression + (if (or (char=? c #\#) (char=? c #\$)) + (let ((p (ftell out))) + (set! closures + (cons (cons p (read copycat)) + closures)))))))))) `(let* ((clone (ly:parser-clone parser (list ,@(map (lambda (c) - `(lambda () ,c)) + `(cons ,(car c) + (lambda () ,(cdr c)))) (reverse! closures))))) - (result (ly:parse-string-expression clone ,lily-string))) + (result (ly:parse-string-expression clone ,lily-string + ,filename + ,line))) (if (ly:parser-has-error? clone) (ly:parser-error parser (_ "error in #{ ... #}"))) result))) -- 2.39.2