]> git.donarmstrong.com Git - lilypond.git/commitdiff
Lambaize $ and # in #{ ... #} to make Guile V2 happy.
authorDavid Kastrup <dak@gnu.org>
Wed, 16 Nov 2011 07:04:23 +0000 (08:04 +0100)
committerDavid Kastrup <dak@gnu.org>
Tue, 22 Nov 2011 22:34:55 +0000 (23:34 +0100)
lily/include/lily-lexer.hh
lily/parse-scm.cc
scm/parser-ly-from-scheme.scm

index c53263d33ec3da6ebfa40cdfd697087703acb6c1..79aee379fe4cd16de5e9c2a635128c69616dddbe 100644 (file)
@@ -100,6 +100,7 @@ public:
   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);
index 7fea6f7d2c390e68f5d72585afeb6d42d578e7fe..9cd177f23cc62546fde07e8895525fa40c24690a 100644 (file)
@@ -23,6 +23,7 @@
 using namespace std;
 
 #include "lily-parser.hh"
+#include "lily-lexer.hh"
 #include "international.hh"
 #include "main.hh"
 #include "paper-book.hh"
@@ -57,8 +58,14 @@ internal_ly_parse_scm (Parse_start *ps)
      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;
 }
@@ -66,8 +73,6 @@ internal_ly_parse_scm (Parse_start *ps)
 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;
index 3f19641916c51a87030a13a10bfa6df1afce49a4..f96af9396dfd11d7bbe31a192fc089af6411a954 100644 (file)
   "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 #{ ... #}")))