45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
395 #include <type_traits>
412 #include <libguile.h>
415 #ifndef DOXYGEN_PARSING
418 namespace Extension {
425 enum VectorDeleteType {Long, Double, String};
427 struct VectorDeleteArgs {
428 VectorDeleteType type;
434 extern
bool init_mutex() noexcept;
442 inline SCM cgu_format_try_handler(
void* data) {
443 using Cgu::Extension::FormatArgs;
444 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
445 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
447 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
450 inline void* cgu_guile_wrapper(
void* data) {
465 inline void cgu_delete_vector(
void* data) {
466 using Cgu::Extension::VectorDeleteArgs;
467 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
468 switch (args->type) {
469 case Cgu::Extension::Long:
470 delete static_cast<std::vector<long>*
>(args->vec);
472 case Cgu::Extension::Double:
473 delete static_cast<std::vector<double>*
>(args->vec);
475 case Cgu::Extension::String:
476 delete static_cast<std::vector<std::string>*
>(args->vec);
479 g_critical(
"Incorrect argument passed to cgu_delete_vector");
483 inline void cgu_unlock_module_mutex(
void*) {
486 Cgu::Extension::get_user_module_mutex()->unlock();
490 #endif // DOXYGEN_PARSING
494 namespace Extension {
500 virtual const char*
what()
const throw() {
return (
const char*)message.get();}
501 const char*
guile_text()
const throw() {
return (
const char*)guile_message.get();}
503 message(g_strdup_printf(u8
"Cgu::Extension::GuileException: %s", msg)),
504 guile_message(g_strdup(msg)) {}
512 virtual const char*
what()
const throw() {
return (
const char*)message.get();}
513 const char*
err_text()
const throw() {
return (
const char*)err_message.get();}
515 message(g_strdup_printf(u8
"Cgu::Extension::ReturnValueError: %s", msg)),
516 err_message(g_strdup(msg)) {}
523 virtual const char*
what()
const throw() {
return (
const char*)message.get();}
525 message(g_strdup_printf(u8
"Cgu::Extension::WrapperError: %s", msg)) {}
529 #ifndef DOXYGEN_PARSING
536 template <
class Ret,
class Translator>
537 Ret exec_impl(
const std::string& preamble,
538 const std::string& file,
539 Translator&& translator,
548 loader += u8
"((lambda ()";
549 loader += u8
"(catch "
554 loader += u8
"primitive-load \"";
556 loader += u8
"load \"";
559 "(lambda (key . details)"
560 "(cons \"***cgu-guile-exception***\" (cons key details))))";
567 std::string guile_except;
568 std::string guile_ret_val_err;
591 std::unique_ptr<Cgu::Callback::Callback> cb(Cgu::Callback::lambda<>([&] () ->
void {
594 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
595 scm_c_resolve_module(
"guile-user"));
599 throw std::bad_alloc();
601 scm_dynwind_begin(scm_t_dynwind_flags(0));
602 scm_dynwind_unwind_handler(&cgu_unlock_module_mutex, 0, SCM_F_WIND_EXPLICITLY);
603 get_user_module_mutex()->lock();
604 SCM new_mod = scm_call_0(scm_c_public_ref(
"guile",
"make-fresh-user-module"));
607 scm = scm_eval_string_in_module(scm_from_utf8_string(loader.c_str()),
631 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
632 scm_dynwind_begin(scm_t_dynwind_flags(0));
633 scm_dynwind_block_asyncs();
640 bool badalloc =
false;
642 retval = translator(scm);
658 catch (GuileException& e) {
660 guile_except = e.guile_text();
666 catch (ReturnValueError& e) {
668 guile_ret_val_err = e.err_text();
674 catch (std::exception& e) {
684 gen_err = u8
"C++ exception thrown in cgu_guile_wrapper()";
690 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
693 if (badalloc)
throw std::bad_alloc();
698 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
699 throw WrapperError(u8
"cgu_guile_wrapper() has trapped std::bad_alloc");
700 if (!guile_except.empty())
701 throw GuileException(guile_except.c_str());
702 if (!guile_ret_val_err.empty())
703 throw ReturnValueError(guile_ret_val_err.c_str());
704 if (!gen_err.empty())
705 throw WrapperError(gen_err.c_str());
707 throw WrapperError(u8
"the preamble or translator threw a native guile exception");
711 #endif // DOXYGEN_PARSING
747 SCM ret = SCM_BOOL_F;
748 int length = scm_to_int(scm_length(args));
750 SCM first = scm_car(args);
751 if (scm_is_true(scm_string_p(first))) {
754 ret = scm_string_append(scm_list_4(scm_from_utf8_string(u8
"Exception "),
755 scm_symbol_to_string(key),
756 scm_from_utf8_string(u8
": "),
760 SCM second = scm_cadr(args);
761 if (scm_is_true(scm_string_p(second))) {
763 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(u8
"Exception "),
764 scm_symbol_to_string(key),
765 scm_from_utf8_string(u8
" in procedure "),
767 scm_from_utf8_string(u8
": "),
773 SCM third = scm_caddr(args);
774 if (scm_is_false(third))
776 else if (scm_is_true(scm_list_p(third))) {
777 FormatArgs format_args = {text, third};
778 ret = scm_internal_catch(SCM_BOOL_T,
779 &cgu_format_try_handler,
781 &cgu_format_catch_handler,
791 if (scm_is_false(ret)) {
794 ret = scm_simple_format(SCM_BOOL_F,
795 scm_from_utf8_string(u8
"Exception ~S: ~S"),
796 scm_list_2(key, args));
829 if (scm_is_false(scm_list_p(scm))
830 || scm_is_true(scm_null_p(scm)))
return;
831 SCM first = scm_car(scm);
832 if (scm_is_true(scm_string_p(first))) {
834 const char* text = 0;
838 scm_dynwind_begin(scm_t_dynwind_flags(0));
839 char* car = scm_to_utf8_stringn(first, &len);
849 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
850 if (len == strlen(u8
"***cgu-guile-exception***")
851 && !strncmp(car, u8
"***cgu-guile-exception***", len)) {
856 text = scm_to_utf8_stringn(str, &len);
862 std::unique_ptr<char, Cgu::CFree> up_car(car);
863 std::unique_ptr<const char, Cgu::CFree> up_text(text);
911 if (scm_is_false(scm_list_p(scm)))
917 scm_dynwind_begin(scm_t_dynwind_flags(0));
925 bool badalloc =
false;
926 const char* rv_error = 0;
927 std::vector<long>* res = 0;
928 VectorDeleteArgs* args = 0;
934 res =
new std::vector<long>;
937 args =
new VectorDeleteArgs{Long, res};
952 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
958 SCM guile_vec = scm_vector(scm);
981 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
983 res->reserve(length);
988 for (
size_t count = 0;
989 count < length && !rv_error && !badalloc;
991 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
992 if (scm_is_false(scm_integer_p(item)))
993 rv_error = u8
"scheme code did not evaluate to a homogeneous list of integer\n";
995 SCM min = scm_from_long(std::numeric_limits<long>::min());
996 SCM max = scm_from_long(std::numeric_limits<long>::max());
997 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
998 rv_error = u8
"scheme code evaluated out of range for long\n";
1001 res->push_back(scm_to_long(item));
1014 std::unique_ptr<std::vector<long>> up_res(res);
1015 std::unique_ptr<VectorDeleteArgs> up_args(args);
1016 if (badalloc)
throw std::bad_alloc();
1020 return std::move(*res);
1070 if (scm_is_false(scm_list_p(scm)))
1076 scm_dynwind_begin(scm_t_dynwind_flags(0));
1084 bool badalloc =
false;
1085 const char* rv_error = 0;
1086 std::vector<double>* res = 0;
1087 VectorDeleteArgs* args = 0;
1093 res =
new std::vector<double>;
1096 args =
new VectorDeleteArgs{Double, res};
1111 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1117 SCM guile_vec = scm_vector(scm);
1140 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1142 res->reserve(length);
1147 for (
size_t count = 0;
1148 count < length && !rv_error && !badalloc;
1150 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1151 if (scm_is_false(scm_real_p(item)))
1152 rv_error = u8
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1154 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1155 SCM max = scm_from_double(std::numeric_limits<double>::max());
1156 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1157 rv_error = u8
"scheme code evaluated out of range for double\n";
1160 res->push_back(scm_to_double(item));
1173 std::unique_ptr<std::vector<double>> up_res(res);
1174 std::unique_ptr<VectorDeleteArgs> up_args(args);
1175 if (badalloc)
throw std::bad_alloc();
1179 return std::move(*res);
1230 if (scm_is_false(scm_list_p(scm)))
1236 scm_dynwind_begin(scm_t_dynwind_flags(0));
1244 bool badalloc =
false;
1245 const char* rv_error = 0;
1246 std::vector<std::string>* res = 0;
1247 VectorDeleteArgs* args = 0;
1253 res =
new std::vector<std::string>;
1256 args =
new VectorDeleteArgs{String, res};
1271 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1277 SCM guile_vec = scm_vector(scm);
1300 size_t length = scm_to_size_t(scm_vector_length(guile_vec));
1302 res->reserve(length);
1307 for (
size_t count = 0;
1308 count < length && !rv_error && !badalloc;
1310 SCM item = scm_vector_ref(guile_vec, scm_from_size_t(count));
1311 if (scm_is_false(scm_string_p(item)))
1312 rv_error = u8
"scheme code did not evaluate to a homogeneous list of string\n";
1318 char* str = scm_to_utf8_stringn(item, &len);
1320 res->emplace_back(str, len);
1333 std::unique_ptr<std::vector<std::string>> up_res(res);
1334 std::unique_ptr<VectorDeleteArgs> up_args(args);
1335 if (badalloc)
throw std::bad_alloc();
1339 return std::move(*res);
1379 if (scm_is_false(scm_integer_p(scm)))
1381 SCM min = scm_from_long(std::numeric_limits<long>::min());
1382 SCM max = scm_from_long(std::numeric_limits<long>::max());
1383 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1385 return scm_to_long(scm);
1431 if (scm_is_false(scm_real_p(scm)))
1432 throw ReturnValueError(u8
"scheme code did not evaluate to a real number\n");
1433 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1434 SCM max = scm_from_double(std::numeric_limits<double>::max());
1435 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1436 throw ReturnValueError(u8
"scheme code evaluated out of range for double\n");
1437 return scm_to_double(scm);
1479 if (scm_is_false(scm_string_p(scm)))
1485 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1486 return std::string(s.get(), len);
1608 template <
class Translator>
1609 auto exec(
const std::string& preamble,
1610 const std::string& file,
1611 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1615 typedef typename std::result_of<Translator(SCM)>::type Ret;
1616 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
false);
1696 template <
class Translator>
1698 const std::string& file,
1699 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1703 typedef typename std::result_of<Translator(SCM)>::type Ret;
1704 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
true);
1711 #endif // CGU_EXTENSION_H