From: David Kastrup Date: Sun, 31 May 2015 16:53:38 +0000 (+0200) Subject: Issue 4440: Establish %parser in Lily_parser::do_yyparse X-Git-Tag: release/2.19.22-1~55 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=6eeb55a4b1d4a6da23b656cff0839eb0f921807f;p=lilypond.git Issue 4440: Establish %parser in Lily_parser::do_yyparse Consequently, this does not need to be done any more in syntax constructors or Scheme expressions. --- diff --git a/lily/include/lily-parser.hh b/lily/include/lily-parser.hh index 0b1b87aa23..6d299d48b4 100644 --- a/lily/include/lily-parser.hh +++ b/lily/include/lily-parser.hh @@ -31,6 +31,8 @@ */ class Lily_parser : public Smob { + SCM do_yyparse (); + static SCM do_yyparse_trampoline (void *parser); public: int print_smob (SCM, scm_print_state *); SCM mark_smob (); @@ -55,7 +57,6 @@ public: void clear (); void do_init_file (); - SCM do_yyparse (); void include_string (const string &ly_code); void parse_file (const string &init, const string &name, const string &out_name); void parse_string (const string &ly_code); diff --git a/lily/music-function.cc b/lily/music-function.cc index f89b719f60..353dc89970 100644 --- a/lily/music-function.cc +++ b/lily/music-function.cc @@ -79,7 +79,6 @@ with_loc (SCM arg, Fluid &loc, bool clone = true) SCM Music_function::call (SCM rest) { - Fluid parser (ly_lily_module_constant ("%parser")); Fluid location (ly_lily_module_constant ("%location")); // (car (ly:music-signature self_scm())) is the return type, skip it @@ -143,10 +142,10 @@ Music_function::call (SCM rest) if (scm_is_false (scm_call_1 (pred, arg))) { - scm_apply_0 (ly_lily_module_constant ("argument-error"), - scm_list_5 (parser, location, - scm_from_int (scm_ilength (args)), - pred, arg)); + scm_call_4 (ly_lily_module_constant ("argument-error"), + location, + scm_from_int (scm_ilength (args)), + pred, arg); SCM val = scm_car (get_signature ()); val = scm_is_pair (val) ? scm_cdr (val) : SCM_BOOL_F; return with_loc (val, location); @@ -169,7 +168,6 @@ Music_function::call (SCM rest) if (scm_is_true (scm_call_1 (pred, res))) return with_loc (res, location, false); - return scm_call_4 (ly_lily_module_constant ("music-function-call-error"), - parser, location, - self_scm (), res); + return scm_call_3 (ly_lily_module_constant ("music-function-call-error"), + location, self_scm (), res); } diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc index 08c67cc17f..7e8c26b06f 100644 --- a/lily/parse-scm.cc +++ b/lily/parse-scm.cc @@ -178,11 +178,9 @@ ly_eval_scm (SCM form, Input i, bool safe, Lily_parser *parser) { Parse_start ps (form, i, safe, parser); - SCM ans = scm_c_with_fluids - (scm_list_2 (ly_lily_module_constant ("%parser"), - ly_lily_module_constant ("%location")), - scm_list_2 (parser->self_scm (), - i.smobbed_copy ()), + SCM ans = scm_c_with_fluid + (ly_lily_module_constant ("%location"), + i.smobbed_copy (), parse_protect_global ? protected_ly_eval_scm : catch_protected_eval_body, (void *) &ps); diff --git a/lily/parser.yy b/lily/parser.yy index 71095680c5..08ca2363d9 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -194,11 +194,11 @@ Lily_parser::parser_error (Input const *i, Lily_parser *parser, SCM *, const str scm_apply_0 (proc, args) /* Syntactic Sugar. */ #define MAKE_SYNTAX(name, location, ...) \ - LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->self_scm (), parser->lexer_->override_input (location).smobbed_copy (), ##__VA_ARGS__, SCM_UNDEFINED)) + LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant (name), scm_list_n (parser->lexer_->override_input (location).smobbed_copy (), ##__VA_ARGS__, SCM_UNDEFINED)) #define START_MAKE_SYNTAX(name, ...) \ scm_list_n (ly_lily_module_constant (name) , ##__VA_ARGS__, SCM_UNDEFINED) #define FINISH_MAKE_SYNTAX(start, location, ...) \ - LOWLEVEL_MAKE_SYNTAX (scm_car (start), scm_cons2 (parser->self_scm (), parser->lexer_->override_input (location).smobbed_copy (), scm_append_x (scm_list_2 (scm_cdr (start), scm_list_n (__VA_ARGS__, SCM_UNDEFINED))))) + LOWLEVEL_MAKE_SYNTAX (scm_car (start), scm_cons (parser->lexer_->override_input (location).smobbed_copy (), scm_append_x (scm_list_2 (scm_cdr (start), scm_list_n (__VA_ARGS__, SCM_UNDEFINED))))) SCM get_next_unique_context_id (); SCM get_next_unique_lyrics_context_id (); @@ -2571,7 +2571,7 @@ music_property_def: if (SCM_UNBNDP ($1)) $$ = MAKE_SYNTAX ("void-music", @1); else - $$ = LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("property-operation"), scm_cons2 (parser->self_scm (), @$.smobbed_copy (), $1)); + $$ = LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("property-operation"), scm_cons (@$.smobbed_copy (), $1)); } ; @@ -3691,12 +3691,19 @@ Lily_parser::set_yydebug (bool x) SCM Lily_parser::do_yyparse () { - SCM retval = SCM_UNDEFINED; - yyparse (this, &retval); - return retval; + return scm_c_with_fluid (ly_lily_module_constant ("%parser"), + self_scm (), + do_yyparse_trampoline, + static_cast (this)); } - +SCM +Lily_parser::do_yyparse_trampoline (void *parser) +{ + SCM retval = SCM_UNDEFINED; + yyparse (static_cast (parser), &retval); + return retval; +} diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm index fb52465ba5..eb323b8a00 100644 --- a/scm/ly-syntax-constructors.scm +++ b/scm/ly-syntax-constructors.scm @@ -20,35 +20,34 @@ (defmacro define-ly-syntax (args . body) `(define-public ,args ,@body)) -;; A ly-syntax constructor takes two extra parameters, parser and -;; location. These are mainly used for reporting errors and +;; A ly-syntax constructor takes one extra parameter, +;; location. This is mainly used for reporting errors and ;; warnings. This function is a syntactic sugar which uses the ;; location arg to set the origin of the returned music object; this ;; behaviour is usually desired (defmacro define-ly-syntax-loc (args . body) `(define-public ,args (let ((m ,(cons 'begin body))) - (set! (ly:music-property m 'origin) ,(third args)) + (set! (ly:music-property m 'origin) ,(second args)) m))) -;; Like define-ly-syntax-loc, but adds parser and location -;; parameters. Useful for simple constructors that don't need to +;; Like define-ly-syntax-loc, but adds location +;; parameter. Useful for simple constructors that don't need to ;; report errors. (defmacro define-ly-syntax-simple (args . body) `(define-public ,(cons* (car args) - 'parser 'location (cdr args)) (let ((m ,(cons 'begin body))) (set! (ly:music-property m 'origin) location) m))) -(define (music-function-call-error parser loc fun m) +(define (music-function-call-error loc fun m) (let* ((sig (ly:music-function-signature fun)) (pred (if (pair? (car sig)) (caar sig) (car sig)))) - (ly:parser-error parser + (ly:parser-error (*parser*) (format #f (_ "~a function cannot return ~a") (type-name pred) - (value->lily-string m parser)) + (value->lily-string m (*parser*))) loc) (and (pair? (car sig)) (cdar sig)))) @@ -59,11 +58,11 @@ ;; and no fallback value had been available. In this case, ;; we don't call the function but rather return the general ;; fallback. -(define-ly-syntax (music-function parser loc fun args . rest) +(define-ly-syntax (music-function loc fun args . rest) (let* ((sig (ly:music-function-signature fun)) (pred (if (pair? (car sig)) (caar sig) (car sig))) (good (proper-list? args)) - (m (and good (with-fluids ((%parser parser) (%location loc)) + (m (and good (with-fluids ((%location loc)) (apply (ly:music-function-extract fun) (reverse! args rest)))))) (if (and good (pred m)) @@ -72,12 +71,12 @@ (set! (ly:music-property m 'origin) loc)) m) (if good - (music-function-call-error parser loc fun m) + (music-function-call-error loc fun m) (and (pair? (car sig)) (cdar sig)))))) -(define-ly-syntax (argument-error parser location n pred arg) +(define-ly-syntax (argument-error location n pred arg) (ly:parser-error - parser + (*parser*) (format #f (_ "wrong type for argument ~a. Expecting ~a, found ~s") n (type-name pred) (music->make-music arg)) @@ -105,7 +104,7 @@ 'change-to-type type 'change-to-id id)) -(define-ly-syntax (tempo parser location text . rest) +(define-ly-syntax (tempo location text . rest) (let* ((unit (and (pair? rest) (car rest))) (count (and unit @@ -145,13 +144,13 @@ into a @code{MultiMeasureTextEvent}." (make-music 'MultiMeasureTextEvent music) music)) -(define-ly-syntax (multi-measure-rest parser location duration articulations) +(define-ly-syntax (multi-measure-rest location duration articulations) (make-music 'MultiMeasureRestMusic 'articulations (map script-to-mmrest-text articulations) 'duration duration 'origin location)) -(define-ly-syntax (repetition-chord parser location duration articulations) +(define-ly-syntax (repetition-chord location duration articulations) (make-music 'EventChord 'duration duration 'elements articulations @@ -163,7 +162,7 @@ into a @code{MultiMeasureTextEvent}." (if create-new (set! (ly:music-property csm 'create-new) #t)) csm)) -(define-ly-syntax (composed-markup-list parser location commands markups) +(define-ly-syntax (composed-markup-list location commands markups) ;; `markups' being a list of markups, eg (markup1 markup2 markup3), ;; and `commands' a list of commands with their scheme arguments, in reverse order, ;; eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg: @@ -190,7 +189,7 @@ into a @code{MultiMeasureTextEvent}." (make-map-markup-commands-markup-list compose complex) completed)))))))) -(define-ly-syntax (property-operation parser location ctx music-type symbol . args) +(define-ly-syntax (property-operation location ctx music-type symbol . args) (let* ((props (case music-type ((PropertySet) (list 'value (car args))) ((PropertyUnset) '()) @@ -249,10 +248,10 @@ into a @code{MultiMeasureTextEvent}." 'associated-context-type sync-type 'origin loc)) -(define-ly-syntax (lyric-combine parser location voice typ music) +(define-ly-syntax (lyric-combine location voice typ music) (lyric-combine-music voice typ music location)) -(define-ly-syntax (add-lyrics parser location music addlyrics-list) +(define-ly-syntax (add-lyrics location music addlyrics-list) (let* ((existing-voice-name (get-first-context-id! music)) (voice-name (if (string? existing-voice-name) existing-voice-name