Reviewers: hanwenn, Message: On 2020/05/08 17:12:41, hanwenn wrote: > I don't understand how this approach could ever help byte-compiling the markup > scheme files. This still uses module-define! , so the guile2 compilation step > will be oblivious to markup functions.
It makes it easier to create specific different behavior for byte-compilation using eval-when. Description: define-markup-command-internal -> module-define-markup-command! Tangible benefits of this approach are not all that clear, and it doesn't cover define-markup-list-command in the current form either, so it warrants more work before committing or even deciding to commit. Particularly so since for convenience it reverts a previous patch combining the internals of define-markup-command and define-markup-list-command, in order to illustrate the approach just on the former. However, it works and provides a basis for discussion. The principal idea is to provide a version of define-markup-command that is not specific to the current module and not a macro, in a similar vein to how module-define! complements define , and use this in the parser rather than the previous somewhat fuzzier define-markup-command-internal . Additional commits: Add Lily_lexer::current_scope () function Revert "Express define-markup-list-command-internal using define-markup-command-internal" This reverts commit 9f1683921621b612b94080d506ee317b058b29c8. Please review this at https://codereview.appspot.com/547920045/ Affected files (+40, -22 lines): M lily/include/lily-imports.hh M lily/include/lily-lexer.hh M lily/lily-imports.cc M lily/lily-lexer.cc M lily/parser.yy M scm/markup-macros.scm Index: lily/include/lily-imports.hh diff --git a/lily/include/lily-imports.hh b/lily/include/lily-imports.hh index 145b5aa763dc544a083bf85d1b3521aed280b988..d6b6e568a2c8e1d30463a84b8138ac9328265f63 100644 --- a/lily/include/lily-imports.hh +++ b/lily/include/lily-imports.hh @@ -67,7 +67,6 @@ extern Variable car_less; extern Variable chordmodifiers; extern Variable construct_chord_elements; extern Variable default_time_signature_settings; -extern Variable define_markup_command_internal; extern Variable drum_pitch_names; extern Variable grob_compose_function; extern Variable grob_offset_function; @@ -102,6 +101,7 @@ extern Variable midi_program; #if !GUILEV2 extern Variable module_export_all_x; #endif +extern Variable module_define_markup_command_x; extern Variable f_parser; extern Variable percussion_p; extern Variable pitchnames; Index: lily/include/lily-lexer.hh diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh index 83fb6f7a2d39dfd28d8ac8f4e7a0b1d38f29ecff..61d9ed6704993490d1a0d1f6a61ecbc786bb3915 100644 --- a/lily/include/lily-lexer.hh +++ b/lily/include/lily-lexer.hh @@ -89,6 +89,7 @@ public: void add_scope (SCM); SCM set_current_scope (); + SCM current_scope () const; bool has_scope () const; SCM remove_scope (); Index: lily/lily-imports.cc diff --git a/lily/lily-imports.cc b/lily/lily-imports.cc index 844a8210ee71da92095c4d3329a39f3503df0f9b..b6a1e28f783ebd9ea9634c02ff7019f12a789798 100644 --- a/lily/lily-imports.cc +++ b/lily/lily-imports.cc @@ -58,7 +58,6 @@ Variable car_less ("car<"); Variable chordmodifiers ("chordmodifiers"); Variable construct_chord_elements ("construct-chord-elements"); Variable default_time_signature_settings ("default-time-signature-settings"); -Variable define_markup_command_internal ("define-markup-command-internal"); Variable drum_pitch_names ("drumPitchNames"); Variable grob_compose_function ("grob::compose-function"); Variable grob_offset_function ("grob::offset-function"); @@ -93,6 +92,7 @@ Variable midi_program ("midi-program"); #if !GUILEV2 Variable module_export_all_x ("module-export-all!"); #endif +Variable module_define_markup_command_x ("module-define-markup-command!"); Variable f_parser ("%parser"); Variable percussion_p ("percussion?"); Variable pitchnames ("pitchnames"); Index: lily/lily-lexer.cc diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc index 4851349cd08f90d04c2f86211bfaa45ea43206f6..6fcec1bca9ab1c17e02eaef79d47a536ae350b89 100644 --- a/lily/lily-lexer.cc +++ b/lily/lily-lexer.cc @@ -152,6 +152,7 @@ Lily_lexer::add_scope (SCM module) set_current_scope (); } + bool Lily_lexer::has_scope () const { @@ -180,6 +181,15 @@ Lily_lexer::set_current_scope () return old; } +SCM +Lily_lexer::current_scope () const +{ + if (scm_is_pair (scopes_)) + return scm_car (scopes_); + error (_ ("no active module in scope")); + return SCM_BOOL_F; +} + int Lily_lexer::lookup_keyword (const string &s) { @@ -233,7 +243,7 @@ Lily_lexer::start_main_input () new_input (main_input_name_, sources_); - scm_module_define (scm_car (scopes_), + scm_module_define (current_scope (), ly_symbol2scm ("input-file-name"), ly_string2scm (main_input_name_)); } @@ -273,7 +283,7 @@ Lily_lexer::set_identifier (SCM path, SCM val) warning (_f ("identifier name is a keyword: `%s'", symstr.c_str ())); } - SCM mod = scm_car (scopes_); + SCM mod = current_scope (); if (scm_is_pair (path)) { Index: lily/parser.yy diff --git a/lily/parser.yy b/lily/parser.yy index 11770b6f7d8c52eb3c57a3254437ea1e6d674920..e30d65b7b777a041af526c82ea25e6c23c704bb1 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -703,8 +703,8 @@ assignment: { parser->parser_error (@3, _ ("Not a markup function")); } else { - Lily::define_markup_command_internal - (scm_string_to_symbol ($1), $3, SCM_BOOL_F); + Lily::module_define_markup_command_x + (parser->lexer_->current_scope (), scm_string_to_symbol ($1), $3); } $$ = SCM_UNSPECIFIED; } Index: scm/markup-macros.scm diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm index cdebb86196c613c4c305e1870d9e4cc41326c57f..922c94161f92db2f84b302bf6ca16cac9222502e 100644 --- a/scm/markup-macros.scm +++ b/scm/markup-macros.scm @@ -101,10 +101,20 @@ command. There is no protection against circular definitions. command-and-args)) (args (and (pair? command-and-args) (cdr command-and-args)))) (if args - `(,define-markup-command-internal - ',command (markup-lambda ,args ,@definition) #f) - `(,define-markup-command-internal - ',command ,@definition #f)))) + `(module-define-markup-command! (current-module) + ',command (markup-lambda ,args ,@definition)) + `(module-define-markup-command! (current-module) + ',command ,@definition)))) + +(define-public (module-define-markup-command! module command definition) + (let* ((command-name (string->symbol (format #f "~a-markup" command))) + (make-markup-name (string->symbol (format #f "make-~a-markup" command)))) + (if (not (procedure-name definition)) + (set-procedure-property! definition 'name command-name)) + (module-define! module command-name definition) + (module-define! module make-markup-name + (lambda args (make-markup definition make-markup-name args))) + (module-export! module (list command-name make-markup-name)))) (defmacro*-public markup-lambda (args signature @@ -162,23 +172,20 @@ interpreted, returns a list of stencils instead of a single one" command-and-args)) (args (and (pair? command-and-args) (cdr command-and-args)))) (if args - `(,define-markup-command-internal - ',command (markup-list-lambda ,args ,@definition) #t) - `(,define-markup-command-internal - ',command ,@definition #t)))) - -(define (define-markup-command-internal command definition is-list) - (let* ((suffix (if is-list "-list" "")) - (command-name (string->symbol (format #f "~a-markup~a" command suffix))) - (make-markup-name (string->symbol (format #f "make-~a-markup~a" command suffix)))) + `(,define-markup-list-command-internal + ',command (markup-list-lambda ,args ,@definition)) + `(,define-markup-list-command-internal + ',command ,@definition)))) + +(define (define-markup-list-command-internal command definition) + (let* ((command-name (string->symbol (format #f "~a-markup-list" command))) + (make-markup-name (string->symbol (format #f "make-~a-markup-list" command)))) (if (not (procedure-name definition)) (set-procedure-property! definition 'name command-name)) (module-define! (current-module) command-name definition) (module-define! (current-module) make-markup-name (lambda args - (if is-list - (list (make-markup definition make-markup-name args)) - (make-markup definition make-markup-name args)))) + (list (make-markup definition make-markup-name args)))) (module-export! (current-module) (list command-name make-markup-name))))
