From c324981f1598c00059ce42e3226cc2ad078a6db2 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Thu, 29 Mar 2012 01:38:29 +0200 Subject: [PATCH] Turn music functions and their signatures into C++ smobs --- lily/include/music-function.hh | 1 + lily/lexer.ll | 4 +-- lily/music-function-scheme.cc | 12 ++++++-- lily/music-function.cc | 55 +++++++++++++++++++++------------- scm/document-identifiers.scm | 2 +- scm/ly-syntax-constructors.scm | 5 ++-- 6 files changed, 52 insertions(+), 27 deletions(-) diff --git a/lily/include/music-function.hh b/lily/include/music-function.hh index 8c64a3d7df..d257b136b8 100644 --- a/lily/include/music-function.hh +++ b/lily/include/music-function.hh @@ -26,6 +26,7 @@ SCM ly_make_music_function (SCM, SCM); SCM make_music_function (SCM, SCM); SCM get_music_function_transform (SCM); +SCM get_music_function_signature (SCM); bool is_music_function (SCM); #endif /* MUSIC_FUNCTION_HH */ diff --git a/lily/lexer.ll b/lily/lexer.ll index c2d8b6baef..78b6475303 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -890,9 +890,9 @@ Lily_lexer::scan_scm_id (SCM sid) { int funtype = SCM_FUNCTION; - yylval.scm = get_music_function_transform (sid); + yylval.scm = sid; - SCM s = scm_object_property (yylval.scm, ly_symbol2scm ("music-function-signature")); + SCM s = get_music_function_signature (sid); SCM cs = scm_car (s); if (scm_is_pair (cs)) diff --git a/lily/music-function-scheme.cc b/lily/music-function-scheme.cc index 93c7e0fbc4..39f1bdecbc 100644 --- a/lily/music-function-scheme.cc +++ b/lily/music-function-scheme.cc @@ -13,7 +13,16 @@ LY_DEFINE (ly_music_function_extract, "ly:music-function-extract", 1, 0, 0, { LY_ASSERT_TYPE (is_music_function, x, 1); - return SCM_CELL_OBJECT_1 (x); + return get_music_function_transform (x); +} + +LY_DEFINE (ly_music_function_signature, "ly:music-function-signature", 1, 0, 0, + (SCM x), + "Return the function signature inside@tie{}@var{x}.") +{ + LY_ASSERT_TYPE (is_music_function, x, 1); + + return get_music_function_signature (x); } LY_DEFINE (ly_make_music_function, "ly:make-music-function", 2, 0, 0, @@ -41,4 +50,3 @@ LY_DEFINE (ly_make_music_function, "ly:make-music-function", 2, 0, 0, return make_music_function (signature, func); } - diff --git a/lily/music-function.cc b/lily/music-function.cc index 7d6675b3b7..85b2157576 100644 --- a/lily/music-function.cc +++ b/lily/music-function.cc @@ -20,17 +20,28 @@ #include "music-function.hh" #include "music.hh" - -static scm_t_bits music_function_tag; +#include "ly-smobs.icc" + +class Musicfunction { + DECLARE_SIMPLE_SMOBS (Musicfunction); + SCM signature_; + SCM function_; +public: + Musicfunction (SCM signature, SCM function): + signature_(signature), function_(function) { } + SCM get_function () { return function_; } + SCM get_signature () { return signature_; } +}; + +IMPLEMENT_SIMPLE_SMOBS (Musicfunction); +IMPLEMENT_DEFAULT_EQUAL_P (Musicfunction); /* Print a textual represenation of the smob to a given port. */ -static int -print_music_function (SCM b, SCM port, scm_print_state *) +int +Musicfunction::print_smob (SCM b, SCM port, scm_print_state *) { - SCM value = SCM_CELL_OBJECT_1 (b); - scm_puts ("#get_function (), port); scm_puts (">", port); /* Non-zero means success. */ @@ -40,7 +51,7 @@ print_music_function (SCM b, SCM port, scm_print_state *) bool is_music_function (SCM music_function) { - return (SCM_NIMP (music_function) && SCM_CELL_TYPE (music_function) == music_function_tag); + return Musicfunction::unsmob (music_function); } SCM @@ -49,25 +60,29 @@ get_music_function_transform (SCM music_function) if (!is_music_function (music_function)) return SCM_UNDEFINED; - return SCM_CELL_OBJECT_1 (music_function); + return Musicfunction::unsmob (music_function)->get_function (); } -static void -init_music_function (void) +SCM +make_music_function (SCM signature, SCM func) { - music_function_tag = scm_make_smob_type ("music-function", 0); - scm_set_smob_mark (music_function_tag, scm_markcdr); - scm_set_smob_print (music_function_tag, print_music_function); + return Musicfunction (signature, func).smobbed_copy (); } SCM -make_music_function (SCM signature, SCM func) +get_music_function_signature (SCM music_function) { - scm_set_object_property_x (func, ly_symbol2scm ("music-function-signature"), - signature); + if (!is_music_function (music_function)) + return SCM_UNDEFINED; - SCM_RETURN_NEWSMOB (music_function_tag, func); + return Musicfunction::unsmob (music_function)->get_signature (); } -ADD_SCM_INIT_FUNC (music_function_tag, init_music_function); - +SCM +Musicfunction::mark_smob (SCM s) +{ + Musicfunction *p = Musicfunction::unsmob (s); + scm_gc_mark (p->signature_); + ASSERT_LIVE_IS_ALLOWED (); + return p->function_; +} diff --git a/scm/document-identifiers.scm b/scm/document-identifiers.scm index 821dde09c2..fcd8f93214 100644 --- a/scm/document-identifiers.scm +++ b/scm/document-identifiers.scm @@ -26,7 +26,7 @@ (map symbol->string (cddr (cadr (procedure-source func))))) (doc (procedure-documentation func)) - (sign (object-property func 'music-function-signature)) + (sign (ly:music-function-signature music-func)) (type-names (map (lambda (pred) (if (pair? pred) (format #f "[~a]" (type-name (car pred))) diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm index 45d308c4a9..9cbec5fc4f 100644 --- a/scm/ly-syntax-constructors.scm +++ b/scm/ly-syntax-constructors.scm @@ -50,10 +50,11 @@ ;; we don't call the function but rather return the general ;; fallback. (define-ly-syntax (music-function parser loc fun args . rest) - (let* ((sig (object-property fun 'music-function-signature)) + (let* ((sig (ly:music-function-signature fun)) (pred (if (pair? (car sig)) (caar sig) (car sig))) (good (proper-list? args)) - (m (and good (apply fun parser loc (reverse! args rest))))) + (m (and good (apply (ly:music-function-extract fun) + parser loc (reverse! args rest))))) (if (and good (pred m)) (begin (if (ly:music? m) -- 2.39.2