-
-SCM
-pure_mark (SCM smob)
-{
- scm_gc_mark (SCM_SMOB_OBJECT (smob));
- return SCM_SMOB_OBJECT_2 (smob);
-}
-
-// Function signature has two fixed arguments so that dropping two
-// will always work: if we have fewer to start with, it will trigger
-// wrong-number-of-args in a sensible location rather than making
-// drop-right barf.
-
-SCM
-apply_unpure_pure (SCM clo, SCM arg1, SCM arg2, SCM rest)
-{
- return scm_apply_0 (SCM_SMOB_OBJECT (clo),
- scm_call_2 (ly_lily_module_constant ("drop-right"),
- scm_cons2 (arg1, arg2, rest),
- scm_from_int (2)));
-}
-
-
-void init_unpure_pure_container ()
-{
- unpure_pure_container_tag = scm_make_smob_type ("unpure-pure-container", 0);
- scm_set_smob_mark (unpure_pure_container_tag, pure_mark);
- scm_set_smob_print (unpure_pure_container_tag, print_unpure_pure_container);
- unpure_pure_call_tag = scm_make_smob_type ("unpure-pure-call", 0);
- scm_set_smob_mark (unpure_pure_call_tag, scm_markcdr);
- scm_set_smob_apply (unpure_pure_call_tag,
- (scm_t_subr) apply_unpure_pure, 2, 0, 1);
-};
-
-ADD_SCM_INIT_FUNC (unpure_pure_container, init_unpure_pure_container);