45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
431 #include <type_traits>
433 #include <functional>
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();
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(
"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(
"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(
"Cgu::Extension::WrapperError: %s", msg)) {}
566 #ifndef DOXYGEN_PARSING
571 template <
class Ret,
class TransType>
572 void guile_wrapper_cb2(TransType* translator,
576 std::string* guile_except,
577 std::string* guile_ret_val_err,
578 std::string* gen_err,
582 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
583 scm_c_resolve_module(
"guile-user"));
587 throw std::bad_alloc();
589 scm_dynwind_begin(scm_t_dynwind_flags(0));
590 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
591 get_user_module_mutex()->lock();
592 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
595 scm = scm_eval_string_in_module(scm_from_utf8_string(loader->c_str()),
617 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
618 scm_dynwind_begin(scm_t_dynwind_flags(0));
619 scm_dynwind_block_asyncs();
625 bool badalloc =
false;
627 *retval = (*translator)(scm);
657 catch (std::exception& e) {
667 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
673 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
676 if (badalloc)
throw std::bad_alloc();
679 template <
class Ret,
class Translator>
680 Ret exec_impl(
const std::string& preamble,
681 const std::string& file,
682 Translator translator,
691 loader +=
"((lambda ()";
697 loader +=
"primitive-load \"";
702 "(lambda (key . details)"
703 "(cons \"***cgu-guile-exception***\" (cons key details))))";
710 std::string guile_except;
711 std::string guile_ret_val_err;
734 std::unique_ptr<Cgu::Callback::Callback> cb(
735 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb2<Ret, Translator>,
748 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
749 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
750 if (!guile_except.empty())
751 throw GuileException(guile_except.c_str());
752 if (!guile_ret_val_err.empty())
753 throw ReturnValueError(guile_ret_val_err.c_str());
754 if (!gen_err.empty())
755 throw WrapperError(gen_err.c_str());
757 throw WrapperError(
"the preamble or translator threw a native guile exception");
761 #endif // DOXYGEN_PARSING
797 SCM ret = SCM_BOOL_F;
798 int length = scm_to_int(scm_length(args));
800 SCM first = scm_car(args);
801 if (scm_is_true(scm_string_p(first))) {
804 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
805 scm_symbol_to_string(key),
806 scm_from_utf8_string(
": "),
810 SCM second = scm_cadr(args);
811 if (scm_is_true(scm_string_p(second))) {
813 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
814 scm_symbol_to_string(key),
815 scm_from_utf8_string(
" in procedure "),
817 scm_from_utf8_string(
": "),
823 SCM third = scm_caddr(args);
824 if (scm_is_false(third))
826 else if (scm_is_true(scm_list_p(third))) {
827 FormatArgs format_args = {text, third};
828 ret = scm_internal_catch(SCM_BOOL_T,
829 &cgu_format_try_handler,
831 &cgu_format_catch_handler,
841 if (scm_is_false(ret)) {
844 ret = scm_simple_format(SCM_BOOL_F,
845 scm_from_utf8_string(
"Exception ~S: ~S"),
846 scm_list_2(key, args));
879 if (scm_is_false(scm_list_p(scm))
880 || scm_is_true(scm_null_p(scm)))
return;
881 SCM first = scm_car(scm);
882 if (scm_is_true(scm_string_p(first))) {
884 const char* text = 0;
888 scm_dynwind_begin(scm_t_dynwind_flags(0));
889 char* car = scm_to_utf8_stringn(first, &len);
899 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
900 if (len == strlen(
"***cgu-guile-exception***")
901 && !strncmp(car,
"***cgu-guile-exception***", len)) {
906 text = scm_to_utf8_stringn(str, &len);
912 std::unique_ptr<char, Cgu::CFree> up_car(car);
913 std::unique_ptr<const char, Cgu::CFree> up_text(text);
960 if (scm_is_false(scm_list_p(scm)))
966 scm_dynwind_begin(scm_t_dynwind_flags(0));
974 bool badalloc =
false;
975 const char* rv_error = 0;
976 std::vector<long>* res = 0;
977 VectorDeleteArgs* args = 0;
983 res =
new std::vector<long>;
986 args =
new VectorDeleteArgs{Long, res};
1001 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1007 SCM guile_vec = scm_vector(scm);
1030 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1032 res->reserve(length);
1037 for (
size_t count = 0;
1038 count < length && !rv_error && !badalloc;
1040 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1041 if (scm_is_false(scm_integer_p(item)))
1042 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
1044 SCM min = scm_from_long(std::numeric_limits<long>::min());
1045 SCM max = scm_from_long(std::numeric_limits<long>::max());
1046 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1047 rv_error =
"scheme code evaluated out of range for long\n";
1050 res->push_back(scm_to_long(item));
1063 std::unique_ptr<std::vector<long>> up_res(res);
1064 std::unique_ptr<VectorDeleteArgs> up_args(args);
1065 if (badalloc)
throw std::bad_alloc();
1069 return std::move(*res);
1118 if (scm_is_false(scm_list_p(scm)))
1124 scm_dynwind_begin(scm_t_dynwind_flags(0));
1132 bool badalloc =
false;
1133 const char* rv_error = 0;
1134 std::vector<double>* res = 0;
1135 VectorDeleteArgs* args = 0;
1141 res =
new std::vector<double>;
1144 args =
new VectorDeleteArgs{Double, res};
1159 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1165 SCM guile_vec = scm_vector(scm);
1188 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1190 res->reserve(length);
1195 for (
size_t count = 0;
1196 count < length && !rv_error && !badalloc;
1198 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1199 if (scm_is_false(scm_real_p(item)))
1200 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1202 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1203 SCM max = scm_from_double(std::numeric_limits<double>::max());
1204 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1205 rv_error =
"scheme code evaluated out of range for double\n";
1208 res->push_back(scm_to_double(item));
1221 std::unique_ptr<std::vector<double>> up_res(res);
1222 std::unique_ptr<VectorDeleteArgs> up_args(args);
1223 if (badalloc)
throw std::bad_alloc();
1227 return std::move(*res);
1276 if (scm_is_false(scm_list_p(scm)))
1282 scm_dynwind_begin(scm_t_dynwind_flags(0));
1290 bool badalloc =
false;
1291 const char* rv_error = 0;
1292 std::vector<std::string>* res = 0;
1293 VectorDeleteArgs* args = 0;
1299 res =
new std::vector<std::string>;
1302 args =
new VectorDeleteArgs{String, res};
1317 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1323 SCM guile_vec = scm_vector(scm);
1346 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1348 res->reserve(length);
1353 for (
size_t count = 0;
1354 count < length && !rv_error && !badalloc;
1356 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1357 if (scm_is_false(scm_string_p(item)))
1358 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1364 char* str = scm_to_utf8_stringn(item, &len);
1366 res->emplace_back(str, len);
1379 std::unique_ptr<std::vector<std::string>> up_res(res);
1380 std::unique_ptr<VectorDeleteArgs> up_args(args);
1381 if (badalloc)
throw std::bad_alloc();
1385 return std::move(*res);
1424 if (scm_is_false(scm_integer_p(scm)))
1426 SCM min = scm_from_long(std::numeric_limits<long>::min());
1427 SCM max = scm_from_long(std::numeric_limits<long>::max());
1428 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1430 return scm_to_long(scm);
1474 if (scm_is_false(scm_real_p(scm)))
1476 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1477 SCM max = scm_from_double(std::numeric_limits<double>::max());
1478 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1480 return scm_to_double(scm);
1520 if (scm_is_false(scm_string_p(scm)))
1526 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1527 return std::string(s.get(), len);
1653 template <
class Translator>
1654 auto exec(
const std::string& preamble,
1655 const std::string& file,
1656 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1660 typedef typename std::result_of<Translator(SCM)>::type Ret;
1661 return exec_impl<Ret>(preamble, file, translator,
false);
1745 template <
class Translator>
1747 const std::string& file,
1748 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1752 typedef typename std::result_of<Translator(SCM)>::type Ret;
1753 return exec_impl<Ret>(preamble, file, translator,
true);
1760 #endif // CGU_EXTENSION_H