45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
430 #include <type_traits>
447 #include <libguile.h>
450 #ifndef DOXYGEN_PARSING
453 namespace Extension {
460 enum VectorDeleteType {Long, Double, String};
462 struct VectorDeleteArgs {
463 VectorDeleteType type;
469 extern
bool init_mutex() noexcept;
477 inline SCM cgu_format_try_handler(
void* data) {
478 using Cgu::Extension::FormatArgs;
479 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
480 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
482 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
485 inline void* cgu_guile_wrapper(
void* data) {
500 inline void cgu_delete_vector(
void* data) {
501 using Cgu::Extension::VectorDeleteArgs;
502 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
503 switch (args->type) {
504 case Cgu::Extension::Long:
505 delete static_cast<std::vector<long>*
>(args->vec);
507 case Cgu::Extension::Double:
508 delete static_cast<std::vector<double>*
>(args->vec);
510 case Cgu::Extension::String:
511 delete static_cast<std::vector<std::string>*
>(args->vec);
514 g_critical(
"Incorrect argument passed to cgu_delete_vector");
518 inline void cgu_unlock_module_mutex(
void*) {
521 Cgu::Extension::get_user_module_mutex()->unlock();
525 #endif // DOXYGEN_PARSING
529 namespace Extension {
535 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
536 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
538 message(g_strdup_printf(u8
"Cgu::Extension::GuileException: %s", msg)),
539 guile_message(g_strdup(msg)) {}
547 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
548 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
550 message(g_strdup_printf(u8
"Cgu::Extension::ReturnValueError: %s", msg)),
551 err_message(g_strdup(msg)) {}
558 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
560 message(g_strdup_printf(u8
"Cgu::Extension::WrapperError: %s", msg)) {}
564 #ifndef DOXYGEN_PARSING
571 template <
class Ret,
class Translator>
572 Ret exec_impl(
const std::string& preamble,
573 const std::string& file,
574 Translator&& translator,
583 loader += u8
"((lambda ()";
584 loader += u8
"(catch "
589 loader += u8
"primitive-load \"";
591 loader += u8
"load \"";
594 "(lambda (key . details)"
595 "(cons \"***cgu-guile-exception***\" (cons key details))))";
602 std::string guile_except;
603 std::string guile_ret_val_err;
626 std::unique_ptr<Cgu::Callback::Callback> cb(Cgu::Callback::lambda<>([&] () ->
void {
629 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
630 scm_c_resolve_module(
"guile-user"));
634 throw std::bad_alloc();
636 scm_dynwind_begin(scm_t_dynwind_flags(0));
637 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
638 get_user_module_mutex()->lock();
639 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
642 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
666 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
667 scm_dynwind_begin(scm_t_dynwind_flags(0));
668 scm_dynwind_block_asyncs();
675 bool badalloc =
false;
677 retval = translator(scm);
693 catch (GuileException& e) {
695 guile_except = e.guile_text();
701 catch (ReturnValueError& e) {
703 guile_ret_val_err = e.err_text();
709 catch (std::exception& e) {
719 gen_err = u8
"C++ exception thrown in cgu_guile_wrapper()";
725 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
728 if (badalloc)
throw std::bad_alloc();
733 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
734 throw WrapperError(u8
"cgu_guile_wrapper() has trapped std::bad_alloc");
735 if (!guile_except.empty())
736 throw GuileException(guile_except.c_str());
737 if (!guile_ret_val_err.empty())
738 throw ReturnValueError(guile_ret_val_err.c_str());
739 if (!gen_err.empty())
740 throw WrapperError(gen_err.c_str());
742 throw WrapperError(u8
"the preamble or translator threw a native guile exception");
746 #endif // DOXYGEN_PARSING
782 SCM ret = SCM_BOOL_F;
783 int length = scm_to_int(scm_length(args));
785 SCM first = scm_car(args);
786 if (scm_is_true(scm_string_p(first))) {
789 ret = scm_string_append(scm_list_4(scm_from_utf8_string(u8
"Exception "),
790 scm_symbol_to_string(key),
791 scm_from_utf8_string(u8
": "),
795 SCM second = scm_cadr(args);
796 if (scm_is_true(scm_string_p(second))) {
798 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(u8
"Exception "),
799 scm_symbol_to_string(key),
800 scm_from_utf8_string(u8
" in procedure "),
802 scm_from_utf8_string(u8
": "),
808 SCM third = scm_caddr(args);
809 if (scm_is_false(third))
811 else if (scm_is_true(scm_list_p(third))) {
812 FormatArgs format_args = {text, third};
813 ret = scm_internal_catch(SCM_BOOL_T,
814 &cgu_format_try_handler,
816 &cgu_format_catch_handler,
826 if (scm_is_false(ret)) {
829 ret = scm_simple_format(SCM_BOOL_F,
830 scm_from_utf8_string(u8
"Exception ~S: ~S"),
831 scm_list_2(key, args));
864 if (scm_is_false(scm_list_p(scm))
865 || scm_is_true(scm_null_p(scm)))
return;
866 SCM first = scm_car(scm);
867 if (scm_is_true(scm_string_p(first))) {
869 const char* text = 0;
873 scm_dynwind_begin(scm_t_dynwind_flags(0));
874 char* car = scm_to_utf8_stringn(first, &len);
884 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
885 if (len == strlen(u8
"***cgu-guile-exception***")
886 && !strncmp(car, u8
"***cgu-guile-exception***", len)) {
891 text = scm_to_utf8_stringn(str, &len);
897 std::unique_ptr<char, Cgu::CFree> up_car(car);
898 std::unique_ptr<const char, Cgu::CFree> up_text(text);
946 if (scm_is_false(scm_list_p(scm)))
952 scm_dynwind_begin(scm_t_dynwind_flags(0));
960 bool badalloc =
false;
961 const char* rv_error = 0;
962 std::vector<long>* res = 0;
963 VectorDeleteArgs* args = 0;
969 res =
new std::vector<long>;
972 args =
new VectorDeleteArgs{Long, res};
987 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
993 SCM guile_vec = scm_vector(scm);
1016 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1018 res->reserve(length);
1023 for (
size_t count = 0;
1024 count < length && !rv_error && !badalloc;
1026 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1027 if (scm_is_false(scm_integer_p(item)))
1028 rv_error = u8
"scheme code did not evaluate to a homogeneous list of integer\n";
1030 SCM min = scm_from_long(std::numeric_limits<long>::min());
1031 SCM max = scm_from_long(std::numeric_limits<long>::max());
1032 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1033 rv_error = u8
"scheme code evaluated out of range for long\n";
1036 res->push_back(scm_to_long(item));
1049 std::unique_ptr<std::vector<long>> up_res(res);
1050 std::unique_ptr<VectorDeleteArgs> up_args(args);
1051 if (badalloc)
throw std::bad_alloc();
1055 return std::move(*res);
1105 if (scm_is_false(scm_list_p(scm)))
1111 scm_dynwind_begin(scm_t_dynwind_flags(0));
1119 bool badalloc =
false;
1120 const char* rv_error = 0;
1121 std::vector<double>* res = 0;
1122 VectorDeleteArgs* args = 0;
1128 res =
new std::vector<double>;
1131 args =
new VectorDeleteArgs{Double, res};
1146 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1152 SCM guile_vec = scm_vector(scm);
1175 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1177 res->reserve(length);
1182 for (
size_t count = 0;
1183 count < length && !rv_error && !badalloc;
1185 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1186 if (scm_is_false(scm_real_p(item)))
1187 rv_error = u8
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1189 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1190 SCM max = scm_from_double(std::numeric_limits<double>::max());
1191 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1192 rv_error = u8
"scheme code evaluated out of range for double\n";
1195 res->push_back(scm_to_double(item));
1208 std::unique_ptr<std::vector<double>> up_res(res);
1209 std::unique_ptr<VectorDeleteArgs> up_args(args);
1210 if (badalloc)
throw std::bad_alloc();
1214 return std::move(*res);
1265 if (scm_is_false(scm_list_p(scm)))
1271 scm_dynwind_begin(scm_t_dynwind_flags(0));
1279 bool badalloc =
false;
1280 const char* rv_error = 0;
1281 std::vector<std::string>* res = 0;
1282 VectorDeleteArgs* args = 0;
1288 res =
new std::vector<std::string>;
1291 args =
new VectorDeleteArgs{String, res};
1306 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1312 SCM guile_vec = scm_vector(scm);
1335 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1337 res->reserve(length);
1342 for (
size_t count = 0;
1343 count < length && !rv_error && !badalloc;
1345 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1346 if (scm_is_false(scm_string_p(item)))
1347 rv_error = u8
"scheme code did not evaluate to a homogeneous list of string\n";
1353 char* str = scm_to_utf8_stringn(item, &len);
1355 res->emplace_back(str, len);
1368 std::unique_ptr<std::vector<std::string>> up_res(res);
1369 std::unique_ptr<VectorDeleteArgs> up_args(args);
1370 if (badalloc)
throw std::bad_alloc();
1374 return std::move(*res);
1414 if (scm_is_false(scm_integer_p(scm)))
1416 SCM min = scm_from_long(std::numeric_limits<long>::min());
1417 SCM max = scm_from_long(std::numeric_limits<long>::max());
1418 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1420 return scm_to_long(scm);
1466 if (scm_is_false(scm_real_p(scm)))
1467 throw ReturnValueError(u8
"scheme code did not evaluate to a real number\n");
1468 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1469 SCM max = scm_from_double(std::numeric_limits<double>::max());
1470 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1471 throw ReturnValueError(u8
"scheme code evaluated out of range for double\n");
1472 return scm_to_double(scm);
1514 if (scm_is_false(scm_string_p(scm)))
1520 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1521 return std::string(s.get(), len);
1643 template <
class Translator>
1644 auto exec(
const std::string& preamble,
1645 const std::string& file,
1646 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1650 typedef typename std::result_of<Translator(SCM)>::type Ret;
1651 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
false);
1731 template <
class Translator>
1733 const std::string& file,
1734 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1738 typedef typename std::result_of<Translator(SCM)>::type Ret;
1739 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
true);
1746 #endif // CGU_EXTENSION_H
std::vector< long > list_to_vector_long(SCM scm)
Definition: extension.h:944
GuileException(const char *msg)
Definition: extension.h:537
long integer_to_long(SCM scm)
Definition: extension.h:1412
~ReturnValueError()
Definition: extension.h:552
T get() const noexcept
Definition: shared_handle.h:762
~GuileException()
Definition: extension.h:540
const char * err_text() const
Definition: extension.h:548
void * any_to_void(SCM scm)
Definition: extension.h:1559
WrapperError(const char *msg)
Definition: extension.h:559
This file provides classes for type erasure.
Definition: extension.h:543
SCM exception_to_string(SCM key, SCM args) noexcept
Definition: extension.h:775
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:1464
Definition: extension.h:531
std::string string_to_string(SCM scm)
Definition: extension.h:1512
std::vector< double > list_to_vector_double(SCM scm)
Definition: extension.h:1103
virtual const char * what() const
Definition: extension.h:558
auto exec(const std::string &preamble, const std::string &file, Translator &&translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1644
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:1263
Definition: extension.h:555
virtual const char * what() const
Definition: extension.h:547
~WrapperError()
Definition: extension.h:561
virtual const char * what() const
Definition: extension.h:535
auto exec_shared(const std::string &preamble, const std::string &file, Translator &&translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1732
void rethrow_guile_exception(SCM scm)
Definition: extension.h:861
ReturnValueError(const char *msg)
Definition: extension.h:549
The callback interface class.
Definition: callback.h:567
const char * guile_text() const
Definition: extension.h:536