[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: define-markup-command-internal -> module-define-markup-command! (iss
From: |
dak |
Subject: |
Re: define-markup-command-internal -> module-define-markup-command! (issue 547920045 by address@hidden) |
Date: |
Fri, 08 May 2020 10:30:10 -0700 |
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))))