virtual void new_input (string s, Sources *);
virtual void new_input (string s, string d, Sources *);
+ bool top_input () { return include_stack_.size () < 2; }
SCM keyword_list () const;
SCM lookup_identifier (string s);
SCM lookup_identifier_symbol (SCM s);
using namespace std;
#include "lily-parser.hh"
+#include "lily-lexer.hh"
#include "international.hh"
#include "main.hh"
#include "paper-book.hh"
early. */
// scm_close_port (port);
- if (!SCM_EOF_OBJECT_P (form))
+ 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;
}
SCM
internal_ly_eval_scm (Parse_start *ps)
{
- if (ps->parser_ && !SCM_UNBNDP (ps->parser_->local_environment_))
- return scm_local_eval (ps->form_, ps->parser_->local_environment_);
if (ps->safe_)
{
static SCM module = SCM_BOOL_F;
"Read a lilypond music expression enclosed within @code{#@{} and @code{#@}}
from @var{port} and return the corresponding Scheme music expression.
@samp{$} and @samp{#} introduce immediate and normal Scheme forms."
- (let ((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 #\$))
- (format out "~a~s" c (read port))
- ;; other characters
- (display c out)))))))
+ (let* ((closures '())
+ (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* ((clone
- (ly:parser-clone parser (procedure-environment (lambda () '()))))
+ (ly:parser-clone parser (list ,@(map (lambda (c)
+ `(lambda () ,c))
+ (reverse! closures)))))
(result (ly:parse-string-expression clone ,lily-string)))
(if (ly:parser-has-error? clone)
(ly:parser-error parser (_ "error in #{ ... #}")))