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();
636 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
637 #if SCM_MAJOR_VERSION >= 3
638 scm_call_2(scm_c_public_ref(
"guile",
"set-module-declarative?!"),
639 new_mod, SCM_BOOL_F);
643 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
665 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
666 scm_dynwind_begin(scm_t_dynwind_flags(0));
667 scm_dynwind_block_asyncs();
673 bool badalloc =
false;
675 *retval = (*translator)(scm);
705 catch (std::exception& e) {
715 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
721 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
724 if (badalloc)
throw std::bad_alloc();
727 template <
class Ret,
class Translator>
728 Ret exec_impl(
const std::string& preamble,
729 const std::string& file,
730 Translator translator,
739 loader +=
"((lambda ()";
745 loader +=
"primitive-load \"";
750 "(lambda (key . details)"
751 "(cons \"***cgu-guile-exception***\" (cons key details))))";
758 std::string guile_except;
759 std::string guile_ret_val_err;
782 std::unique_ptr<Cgu::Callback::Callback> cb(
783 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb2<Ret, Translator>,
796 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
797 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
798 if (!guile_except.empty())
799 throw GuileException(guile_except.c_str());
800 if (!guile_ret_val_err.empty())
801 throw ReturnValueError(guile_ret_val_err.c_str());
802 if (!gen_err.empty())
803 throw WrapperError(gen_err.c_str());
805 throw WrapperError(
"the preamble or translator threw a native guile exception");
809 #endif // DOXYGEN_PARSING
845 SCM ret = SCM_BOOL_F;
846 int length = scm_to_int(scm_length(args));
848 SCM first = scm_car(args);
849 if (scm_is_true(scm_string_p(first))) {
852 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
853 scm_symbol_to_string(key),
854 scm_from_utf8_string(
": "),
858 SCM second = scm_cadr(args);
859 if (scm_is_true(scm_string_p(second))) {
861 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
862 scm_symbol_to_string(key),
863 scm_from_utf8_string(
" in procedure "),
865 scm_from_utf8_string(
": "),
871 SCM third = scm_caddr(args);
872 if (scm_is_false(third))
874 else if (scm_is_true(scm_list_p(third))) {
875 FormatArgs format_args = {text, third};
876 ret = scm_internal_catch(SCM_BOOL_T,
877 &cgu_format_try_handler,
879 &cgu_format_catch_handler,
889 if (scm_is_false(ret)) {
892 ret = scm_simple_format(SCM_BOOL_F,
893 scm_from_utf8_string(
"Exception ~S: ~S"),
894 scm_list_2(key, args));
927 if (scm_is_false(scm_list_p(scm))
928 || scm_is_true(scm_null_p(scm)))
return;
929 SCM first = scm_car(scm);
930 if (scm_is_true(scm_string_p(first))) {
932 const char* text = 0;
936 scm_dynwind_begin(scm_t_dynwind_flags(0));
937 char* car = scm_to_utf8_stringn(first, &len);
947 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
948 if (len == strlen(
"***cgu-guile-exception***")
949 && !strncmp(car,
"***cgu-guile-exception***", len)) {
954 text = scm_to_utf8_stringn(str, &len);
960 std::unique_ptr<char, Cgu::CFree> up_car(car);
961 std::unique_ptr<const char, Cgu::CFree> up_text(text);
1008 if (scm_is_false(scm_list_p(scm)))
1014 scm_dynwind_begin(scm_t_dynwind_flags(0));
1022 bool badalloc =
false;
1023 const char* rv_error = 0;
1024 std::vector<long>* res = 0;
1025 VectorDeleteArgs* args = 0;
1031 res =
new std::vector<long>;
1034 args =
new VectorDeleteArgs{Long, res};
1049 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1055 SCM guile_vec = scm_vector(scm);
1078 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1080 res->reserve(length);
1085 for (
size_t count = 0;
1086 count < length && !rv_error && !badalloc;
1088 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1089 if (scm_is_false(scm_integer_p(item)))
1090 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
1092 SCM min = scm_from_long(std::numeric_limits<long>::min());
1093 SCM max = scm_from_long(std::numeric_limits<long>::max());
1094 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1095 rv_error =
"scheme code evaluated out of range for long\n";
1098 res->push_back(scm_to_long(item));
1111 std::unique_ptr<std::vector<long>> up_res(res);
1112 std::unique_ptr<VectorDeleteArgs> up_args(args);
1113 if (badalloc)
throw std::bad_alloc();
1117 return std::move(*res);
1166 if (scm_is_false(scm_list_p(scm)))
1172 scm_dynwind_begin(scm_t_dynwind_flags(0));
1180 bool badalloc =
false;
1181 const char* rv_error = 0;
1182 std::vector<double>* res = 0;
1183 VectorDeleteArgs* args = 0;
1189 res =
new std::vector<double>;
1192 args =
new VectorDeleteArgs{Double, res};
1207 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1213 SCM guile_vec = scm_vector(scm);
1236 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1238 res->reserve(length);
1243 for (
size_t count = 0;
1244 count < length && !rv_error && !badalloc;
1246 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1247 if (scm_is_false(scm_real_p(item)))
1248 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1250 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1251 SCM max = scm_from_double(std::numeric_limits<double>::max());
1252 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1253 rv_error =
"scheme code evaluated out of range for double\n";
1256 res->push_back(scm_to_double(item));
1269 std::unique_ptr<std::vector<double>> up_res(res);
1270 std::unique_ptr<VectorDeleteArgs> up_args(args);
1271 if (badalloc)
throw std::bad_alloc();
1275 return std::move(*res);
1324 if (scm_is_false(scm_list_p(scm)))
1330 scm_dynwind_begin(scm_t_dynwind_flags(0));
1338 bool badalloc =
false;
1339 const char* rv_error = 0;
1340 std::vector<std::string>* res = 0;
1341 VectorDeleteArgs* args = 0;
1347 res =
new std::vector<std::string>;
1350 args =
new VectorDeleteArgs{String, res};
1365 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1371 SCM guile_vec = scm_vector(scm);
1394 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1396 res->reserve(length);
1401 for (
size_t count = 0;
1402 count < length && !rv_error && !badalloc;
1404 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1405 if (scm_is_false(scm_string_p(item)))
1406 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1412 char* str = scm_to_utf8_stringn(item, &len);
1414 res->emplace_back(str, len);
1427 std::unique_ptr<std::vector<std::string>> up_res(res);
1428 std::unique_ptr<VectorDeleteArgs> up_args(args);
1429 if (badalloc)
throw std::bad_alloc();
1433 return std::move(*res);
1472 if (scm_is_false(scm_integer_p(scm)))
1474 SCM min = scm_from_long(std::numeric_limits<long>::min());
1475 SCM max = scm_from_long(std::numeric_limits<long>::max());
1476 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1478 return scm_to_long(scm);
1522 if (scm_is_false(scm_real_p(scm)))
1524 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1525 SCM max = scm_from_double(std::numeric_limits<double>::max());
1526 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1528 return scm_to_double(scm);
1568 if (scm_is_false(scm_string_p(scm)))
1574 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1575 return std::string(s.get(), len);
1701 template <
class Translator>
1702 auto exec(
const std::string& preamble,
1703 const std::string& file,
1704 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1708 typedef typename std::result_of<Translator(SCM)>::type Ret;
1709 return exec_impl<Ret>(preamble, file, translator,
false);
1793 template <
class Translator>
1795 const std::string& file,
1796 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1800 typedef typename std::result_of<Translator(SCM)>::type Ret;
1801 return exec_impl<Ret>(preamble, file, translator,
true);
1808 #endif // CGU_EXTENSION_H