45 #ifndef CGU_EXTENSION_H 46 #define CGU_EXTENSION_H 468 #include <type_traits> 470 #include <functional> 486 #include <libguile.h> 489 #ifndef DOXYGEN_PARSING 492 namespace Extension {
499 enum VectorDeleteType {Long, Double, String};
501 struct VectorDeleteArgs {
502 VectorDeleteType type;
508 extern bool init_mutex();
516 inline SCM cgu_format_try_handler(
void* data) {
517 using Cgu::Extension::FormatArgs;
518 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
519 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
521 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
524 inline void* cgu_guile_wrapper(
void* data) {
539 inline void cgu_delete_vector(
void* data) {
540 using Cgu::Extension::VectorDeleteArgs;
541 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
542 switch (args->type) {
543 case Cgu::Extension::Long:
544 delete static_cast<std::vector<long>*
>(args->vec);
546 case Cgu::Extension::Double:
547 delete static_cast<std::vector<double>*
>(args->vec);
549 case Cgu::Extension::String:
550 delete static_cast<std::vector<std::string>*
>(args->vec);
553 g_critical(
"Incorrect argument passed to cgu_delete_vector");
557 inline void cgu_unlock_module_mutex(
void*) {
560 Cgu::Extension::get_user_module_mutex()->unlock();
564 #endif // DOXYGEN_PARSING 568 namespace Extension {
574 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
575 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
577 message(g_strdup_printf(
"Cgu::Extension::GuileException: %s", msg)),
578 guile_message(g_strdup(msg)) {}
586 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
587 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
589 message(g_strdup_printf(
"Cgu::Extension::ReturnValueError: %s", msg)),
590 err_message(g_strdup(msg)) {}
597 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
599 message(g_strdup_printf(
"Cgu::Extension::WrapperError: %s", msg)) {}
603 #ifndef DOXYGEN_PARSING 608 template <
class Ret,
class TransType>
609 void guile_wrapper_cb2(TransType* translator,
613 std::string* guile_except,
614 std::string* guile_ret_val_err,
615 std::string* gen_err,
619 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
620 scm_c_resolve_module(
"guile-user"));
624 throw std::bad_alloc();
626 scm_dynwind_begin(scm_t_dynwind_flags(0));
627 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
628 get_user_module_mutex()->lock();
629 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
632 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
654 #ifndef CGU_GUILE_HAS_BROKEN_LINKING 655 scm_dynwind_begin(scm_t_dynwind_flags(0));
656 scm_dynwind_block_asyncs();
662 bool badalloc =
false;
664 *retval = (*translator)(scm);
694 catch (std::exception& e) {
704 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
710 #ifndef CGU_GUILE_HAS_BROKEN_LINKING 713 if (badalloc)
throw std::bad_alloc();
716 template <
class Ret,
class Translator>
717 Ret exec_impl(
const std::string& preamble,
718 const std::string& file,
719 Translator translator,
728 loader +=
"((lambda ()";
734 loader +=
"primitive-load \"";
739 "(lambda (key . details)" 740 "(cons \"***cgu-guile-exception***\" (cons key details))))";
747 std::string guile_except;
748 std::string guile_ret_val_err;
771 std::unique_ptr<Cgu::Callback::Callback> cb(
772 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb2<Ret, Translator>,
785 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
786 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
787 if (!guile_except.empty())
788 throw GuileException(guile_except.c_str());
789 if (!guile_ret_val_err.empty())
790 throw ReturnValueError(guile_ret_val_err.c_str());
791 if (!gen_err.empty())
792 throw WrapperError(gen_err.c_str());
794 throw WrapperError(
"the preamble or translator threw a native guile exception");
798 #endif // DOXYGEN_PARSING 834 SCM ret = SCM_BOOL_F;
835 int length = scm_to_int(scm_length(args));
837 SCM first = scm_car(args);
838 if (scm_is_true(scm_string_p(first))) {
841 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
842 scm_symbol_to_string(key),
843 scm_from_utf8_string(
": "),
847 SCM second = scm_cadr(args);
848 if (scm_is_true(scm_string_p(second))) {
850 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
851 scm_symbol_to_string(key),
852 scm_from_utf8_string(
" in procedure "),
854 scm_from_utf8_string(
": "),
860 SCM third = scm_caddr(args);
861 if (scm_is_false(third))
863 else if (scm_is_true(scm_list_p(third))) {
864 FormatArgs format_args = {text, third};
865 ret = scm_internal_catch(SCM_BOOL_T,
866 &cgu_format_try_handler,
868 &cgu_format_catch_handler,
878 if (scm_is_false(ret)) {
881 ret = scm_simple_format(SCM_BOOL_F,
882 scm_from_utf8_string(
"Exception ~S: ~S"),
883 scm_list_2(key, args));
916 if (scm_is_false(scm_list_p(scm))
917 || scm_is_true(scm_null_p(scm)))
return;
918 SCM first = scm_car(scm);
919 if (scm_is_true(scm_string_p(first))) {
921 const char* text = 0;
925 scm_dynwind_begin(scm_t_dynwind_flags(0));
926 char* car = scm_to_utf8_stringn(first, &len);
936 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
937 if (len == strlen(
"***cgu-guile-exception***")
938 && !strncmp(car,
"***cgu-guile-exception***", len)) {
943 text = scm_to_utf8_stringn(str, &len);
949 std::unique_ptr<char, Cgu::CFree> up_car(car);
950 std::unique_ptr<const char, Cgu::CFree> up_text(text);
997 if (scm_is_false(scm_list_p(scm)))
1003 scm_dynwind_begin(scm_t_dynwind_flags(0));
1011 bool badalloc =
false;
1012 const char* rv_error = 0;
1013 std::vector<long>* res = 0;
1014 VectorDeleteArgs* args = 0;
1020 res =
new std::vector<long>;
1023 args =
new VectorDeleteArgs{Long, res};
1038 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1044 SCM guile_vec = scm_vector(scm);
1067 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1069 res->reserve(length);
1074 for (
size_t count = 0;
1075 count < length && !rv_error && !badalloc;
1077 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1078 if (scm_is_false(scm_integer_p(item)))
1079 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
1081 SCM min = scm_from_long(std::numeric_limits<long>::min());
1082 SCM max = scm_from_long(std::numeric_limits<long>::max());
1083 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1084 rv_error =
"scheme code evaluated out of range for long\n";
1087 res->push_back(scm_to_long(item));
1100 std::unique_ptr<std::vector<long>> up_res(res);
1101 std::unique_ptr<VectorDeleteArgs> up_args(args);
1102 if (badalloc)
throw std::bad_alloc();
1106 return std::move(*res);
1155 if (scm_is_false(scm_list_p(scm)))
1161 scm_dynwind_begin(scm_t_dynwind_flags(0));
1169 bool badalloc =
false;
1170 const char* rv_error = 0;
1171 std::vector<double>* res = 0;
1172 VectorDeleteArgs* args = 0;
1178 res =
new std::vector<double>;
1181 args =
new VectorDeleteArgs{Double, res};
1196 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1202 SCM guile_vec = scm_vector(scm);
1225 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1227 res->reserve(length);
1232 for (
size_t count = 0;
1233 count < length && !rv_error && !badalloc;
1235 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1236 if (scm_is_false(scm_real_p(item)))
1237 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1239 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1240 SCM max = scm_from_double(std::numeric_limits<double>::max());
1241 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1242 rv_error =
"scheme code evaluated out of range for double\n";
1245 res->push_back(scm_to_double(item));
1258 std::unique_ptr<std::vector<double>> up_res(res);
1259 std::unique_ptr<VectorDeleteArgs> up_args(args);
1260 if (badalloc)
throw std::bad_alloc();
1264 return std::move(*res);
1313 if (scm_is_false(scm_list_p(scm)))
1319 scm_dynwind_begin(scm_t_dynwind_flags(0));
1327 bool badalloc =
false;
1328 const char* rv_error = 0;
1329 std::vector<std::string>* res = 0;
1330 VectorDeleteArgs* args = 0;
1336 res =
new std::vector<std::string>;
1339 args =
new VectorDeleteArgs{String, res};
1354 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1360 SCM guile_vec = scm_vector(scm);
1383 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1385 res->reserve(length);
1390 for (
size_t count = 0;
1391 count < length && !rv_error && !badalloc;
1393 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1394 if (scm_is_false(scm_string_p(item)))
1395 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1401 char* str = scm_to_utf8_stringn(item, &len);
1403 res->emplace_back(str, len);
1416 std::unique_ptr<std::vector<std::string>> up_res(res);
1417 std::unique_ptr<VectorDeleteArgs> up_args(args);
1418 if (badalloc)
throw std::bad_alloc();
1422 return std::move(*res);
1461 if (scm_is_false(scm_integer_p(scm)))
1463 SCM min = scm_from_long(std::numeric_limits<long>::min());
1464 SCM max = scm_from_long(std::numeric_limits<long>::max());
1465 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1467 return scm_to_long(scm);
1511 if (scm_is_false(scm_real_p(scm)))
1513 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1514 SCM max = scm_from_double(std::numeric_limits<double>::max());
1515 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1517 return scm_to_double(scm);
1557 if (scm_is_false(scm_string_p(scm)))
1563 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1564 return std::string(s.get(), len);
1690 template <
class Translator>
1691 auto exec(
const std::string& preamble,
1692 const std::string& file,
1693 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1697 typedef typename std::result_of<Translator(SCM)>::type Ret;
1698 return exec_impl<Ret>(preamble, file, translator,
false);
1782 template <
class Translator>
1784 const std::string& file,
1785 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1789 typedef typename std::result_of<Translator(SCM)>::type Ret;
1790 return exec_impl<Ret>(preamble, file, translator,
true);
1797 #endif // CGU_EXTENSION_H virtual const char * what() const
Definition: extension.h:586
std::vector< long > list_to_vector_long(SCM scm)
Definition: extension.h:995
GuileException(const char *msg)
Definition: extension.h:576
long integer_to_long(SCM scm)
Definition: extension.h:1459
~ReturnValueError()
Definition: extension.h:591
~GuileException()
Definition: extension.h:579
void * any_to_void(SCM scm)
Definition: extension.h:1602
const char * err_text() const
Definition: extension.h:587
auto exec(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1691
virtual const char * what() const
Definition: extension.h:597
virtual const char * what() const
Definition: extension.h:574
const char * guile_text() const
Definition: extension.h:575
WrapperError(const char *msg)
Definition: extension.h:598
This file provides classes for type erasure.
Definition: extension.h:582
A class enabling the cancellation state of a thread to be controlled.
Definition: thread.h:686
double real_to_double(SCM scm)
Definition: extension.h:1509
Definition: extension.h:570
std::string string_to_string(SCM scm)
Definition: extension.h:1555
std::vector< double > list_to_vector_double(SCM scm)
Definition: extension.h:1153
auto exec_shared(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1783
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:827
std::vector< std::string > list_to_vector_string(SCM scm)
Definition: extension.h:1311
Definition: extension.h:594
~WrapperError()
Definition: extension.h:600
void rethrow_guile_exception(SCM scm)
Definition: extension.h:913
T get() const
Definition: shared_handle.h:762
ReturnValueError(const char *msg)
Definition: extension.h:588
The callback interface class.
Definition: callback.h:522