From b109b45c99e6d2595102e9c365fd8c6c23d59629 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sun, 24 Dec 2006 16:12:18 +0100 Subject: [PATCH] bugfixes and cleanups for stream-events. Better typechecks, and implement copy_mutable_properties() for reliable copying. --- lily/dispatcher-scheme.cc | 7 ++++--- lily/duration-scheme.cc | 4 ++-- lily/general-scheme.cc | 2 +- lily/include/stream-event.hh | 6 ++++-- lily/music.cc | 2 +- lily/scheme-listener-scheme.cc | 2 +- lily/stream-event-scheme.cc | 28 +++++++++++++++++++++++----- lily/stream-event.cc | 7 +++---- 8 files changed, 39 insertions(+), 19 deletions(-) diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc index 2a2720656c..8500cf9811 100644 --- a/lily/dispatcher-scheme.cc +++ b/lily/dispatcher-scheme.cc @@ -38,10 +38,11 @@ LY_DEFINE (ly_add_listener, "ly:add-listener", SCM_ASSERT_TYPE (l, list, SCM_ARG1, __FUNCTION__, "listener"); SCM_ASSERT_TYPE (d, disp, SCM_ARG2, __FUNCTION__, "dispatcher"); - for (int arg=SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++) + for (int arg = SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++) { - SCM_ASSERT_TYPE (scm_symbol_p (cl), cl, arg, __FUNCTION__, "symbol"); - d->add_listener (*l, scm_car (cl)); + SCM sym = scm_car (cl); + SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, arg, __FUNCTION__, "symbol"); + d->add_listener (*l, sym); } return SCM_UNDEFINED; diff --git a/lily/duration-scheme.cc b/lily/duration-scheme.cc index fb4bb10263..361036256d 100644 --- a/lily/duration-scheme.cc +++ b/lily/duration-scheme.cc @@ -53,13 +53,13 @@ LY_DEFINE (ly_make_duration, "ly:make-duration", "(whole, half, quarter, etc.) and a number of augmentation\n" "dots. \n") { - SCM_ASSERT_TYPE (scm_integer_p (length) == SCM_BOOL_T, + SCM_ASSERT_TYPE (scm_is_integer (length), length, SCM_ARG1, __FUNCTION__, "integer"); int dots = 0; if (dotcount != SCM_UNDEFINED) { - SCM_ASSERT_TYPE (scm_integer_p (dotcount) == SCM_BOOL_T, + SCM_ASSERT_TYPE (scm_is_integer (dotcount), dotcount, SCM_ARG2, __FUNCTION__, "integer"); dots = scm_to_int (dotcount); } diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc index 59fc0bafb7..1cb51a10ff 100644 --- a/lily/general-scheme.cc +++ b/lily/general-scheme.cc @@ -296,7 +296,7 @@ LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect", 1, 1, 0, (SCM file_name, SCM mode), "Redirect stderr to FILE-NAME, opened with MODE.") { - SCM_ASSERT_TYPE (scm_string_p (file_name), file_name, SCM_ARG1, + SCM_ASSERT_TYPE (scm_is_string (file_name), file_name, SCM_ARG1, __FUNCTION__, "file_name"); char const *m = "w"; if (mode != SCM_UNDEFINED && scm_string_p (mode)) diff --git a/lily/include/stream-event.hh b/lily/include/stream-event.hh index 4e1688f6f4..9f226f48db 100644 --- a/lily/include/stream-event.hh +++ b/lily/include/stream-event.hh @@ -18,15 +18,16 @@ class Stream_event : public Prob public: Stream_event (); VIRTUAL_COPY_CONSTRUCTOR (Stream_event, Stream_event); - // todo: remove unneeded constructors + Stream_event (SCM event_class, SCM mutable_props=SCM_EOL); Stream_event (SCM class_name, Input *); - Stream_event (Stream_event *ev); Input *origin () const; void set_spot (Input *i); bool internal_in_event_class (SCM class_name); + virtual SCM copy_mutable_properties () const; + DECLARE_SCHEME_CALLBACK (undump, (SCM)); DECLARE_SCHEME_CALLBACK (dump, (SCM)); @@ -36,5 +37,6 @@ public: Stream_event *unsmob_stream_event (SCM); DECLARE_TYPE_P (Stream_event); +SCM ly_event_deep_copy (SCM); #endif /* STREAM_EVENT_HH */ diff --git a/lily/music.cc b/lily/music.cc index dd53e98643..cd27ba01be 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -184,7 +184,7 @@ Music::compress (Moment factor) } /* -TODO: make transposition non-destructive + This mutates alist. Hence, make sure that it is not changed */ SCM transpose_mutable (SCM alist, Pitch delta) diff --git a/lily/scheme-listener-scheme.cc b/lily/scheme-listener-scheme.cc index b8946871c0..7e8370068f 100644 --- a/lily/scheme-listener-scheme.cc +++ b/lily/scheme-listener-scheme.cc @@ -16,7 +16,7 @@ LY_DEFINE (ly_make_listener, "ly:make-listener", "\n" " @var{callback} should take exactly one argument." ) { - SCM_ASSERT_TYPE (scm_procedure_p (callback), callback, SCM_ARG1, __FUNCTION__, "procedure"); + SCM_ASSERT_TYPE (ly_is_procedure (callback), callback, SCM_ARG1, __FUNCTION__, "procedure"); Scheme_listener *l = new Scheme_listener (callback); SCM listener = GET_LISTENER (l->call).smobbed_copy (); l->unprotect (); diff --git a/lily/stream-event-scheme.cc b/lily/stream-event-scheme.cc index 1f890782a4..46f19b2ee2 100644 --- a/lily/stream-event-scheme.cc +++ b/lily/stream-event-scheme.cc @@ -13,12 +13,13 @@ LY_DEFINE (ly_make_stream_event, "ly:make-stream-event", "Creates a stream event of class @var{cl} with the given mutable property list.\n" ) { SCM_ASSERT_TYPE (scm_is_symbol (cl), cl, SCM_ARG1, __FUNCTION__, "symbol"); - if (proplist != SCM_UNDEFINED) - { - SCM_ASSERT_TYPE (scm_list_p (proplist), proplist, SCM_ARG2, __FUNCTION__, "association list"); - } - else + + /* should be scm_list_p, but scm_list_p is expensive. */ + SCM_ASSERT_TYPE (scm_is_pair (proplist), proplist, SCM_ARG2, __FUNCTION__, "association list"); + + if (proplist == SCM_UNDEFINED) proplist = SCM_EOL; + Stream_event *e = new Stream_event (cl, proplist); return e->unprotect (); } @@ -42,3 +43,20 @@ LY_DEFINE (ly_event_set_property, "ly:event-set-property!", SCM_ASSERT_TYPE (sc, ev, SCM_ARG1, __FUNCTION__, "event"); return ly_prob_set_property_x (ev, sym, val); } + +LY_DEFINE (ly_event_deep_copy, "ly:event-deep-copy", + 1, 0, 0, (SCM m), + "Copy @var{m} and all sub expressions of @var{m}") +{ + SCM copy = m; + if (Stream_event *ev = unsmob_stream_event (m)) + { + ev = ev->clone (); + copy = ev->unprotect (); + } + else if (scm_is_pair (m)) + copy = scm_cons (ly_event_deep_copy (scm_car (m)), + ly_event_deep_copy (scm_cdr (m))); + + return copy; +} diff --git a/lily/stream-event.cc b/lily/stream-event.cc index ff736d8832..12219884b1 100644 --- a/lily/stream-event.cc +++ b/lily/stream-event.cc @@ -35,11 +35,10 @@ Stream_event::Stream_event (SCM class_name, Input *origin) set_spot (origin); } -Stream_event::Stream_event (Stream_event *ev) - : Prob (ly_symbol2scm ("Stream_event"), SCM_EOL) +SCM +Stream_event::copy_mutable_properties () const { - mutable_property_alist_ = scm_copy_tree (ev->mutable_property_alist_); - immutable_property_alist_ = ev->immutable_property_alist_; + return ly_event_deep_copy (mutable_property_alist_); } Input * -- 2.39.2