45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
433 #include <type_traits>
435 #include <functional>
451 #include <libguile.h>
454 #ifndef DOXYGEN_PARSING
457 namespace Extension {
464 enum VectorDeleteType {Long, Double, String};
466 struct VectorDeleteArgs {
467 VectorDeleteType type;
473 extern bool init_mutex();
481 inline SCM cgu_format_try_handler(
void* data) {
482 using Cgu::Extension::FormatArgs;
483 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
484 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
486 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
489 inline void* cgu_guile_wrapper(
void* data) {
504 inline void cgu_delete_vector(
void* data) {
505 using Cgu::Extension::VectorDeleteArgs;
506 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
507 switch (args->type) {
508 case Cgu::Extension::Long:
509 delete static_cast<std::vector<long>*
>(args->vec);
511 case Cgu::Extension::Double:
512 delete static_cast<std::vector<double>*
>(args->vec);
514 case Cgu::Extension::String:
515 delete static_cast<std::vector<std::string>*
>(args->vec);
518 g_critical(
"Incorrect argument passed to cgu_delete_vector");
522 inline void cgu_unlock_module_mutex(
void*) {
525 Cgu::Extension::get_user_module_mutex()->unlock();
529 #endif // DOXYGEN_PARSING
533 namespace Extension {
539 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
540 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
542 message(g_strdup_printf(
"Cgu::Extension::GuileException: %s", msg)),
543 guile_message(g_strdup(msg)) {}
551 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
552 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
554 message(g_strdup_printf(
"Cgu::Extension::ReturnValueError: %s", msg)),
555 err_message(g_strdup(msg)) {}
562 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
564 message(g_strdup_printf(
"Cgu::Extension::WrapperError: %s", msg)) {}
568 #ifndef DOXYGEN_PARSING
573 template <
class Ret,
class TransType>
574 void guile_wrapper_cb2(TransType* translator,
578 std::string* guile_except,
579 std::string* guile_ret_val_err,
580 std::string* gen_err,
584 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
585 scm_c_resolve_module(
"guile-user"));
589 throw std::bad_alloc();
591 scm_dynwind_begin(scm_t_dynwind_flags(0));
592 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
593 get_user_module_mutex()->lock();
594 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
597 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
619 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
620 scm_dynwind_begin(scm_t_dynwind_flags(0));
621 scm_dynwind_block_asyncs();
627 bool badalloc =
false;
629 *retval = (*translator)(scm);
659 catch (std::exception& e) {
669 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
675 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
678 if (badalloc)
throw std::bad_alloc();
681 template <
class Ret,
class Translator>
682 Ret exec_impl(
const std::string& preamble,
683 const std::string& file,
684 Translator translator,
693 loader +=
"((lambda ()";
699 loader +=
"primitive-load \"";
704 "(lambda (key . details)"
705 "(cons \"***cgu-guile-exception***\" (cons key details))))";
712 std::string guile_except;
713 std::string guile_ret_val_err;
736 std::unique_ptr<Cgu::Callback::Callback> cb(
737 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb2<Ret, Translator>,
750 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
751 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
752 if (!guile_except.empty())
753 throw GuileException(guile_except.c_str());
754 if (!guile_ret_val_err.empty())
755 throw ReturnValueError(guile_ret_val_err.c_str());
756 if (!gen_err.empty())
757 throw WrapperError(gen_err.c_str());
759 throw WrapperError(
"the preamble or translator threw a native guile exception");
763 #endif // DOXYGEN_PARSING
799 SCM ret = SCM_BOOL_F;
800 int length = scm_to_int(scm_length(args));
802 SCM first = scm_car(args);
803 if (scm_is_true(scm_string_p(first))) {
806 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
807 scm_symbol_to_string(key),
808 scm_from_utf8_string(
": "),
812 SCM second = scm_cadr(args);
813 if (scm_is_true(scm_string_p(second))) {
815 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
816 scm_symbol_to_string(key),
817 scm_from_utf8_string(
" in procedure "),
819 scm_from_utf8_string(
": "),
825 SCM third = scm_caddr(args);
826 if (scm_is_false(third))
828 else if (scm_is_true(scm_list_p(third))) {
829 FormatArgs format_args = {text, third};
830 ret = scm_internal_catch(SCM_BOOL_T,
831 &cgu_format_try_handler,
833 &cgu_format_catch_handler,
843 if (scm_is_false(ret)) {
846 ret = scm_simple_format(SCM_BOOL_F,
847 scm_from_utf8_string(
"Exception ~S: ~S"),
848 scm_list_2(key, args));
881 if (scm_is_false(scm_list_p(scm))
882 || scm_is_true(scm_null_p(scm)))
return;
883 SCM first = scm_car(scm);
884 if (scm_is_true(scm_string_p(first))) {
886 const char* text = 0;
890 scm_dynwind_begin(scm_t_dynwind_flags(0));
891 char* car = scm_to_utf8_stringn(first, &len);
901 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
902 if (len == strlen(
"***cgu-guile-exception***")
903 && !strncmp(car,
"***cgu-guile-exception***", len)) {
908 text = scm_to_utf8_stringn(str, &len);
914 std::unique_ptr<char, Cgu::CFree> up_car(car);
915 std::unique_ptr<const char, Cgu::CFree> up_text(text);
962 if (scm_is_false(scm_list_p(scm)))
968 scm_dynwind_begin(scm_t_dynwind_flags(0));
976 bool badalloc =
false;
977 const char* rv_error = 0;
978 std::vector<long>* res = 0;
979 VectorDeleteArgs* args = 0;
985 res =
new std::vector<long>;
988 args =
new VectorDeleteArgs{Long, res};
1003 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1009 SCM guile_vec = scm_vector(scm);
1032 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1034 res->reserve(length);
1039 for (
size_t count = 0;
1040 count < length && !rv_error && !badalloc;
1042 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1043 if (scm_is_false(scm_integer_p(item)))
1044 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
1046 SCM min = scm_from_long(std::numeric_limits<long>::min());
1047 SCM max = scm_from_long(std::numeric_limits<long>::max());
1048 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1049 rv_error =
"scheme code evaluated out of range for long\n";
1052 res->push_back(scm_to_long(item));
1065 std::unique_ptr<std::vector<long>> up_res(res);
1066 std::unique_ptr<VectorDeleteArgs> up_args(args);
1067 if (badalloc)
throw std::bad_alloc();
1071 return std::move(*res);
1120 if (scm_is_false(scm_list_p(scm)))
1126 scm_dynwind_begin(scm_t_dynwind_flags(0));
1134 bool badalloc =
false;
1135 const char* rv_error = 0;
1136 std::vector<double>* res = 0;
1137 VectorDeleteArgs* args = 0;
1143 res =
new std::vector<double>;
1146 args =
new VectorDeleteArgs{Double, res};
1161 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1167 SCM guile_vec = scm_vector(scm);
1190 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1192 res->reserve(length);
1197 for (
size_t count = 0;
1198 count < length && !rv_error && !badalloc;
1200 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1201 if (scm_is_false(scm_real_p(item)))
1202 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1204 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1205 SCM max = scm_from_double(std::numeric_limits<double>::max());
1206 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1207 rv_error =
"scheme code evaluated out of range for double\n";
1210 res->push_back(scm_to_double(item));
1223 std::unique_ptr<std::vector<double>> up_res(res);
1224 std::unique_ptr<VectorDeleteArgs> up_args(args);
1225 if (badalloc)
throw std::bad_alloc();
1229 return std::move(*res);
1278 if (scm_is_false(scm_list_p(scm)))
1284 scm_dynwind_begin(scm_t_dynwind_flags(0));
1292 bool badalloc =
false;
1293 const char* rv_error = 0;
1294 std::vector<std::string>* res = 0;
1295 VectorDeleteArgs* args = 0;
1301 res =
new std::vector<std::string>;
1304 args =
new VectorDeleteArgs{String, res};
1319 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1325 SCM guile_vec = scm_vector(scm);
1348 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1350 res->reserve(length);
1355 for (
size_t count = 0;
1356 count < length && !rv_error && !badalloc;
1358 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1359 if (scm_is_false(scm_string_p(item)))
1360 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1366 char* str = scm_to_utf8_stringn(item, &len);
1368 res->emplace_back(str, len);
1381 std::unique_ptr<std::vector<std::string>> up_res(res);
1382 std::unique_ptr<VectorDeleteArgs> up_args(args);
1383 if (badalloc)
throw std::bad_alloc();
1387 return std::move(*res);
1426 if (scm_is_false(scm_integer_p(scm)))
1428 SCM min = scm_from_long(std::numeric_limits<long>::min());
1429 SCM max = scm_from_long(std::numeric_limits<long>::max());
1430 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1432 return scm_to_long(scm);
1476 if (scm_is_false(scm_real_p(scm)))
1478 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1479 SCM max = scm_from_double(std::numeric_limits<double>::max());
1480 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1482 return scm_to_double(scm);
1522 if (scm_is_false(scm_string_p(scm)))
1528 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1529 return std::string(s.get(), len);
1655 template <
class Translator>
1656 auto exec(
const std::string& preamble,
1657 const std::string& file,
1658 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1662 typedef typename std::result_of<Translator(SCM)>::type Ret;
1663 return exec_impl<Ret>(preamble, file, translator,
false);
1747 template <
class Translator>
1749 const std::string& file,
1750 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1754 typedef typename std::result_of<Translator(SCM)>::type Ret;
1755 return exec_impl<Ret>(preamble, file, translator,
true);
1762 #endif // CGU_EXTENSION_H
std::vector< long > list_to_vector_long(SCM scm)
Definition: extension.h:960
GuileException(const char *msg)
Definition: extension.h:541
long integer_to_long(SCM scm)
Definition: extension.h:1424
~ReturnValueError()
Definition: extension.h:556
~GuileException()
Definition: extension.h:544
const char * err_text() const
Definition: extension.h:552
void * any_to_void(SCM scm)
Definition: extension.h:1567
auto exec(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1656
WrapperError(const char *msg)
Definition: extension.h:563
This file provides classes for type erasure.
Definition: extension.h:547
A class enabling the cancellation state of a thread to be controlled.
Definition: thread.h:681
double real_to_double(SCM scm)
Definition: extension.h:1474
Definition: extension.h:535
std::string string_to_string(SCM scm)
Definition: extension.h:1520
std::vector< double > list_to_vector_double(SCM scm)
Definition: extension.h:1118
auto exec_shared(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1748
virtual const char * what() const
Definition: extension.h:562
T get() const
Definition: shared_handle.h:762
A wrapper class for pthread mutexes.
Definition: mutex.h:117
Provides wrapper classes for pthread mutexes and condition variables, and scoped locking classes for ...
Definition: application.h:44
SCM exception_to_string(SCM key, SCM args)
Definition: extension.h:792
std::vector< std::string > list_to_vector_string(SCM scm)
Definition: extension.h:1276
Definition: extension.h:559
virtual const char * what() const
Definition: extension.h:551
~WrapperError()
Definition: extension.h:565
virtual const char * what() const
Definition: extension.h:539
void rethrow_guile_exception(SCM scm)
Definition: extension.h:878
ReturnValueError(const char *msg)
Definition: extension.h:553
The callback interface class.
Definition: callback.h:522
const char * guile_text() const
Definition: extension.h:540