/**
* 畳み込みを計算する(foldr式)
* @param[in] mode モード(FOLD_ADD: 和，FOLD_SUB: 差, FOLD_MULTI: 積, FOLD_DIV: 商)
* @param[in] init 初期値
* @param[in] ary 入力配列
* @param[in] from 開始インデックス
* @param[in] to 終了インデックス
* @return resultの要素数
*/
double foldr(int mode, double init, const double *ary, int from, int to)
{
if ( from <= to ) {
switch ( mode ) {
case FOLD_ADD:
return ary[from] + foldr(mode, init, ary, from + 1, to);
break;
case FOLD_SUB:
return ary[from] - foldr(mode, init, ary, from + 1, to);
break;
case FOLD_MULT:
return ary[from] * foldr(mode, init, ary, from + 1, to);
break;
case FOLD_DIV:
return ary[from] / foldr(mode, init, ary, from + 1, to);
break;
default:
return 0;
break;
}
} else {
return init;
}
}
static constexpr decltype(auto) apply(N&& n, S&& s, F f) {
return f(
std::forward<N>(n).value,
foldr(std::forward<N>(n).subforest, std::forward<S>(s),
[=](auto&& subtree, auto&& state) -> decltype(auto) {
return foldr(
std::forward<decltype(subtree)>(subtree),
std::forward<decltype(state)>(state),
f
);
}
)
);
}
U foldr_dest(std::function< U (U, T)>& op, const U& val, std::forward_list<T>& L)
{
if (L.empty()) return U(val);
T h = L.front();
L.pop_front();
return op (foldr(op, val, L), h);
}
/* Returns a new list that passes the predicate p */
List list_filter(bool (*p)(void *data), List list) {
/* Nested functions are not ISO C */
__extension__
void *f(void *data, void *res) {
return p(data) ? list_push(res, data) : res;
};
return foldr(f, NULL, list);
}
namespace boost { namespace hana { namespace test {
template <typename T>
auto laws<Foldable, T> = [] {
static_assert(models<Foldable(T)>{}, "");
auto f = injection([]{});
auto s = injection([]{})();
for_each(objects<T>, [=](auto xs) {
BOOST_HANA_CHECK(equal(
foldl(xs, s, f),
foldl(to<Tuple>(xs), s, f)
));
BOOST_HANA_CHECK(equal(
foldr(xs, s, f),
foldr(to<Tuple>(xs), s, f)
));
});
};
}}} // end namespace boost::hana::test
int main(){
list L = cons(1,cons(5,cons(3,cons(8,nil))));
write("Erlang: foldl (xmy, 0, L) = (8-(3-(5-(1-0)))) = ");
writeln(foldl(xmy, 0, L));
write("Haskell: foldlH(xmy, 0, L) = ((((0-1)-5)-3)-8) = ");
writeln(foldlH(xmy, 0, L));
write("Erlang: foldl (ymx, 0, L) = ((((0-1)-5)-3)-8) = ");
writeln(foldl(ymx, 0, L));
write("Haskell: foldlH(ymx, 0, L) = (8-(3-(5-(1-0)))) = ");
writeln(foldlH(ymx, 0, L));
write(" foldr (xmy, 0, L) = (1-(5-(3-(8-0)))) = ");
writeln(foldr(xmy, 0, L));
}
bool SPOTFileDownload::downloadResources(const std::string & resFolder)
{
std::cout << "\nDownloading resources to SPOT." << resFolder << std::endl<< std::endl;
Poco::File foldr(resFolder);
if(!foldr.exists() || !foldr.isDirectory())
{
std::cout << "SPOTFileDownload - not a valid "<< CResourcesFoldername << " folder. "<< resFolder << std::endl;
return true;
}
Poco::DirectoryIterator end;
for (Poco::DirectoryIterator it(resFolder); it != end; ++it)
{
if(it->isDirectory())
{
if(!downloadResources(it->path()))
{
return false;
}
}
else
{
unsigned char resType;
if(getResTypeId(resFolder, resType) )
{
std::cout << "SPOTFileDownload - ready to install " << it->path() << std::endl << std::endl;
if(!this->downloadResourceFile(it->path(),resType))
{
std::cout << "resource download fail" << std::endl<< std::endl;
return false;
}
else
{
std::cout << "resource download Ok" << std::endl<< std::endl;
}
}
}
}
return true;
}
bool SPOTFileDownload::downloadSpotPackages()
{
std::cout << "SPOTFileDownload - looking for packages versions.." << std::endl;
std::string versFolder = releaseFolderPath + folderSeparator() + CVersionsFoldername + folderSeparator() + releaseName;
try
{
Poco::File foldr(versFolder);
if(!foldr.exists() || !foldr.isDirectory())
{
std::cout << "SPOTFileDownload - not a valid " << CVersionsFoldername << " folder. "<< versFolder << std::endl;
return true;
}
}
catch(...)
{
std::cout << "SPOTFileDownload - not a valid " << CVersionsFoldername << " folder" << std::endl;
return true;
}
Poco::DirectoryIterator end;
for (Poco::DirectoryIterator it(versFolder); it != end; ++it)
{
if(!it->isDirectory())
{
std::cout << "SPOTFileDownload - ready to install " << it->path() << std::endl << std::endl;
if( !this->downloadSPOTPackage(it->path()) )
{
return false;
}
else
{
std::cout << "package download Ok" << std::endl<< std::endl;
}
}
else
{
std::cout << "No Version folder" << std::endl<< std::endl;
}
}
return true;
}
void testHigher()
{
std::string str = "abcd";
auto lst = fromIt(str.begin(), str.end());
auto lst2 = fmap<char>(toupper, lst);
std::cout << lst2 << std::endl;
auto result = foldr([](char c, std::string str)
{
return str + c;
}, std::string(), lst2);
std::cout << result << std::endl;
auto result2 = foldl([](std::string str, char c)
{
return str + c;
}, std::string(), lst2);
std::cout << result2 << std::endl;
std::string mix = "TooMuchInformation";
auto lst3 = filter(isupper, fromIt(mix.begin(), mix.end()));
std::cout << lst3 << std::endl;
}
bool SPOTFileDownload::checkAndGetResourceFolder( std::string & sFolder )
{
std::cout << "SPOTFileDownload - looking for resources.." << std::endl;
sFolder.clear();
std::string resFolder = releaseFolderPath + folderSeparator() + CResourcesFoldername + folderSeparator() + releaseName;
try
{
Poco::File foldr(resFolder);
if(!foldr.exists() || !foldr.isDirectory())
{
std::cout << "SPOTFileDownload - not a valid "<< CResourcesFoldername << " folder. " << resFolder << std::endl;
return false;
}
}
catch(...)
{
std::cout << "SPOTFileDownload - not a valid "<< CResourcesFoldername << " folder" << std::endl;
return false;
}
sFolder = resFolder;
return true;
}
/* An abstraction of recursively traversing a list from right to left */
static void *foldr(void *(*f)(void *data, void *res), void *res, List list) {
return !list
? res
: f(list->data, foldr(f, res, list->next));
}
void do_Sum(ComputationNode * self) {
foldr(sum, self);
}
friend constexpr auto foldr(llist xs, State s, F f) {
if (is_empty(xs))
return s;
else
return f(head(xs), foldr(tail(xs), s, f));
}
static environment mk_brec_on(environment const & env, name const & n, bool ind) {
if (!is_recursive_datatype(env, n))
return env;
if (is_inductive_predicate(env, n))
return env;
inductive::inductive_decls decls = *inductive::is_inductive_decl(env, n);
type_checker tc(env);
name_generator ngen;
unsigned nparams = std::get<1>(decls);
declaration ind_decl = env.get(n);
declaration rec_decl = env.get(inductive::get_elim_name(n));
// declaration below_decl = env.get(name(n, ind ? "ibelow" : "below"));
unsigned nindices = *inductive::get_num_indices(env, n);
unsigned nminors = *inductive::get_num_minor_premises(env, n);
unsigned ntypeformers = length(std::get<2>(decls));
level_param_names lps = rec_decl.get_univ_params();
bool is_reflexive = is_reflexive_datatype(tc, n);
level lvl = mk_param_univ(head(lps));
levels lvls = param_names_to_levels(tail(lps));
level rlvl;
level_param_names blps;
levels blvls; // universe level parameters of brec_on/binduction_on
// The arguments of brec_on (binduction_on) are the ones in the recursor - minor premises.
// The universe we map to is also different (l+1 for below of reflexive types) and (0 fo ibelow).
expr ref_type;
if (ind) {
// we are eliminating to Prop
blps = tail(lps);
blvls = lvls;
rlvl = mk_level_zero();
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_level_zero());
} else if (is_reflexive) {
blps = lps;
blvls = cons(lvl, lvls);
rlvl = get_datatype_level(ind_decl.get_type());
// if rlvl is of the form (max 1 l), then rlvl <- l
if (is_max(rlvl) && is_one(max_lhs(rlvl)))
rlvl = max_rhs(rlvl);
rlvl = mk_max(mk_succ(lvl), rlvl);
// inner_prod, inner_prod_intro, pr1, pr2 do not use the same universe levels for
// reflective datatypes.
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_succ(lvl));
} else {
// we can simplify the universe levels for non-reflexive datatypes
blps = lps;
blvls = cons(lvl, lvls);
rlvl = mk_max(mk_level_one(), lvl);
ref_type = rec_decl.get_type();
}
buffer<expr> ref_args;
to_telescope(ngen, ref_type, ref_args);
if (ref_args.size() != nparams + ntypeformers + nminors + nindices + 1)
throw_corrupted(n);
// args contains the brec_on/binduction_on arguments
buffer<expr> args;
buffer<name> typeformer_names;
// add parameters and typeformers
for (unsigned i = 0; i < nparams; i++)
args.push_back(ref_args[i]);
for (unsigned i = nparams; i < nparams + ntypeformers; i++) {
args.push_back(ref_args[i]);
typeformer_names.push_back(mlocal_name(ref_args[i]));
}
// add indices and major premise
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
args.push_back(ref_args[i]);
// create below terms (one per datatype)
// (below.{lvls} params type-formers)
// Remark: it also creates the result type
buffer<expr> belows;
expr result_type;
unsigned k = 0;
for (auto const & decl : std::get<2>(decls)) {
name const & n1 = inductive::inductive_decl_name(decl);
if (n1 == n) {
result_type = ref_args[nparams + k];
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
result_type = mk_app(result_type, ref_args[i]);
}
k++;
name bname = name(n1, ind ? "ibelow" : "below");
expr below = mk_constant(bname, blvls);
for (unsigned i = 0; i < nparams; i++)
below = mk_app(below, ref_args[i]);
for (unsigned i = nparams; i < nparams + ntypeformers; i++)
below = mk_app(below, ref_args[i]);
belows.push_back(below);
}
// create functionals (one for each type former)
// Pi idxs t, below idxs t -> C idxs t
buffer<expr> Fs;
name F_name("F");
for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) {
expr const & C = ref_args[i];
buffer<expr> F_args;
to_telescope(ngen, mlocal_type(C), F_args);
expr F_result = mk_app(C, F_args);
expr F_below = mk_app(belows[j], F_args);
F_args.push_back(mk_local(ngen.next(), "f", F_below, binder_info()));
expr F_type = Pi(F_args, F_result);
expr F = mk_local(ngen.next(), F_name.append_after(j+1), F_type, binder_info());
Fs.push_back(F);
args.push_back(F);
}
// We define brec_on/binduction_on using the recursor for this type
levels rec_lvls = cons(rlvl, lvls);
expr rec = mk_constant(rec_decl.get_name(), rec_lvls);
// add parameters to rec
for (unsigned i = 0; i < nparams; i++)
rec = mk_app(rec, ref_args[i]);
// add type formers to rec
// Pi indices t, prod (C ... t) (below ... t)
for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) {
expr const & C = ref_args[i];
buffer<expr> C_args;
to_telescope(ngen, mlocal_type(C), C_args);
expr C_t = mk_app(C, C_args);
expr below_t = mk_app(belows[j], C_args);
expr prod = mk_prod(tc, C_t, below_t, ind);
rec = mk_app(rec, Fun(C_args, prod));
}
// add minor premises to rec
for (unsigned i = nparams + ntypeformers, j = 0; i < nparams + ntypeformers + nminors; i++, j++) {
expr minor = ref_args[i];
expr minor_type = mlocal_type(minor);
buffer<expr> minor_args;
minor_type = to_telescope(ngen, minor_type, minor_args);
buffer<expr> pairs;
for (expr & minor_arg : minor_args) {
buffer<expr> minor_arg_args;
expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args);
if (auto k = is_typeformer_app(typeformer_names, minor_arg_type)) {
buffer<expr> C_args;
get_app_args(minor_arg_type, C_args);
expr new_minor_arg_type = mk_prod(tc, minor_arg_type, mk_app(belows[*k], C_args), ind);
minor_arg = update_mlocal(minor_arg, Pi(minor_arg_args, new_minor_arg_type));
if (minor_arg_args.empty()) {
pairs.push_back(minor_arg);
} else {
expr r = mk_app(minor_arg, minor_arg_args);
expr r_1 = Fun(minor_arg_args, mk_pr1(tc, r, ind));
expr r_2 = Fun(minor_arg_args, mk_pr2(tc, r, ind));
pairs.push_back(mk_pair(tc, r_1, r_2, ind));
}
}
}
expr b = foldr([&](expr const & a, expr const & b) { return mk_pair(tc, a, b, ind); },
[&]() { return mk_unit_mk(rlvl, ind); },
pairs.size(), pairs.data());
unsigned F_idx = *is_typeformer_app(typeformer_names, minor_type);
expr F = Fs[F_idx];
buffer<expr> F_args;
get_app_args(minor_type, F_args);
F_args.push_back(b);
expr new_arg = mk_pair(tc, mk_app(F, F_args), b, ind);
rec = mk_app(rec, Fun(minor_args, new_arg));
}
// add indices and major to rec
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
rec = mk_app(rec, ref_args[i]);
name brec_on_name = name(n, ind ? "binduction_on" : "brec_on");
expr brec_on_type = Pi(args, result_type);
expr brec_on_value = Fun(args, mk_pr1(tc, rec, ind));
bool use_conv_opt = true;
declaration new_d = mk_definition(env, brec_on_name, blps, brec_on_type, brec_on_value,
use_conv_opt);
environment new_env = module::add(env, check(env, new_d));
new_env = set_reducible(new_env, brec_on_name, reducible_status::Reducible);
if (!ind)
new_env = add_unfold_hint(new_env, brec_on_name, nparams + nindices + ntypeformers);
return add_protected(new_env, brec_on_name);
}
static constexpr auto foldr_impl(X x, S s, F f) {
return foldr(members<R>, s, [=](auto k_f, auto s) {
return f(second(k_f)(x), s);
});
}
static environment mk_below(environment const & env, name const & n, bool ibelow) {
if (!is_recursive_datatype(env, n))
return env;
if (is_inductive_predicate(env, n))
return env;
inductive::inductive_decls decls = *inductive::is_inductive_decl(env, n);
type_checker tc(env);
name_generator ngen;
unsigned nparams = std::get<1>(decls);
declaration ind_decl = env.get(n);
declaration rec_decl = env.get(inductive::get_elim_name(n));
unsigned nindices = *inductive::get_num_indices(env, n);
unsigned nminors = *inductive::get_num_minor_premises(env, n);
unsigned ntypeformers = length(std::get<2>(decls));
level_param_names lps = rec_decl.get_univ_params();
bool is_reflexive = is_reflexive_datatype(tc, n);
level lvl = mk_param_univ(head(lps));
levels lvls = param_names_to_levels(tail(lps));
level_param_names blvls; // universe level parameters of ibelow/below
level rlvl; // universe level of the resultant type
// The arguments of below (ibelow) are the ones in the recursor - minor premises.
// The universe we map to is also different (l+1 for below of reflexive types) and (0 fo ibelow).
expr ref_type;
expr Type_result;
if (ibelow) {
// we are eliminating to Prop
blvls = tail(lps);
rlvl = mk_level_zero();
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_level_zero());
} else if (is_reflexive) {
blvls = lps;
rlvl = get_datatype_level(ind_decl.get_type());
// if rlvl is of the form (max 1 l), then rlvl <- l
if (is_max(rlvl) && is_one(max_lhs(rlvl)))
rlvl = max_rhs(rlvl);
rlvl = mk_max(mk_succ(lvl), rlvl);
ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_succ(lvl));
} else {
// we can simplify the universe levels for non-reflexive datatypes
blvls = lps;
rlvl = mk_max(mk_level_one(), lvl);
ref_type = rec_decl.get_type();
}
Type_result = mk_sort(rlvl);
buffer<expr> ref_args;
to_telescope(ngen, ref_type, ref_args);
if (ref_args.size() != nparams + ntypeformers + nminors + nindices + 1)
throw_corrupted(n);
// args contains the below/ibelow arguments
buffer<expr> args;
buffer<name> typeformer_names;
// add parameters and typeformers
for (unsigned i = 0; i < nparams; i++)
args.push_back(ref_args[i]);
for (unsigned i = nparams; i < nparams + ntypeformers; i++) {
args.push_back(ref_args[i]);
typeformer_names.push_back(mlocal_name(ref_args[i]));
}
// we ignore minor premises in below/ibelow
for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++)
args.push_back(ref_args[i]);
// We define below/ibelow using the recursor for this type
levels rec_lvls = cons(mk_succ(rlvl), lvls);
expr rec = mk_constant(rec_decl.get_name(), rec_lvls);
for (unsigned i = 0; i < nparams; i++)
rec = mk_app(rec, args[i]);
// add type formers
for (unsigned i = nparams; i < nparams + ntypeformers; i++) {
buffer<expr> targs;
to_telescope(ngen, mlocal_type(args[i]), targs);
rec = mk_app(rec, Fun(targs, Type_result));
}
// add minor premises
for (unsigned i = nparams + ntypeformers; i < nparams + ntypeformers + nminors; i++) {
expr minor = ref_args[i];
expr minor_type = mlocal_type(minor);
buffer<expr> minor_args;
minor_type = to_telescope(ngen, minor_type, minor_args);
buffer<expr> prod_pairs;
for (expr & minor_arg : minor_args) {
buffer<expr> minor_arg_args;
expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args);
if (is_typeformer_app(typeformer_names, minor_arg_type)) {
expr fst = mlocal_type(minor_arg);
minor_arg = update_mlocal(minor_arg, Pi(minor_arg_args, Type_result));
expr snd = Pi(minor_arg_args, mk_app(minor_arg, minor_arg_args));
prod_pairs.push_back(mk_prod(tc, fst, snd, ibelow));
}
}
expr new_arg = foldr([&](expr const & a, expr const & b) { return mk_prod(tc, a, b, ibelow); },
[&]() { return mk_unit(rlvl, ibelow); },
prod_pairs.size(), prod_pairs.data());
rec = mk_app(rec, Fun(minor_args, new_arg));
}
// add indices and major premise
for (unsigned i = nparams + ntypeformers; i < args.size(); i++) {
rec = mk_app(rec, args[i]);
}
name below_name = ibelow ? name{n, "ibelow"} : name{n, "below"};
expr below_type = Pi(args, Type_result);
expr below_value = Fun(args, rec);
bool use_conv_opt = true;
declaration new_d = mk_definition(env, below_name, blvls, below_type, below_value,
use_conv_opt);
environment new_env = module::add(env, check(env, new_d));
new_env = set_reducible(new_env, below_name, reducible_status::Reducible);
if (!ibelow)
new_env = add_unfold_hint(new_env, below_name, nparams + nindices + ntypeformers);
return add_protected(new_env, below_name);
}
// hajtogatás jobbról, Haskell és Erlang megegyezik
// foldr(F, a, [x1, ..., xn]) = F(x1, F(x2, ..., F(xn,a)...))
int foldr(const fun2 F, const int A, const list L)
{
if (L == nil) return A;
else
return F(hd(L), foldr(F, A, tl(L)));
}
