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, ());
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);
}
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 ();
}
}
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 = "<string>";
+ 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 ())
{
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",
#include "paper-book.hh"
#include "parser.hh"
#include "score.hh"
+#include "source-file.hh"
#include "sources.hh"
#include "warn.hh"
#include "program-option.hh"
sources_ = sources;
default_duration_ = Duration (2, 0);
error_level_ = 0;
- local_environment_ = SCM_UNDEFINED;
+ closures_ = SCM_EOL;
smobify_self ();
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_)
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;
}
}
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_ = "<string>";
+ 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 ();
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;
}
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_,
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
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)))
projects / lilypond.git / commitdiff