45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
395 #include <type_traits>
411 #include <libguile.h>
414 #ifndef DOXYGEN_PARSING
417 namespace Extension {
424 enum VectorDeleteType {Long, Double, String};
426 struct VectorDeleteArgs {
427 VectorDeleteType type;
437 inline SCM cgu_format_try_handler(
void* data) {
438 using Cgu::Extension::FormatArgs;
439 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
440 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
442 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
445 inline void* cgu_guile_wrapper(
void* data) {
460 inline void cgu_delete_vector(
void* data) {
461 using Cgu::Extension::VectorDeleteArgs;
462 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
463 switch (args->type) {
464 case Cgu::Extension::Long:
465 delete static_cast<std::vector<long>*
>(args->vec);
467 case Cgu::Extension::Double:
468 delete static_cast<std::vector<double>*
>(args->vec);
470 case Cgu::Extension::String:
471 delete static_cast<std::vector<std::string>*
>(args->vec);
474 g_critical(
"Incorrect argument passed to cgu_delete_vector");
480 #endif // DOXYGEN_PARSING
484 namespace Extension {
490 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
491 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
493 message(g_strdup_printf(u8
"Cgu::Extension::GuileException: %s", msg)),
494 guile_message(g_strdup(msg)) {}
502 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
503 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
505 message(g_strdup_printf(u8
"Cgu::Extension::ReturnValueError: %s", msg)),
506 err_message(g_strdup(msg)) {}
513 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
515 message(g_strdup_printf(u8
"Cgu::Extension::WrapperError: %s", msg)) {}
519 #ifndef DOXYGEN_PARSING
526 template <
class Ret,
class Translator>
527 Ret exec_impl(
const std::string& preamble,
528 const std::string& file,
529 Translator&& translator,
536 loader += u8
"(set-current-module (make-fresh-user-module))";
540 loader += u8
"((lambda ()";
541 loader += u8
"(catch "
546 loader += u8
"primitive-load \"";
548 loader += u8
"load \"";
551 "(lambda (key . details)"
552 "(cons \"***cgu-guile-exception***\" (cons key details))))";
559 std::string guile_except;
560 std::string guile_ret_val_err;
583 std::unique_ptr<Cgu::Callback::Callback> cb(Cgu::Callback::lambda<>([&] () ->
void {
584 SCM scm = scm_eval_string(scm_from_utf8_string(loader.c_str()));
606 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
607 scm_dynwind_begin(scm_t_dynwind_flags(0));
608 scm_dynwind_block_asyncs();
615 bool badalloc =
false;
617 retval = translator(scm);
633 catch (GuileException& e) {
635 guile_except = e.guile_text();
641 catch (ReturnValueError& e) {
643 guile_ret_val_err = e.err_text();
649 catch (std::exception& e) {
659 gen_err = u8
"C++ exception thrown in cgu_guile_wrapper()";
665 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
668 if (badalloc)
throw std::bad_alloc();
673 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
674 throw WrapperError(u8
"cgu_guile_wrapper() has trapped std::bad_alloc");
675 if (!guile_except.empty())
676 throw GuileException(guile_except.c_str());
677 if (!guile_ret_val_err.empty())
678 throw ReturnValueError(guile_ret_val_err.c_str());
679 if (!gen_err.empty())
680 throw WrapperError(gen_err.c_str());
682 throw WrapperError(u8
"the preamble or translator threw a native guile exception");
686 #endif // DOXYGEN_PARSING
722 SCM ret = SCM_BOOL_F;
723 int length = scm_to_int(scm_length(args));
725 SCM first = scm_car(args);
726 if (scm_is_true(scm_string_p(first))) {
729 ret = scm_string_append(scm_list_4(scm_from_utf8_string(u8
"Exception "),
730 scm_symbol_to_string(key),
731 scm_from_utf8_string(u8
": "),
735 SCM second = scm_cadr(args);
736 if (scm_is_true(scm_string_p(second))) {
738 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(u8
"Exception "),
739 scm_symbol_to_string(key),
740 scm_from_utf8_string(u8
" in procedure "),
742 scm_from_utf8_string(u8
": "),
748 SCM third = scm_caddr(args);
749 if (scm_is_false(third))
751 else if (scm_is_true(scm_list_p(third))) {
752 FormatArgs format_args = {text, third};
753 ret = scm_internal_catch(SCM_BOOL_T,
754 &cgu_format_try_handler,
756 &cgu_format_catch_handler,
766 if (scm_is_false(ret)) {
769 ret = scm_simple_format(SCM_BOOL_F,
770 scm_from_utf8_string(u8
"Exception ~S: ~S"),
771 scm_list_2(key, args));
804 if (scm_is_false(scm_list_p(scm))
805 || scm_is_true(scm_null_p(scm)))
return;
806 SCM first = scm_car(scm);
807 if (scm_is_true(scm_string_p(first))) {
809 const char* text = 0;
813 scm_dynwind_begin(scm_t_dynwind_flags(0));
814 char* car = scm_to_utf8_stringn(first, &len);
824 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
825 if (len == strlen(u8
"***cgu-guile-exception***")
826 && !strncmp(car, u8
"***cgu-guile-exception***", len)) {
831 text = scm_to_utf8_stringn(str, &len);
837 std::unique_ptr<char, Cgu::CFree> up_car(car);
838 std::unique_ptr<const char, Cgu::CFree> up_text(text);
883 if (scm_is_false(scm_list_p(scm)))
889 scm_dynwind_begin(scm_t_dynwind_flags(0));
897 bool badalloc =
false;
898 const char* rv_error = 0;
899 std::vector<long>* res = 0;
900 VectorDeleteArgs* args = 0;
902 res =
new std::vector<long>;
911 args =
new VectorDeleteArgs{Long, res};
926 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
927 int length = scm_to_int(scm_length(scm));
929 res->reserve(length);
935 count < length && !rv_error && !badalloc;
937 SCM item = scm_list_ref(scm, scm_from_int(count));
938 if (scm_is_false(scm_integer_p(item)))
939 rv_error = u8
"scheme code did not evaluate to a homogeneous list of integer\n";
941 SCM min = scm_from_long(std::numeric_limits<long>::min());
942 SCM max = scm_from_long(std::numeric_limits<long>::max());
943 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
944 rv_error = u8
"scheme code evaluated out of range for long\n";
947 res->push_back(scm_to_long(item));
961 std::unique_ptr<std::vector<long>> up_res(res);
962 std::unique_ptr<VectorDeleteArgs> up_args(args);
963 if (badalloc)
throw std::bad_alloc();
967 return std::move(*res);
1014 if (scm_is_false(scm_list_p(scm)))
1020 scm_dynwind_begin(scm_t_dynwind_flags(0));
1028 bool badalloc =
false;
1029 const char* rv_error = 0;
1030 std::vector<double>* res = 0;
1031 VectorDeleteArgs* args = 0;
1033 res =
new std::vector<double>;
1042 args =
new VectorDeleteArgs{Double, res};
1057 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1058 int length = scm_to_int(scm_length(scm));
1060 res->reserve(length);
1066 count < length && !rv_error && !badalloc;
1068 SCM item = scm_list_ref(scm, scm_from_int(count));
1069 if (scm_is_false(scm_real_p(item)))
1070 rv_error = u8
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1072 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1073 SCM max = scm_from_double(std::numeric_limits<double>::max());
1074 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1075 rv_error = u8
"scheme code evaluated out of range for double\n";
1078 res->push_back(scm_to_double(item));
1092 std::unique_ptr<std::vector<double>> up_res(res);
1093 std::unique_ptr<VectorDeleteArgs> up_args(args);
1094 if (badalloc)
throw std::bad_alloc();
1098 return std::move(*res);
1146 if (scm_is_false(scm_list_p(scm)))
1152 scm_dynwind_begin(scm_t_dynwind_flags(0));
1160 bool badalloc =
false;
1161 const char* rv_error = 0;
1162 std::vector<std::string>* res = 0;
1163 VectorDeleteArgs* args = 0;
1165 res =
new std::vector<std::string>;
1174 args =
new VectorDeleteArgs{String, res};
1189 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1190 int length = scm_to_int(scm_length(scm));
1192 res->reserve(length);
1198 count < length && !rv_error && !badalloc;
1200 SCM item = scm_list_ref(scm, scm_from_int(count));
1201 if (scm_is_false(scm_string_p(item)))
1202 rv_error = u8
"scheme code did not evaluate to a homogeneous list of string\n";
1208 char* str = scm_to_utf8_stringn(item, &len);
1210 res->emplace_back(str, len);
1224 std::unique_ptr<std::vector<std::string>> up_res(res);
1225 std::unique_ptr<VectorDeleteArgs> up_args(args);
1226 if (badalloc)
throw std::bad_alloc();
1230 return std::move(*res);
1270 if (scm_is_false(scm_integer_p(scm)))
1272 SCM min = scm_from_long(std::numeric_limits<long>::min());
1273 SCM max = scm_from_long(std::numeric_limits<long>::max());
1274 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1276 return scm_to_long(scm);
1322 if (scm_is_false(scm_real_p(scm)))
1323 throw ReturnValueError(u8
"scheme code did not evaluate to a real number\n");
1324 SCM min = scm_from_double(std::numeric_limits<double>::lowest());
1325 SCM max = scm_from_double(std::numeric_limits<double>::max());
1326 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1327 throw ReturnValueError(u8
"scheme code evaluated out of range for double\n");
1328 return scm_to_double(scm);
1370 if (scm_is_false(scm_string_p(scm)))
1376 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1377 return std::string(s.get(), len);
1498 template <
class Translator>
1499 auto exec(
const std::string& preamble,
1500 const std::string& file,
1501 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1502 typedef typename std::result_of<Translator(SCM)>::type Ret;
1503 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
false);
1582 template <
class Translator>
1584 const std::string& file,
1585 Translator&& translator) ->
typename std::result_of<Translator(SCM)>::type {
1586 typedef typename std::result_of<Translator(SCM)>::type Ret;
1587 return exec_impl<Ret>(preamble, file, std::forward<Translator>(translator),
true);
1594 #endif // CGU_EXTENSION_H