-(define-ly-syntax (music-function parser loc pred default fun args)
- (let ((m (apply fun parser loc args)))
- (if (pred m)
- m
- (begin
- (ly:parser-error parser
- (format #f (_ "~a function cannot return ~a")
- (type-name pred) m)
- loc)
- default))))
-
-(define-ly-syntax-simple (void-music)
- (make-music 'Music))
-
-(define-ly-syntax-simple (sequential-music mlist)
- (make-sequential-music mlist))
-
-(define-ly-syntax-simple (simultaneous-music mlist)
- (make-simultaneous-music mlist))
-
-(define-ly-syntax-simple (event-chord mlist)
- (make-music 'EventChord
- 'elements mlist))
-
-(define-ly-syntax-simple (unrelativable-music mus)
- (make-music 'UnrelativableMusic
- 'element mus))
-
-(define-ly-syntax-simple (context-change type id)
- (make-music 'ContextChange
- 'change-to-type type
- 'change-to-id id))
-
-(define-ly-syntax-simple (voice-separator)
- (make-music 'VoiceSeparator))
-
-(define-ly-syntax-simple (bar-check)
- (make-music 'BarCheck))
-
-(define-ly-syntax-simple (time-scaled-music fraction music)
- (make-music 'TimeScaledMusic
- 'element (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction)))
- 'numerator (car fraction)
- 'denominator (cdr fraction)))
-
-(define-ly-syntax (tempo parser location text . rest)
+;; args are in reverse order.
+;;
+;; If args is not a proper list, an error has been flagged earlier
+;; and no fallback value had been available. In this case,
+;; we don't call the function but rather return the general
+;; fallback.
+(define-public (music-function fun args)
+ (let* ((sigcar (car (ly:music-function-signature fun)))
+ (pred? (if (pair? sigcar) (car sigcar) sigcar))
+ (good (list? args))
+ (m (and good (apply (ly:music-function-extract fun) (reverse! args)))))
+ (if good
+ (if (pred? m)
+ (if (ly:music? m) (ly:set-origin! m) m)
+ (music-function-call-error fun m))
+ (and (pair? sigcar)
+ (if (ly:music? (cdr sigcar))
+ (ly:music-deep-copy (cdr sigcar) (*location*))
+ (cdr sigcar))))))
+
+(define-public (argument-error n pred arg)
+ (ly:parser-error
+ (format #f
+ (_ "wrong type for argument ~a. Expecting ~a, found ~s")
+ n (type-name pred) (music->make-music arg))
+ (*location*)))
+
+;; Used for chaining several music functions together. `final'
+;; contains the last argument and still needs typechecking.
+(define (music-function-chain call final)
+ (let* ((fun (car call))
+ (siglast (last (ly:music-function-signature fun)))
+ (pred? (if (pair? siglast) (car siglast) siglast)))
+ (if (pred? final)
+ (music-function fun (cons final (cdr call)))
+ (begin
+ (argument-error (length call) pred? final)
+ ;; call music function just for the error return value
+ (music-function fun #f)))))
+
+(define-public (partial-music-function call-list)
+ (let* ((good (every list? call-list))
+ (sig (ly:music-function-signature (caar call-list))))
+ (and good
+ (ly:make-music-function
+ (cons (car sig) (list-tail sig (length (car call-list))))
+ (lambda rest
+ ;; Every time we use music-function, it destructively
+ ;; reverses its list of arguments. Changing the calling
+ ;; convention would be non-trivial since we do error
+ ;; propagation to the reversed argument list by making it
+ ;; a non-proper list. So we just create a fresh copy of
+ ;; all argument lists for each call. We also want to
+ ;; avoid reusing any music expressions without copying and
+ ;; want to let them point to the location of the music
+ ;; function call rather than its definition.
+ (let ((call-list (ly:music-deep-copy call-list (*location*))))
+ (fold music-function-chain
+ (music-function (caar call-list)
+ (reverse! rest (cdar call-list)))
+ (cdr call-list))))))))
+
+(define-public (void-music)
+ (ly:set-origin! (make-music 'Music)))
+
+(define-public (sequential-music mlist)
+ (ly:set-origin! (make-sequential-music mlist)))
+
+(define-public (simultaneous-music mlist)
+ (ly:set-origin! (make-simultaneous-music mlist)))
+
+(define-public (event-chord mlist)
+ (ly:set-origin! (make-music 'EventChord
+ 'elements mlist)))
+
+(define-public (unrelativable-music mus)
+ (ly:set-origin! (make-music 'UnrelativableMusic
+ 'element mus)))
+
+(define-public (context-change type id)
+ (ly:set-origin! (make-music 'ContextChange
+ 'change-to-type type
+ 'change-to-id id)))
+
+(define-public (tempo text . rest)