From 41b8dd4d0bec0445e1850ed8b87fef3599d2d41b Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 10 Jun 2005 10:58:50 +0000 Subject: [PATCH] * lily/default-actions.cc (Module): new file. default {book,score}-print functions. * scm/ly-from-scheme.scm (ly:parse-string-result): use new setup: pass results via parseStringResult, lookup via ly:parser-lookup. * lily/lily-parser.cc (Lily_parser): only clone lexer in constructors. (parse_file): encapsulate do_yyparse() in scm_set_current_module() (parse_string): idem. * ly/spanners-init.ly (assertBeamQuant): don't use #{ #} in init. --- ChangeLog | 13 +++ input/regression/beam-quant-standard.ly | 2 +- lily/default-actions.cc | 106 ++++++++++++++++++++++++ lily/include/lily-lexer.hh | 2 +- lily/include/lily-parser.hh | 8 +- lily/lily-lexer.cc | 15 +++- lily/lily-parser-scheme.cc | 100 ++-------------------- lily/lily-parser.cc | 34 ++++---- ly/spanners-init.ly | 21 ++--- scm/ly-from-scheme.scm | 38 +++++---- 10 files changed, 185 insertions(+), 154 deletions(-) create mode 100644 lily/default-actions.cc diff --git a/ChangeLog b/ChangeLog index 39f9b04e43..ff111bad93 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,18 @@ 2005-06-10 Han-Wen Nienhuys + * lily/default-actions.cc (Module): new file. default + {book,score}-print functions. + + * scm/ly-from-scheme.scm (ly:parse-string-result): use new setup: + pass results via parseStringResult, lookup via ly:parser-lookup. + + * lily/lily-parser.cc (Lily_parser): only clone lexer in + constructors. + (parse_file): encapsulate do_yyparse() in scm_set_current_module() + (parse_string): idem. + + * ly/spanners-init.ly (assertBeamQuant): don't use #{ #} in init. + * lily/main.cc (main_with_guile): copy be_verbose_global into ly_set_option() diff --git a/input/regression/beam-quant-standard.ly b/input/regression/beam-quant-standard.ly index affe6713dc..ebf4c44b96 100644 --- a/input/regression/beam-quant-standard.ly +++ b/input/regression/beam-quant-standard.ly @@ -142,5 +142,5 @@ primeSixteenths = \relative { \filler } -{ \primes \seconds \primeSixteenths } +\new Voice { \primes \seconds \primeSixteenths } diff --git a/lily/default-actions.cc b/lily/default-actions.cc new file mode 100644 index 0000000000..34f7c62224 --- /dev/null +++ b/lily/default-actions.cc @@ -0,0 +1,106 @@ +/* + default-actions.cc -- implement default toplevel actions for .ly + file. + + source file of the GNU LilyPond music typesetter + + (c) 2005 Han-Wen Nienhuys + +*/ + +#include "lily-parser.hh" +#include "lily-lexer.hh" +#include "lilypond-key.hh" +#include "book.hh" +#include "paper-book.hh" +#include "score.hh" +#include "file-name.hh" +#include "output-def.hh" + + + + +/* TODO: move this to Scheme? Why take the parser arg, and all the back + & forth between scm and c++? */ +LY_DEFINE (ly_parser_print_score, "ly:parser-print-score", + 2, 0, 0, + (SCM parser_smob, SCM score_smob), + "Print score, i.e., the classic way.") +{ + Lily_parser *parser = unsmob_lily_parser (parser_smob); + Score *score = unsmob_score (score_smob); + + Object_key *key = new Lilypond_general_key (0, score->user_key_, 0); + + if (score->error_found_) + return SCM_UNSPECIFIED; + + SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser"); + SCM_ASSERT_TYPE (score, score_smob, SCM_ARG2, __FUNCTION__, "score"); + + SCM header = ly_c_module_p (score->header_) + ? score->header_ + : parser->lexer_->lookup_identifier ("$globalheader"); + + File_name outname (parser->output_basename_); + int *c = &parser->book_count_; + if (*c) + outname.base_ += "-" + to_string (*c); + (*c)++; + + SCM os = scm_makfrom0str (outname.to_string ().to_str0 ()); + SCM paper = get_paper (parser)->self_scm (); + for (int i = 0; i < score->defs_.size (); i++) + default_rendering (score->get_music (), score->defs_[i]->self_scm (), + paper, header, os, key->self_scm ()); + + if (score->defs_.is_empty ()) + { + Output_def *layout = get_layout (parser); + default_rendering (score->get_music (), + layout->self_scm (), + paper, + header, os, key->self_scm ()); + + scm_gc_unprotect_object (layout->self_scm ()); + } + + scm_gc_unprotect_object (paper); + scm_gc_unprotect_object (key->self_scm ()); + return SCM_UNSPECIFIED; +} + + +LY_DEFINE (ly_parser_print_book, "ly:parser-print-book", + 2, 0, 0, (SCM parser_smob, SCM book_smob), + "Print book.") +{ + Lily_parser *parser = unsmob_lily_parser (parser_smob); + Book *book = unsmob_book (book_smob); + Output_def *bp = unsmob_output_def (parser->lexer_->lookup_identifier ("$defaultpaper")); + + SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser"); + SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book"); + + /* ugh. changing argument.*/ + book->paper_ = bp; + + File_name outname (parser->output_basename_); + int *c = &parser->book_count_; + if (*c) + outname.base_ += "-" + to_string (*c); + (*c)++; + + Output_def *layout = get_layout (parser); + Paper_book *pb = book->process (outname.to_string (), layout); + + if (pb) + { + pb->output (outname.to_string ()); + scm_gc_unprotect_object (pb->self_scm ()); + } + + scm_gc_unprotect_object (layout->self_scm ()); + return SCM_UNSPECIFIED; +} + diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh index cfc09af6bf..6aa0a54d74 100644 --- a/lily/include/lily-lexer.hh +++ b/lily/include/lily-lexer.hh @@ -60,7 +60,7 @@ public: Input here_input () const; void add_scope (SCM); - void set_current_scope (); + SCM set_current_scope (); SCM remove_scope (); void start_main_input (); diff --git a/lily/include/lily-parser.hh b/lily/include/lily-parser.hh index 96f46d4a6f..f71e0c3ed5 100644 --- a/lily/include/lily-parser.hh +++ b/lily/include/lily-parser.hh @@ -6,8 +6,8 @@ (c) 1997--2005 Han-Wen Nienhuys */ -#ifndef MY_LILY_PARSER_HH -#define MY_LILY_PARSER_HH +#ifndef LILY_PARSER_HH +#define LILY_PARSER_HH #include "duration.hh" #include "input.hh" @@ -62,7 +62,7 @@ public: void set_yydebug (bool); }; -DECLARE_UNSMOB (Lily_parser, my_lily_parser); +DECLARE_UNSMOB (Lily_parser, lily_parser); SCM ly_parse_file (SCM); SCM ly_parse_string (SCM); @@ -76,4 +76,4 @@ Output_def *get_layout (Lily_parser *parser); Output_def *get_midi (Lily_parser *parser); Output_def *get_paper (Lily_parser *parser); -#endif /* MY_LILY_PARSER_HH */ +#endif /* LILY_PARSER_HH */ diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc index 6194400ab0..06ab799acc 100644 --- a/lily/lily-lexer.cc +++ b/lily/lily-lexer.cc @@ -143,12 +143,13 @@ Lily_lexer::add_scope (SCM module) if (!scm_is_pair (scopes_)) start_module_ = scm_current_module (); - scm_set_current_module (module); for (SCM s = scopes_; scm_is_pair (s); s = scm_cdr (s)) { ly_use_module (module, scm_car (s)); } scopes_ = scm_cons (module, scopes_); + + set_current_scope (); } @@ -161,13 +162,17 @@ Lily_lexer::remove_scope () return sc; } -void +SCM Lily_lexer::set_current_scope () { + SCM old = scm_current_module (); + if (scm_is_pair (scopes_)) scm_set_current_module (scm_car (scopes_)); else scm_set_current_module (start_module_); + + return old; } int @@ -300,13 +305,17 @@ Lily_lexer::mark_smob (SCM s) scm_gc_mark (lexer->chordmodifier_tab_); scm_gc_mark (lexer->pitchname_tab_stack_); + scm_gc_mark (lexer->start_module_); return lexer->scopes_; } int -Lily_lexer::print_smob (SCM, SCM port, scm_print_state*) +Lily_lexer::print_smob (SCM s, SCM port, scm_print_state*) { + Lily_lexer *lexer = Lily_lexer::unsmob (s); + scm_puts ("#scopes_, port); scm_puts (" >", port); return 1; } diff --git a/lily/lily-parser-scheme.cc b/lily/lily-parser-scheme.cc index 07ad5f7b7d..5779bea9e9 100644 --- a/lily/lily-parser-scheme.cc +++ b/lily/lily-parser-scheme.cc @@ -15,12 +15,7 @@ #include "warn.hh" #include "source.hh" #include "lily-lexer.hh" -#include "score.hh" -#include "lilypond-key.hh" #include "ly-module.hh" -#include "output-def.hh" -#include "book.hh" -#include "paper-book.hh" #include "file-name-map.hh" /* Do not append `!' suffix, since 1st argument is not modified. */ @@ -156,10 +151,9 @@ LY_DEFINE (ly_clone_parser, "ly:clone-parser", 1, 0, 0, (SCM parser_smob), "Return a clone of PARSER_SMOB.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + Lily_parser *parser = unsmob_lily_parser (parser_smob); Lily_parser *clone = new Lily_parser (*parser); - /* FIXME: should copy scopes too. */ return scm_gc_unprotect_object (clone->self_scm ()); } @@ -167,7 +161,7 @@ LY_DEFINE (ly_parser_define, "ly:parser-define", 3, 0, 0, (SCM parser_smob, SCM symbol, SCM val), "Bind SYMBOL to VAL in PARSER_SMOB's module.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + Lily_parser *parser = unsmob_lily_parser (parser_smob); SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol"); SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser"); @@ -180,7 +174,7 @@ LY_DEFINE (ly_parser_lookup, "ly:parser-lookup", "Lookup @var{symbol} in @var{parser_smob}'s module. " "Undefined is '().") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + Lily_parser *parser = unsmob_lily_parser (parser_smob); SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, SCM_ARG2, __FUNCTION__, "symbol"); SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG2, __FUNCTION__, "parser"); @@ -197,7 +191,7 @@ LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", "Parse the string LY_CODE with PARSER_SMOB." "Upon failure, throw @code{ly-file-failed} key.") { - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); + Lily_parser *parser = unsmob_lily_parser (parser_smob); SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser"); SCM_ASSERT_TYPE (scm_is_string (ly_code), ly_code, SCM_ARG2, __FUNCTION__, "string"); @@ -207,63 +201,13 @@ LY_DEFINE (ly_parser_parse_string, "ly:parser-parse-string", return SCM_UNSPECIFIED; } -/* TODO: move this to Scheme? Why take the parser arg, and all the back - & forth between scm and c++? */ -LY_DEFINE (ly_parser_print_score, "ly:parser-print-score", - 2, 0, 0, - (SCM parser_smob, SCM score_smob), - "Print score, i.e., the classic way.") -{ - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - Score *score = unsmob_score (score_smob); - - Object_key *key = new Lilypond_general_key (0, score->user_key_, 0); - - if (score->error_found_) - return SCM_UNSPECIFIED; - - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "parser"); - SCM_ASSERT_TYPE (score, score_smob, SCM_ARG2, __FUNCTION__, "score"); - - SCM header = ly_c_module_p (score->header_) - ? score->header_ - : parser->lexer_->lookup_identifier ("$globalheader"); - - File_name outname (parser->output_basename_); - int *c = &parser->book_count_; - if (*c) - outname.base_ += "-" + to_string (*c); - (*c)++; - - SCM os = scm_makfrom0str (outname.to_string ().to_str0 ()); - SCM paper = get_paper (parser)->self_scm (); - for (int i = 0; i < score->defs_.size (); i++) - default_rendering (score->get_music (), score->defs_[i]->self_scm (), - paper, header, os, key->self_scm ()); - - if (score->defs_.is_empty ()) - { - Output_def *layout = get_layout (parser); - default_rendering (score->get_music (), - layout->self_scm (), - paper, - header, os, key->self_scm ()); - - scm_gc_unprotect_object (layout->self_scm ()); - } - - scm_gc_unprotect_object (paper); - scm_gc_unprotect_object (key->self_scm ()); - return SCM_UNSPECIFIED; -} - LY_DEFINE (ly_parser_set_note_names, "ly:parser-set-note-names", 2, 0, 0, (SCM parser, SCM names), "Replace current note names in @var{parser}. " "@var{names} is an alist of symbols. " "This only has effect if the current mode is notes.") { - Lily_parser *p = unsmob_my_lily_parser (parser); + Lily_parser *p = unsmob_lily_parser (parser); SCM_ASSERT_TYPE (p, parser, SCM_ARG1, __FUNCTION__, "Lilypond parser"); if (p->lexer_->is_note_state ()) @@ -274,37 +218,3 @@ LY_DEFINE (ly_parser_set_note_names, "ly:parser-set-note-names", return SCM_UNSPECIFIED; } - -LY_DEFINE (ly_parser_print_book, "ly:parser-print-book", - 2, 0, 0, (SCM parser_smob, SCM book_smob), - "Print book.") -{ - Lily_parser *parser = unsmob_my_lily_parser (parser_smob); - Book *book = unsmob_book (book_smob); - Output_def *bp = unsmob_output_def (parser->lexer_->lookup_identifier ("$defaultpaper")); - - SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser"); - SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book"); - - /* ugh. changing argument.*/ - book->paper_ = bp; - - File_name outname (parser->output_basename_); - int *c = &parser->book_count_; - if (*c) - outname.base_ += "-" + to_string (*c); - (*c)++; - - Output_def *layout = get_layout (parser); - Paper_book *pb = book->process (outname.to_string (), layout); - - if (pb) - { - pb->output (outname.to_string ()); - scm_gc_unprotect_object (pb->self_scm ()); - } - - scm_gc_unprotect_object (layout->self_scm ()); - return SCM_UNSPECIFIED; -} - diff --git a/lily/lily-parser.cc b/lily/lily-parser.cc index 76915d07e8..050f8dd7b2 100644 --- a/lily/lily-parser.cc +++ b/lily/lily-parser.cc @@ -33,6 +33,9 @@ Lily_parser::Lily_parser (Sources *sources) error_level_ = 0; smobify_self (); + + lexer_ = new Lily_lexer (sources_); + scm_gc_unprotect_object (lexer_->self_scm ()); } Lily_parser::Lily_parser (Lily_parser const &src) @@ -71,9 +74,9 @@ Lily_parser::mark_smob (SCM s) int Lily_parser::print_smob (SCM s, SCM port, scm_print_state*) { - scm_puts ("#lexer_->self_scm (), port); scm_puts (" >", port); return 1; } @@ -87,10 +90,6 @@ Lily_parser::parse_file (String init, String name, String out_name) try_load_text_metrics (out_name); } - SCM oldmod = scm_current_module (); - - lexer_ = new Lily_lexer (sources_); - scm_gc_unprotect_object (lexer_->self_scm ()); // TODO: use $parser lexer_->set_identifier (ly_symbol2scm ("parser"), self_scm ()); @@ -112,8 +111,11 @@ Lily_parser::parse_file (String init, String name, String out_name) /* Read .ly IN_FILE, lex, parse, write \score blocks from IN_FILE to OUT_FILE (unless IN_FILE redefines output file name). */ - do_yyparse (); + SCM mod = lexer_->set_current_scope (); + do_yyparse (); + scm_set_current_module (mod); + if (!define_spots_.is_empty ()) { define_spots_.top ().warning (_ ("braces don't match")); @@ -122,20 +124,12 @@ Lily_parser::parse_file (String init, String name, String out_name) error_level_ = error_level_ | lexer_->error_level_; lexer_ = 0; - - scm_set_current_module (oldmod); } void Lily_parser::parse_string (String ly_code) { - Lily_lexer *parent = lexer_; - lexer_ = (parent == 0 ? new Lily_lexer (sources_) - : new Lily_lexer (*parent)); - scm_gc_unprotect_object (lexer_->self_scm ()); - - SCM oldmod = scm_current_module (); - // TODO: use $parser + // TODO: use $parser lexer_->set_identifier (ly_symbol2scm ("parser"), self_scm ()); @@ -144,8 +138,11 @@ Lily_parser::parse_string (String ly_code) set_yydebug (0); lexer_->new_input (lexer_->main_input_name_, ly_code, sources_); - do_yyparse (); + SCM mod = lexer_->set_current_scope (); + do_yyparse (); + scm_set_current_module (mod); + if (!define_spots_.is_empty ()) { if (define_spots_.is_empty () @@ -154,9 +151,6 @@ Lily_parser::parse_string (String ly_code) } error_level_ = error_level_ | lexer_->error_level_; - - scm_set_current_module (oldmod); - lexer_ = 0; } char const * diff --git a/ly/spanners-init.ly b/ly/spanners-init.ly index 9f18169c71..98e663f7bd 100644 --- a/ly/spanners-init.ly +++ b/ly/spanners-init.ly @@ -96,22 +96,13 @@ sostenutoUp = #(make-span-event 'SostenutoEvent STOP) % for regression testing purposes. assertBeamQuant = #(def-music-function (parser location l r) (pair? pair?) - (let* ((f (check-quant-callbacks l r))) - - #{ - \once \override Beam #'position-callbacks = $f - #} - -)) - + (make-grob-property-override 'Beam 'position-callbacks + (check-quant-callbacks l r))) + % for regression testing purposes. assertBeamSlope = #(def-music-function (parser location comp) (procedure?) - (let* ((f (check-slope-callbacks comp))) - - #{ - \once \override Beam #'position-callbacks = $f - #} - -)) + (make-grob-property-override 'Beam 'position-callbacks + (check-slope-callbacks comp))) + diff --git a/scm/ly-from-scheme.scm b/scm/ly-from-scheme.scm index 960353dbc5..00aab05b28 100644 --- a/scm/ly-from-scheme.scm +++ b/scm/ly-from-scheme.scm @@ -16,18 +16,14 @@ (char->integer #\0))))) (string->list (number->string var-idx))))))))) -(define-public (ly:parse-string-result str parser module) +(define-public (ly:parse-string-result str parser) "Parse `str', which is supposed to contain a music expression." (let ((music-sym (gen-lily-sym))) (ly:parser-parse-string parser - (format #f " -~a = { ~a } -#(ly:export '~a) -#(module-define! (resolve-module '~a) '~a ~a) -" - music-sym str music-sym (module-name module) music-sym music-sym)) - (eval `,music-sym module))) + (format #f "parseStringResult = { ~a }" str)) + + (ly:parser-lookup parser 'parseStringResult))) (define-public (read-lily-expression chr port) "Read a #{ lily music expression #} from port and return @@ -35,11 +31,14 @@ the scheme music expression. The $ character may be used to introduce scheme forms, typically symbols. $$ may be used to simply write a `$' character." (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." @@ -56,7 +55,8 @@ character." (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 + (let* + ((lily-string (call-with-output-string (lambda (out) (do ((c (read-char port) (read-char port))) ((and (char=? c #\#) @@ -78,11 +78,19 @@ character." (remove-dollars! expr))))) ;; other caracters (else - (display c out)))))))) - `(let ((parser-clone (ly:clone-parser parser))) - ,@(map (lambda (binding) - `(ly:parser-define parser-clone ',(car binding) ,(cdr binding))) - (reverse bindings)) - (ly:parse-string-result ,lily-string parser-clone (current-module)))))) + (display c out))))))) + + (result + `(let ((parser-clone (ly:clone-parser parser))) + ,@(map (lambda (binding) + `(ly:parser-define parser-clone ',(car binding) ,(cdr binding))) + (reverse bindings)) + (ly:parse-string-result ,lily-string parser-clone)) + )) + + + + result + ))) (read-hash-extend #\{ read-lily-expression) -- 2.39.2