From fecc5999e224304e9d54e48bc7a92cdbb123cd35 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sun, 6 Nov 2011 19:15:27 +0100 Subject: [PATCH] Let #{ ... #} pass its $ handling to environment cloning Includes convertrules.py rules for dealing with #{ ... #} and for removing uses of ly:export --- python/convertrules.py | 59 +++++++++++++++++++++++ scm/parser-ly-from-scheme.scm | 89 +++++++++-------------------------- 2 files changed, 80 insertions(+), 68 deletions(-) diff --git a/python/convertrules.py b/python/convertrules.py index 6ee120df7b..18cadb199b 100644 --- a/python/convertrules.py +++ b/python/convertrules.py @@ -3274,6 +3274,65 @@ def conv (str): stderr_write (UPDATE_MANUALLY) return str +def paren_matcher (n): + # poor man's matched paren scanning, gives up + # after n+1 levels. + return r"\([^()]*(?:"*n+r"\([^()]*\)"+r"[^()]*)*\)"*n + return + +def undollar_scm (m): + return re.sub (r"\$", "", m.group (0)) + +def undollar_embedded (m): + str = re.sub (r"#\$", "#", m.group (1)) + # poor man's matched paren scanning after #, gives up + # after 25 levels. + str = re.sub ("#`?"+paren_matcher (25), undollar_scm, str) + return m.string[m.start (0):m.start (1)] + str + m.string[m.end (1):m.end (0)] + +def strip_export (str): + return re.sub (r"\(ly:export\s+((?:[^()]*?" + paren_matcher (25) + + r")*[^()]*)\)", + r"\1", str) + +def export_puller (m): + if not re.search (r"ly:export\s+", m.group (0)): + return m.group (0) + return "$" + strip_export (m.string[m.start (0)+1:m.end (0)]) + +def ugly_function_rewriter (m): + return m.string[m.start(0):m.start(1)] + strip_export (m.group (1)) + m.string[m.end(1):m.end(0)] + +should_really_be_music_function = "(?:\ +set-time-signature|empty-music|add-grace-property|\ +remove-grace-property|set-accidental-style)" + +def record_ugly (m): + global should_really_be_music_function + if not re.match (should_really_be_music_function, m.group (1)) \ + and re.search (r"ly:export\s+", m.group (2)): + should_really_be_music_function = \ + should_really_be_music_function[:-1] + "|" + m.group (1) + ")" + return m.group (0) + +@rule ((2, 15, 18), "#$ -> #, ly:export -> $") +def conv (str): + str = re.sub (r"(?s)#@?\{(.*?)#@?\}", undollar_embedded, str) + str = re.sub (r"#\(define(?:-public)?\s+\(([-a-zA-Z]+)" + + r"\b[^()]*?\)([^()]*(?:" + paren_matcher (25) + + r"[^()]*)*)\)", record_ugly, str) + str = re.sub (r"\(define(?:-public)?\s+\(" + should_really_be_music_function + + r"\b[^()]*\)([^()]*(?:" + paren_matcher (25) + + r"[^()]*)*)\)", ugly_function_rewriter, str) + str = re.sub (r"#(?=\(" + should_really_be_music_function + ")", "$", str) + str = re.sub (r"#\(markup\*(?=\s)", r"$(markup", str) + str = re.sub ("#"+paren_matcher (25), export_puller, str) + if re.search (r"\(ly:export\s+", str): + stderr_write ('\n') + stderr_write (NOT_SMART % "ly:export") + stderr_write ('\n') + return str + # Guidelines to write rules (please keep this at the end of this file) # # - keep at most one rule per version; if several conversions should be done, diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm index a17edb63f9..1a51a37140 100644 --- a/scm/parser-ly-from-scheme.scm +++ b/scm/parser-ly-from-scheme.scm @@ -16,75 +16,28 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -(define gen-lily-sym - ;; Generate a lilyvartmpXX symbol, that may be (hopefully) unique. - (let ((var-idx -1)) - (lambda () - (set! var-idx (1+ var-idx)) - (string->symbol (format #f "lilyvartmp~a" - (list->string (map (lambda (chr) - (integer->char (+ (char->integer #\a) - (- (char->integer chr) - (char->integer #\0))))) - (string->list (number->string var-idx))))))))) - (define-public (read-lily-expression chr port) - "Read a lilypond music expression enclosed within @code{#@}} and @code{#@}} + "Read a lilypond music expression enclosed within @code{#@{} and @code{#@}} from @var{port} and return the corresponding Scheme music expression. -The @samp{$} character may be used to introduce Scheme forms, typically -symbols. @code{$$} may be used to simply write a @samp{$} character itself." - (let ((bindings '())) - - (define (create-binding! val) - "Create a new symbol, bind it to `val' and return it." - (let ((tmp-symbol (gen-lily-sym))) - (set! bindings (cons (cons tmp-symbol val) bindings)) - tmp-symbol)) - - (define (remove-dollars! form) - "Generate a form where `$variable' and `$ value' mottos are replaced - by new symbols, which are binded to the adequate values." - (cond (;; $variable - (and (symbol? form) - (string=? (substring (symbol->string form) 0 1) "$") - (not (and (<= 2 (string-length (symbol->string form))) - (string=? (substring (symbol->string form) 1 2) "$")))) - (create-binding! (string->symbol (substring (symbol->string form) 1)))) - (;; atom - (not (pair? form)) form) - (;; ($ value ...) - (eqv? (car form) '$) - (cons (create-binding! (cadr form)) (remove-dollars! (cddr form)))) - (else ;; (something ...) - (cons (remove-dollars! (car form)) (remove-dollars! (cdr form)))))) - - (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 encoutered - (read-char port)) - (cond - ;; a $form expression - ((and (char=? c #\$) (not (char=? (peek-char port) #\$))) - (format out "\\~a" (create-binding! (read port)))) - ;; just a $ character - ((and (char=? c #\$) (char=? (peek-char port) #\$)) - ;; pop the second $ - (display (read-char port) out)) - ;; a #scheme expression - ((char=? c #\#) - (let ((expr (read port))) - (format out "#~s" (if (eq? '$ expr) - (create-binding! (read port)) - (remove-dollars! expr))))) - ;; other caracters - (else - (display c out)))))))) - `(let ((parser-clone (ly:parser-clone parser))) - ,@(map (lambda (binding) - `(ly:parser-define! parser-clone ',(car binding) ,(cdr binding))) - (reverse bindings)) - (ly:parse-string-expression parser-clone ,lily-string))))) +@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* ((clone + (ly:parser-clone parser (procedure-environment (lambda () '())))) + (result (begin + (ly:parser-clear-error clone) + (ly:parse-string-expression clone ,lily-string)))) + (if (ly:parser-has-error? clone) + (ly:parser-error parser (_ "error in #{ ... #}"))) + result))) (read-hash-extend #\{ read-lily-expression) -- 2.39.2