45 #ifndef CGU_EXTENSION_H 46 #define CGU_EXTENSION_H 432 #include <type_traits> 449 #include <libguile.h> 452 #ifndef DOXYGEN_PARSING 455 namespace Extension {
462 enum VectorDeleteType {Long, Double, String};
464 struct VectorDeleteArgs {
465 VectorDeleteType type;
471 extern
bool init_mutex() noexcept;
479 inline SCM cgu_format_try_handler(
void* data) {
480 using Cgu::Extension::FormatArgs;
481 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
482 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
484 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
487 inline void* cgu_guile_wrapper(
void* data) {
502 inline void cgu_delete_vector(
void* data) {
503 using Cgu::Extension::VectorDeleteArgs;
504 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
505 switch (args->type) {
506 case Cgu::Extension::Long:
507 delete static_cast<std::vector<long>*
>(args->vec);
509 case Cgu::Extension::Double:
510 delete static_cast<std::vector<double>*
>(args->vec);
512 case Cgu::Extension::String:
513 delete static_cast<std::vector<std::string>*
>(args->vec);
516 g_critical(
"Incorrect argument passed to cgu_delete_vector");
520 inline void cgu_unlock_module_mutex(
void*) {
523 Cgu::Extension::get_user_module_mutex()->unlock();
527 #endif // DOXYGEN_PARSING 531 namespace Extension {
537 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
538 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
540 message(g_strdup_printf(u8
"Cgu::Extension::GuileException: %s", msg)),
541 guile_message(g_strdup(msg)) {}
549 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
550 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
552 message(g_strdup_printf(u8
"Cgu::Extension::ReturnValueError: %s", msg)),
553 err_message(g_strdup(msg)) {}
560 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
562 message(g_strdup_printf(u8
"Cgu::Extension::WrapperError: %s", msg)) {}
566 #ifndef DOXYGEN_PARSING 573 template <
class Ret,
class Translator>
574 Ret exec_impl(
const std::string& preamble,
575 const std::string& file,
576 Translator&& translator,
585 loader += u8
"((lambda ()";
586 loader += u8
"(catch " 591 loader += u8
"primitive-load \"";
593 loader += u8
"load \"";
596 "(lambda (key . details)" 597 "(cons \"***cgu-guile-exception***\" (cons key details))))";
604 std::string guile_except;
605 std::string guile_ret_val_err;
628 std::unique_ptr<Cgu::Callback::Callback> cb(Cgu::Callback::lambda<>([&] () ->
void {
631 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
632 scm_c_resolve_module(
"guile-user"));
636 throw std::bad_alloc();
638 scm_dynwind_begin(scm_t_dynwind_flags(0));
639 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
640 get_user_module_mutex()->lock();
641 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
644 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
668 #ifndef CGU_GUILE_HAS_BROKEN_LINKING 669 scm_dynwind_begin(scm_t_dynwind_flags(0));
670 scm_dynwind_block_asyncs();
677 bool badalloc =
false;
679 retval = translator(scm);
695 catch (GuileException& e) {
697 guile_except = e.guile_text();
703 catch (ReturnValueError& e) {
705 guile_ret_val_err = e.err_text();
711 catch (std::exception& e) {
721 gen_err = u8
"C++ exception thrown in cgu_guile_wrapper()";
727 #ifndef CGU_GUILE_HAS_BROKEN_LINKING 730 if (badalloc)
throw std::bad_alloc();
735 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
736 throw WrapperError(u8
"cgu_guile_wrapper() has trapped std::bad_alloc");
737 if (!guile_except.empty())
738 throw GuileException(guile_except.c_str());
739 if (!guile_ret_val_err.empty())
740 throw ReturnValueError(guile_ret_val_err.c_str());
741 if (!gen_err.empty())
742 throw WrapperError(gen_err.c_str());
744 throw WrapperError(u8
"the preamble or translator threw a native guile exception");
748 #endif // DOXYGEN_PARSING 784 SCM ret = SCM_BOOL_F;
785 int length = scm_to_int(scm_length(args));
787 SCM first = scm_car(args);
788 if (scm_is_true(scm_string_p(first))) {
791 ret = scm_string_append(scm_list_4(scm_from_utf8_string(u8
"Exception "),
792 scm_symbol_to_string(key),
793 scm_from_utf8_string(u8
": "),
797 SCM second = scm_cadr(args);
798 if (scm_is_true(scm_string_p(second))) {
800 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(u8
"Exception "),
801 scm_symbol_to_string(key),
802 scm_from_utf8_string(u8
" in procedure "),
804 scm_from_utf8_string(u8
": "),
810 SCM third = scm_caddr(args);
811 if (scm_is_false(third))
813 else if (scm_is_true(scm_list_p(third))) {
814 FormatArgs format_args = {text, third};
815 ret = scm_internal_catch(SCM_BOOL_T,
816 &cgu_format_try_handler,
818 &cgu_format_catch_handler,
828 if (scm_is_false(ret)) {
831 ret = scm_simple_format(SCM_BOOL_F,
832 scm_from_utf8_string(u8
"Exception ~S: ~S"),
833 scm_list_2(key, args));
866 if (scm_is_false(scm_list_p(scm))
867 || scm_is_true(scm_null_p(scm)))
return;
868 SCM first = scm_car(scm);
869 if (scm_is_true(scm_string_p(first))) {
871 const char* text = 0;
875 scm_dynwind_begin(scm_t_dynwind_flags(0));
876 char* car = scm_to_utf8_stringn(first, &len);
886 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
887 if (len == strlen(u8
"***cgu-guile-exception***")
888 && !strncmp(car, u8
"***cgu-guile-exception***", len)) {
893 text = scm_to_utf8_stringn(str, &len);
899 std::unique_ptr<char, Cgu::CFree> up_car(car);
900 std::unique_ptr<const char, Cgu::CFree> up_text(text);
948 if (scm_is_false(scm_list_p(scm)))
954 scm_dynwind_begin(scm_t_dynwind_flags(0));
962 bool badalloc =
false;
963 const char* rv_error = 0;
964 std::vector<long>* res = 0;
965 VectorDeleteArgs* args = 0;
971 res =
new std::vector<long>;
974 args =
new VectorDeleteArgs{Long, res};
989 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
995 SCM guile_vec = scm_vector(scm);
1018 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1020 res->reserve(length);
1025 for (
size_t count = 0;
1026 count < length && !rv_error && !badalloc;
1028 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1029 if (scm_is_false(scm_integer_p(item)))
1030 rv_error = u8
"scheme code did not evaluate to a homogeneous list of integer\n";
1032 SCM min = scm_from_long(std::numeric_limits<long>::min());
1033 SCM max = scm_from_long(std::numeric_limits<long>::max());
1034 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1035 rv_error = u8
"scheme code evaluated out of range for long\n";
1038 res->push_back(scm_to_long(item));
1051 std::unique_ptr<std::vector<long>> up_res(res);
1052 std::unique_ptr<VectorDeleteArgs> up_args(args);
1053 if (badalloc)
throw std::bad_alloc();
1057 return std::move(*res);
1107 if (scm_is_false(scm_list_p(scm)))
1113 scm_dynwind_begin(scm_t_dynwind_flags(0));
1121 bool badalloc =
false;
1122 const char* rv_error = 0;
1123 std::vector<double>* res = 0;
1124 VectorDeleteArgs* args = 0;
1130 res =
new std::vector<double>;
1133 args =
new VectorDeleteArgs{Double, res};
1148 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1154 SCM guile_vec = scm_vector(scm);
1177 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1179 res->reserve(length);
1184 for (
size_t count = 0;
1185 count < length && !rv_error && !badalloc;
1187 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1188 if (scm_is_false(scm_real_p(item)))
1189 rv_error = u8
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1191 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1192 SCM max = scm_from_double(std::numeric_limits<double>::max());
1193 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1194 rv_error = u8
"scheme code evaluated out of range for double\n";
1197 res->push_back(scm_to_double(item));
1210 std::unique_ptr<std::vector<double>> up_res(res);
1211 std::unique_ptr<VectorDeleteArgs> up_args(args);
1212 if (badalloc)
throw std::bad_alloc();
1216 return std::move(*res);
1267 if (scm_is_false(scm_list_p(scm)))
1273 scm_dynwind_begin(scm_t_dynwind_flags(0));
1281 bool badalloc =
false;
1282 const char* rv_error = 0;
1283 std::vector<std::string>* res = 0;
1284 VectorDeleteArgs* args = 0;
1290 res =
new std::vector<std::string>;
1293 args =
new VectorDeleteArgs{String, res};
1308 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1314 SCM guile_vec = scm_vector(scm);
1337 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1339 res->reserve(length);
1344 for (
size_t count = 0;
1345 count < length && !rv_error && !badalloc;
1347 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1348 if (scm_is_false(scm_string_p(item)))
1349 rv_error = u8
"scheme code did not evaluate to a homogeneous list of string\n";
1355 char* str = scm_to_utf8_stringn(item, &len);
1357 res->emplace_back(str, len);
1370 std::unique_ptr<std::vector<std::string>> up_res(res);
1371 std::unique_ptr<VectorDeleteArgs> up_args(args);
1372 if (badalloc)
throw std::bad_alloc();
1376 return std::move(*res);
1416 if (scm_is_false(scm_integer_p(scm)))
1418 SCM min = scm_from_long(std::numeric_limits<long>::min());
1419 SCM max = scm_from_long(std::numeric_limits<long>::max());
1420 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1422 return scm_to_long(scm);
1468 if (scm_is_false(scm_real_p(scm)))
1469 throw ReturnValueError(u8
"scheme code did not evaluate to a real number\n");
1470 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1471 SCM max = scm_from_double(std::numeric_limits<double>::max());
1472 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1473 throw ReturnValueError(u8
"scheme code evaluated out of range for double\n");
1474 return scm_to_double(scm);
1516 if (scm_is_false(scm_string_p(scm)))
1522 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1523 return std::string(s.get(), len);
1645 template <
class Translator>
1646 auto exec(
const std::string& preamble,
1647 const std::string& file,
1648 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1652 typedef typename std::result_of<Translator(SCM)>::type Ret;
1653 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
false);
1733 template <
class Translator>
1735 const std::string& file,
1736 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1740 typedef typename std::result_of<Translator(SCM)>::type Ret;
1741 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
true);
1748 #endif // CGU_EXTENSION_H virtual const char * what() const
Definition: extension.h:549
std::vector< long > list_to_vector_long(SCM scm)
Definition: extension.h:946
GuileException(const char *msg)
Definition: extension.h:539
long integer_to_long(SCM scm)
Definition: extension.h:1414
~ReturnValueError()
Definition: extension.h:554
T get() const noexcept
Definition: shared_handle.h:762
~GuileException()
Definition: extension.h:542
void * any_to_void(SCM scm)
Definition: extension.h:1561
const char * err_text() const
Definition: extension.h:550
virtual const char * what() const
Definition: extension.h:560
virtual const char * what() const
Definition: extension.h:537
const char * guile_text() const
Definition: extension.h:538
WrapperError(const char *msg)
Definition: extension.h:561
This file provides classes for type erasure.
Definition: extension.h:545
SCM exception_to_string(SCM key, SCM args) noexcept
Definition: extension.h:777
A class enabling the cancellation state of a thread to be controlled.
Definition: thread.h:723
double real_to_double(SCM scm)
Definition: extension.h:1466
Definition: extension.h:533
std::string string_to_string(SCM scm)
Definition: extension.h:1514
std::vector< double > list_to_vector_double(SCM scm)
Definition: extension.h:1105
auto exec(const std::string &preamble, const std::string &file, Translator &&translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1646
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
std::vector< std::string > list_to_vector_string(SCM scm)
Definition: extension.h:1265
Definition: extension.h:557
~WrapperError()
Definition: extension.h:563
auto exec_shared(const std::string &preamble, const std::string &file, Translator &&translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1734
void rethrow_guile_exception(SCM scm)
Definition: extension.h:863
ReturnValueError(const char *msg)
Definition: extension.h:551
The callback interface class.
Definition: callback.h:567