45 #ifndef CGU_EXTENSION_H
46 #define CGU_EXTENSION_H
431 #include <type_traits>
433 #include <functional>
448 #include <libguile.h>
451 #ifndef DOXYGEN_PARSING
454 namespace Extension {
461 enum VectorDeleteType {Long, Double, String};
463 struct VectorDeleteArgs {
464 VectorDeleteType type;
474 inline SCM cgu_format_try_handler(
void* data) {
475 using Cgu::Extension::FormatArgs;
476 FormatArgs* format_args =
static_cast<FormatArgs*
>(data);
477 return scm_simple_format(SCM_BOOL_F, format_args->text, format_args->rest);
479 inline SCM cgu_format_catch_handler(
void*, SCM, SCM) {
482 inline void* cgu_guile_wrapper(
void* data) {
497 inline void cgu_delete_vector(
void* data) {
498 using Cgu::Extension::VectorDeleteArgs;
499 VectorDeleteArgs* args =
static_cast<VectorDeleteArgs*
>(data);
500 switch (args->type) {
501 case Cgu::Extension::Long:
502 delete static_cast<std::vector<long>*
>(args->vec);
504 case Cgu::Extension::Double:
505 delete static_cast<std::vector<double>*
>(args->vec);
507 case Cgu::Extension::String:
508 delete static_cast<std::vector<std::string>*
>(args->vec);
511 g_critical(
"Incorrect argument passed to cgu_delete_vector");
517 #endif // DOXYGEN_PARSING
521 namespace Extension {
527 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
528 const char*
guile_text()
const throw() {
return (
const char*)guile_message.
get();}
530 message(g_strdup_printf(
"Cgu::Extension::GuileException: %s", msg)),
531 guile_message(g_strdup(msg)) {}
539 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
540 const char*
err_text()
const throw() {
return (
const char*)err_message.
get();}
542 message(g_strdup_printf(
"Cgu::Extension::ReturnValueError: %s", msg)),
543 err_message(g_strdup(msg)) {}
550 virtual const char*
what()
const throw() {
return (
const char*)message.
get();}
552 message(g_strdup_printf(
"Cgu::Extension::WrapperError: %s", msg)) {}
556 #ifndef DOXYGEN_PARSING
557 template <
class Ret,
class TransType>
558 void guile_wrapper_cb(TransType* translator,
562 std::string* guile_except,
563 std::string* guile_ret_val_err,
564 std::string* gen_err) {
565 SCM scm = scm_eval_string(scm_from_utf8_string(loader->c_str()));
585 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
586 scm_dynwind_begin(scm_t_dynwind_flags(0));
587 scm_dynwind_block_asyncs();
593 bool badalloc =
false;
595 *retval = (*translator)(scm);
625 catch (std::exception& e) {
635 *gen_err =
"C++ exception thrown in guile_wrapper_cb()";
641 #ifndef CGU_GUILE_HAS_BROKEN_LINKING
644 if (badalloc)
throw std::bad_alloc();
647 template <
class Ret,
class Translator>
648 Ret exec_impl(
const std::string& preamble,
649 const std::string& file,
650 Translator translator,
657 loader +=
"(set-current-module (make-fresh-user-module))";
661 loader +=
"((lambda ()";
667 loader +=
"primitive-load \"";
672 "(lambda (key . details)"
673 "(cons \"***cgu-guile-exception***\" (cons key details))))";
680 std::string guile_except;
681 std::string guile_ret_val_err;
704 std::unique_ptr<Cgu::Callback::Callback> cb(
705 Cgu::Callback::lambda<>(std::bind(&guile_wrapper_cb<Ret, Translator>,
717 if (scm_with_guile(&cgu_guile_wrapper, cb.get()))
718 throw WrapperError(
"cgu_guile_wrapper() has trapped std::bad_alloc");
719 if (!guile_except.empty())
720 throw GuileException(guile_except.c_str());
721 if (!guile_ret_val_err.empty())
722 throw ReturnValueError(guile_ret_val_err.c_str());
723 if (!gen_err.empty())
724 throw WrapperError(gen_err.c_str());
726 throw WrapperError(
"the preamble or translator threw a native guile exception");
730 #endif // DOXYGEN_PARSING
766 SCM ret = SCM_BOOL_F;
767 int length = scm_to_int(scm_length(args));
769 SCM first = scm_car(args);
770 if (scm_is_true(scm_string_p(first))) {
773 ret = scm_string_append(scm_list_4(scm_from_utf8_string(
"Exception "),
774 scm_symbol_to_string(key),
775 scm_from_utf8_string(
": "),
779 SCM second = scm_cadr(args);
780 if (scm_is_true(scm_string_p(second))) {
782 SCM text = scm_string_append(scm_list_n(scm_from_utf8_string(
"Exception "),
783 scm_symbol_to_string(key),
784 scm_from_utf8_string(
" in procedure "),
786 scm_from_utf8_string(
": "),
792 SCM third = scm_caddr(args);
793 if (scm_is_false(third))
795 else if (scm_is_true(scm_list_p(third))) {
796 FormatArgs format_args = {text, third};
797 ret = scm_internal_catch(SCM_BOOL_T,
798 &cgu_format_try_handler,
800 &cgu_format_catch_handler,
810 if (scm_is_false(ret)) {
813 ret = scm_simple_format(SCM_BOOL_F,
814 scm_from_utf8_string(
"Exception ~S: ~S"),
815 scm_list_2(key, args));
848 if (scm_is_false(scm_list_p(scm))
849 || scm_is_true(scm_null_p(scm)))
return;
850 SCM first = scm_car(scm);
851 if (scm_is_true(scm_string_p(first))) {
853 const char* text = 0;
857 scm_dynwind_begin(scm_t_dynwind_flags(0));
858 char* car = scm_to_utf8_stringn(first, &len);
868 scm_dynwind_unwind_handler(&free, car, scm_t_wind_flags(0));
869 if (len == strlen(
"***cgu-guile-exception***")
870 && !strncmp(car,
"***cgu-guile-exception***", len)) {
875 text = scm_to_utf8_stringn(str, &len);
881 std::unique_ptr<char, Cgu::CFree> up_car(car);
882 std::unique_ptr<const char, Cgu::CFree> up_text(text);
926 if (scm_is_false(scm_list_p(scm)))
932 scm_dynwind_begin(scm_t_dynwind_flags(0));
940 bool badalloc =
false;
941 const char* rv_error = 0;
942 std::vector<long>* res = 0;
943 VectorDeleteArgs* args = 0;
945 res =
new std::vector<long>;
954 args =
new VectorDeleteArgs{Long, res};
969 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
970 int length = scm_to_int(scm_length(scm));
972 res->reserve(length);
978 count < length && !rv_error && !badalloc;
980 SCM item = scm_list_ref(scm, scm_from_int(count));
981 if (scm_is_false(scm_integer_p(item)))
982 rv_error =
"scheme code did not evaluate to a homogeneous list of integer\n";
984 SCM min = scm_from_long(std::numeric_limits<long>::min());
985 SCM max = scm_from_long(std::numeric_limits<long>::max());
986 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
987 rv_error =
"scheme code evaluated out of range for long\n";
990 res->push_back(scm_to_long(item));
1004 std::unique_ptr<std::vector<long>> up_res(res);
1005 std::unique_ptr<VectorDeleteArgs> up_args(args);
1006 if (badalloc)
throw std::bad_alloc();
1010 return std::move(*res);
1056 if (scm_is_false(scm_list_p(scm)))
1062 scm_dynwind_begin(scm_t_dynwind_flags(0));
1070 bool badalloc =
false;
1071 const char* rv_error = 0;
1072 std::vector<double>* res = 0;
1073 VectorDeleteArgs* args = 0;
1075 res =
new std::vector<double>;
1084 args =
new VectorDeleteArgs{Double, res};
1099 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1100 int length = scm_to_int(scm_length(scm));
1102 res->reserve(length);
1108 count < length && !rv_error && !badalloc;
1110 SCM item = scm_list_ref(scm, scm_from_int(count));
1111 if (scm_is_false(scm_real_p(item)))
1112 rv_error =
"scheme code did not evaluate to a homogeneous list of real numbers\n";
1114 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1115 SCM max = scm_from_double(std::numeric_limits<double>::max());
1116 if (scm_is_false(scm_leq_p(item, max)) || scm_is_false(scm_geq_p(item, min)))
1117 rv_error =
"scheme code evaluated out of range for double\n";
1120 res->push_back(scm_to_double(item));
1134 std::unique_ptr<std::vector<double>> up_res(res);
1135 std::unique_ptr<VectorDeleteArgs> up_args(args);
1136 if (badalloc)
throw std::bad_alloc();
1140 return std::move(*res);
1186 if (scm_is_false(scm_list_p(scm)))
1192 scm_dynwind_begin(scm_t_dynwind_flags(0));
1200 bool badalloc =
false;
1201 const char* rv_error = 0;
1202 std::vector<std::string>* res = 0;
1203 VectorDeleteArgs* args = 0;
1205 res =
new std::vector<std::string>;
1214 args =
new VectorDeleteArgs{String, res};
1229 scm_dynwind_unwind_handler(&cgu_delete_vector, args, scm_t_wind_flags(0));
1230 int length = scm_to_int(scm_length(scm));
1232 res->reserve(length);
1238 count < length && !rv_error && !badalloc;
1240 SCM item = scm_list_ref(scm, scm_from_int(count));
1241 if (scm_is_false(scm_string_p(item)))
1242 rv_error =
"scheme code did not evaluate to a homogeneous list of string\n";
1248 char* str = scm_to_utf8_stringn(item, &len);
1250 res->emplace_back(str, len);
1264 std::unique_ptr<std::vector<std::string>> up_res(res);
1265 std::unique_ptr<VectorDeleteArgs> up_args(args);
1266 if (badalloc)
throw std::bad_alloc();
1270 return std::move(*res);
1309 if (scm_is_false(scm_integer_p(scm)))
1311 SCM min = scm_from_long(std::numeric_limits<long>::min());
1312 SCM max = scm_from_long(std::numeric_limits<long>::max());
1313 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1315 return scm_to_long(scm);
1359 if (scm_is_false(scm_real_p(scm)))
1361 SCM min = scm_from_double(-std::numeric_limits<double>::max());
1362 SCM max = scm_from_double(std::numeric_limits<double>::max());
1363 if (scm_is_false(scm_leq_p(scm, max)) || scm_is_false(scm_geq_p(scm, min)))
1365 return scm_to_double(scm);
1405 if (scm_is_false(scm_string_p(scm)))
1411 std::unique_ptr<const char, Cgu::CFree> s(scm_to_utf8_stringn(scm, &len));
1412 return std::string(s.get(), len);
1537 template <
class Translator>
1538 auto exec(
const std::string& preamble,
1539 const std::string& file,
1540 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1541 typedef typename std::result_of<Translator(SCM)>::type Ret;
1542 return exec_impl<Ret>(preamble, file, translator,
false);
1625 template <
class Translator>
1627 const std::string& file,
1628 Translator translator) ->
typename std::result_of<Translator(SCM)>::type {
1629 typedef typename std::result_of<Translator(SCM)>::type Ret;
1630 return exec_impl<Ret>(preamble, file, translator,
true);
1637 #endif // CGU_EXTENSION_H