45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
466 #include <type_traits>
468 #include <functional>
484 #include <libguile.h>
487 #ifndef DOXYGEN_PARSING
490 namespace Extension {
497 enum VectorDeleteType {Long, Double, String};
499 struct VectorDeleteArgs {
500 VectorDeleteType type;
506 extern bool init_mutex();
514 inline SCM cgu_format_try_handler(
void* data) {
515 using Cgu::Extension::FormatArgs;
516 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
517 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
519 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
522 inline void* cgu_guile_wrapper(
void* data) {
537 inline void cgu_delete_vector(
void* data) {
538 using Cgu::Extension::VectorDeleteArgs;
539 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
540 switch (args->type) {
541 case Cgu::Extension::Long:
542 delete static_cast<std::vector<long>*
>(args->vec);
544 case Cgu::Extension::Double:
545 delete static_cast<std::vector<double>*
>(args->vec);
547 case Cgu::Extension::String:
548 delete static_cast<std::vector<std::string>*
>(args->vec);
551 g_critical(
"Incorrect argument passed to cgu_delete_vector");
555 inline void cgu_unlock_module_mutex(
void*) {
558 Cgu::Extension::get_user_module_mutex()->unlock();
562 #endif // DOXYGEN_PARSING
566 namespace Extension {
572 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
573 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
575 message(g_strdup_printf(
"Cgu::Extension::GuileException: %s", msg)),
576 guile_message(g_strdup(msg)) {}
584 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
585 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
587 message(g_strdup_printf(
"Cgu::Extension::ReturnValueError: %s", msg)),
588 err_message(g_strdup(msg)) {}
595 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
597 message(g_strdup_printf(
"Cgu::Extension::WrapperError: %s", msg)) {}
601 #ifndef DOXYGEN_PARSING
606 template <
class Ret,
class TransType>
607 void guile_wrapper_cb2(TransType* translator,
611 std::string* guile_except,
612 std::string* guile_ret_val_err,
613 std::string* gen_err,
617 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
618 scm_c_resolve_module(
"guile-user"));
622 throw std::bad_alloc();
624 scm_dynwind_begin(scm_t_dynwind_flags(0));
625 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
626 get_user_module_mutex()->lock();
627 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
630 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
652 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
653 scm_dynwind_begin(scm_t_dynwind_flags(0));
654 scm_dynwind_block_asyncs();
660 bool badalloc =
false;
662 *retval = (*translator)(scm);
692 catch (std::exception& e) {
702 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
708 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
711 if (badalloc)
throw std::bad_alloc();
714 template <
class Ret,
class Translator>
715 Ret exec_impl(
const std::string& preamble,
716 const std::string& file,
717 Translator translator,
726 loader +=
"((lambda ()";
732 loader +=
"primitive-load \"";
737 "(lambda (key . details)"
738 "(cons \"***cgu-guile-exception***\" (cons key details))))";
745 std::string guile_except;
746 std::string guile_ret_val_err;
769 std::unique_ptr<Cgu::Callback::Callback> cb(
770 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb2<Ret, Translator>,
783 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
784 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
785 if (!guile_except.empty())
786 throw GuileException(guile_except.c_str());
787 if (!guile_ret_val_err.empty())
788 throw ReturnValueError(guile_ret_val_err.c_str());
789 if (!gen_err.empty())
790 throw WrapperError(gen_err.c_str());
792 throw WrapperError(
"the preamble or translator threw a native guile exception");
796 #endif // DOXYGEN_PARSING
832 SCM ret = SCM_BOOL_F;
833 int length = scm_to_int(scm_length(args));
835 SCM first = scm_car(args);
836 if (scm_is_true(scm_string_p(first))) {
839 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
840 scm_symbol_to_string(key),
841 scm_from_utf8_string(
": "),
845 SCM second = scm_cadr(args);
846 if (scm_is_true(scm_string_p(second))) {
848 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
849 scm_symbol_to_string(key),
850 scm_from_utf8_string(
" in procedure "),
852 scm_from_utf8_string(
": "),
858 SCM third = scm_caddr(args);
859 if (scm_is_false(third))
861 else if (scm_is_true(scm_list_p(third))) {
862 FormatArgs format_args = {text, third};
863 ret = scm_internal_catch(SCM_BOOL_T,
864 &cgu_format_try_handler,
866 &cgu_format_catch_handler,
876 if (scm_is_false(ret)) {
879 ret = scm_simple_format(SCM_BOOL_F,
880 scm_from_utf8_string(
"Exception ~S: ~S"),
881 scm_list_2(key, args));
914 if (scm_is_false(scm_list_p(scm))
915 || scm_is_true(scm_null_p(scm)))
return;
916 SCM first = scm_car(scm);
917 if (scm_is_true(scm_string_p(first))) {
919 const char* text = 0;
923 scm_dynwind_begin(scm_t_dynwind_flags(0));
924 char* car = scm_to_utf8_stringn(first, &len);
934 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
935 if (len == strlen(
"***cgu-guile-exception***")
936 && !strncmp(car,
"***cgu-guile-exception***", len)) {
941 text = scm_to_utf8_stringn(str, &len);
947 std::unique_ptr<char, Cgu::CFree> up_car(car);
948 std::unique_ptr<const char, Cgu::CFree> up_text(text);
995 if (scm_is_false(scm_list_p(scm)))
1001 scm_dynwind_begin(scm_t_dynwind_flags(0));
1009 bool badalloc =
false;
1010 const char* rv_error = 0;
1011 std::vector<long>* res = 0;
1012 VectorDeleteArgs* args = 0;
1018 res =
new std::vector<long>;
1021 args =
new VectorDeleteArgs{Long, res};
1036 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1042 SCM guile_vec = scm_vector(scm);
1065 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1067 res->reserve(length);
1072 for (
size_t count = 0;
1073 count < length && !rv_error && !badalloc;
1075 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1076 if (scm_is_false(scm_integer_p(item)))
1077 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
1079 SCM min = scm_from_long(std::numeric_limits<long>::min());
1080 SCM max = scm_from_long(std::numeric_limits<long>::max());
1081 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1082 rv_error =
"scheme code evaluated out of range for long\n";
1085 res->push_back(scm_to_long(item));
1098 std::unique_ptr<std::vector<long>> up_res(res);
1099 std::unique_ptr<VectorDeleteArgs> up_args(args);
1100 if (badalloc)
throw std::bad_alloc();
1104 return std::move(*res);
1153 if (scm_is_false(scm_list_p(scm)))
1159 scm_dynwind_begin(scm_t_dynwind_flags(0));
1167 bool badalloc =
false;
1168 const char* rv_error = 0;
1169 std::vector<double>* res = 0;
1170 VectorDeleteArgs* args = 0;
1176 res =
new std::vector<double>;
1179 args =
new VectorDeleteArgs{Double, res};
1194 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1200 SCM guile_vec = scm_vector(scm);
1223 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1225 res->reserve(length);
1230 for (
size_t count = 0;
1231 count < length && !rv_error && !badalloc;
1233 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1234 if (scm_is_false(scm_real_p(item)))
1235 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1237 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1238 SCM max = scm_from_double(std::numeric_limits<double>::max());
1239 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1240 rv_error =
"scheme code evaluated out of range for double\n";
1243 res->push_back(scm_to_double(item));
1256 std::unique_ptr<std::vector<double>> up_res(res);
1257 std::unique_ptr<VectorDeleteArgs> up_args(args);
1258 if (badalloc)
throw std::bad_alloc();
1262 return std::move(*res);
1311 if (scm_is_false(scm_list_p(scm)))
1317 scm_dynwind_begin(scm_t_dynwind_flags(0));
1325 bool badalloc =
false;
1326 const char* rv_error = 0;
1327 std::vector<std::string>* res = 0;
1328 VectorDeleteArgs* args = 0;
1334 res =
new std::vector<std::string>;
1337 args =
new VectorDeleteArgs{String, res};
1352 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1358 SCM guile_vec = scm_vector(scm);
1381 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1383 res->reserve(length);
1388 for (
size_t count = 0;
1389 count < length && !rv_error && !badalloc;
1391 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1392 if (scm_is_false(scm_string_p(item)))
1393 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1399 char* str = scm_to_utf8_stringn(item, &len);
1401 res->emplace_back(str, len);
1414 std::unique_ptr<std::vector<std::string>> up_res(res);
1415 std::unique_ptr<VectorDeleteArgs> up_args(args);
1416 if (badalloc)
throw std::bad_alloc();
1420 return std::move(*res);
1459 if (scm_is_false(scm_integer_p(scm)))
1461 SCM min = scm_from_long(std::numeric_limits<long>::min());
1462 SCM max = scm_from_long(std::numeric_limits<long>::max());
1463 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1465 return scm_to_long(scm);
1509 if (scm_is_false(scm_real_p(scm)))
1511 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1512 SCM max = scm_from_double(std::numeric_limits<double>::max());
1513 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1515 return scm_to_double(scm);
1555 if (scm_is_false(scm_string_p(scm)))
1561 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1562 return std::string(s.get(), len);
1688 template <
class Translator>
1689 auto exec(
const std::string& preamble,
1690 const std::string& file,
1691 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1695 typedef typename std::result_of<Translator(SCM)>::type Ret;
1696 return exec_impl<Ret>(preamble, file, translator,
false);
1780 template <
class Translator>
1782 const std::string& file,
1783 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1787 typedef typename std::result_of<Translator(SCM)>::type Ret;
1788 return exec_impl<Ret>(preamble, file, translator,
true);
1795 #endif // CGU_EXTENSION_H
std::vector< long > list_to_vector_long(SCM scm)
Definition: extension.h:993
GuileException(const char *msg)
Definition: extension.h:574
long integer_to_long(SCM scm)
Definition: extension.h:1457
~ReturnValueError()
Definition: extension.h:589
~GuileException()
Definition: extension.h:577
const char * err_text() const
Definition: extension.h:585
void * any_to_void(SCM scm)
Definition: extension.h:1600
auto exec(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1689
WrapperError(const char *msg)
Definition: extension.h:596
This file provides classes for type erasure.
Definition: extension.h:580
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:1507
Definition: extension.h:568
std::string string_to_string(SCM scm)
Definition: extension.h:1553
std::vector< double > list_to_vector_double(SCM scm)
Definition: extension.h:1151
auto exec_shared(const std::string &preamble, const std::string &file, Translator translator) -> typename std::result_of< Translator(SCM)>::type
Definition: extension.h:1781
virtual const char * what() const
Definition: extension.h:595
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:825
std::vector< std::string > list_to_vector_string(SCM scm)
Definition: extension.h:1309
Definition: extension.h:592
virtual const char * what() const
Definition: extension.h:584
~WrapperError()
Definition: extension.h:598
virtual const char * what() const
Definition: extension.h:572
void rethrow_guile_exception(SCM scm)
Definition: extension.h:911
ReturnValueError(const char *msg)
Definition: extension.h:586
The callback interface class.
Definition: callback.h:522
const char * guile_text() const
Definition: extension.h:573