From 34e5b21b1af28e4d787ffaf758d4cd4b5b503053 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Wed, 21 Sep 2011 23:38:10 +0200 Subject: [PATCH] Parts from the optional music argument patch to make define-event-function work Note that define-event-function, define-scheme-function and define-music-function now wrongly claim to support optional music function arguments in their documentation strings, in order not to complicate merging. --- lily/lexer.ll | 5 +++ lily/parser.yy | 18 ++++++++- scm/document-identifiers.scm | 14 ++++--- scm/ly-syntax-constructors.scm | 18 ++++----- scm/music-functions.scm | 71 +++++++++++++++++++++++++++++----- 5 files changed, 98 insertions(+), 28 deletions(-) diff --git a/lily/lexer.ll b/lily/lexer.ll index db78e049f2..707f84bd83 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -810,6 +810,11 @@ Lily_lexer::scan_escaped_word (string str) SCM s = scm_object_property (yylval.scm, ly_symbol2scm ("music-function-signature")); SCM cs = scm_car (s); + if (scm_is_pair (cs)) + { + cs = SCM_CAR (cs); + } + if (scm_is_eq (cs, ly_lily_module_constant ("ly:music?"))) funtype = MUSIC_FUNCTION; else if (ly_is_procedure (cs)) diff --git a/lily/parser.yy b/lily/parser.yy index 82df956fa8..0eefc1f40e 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -2741,13 +2741,27 @@ run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args) args = scm_reverse_x (args, SCM_EOL); + SCM fallback = SCM_BOOL_F; + SCM pred = scm_car (sig); + + if (scm_is_pair (pred)) + { + fallback = scm_cdr (pred); + if (Music *m = unsmob_music (fallback)) { + m = m->clone (); + m->set_spot (loc); + fallback = m->unprotect (); + } + pred = scm_car (pred); + } + if (!to_boolean (scm_call_3 (type_check_proc, make_input (loc), scm_cdr (sig), args))) { parser->error_level_ = 1; - return LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("void-music"), scm_list_2 (parser->self_scm (), make_input (loc))); + return fallback; } - SCM syntax_args = scm_list_5 (parser->self_scm (), make_input (loc), scm_car (sig), func, args); + SCM syntax_args = scm_list_n (parser->self_scm (), make_input (loc), pred, fallback, func, args, SCM_UNDEFINED); return LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("music-function"), syntax_args); } diff --git a/scm/document-identifiers.scm b/scm/document-identifiers.scm index 43d26323ff..896e61842f 100644 --- a/scm/document-identifiers.scm +++ b/scm/document-identifiers.scm @@ -27,15 +27,17 @@ (cddr (cadr (procedure-source func))))) (doc (procedure-documentation func)) (sign (object-property func 'music-function-signature)) - (type-names (map type-name sign)) + (type-names (map (lambda (pred) + (if (pair? pred) + (format #f "[~a]" (type-name (car pred))) + (format #f "(~a)" (type-name pred)))) + sign)) (signature-str (string-join - (map (lambda (x) (format #f "@var{~a} (~a)" - (car x) - (cadr x))) - (zip arg-names (cdr type-names)))))) + (map (lambda (arg type) (format #f "@var{~a} ~a" arg type)) + arg-names (cdr type-names))))) (format #f - "@item @code{~a} (~a) ~a~a + "@item @code{~a} ~a ~a~a @funindex ~a ~a " diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm index 6d0290d5f5..17736d4d5d 100644 --- a/scm/ly-syntax-constructors.scm +++ b/scm/ly-syntax-constructors.scm @@ -43,20 +43,16 @@ m))) ;; Music function: Apply function and check return value. -(define-ly-syntax (music-function parser loc pred fun args) +(define-ly-syntax (music-function parser loc pred default fun args) (let ((m (apply fun parser loc args))) - (if (ly:music? m) - (set! (ly:music-property m 'origin) loc)) (if (pred m) m - (cond ((eq? pred ly:music?) - (ly:parser-error parser (_ "Music syntax function must return Music object") loc) - (make-music 'Music 'origin loc)) - (else - (ly:parser-error parser - (format #f (_ "Scheme function must return ~a object") (type-name pred)) - loc) - #f))))) + (begin + (ly:parser-error parser + (format #f (_ "~a function can't return ~a") + (type-name pred) m) + loc) + default)))) (define-ly-syntax-simple (void-music) (make-music 'Music)) diff --git a/scm/music-functions.scm b/scm/music-functions.scm index e1ee530173..feb11143b1 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -794,37 +794,90 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (defmacro-public define-syntax-function (type args signature . body) "Helper macro for `ly:make-music-function'. Syntax: - (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type? arg2-type? ...) + (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...) ...function body...) -" + +argX-type can take one of the forms @code{predicate?} for mandatory +arguments satisfying the predicate, @code{(predicate?)} for optional +parameters of that type defaulting to @code{#f}, @code{@w{(predicate? +value)}} for optional parameters with a specified default +value (evaluated at definition time). An optional parameter can be +omitted in a call only when it can't get confused with a following +parameter of different type. + +Predicates with syntactical significance are @code{ly:pitch?}, +@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other +predicates require the parameter to be entered as Scheme expression. + +@code{result-type?} can specify a default in the same manner as +predicates, to be used in case of a type error in arguments or +result." + + (set! signature (map (lambda (pred) + (if (pair? pred) + `(cons ,(car pred) + ,(and (pair? (cdr pred)) (cadr pred))) + pred)) + (cons type signature))) (if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body))) ;; When the music function definition contains a i10n doc string, ;; (_i "doc string"), keep the literal string only (let ((docstring (cadar body)) (body (cdr body))) - `(ly:make-music-function (list ,type ,@signature) + `(ly:make-music-function (list ,@signature) (lambda ,args ,docstring ,@body))) - `(ly:make-music-function (list ,type ,@signature) + `(ly:make-music-function (list ,@signature) (lambda ,args ,@body)))) (defmacro-public define-music-function rest - "Helper macro for `ly:make-music-function'. + "Defining macro returning music functions. Syntax: (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...) ...function body...) -" - `(define-syntax-function ly:music? ,@rest)) + +argX-type can take one of the forms @code{predicate?} for mandatory +arguments satisfying the predicate, @code{(predicate?)} for optional +parameters of that type defaulting to @code{#f}, @code{@w{(predicate? +value)}} for optional parameters with a specified default +value (evaluated at definition time). An optional parameter can be +omitted in a call only when it can't get confused with a following +parameter of different type. + +Predicates with syntactical significance are @code{ly:pitch?}, +@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other +predicates require the parameter to be entered as Scheme expression. + +Must return a music expression. The @code{origin} is automatically +set to the @code{location} parameter." + + `(define-syntax-function (ly:music? (make-music 'Music 'void #t)) ,@rest)) (defmacro-public define-scheme-function rest - "Helper macro for `ly:make-music-function'. + "Defining macro returning Scheme functions. Syntax: (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...) ...function body...) -" + +argX-type can take one of the forms @code{predicate?} for mandatory +arguments satisfying the predicate, @code{(predicate?)} for optional +parameters of that type defaulting to @code{#f}, @code{@w{(predicate? +value)}} for optional parameters with a specified default +value (evaluated at definition time). An optional parameter can be +omitted in a call only when it can't get confused with a following +parameter of different type. + +Predicates with syntactical significance are @code{ly:pitch?}, +@code{ly:duration?}, @code{ly:music?}, @code{markup?}. Other +predicates require the parameter to be entered as Scheme expression. + +Can return arbitrary expressions. If a music expression is returned, +its @code{origin} is automatically set to the @code{location} +parameter." + `(define-syntax-function scheme? ,@rest)) -- 2.39.5