Re: define-markup-command-internal -> module-define-markup-command! (issue 547920045 by address@hidden)

[dak]

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))))