Ancient
view release on metacpan or search on metacpan
xs/util/util.c view on Meta::CPAN
IV misses; /* Cache misses (stats) */
} MemoizedFunc;
static MemoizedFunc *g_memos = NULL;
static IV g_memo_size = 0;
static IV g_memo_count = 0;
/* ============================================
Lazy evaluation structures
============================================ */
typedef struct {
SV *thunk; /* Deferred computation (coderef) */
SV *value; /* Cached result */
bool forced; /* Has been evaluated? */
} LazyValue;
static LazyValue *g_lazies = NULL;
static IV g_lazy_size = 0;
static IV g_lazy_count = 0;
/* ============================================
Always (constant) structures
============================================ */
static SV **g_always_values = NULL;
static IV g_always_size = 0;
static IV g_always_count = 0;
/* ============================================
Once (execute once) structures
============================================ */
typedef struct {
SV *func; /* Original function */
SV *result; /* Cached result */
bool called; /* Has been called? */
} OnceFunc;
static OnceFunc *g_onces = NULL;
static IV g_once_size = 0;
static IV g_once_count = 0;
/* ============================================
Partial application structures
============================================ */
typedef struct {
SV *func; /* Original function */
AV *bound_args; /* Pre-bound arguments */
} PartialFunc;
static PartialFunc *g_partials = NULL;
static IV g_partial_size = 0;
static IV g_partial_count = 0;
/* ============================================
Loop callback registry structures
============================================ */
/* Function pointer types for loop callbacks */
typedef bool (*UtilPredicateFunc)(pTHX_ SV *elem);
typedef SV* (*UtilMapFunc)(pTHX_ SV *elem);
typedef SV* (*UtilReduceFunc)(pTHX_ SV *accum, SV *elem);
/* Registered callback entry */
typedef struct {
char *name; /* Callback name (e.g., ":is_positive") */
UtilPredicateFunc predicate; /* C function for predicates */
UtilMapFunc mapper; /* C function for map */
UtilReduceFunc reducer; /* C function for reduce */
SV *perl_callback; /* Fallback Perl callback */
} RegisteredCallback;
/* Global callback registry */
static HV *g_callback_registry = NULL;
/* ============================================
Forward declarations
============================================ */
static XS(xs_memo_call);
static XS(xs_compose_call);
static XS(xs_always_call);
static XS(xs_negate_call);
static XS(xs_once_call);
static XS(xs_partial_call);
/* ============================================
Magic destructor infrastructure
============================================ */
/* Magic free function for "once" wrappers */
static int util_once_free(pTHX_ SV *sv, MAGIC *mg) {
PERL_UNUSED_ARG(sv);
IV idx = mg->mg_len;
if (idx >= 0 && idx < g_once_count) {
OnceFunc *of = &g_onces[idx];
if (of->func) {
SvREFCNT_dec(of->func);
of->func = NULL;
}
if (of->result) {
SvREFCNT_dec(of->result);
of->result = NULL;
}
of->called = FALSE;
}
return 0;
}
static MGVTBL util_once_vtbl = {
NULL, /* get */
NULL, /* set */
NULL, /* len */
NULL, /* clear */
util_once_free, /* free */
NULL, /* copy */
NULL, /* dup */
NULL /* local */
};
xs/util/util.c view on Meta::CPAN
while (new_size <= needed) new_size *= 2;
Renew(g_memos, new_size, MemoizedFunc);
g_memo_size = new_size;
}
}
static void ensure_lazy_capacity(IV needed) {
if (needed >= g_lazy_size) {
IV new_size = g_lazy_size ? g_lazy_size * 2 : 16;
while (new_size <= needed) new_size *= 2;
Renew(g_lazies, new_size, LazyValue);
g_lazy_size = new_size;
}
}
static void ensure_always_capacity(IV needed) {
if (needed >= g_always_size) {
IV new_size = g_always_size ? g_always_size * 2 : 16;
while (new_size <= needed) new_size *= 2;
Renew(g_always_values, new_size, SV*);
g_always_size = new_size;
}
}
static void ensure_once_capacity(IV needed) {
if (needed >= g_once_size) {
IV new_size = g_once_size ? g_once_size * 2 : 16;
while (new_size <= needed) new_size *= 2;
Renew(g_onces, new_size, OnceFunc);
g_once_size = new_size;
}
}
static void ensure_partial_capacity(IV needed) {
if (needed >= g_partial_size) {
IV new_size = g_partial_size ? g_partial_size * 2 : 16;
while (new_size <= needed) new_size *= 2;
Renew(g_partials, new_size, PartialFunc);
g_partial_size = new_size;
}
}
/* Build cache key from stack arguments */
static SV* build_cache_key(pTHX_ SV **args, IV count) {
SV *key = newSVpvs("");
IV i;
for (i = 0; i < count; i++) {
if (i > 0) sv_catpvs(key, "\x00");
if (SvOK(args[i])) {
STRLEN len;
const char *pv = SvPV(args[i], len);
sv_catpvn(key, pv, len);
} else {
sv_catpvs(key, "\x01UNDEF\x01");
}
}
return key;
}
/* ============================================
Built-in predicates for loop callbacks
(prefixed with ':' for built-in names)
============================================ */
static bool builtin_is_defined(pTHX_ SV *elem) {
return SvOK(elem) ? TRUE : FALSE;
}
static bool builtin_is_true(pTHX_ SV *elem) {
return SvTRUE(elem) ? TRUE : FALSE;
}
static bool builtin_is_false(pTHX_ SV *elem) {
return !SvTRUE(elem) ? TRUE : FALSE;
}
static bool builtin_is_ref(pTHX_ SV *elem) {
return SvROK(elem) ? TRUE : FALSE;
}
static bool builtin_is_array(pTHX_ SV *elem) {
return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVAV) ? TRUE : FALSE;
}
static bool builtin_is_hash(pTHX_ SV *elem) {
return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVHV) ? TRUE : FALSE;
}
static bool builtin_is_code(pTHX_ SV *elem) {
return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVCV) ? TRUE : FALSE;
}
static bool builtin_is_positive(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) > 0;
if (SvNOK(elem)) return SvNV(elem) > 0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) > 0;
return FALSE;
}
static bool builtin_is_negative(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) < 0;
if (SvNOK(elem)) return SvNV(elem) < 0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) < 0;
return FALSE;
}
static bool builtin_is_zero(pTHX_ SV *elem) {
if (SvIOK(elem)) return SvIV(elem) == 0;
if (SvNOK(elem)) return SvNV(elem) == 0.0;
if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) == 0.0;
return FALSE;
}
static bool builtin_is_even(pTHX_ SV *elem) {
if (!SvIOK(elem) && !SvNOK(elem)) {
if (!SvPOK(elem) || !looks_like_number(elem)) return FALSE;
}
IV val = SvIV(elem);
return (val % 2) == 0;
}
xs/util/util.c view on Meta::CPAN
cb->predicate = func;
cb->mapper = NULL;
cb->reducer = NULL;
cb->perl_callback = NULL;
sv = newSViv(PTR2IV(cb));
hv_store(g_callback_registry, name, strlen(name), sv, 0);
}
/* Public API for XS modules to register mappers */
PERL_CALLCONV void util_register_mapper_xs(pTHX_ const char *name,
UtilMapFunc func) {
RegisteredCallback *cb;
SV *sv;
init_callback_registry(aTHX);
if (get_registered_callback(aTHX_ name)) {
croak("Callback '%s' is already registered", name);
}
Newxz(cb, 1, RegisteredCallback);
cb->name = savepv(name);
cb->predicate = NULL;
cb->mapper = func;
cb->reducer = NULL;
cb->perl_callback = NULL;
sv = newSViv(PTR2IV(cb));
hv_store(g_callback_registry, name, strlen(name), sv, 0);
}
/* Public API for XS modules to register reducers */
PERL_CALLCONV void util_register_reducer_xs(pTHX_ const char *name,
UtilReduceFunc func) {
RegisteredCallback *cb;
SV *sv;
init_callback_registry(aTHX);
if (get_registered_callback(aTHX_ name)) {
croak("Callback '%s' is already registered", name);
}
Newxz(cb, 1, RegisteredCallback);
cb->name = savepv(name);
cb->predicate = NULL;
cb->mapper = NULL;
cb->reducer = func;
cb->perl_callback = NULL;
sv = newSViv(PTR2IV(cb));
hv_store(g_callback_registry, name, strlen(name), sv, 0);
}
/* Check if a callback exists */
static bool has_callback(pTHX_ const char *name) {
return get_registered_callback(aTHX_ name) != NULL;
}
/* List all registered callbacks */
static AV* list_callbacks(pTHX) {
AV *result;
HE *entry;
result = newAV();
if (!g_callback_registry) return result;
hv_iterinit(g_callback_registry);
while ((entry = hv_iternext(g_callback_registry))) {
I32 klen;
char *key = hv_iterkey(entry, &klen);
av_push(result, newSVpvn(key, klen));
}
return result;
}
/* Initialize built-in callbacks (called from BOOT) */
static void init_builtin_callbacks(pTHX) {
register_builtin_predicate(aTHX_ ":is_defined", builtin_is_defined);
register_builtin_predicate(aTHX_ ":is_true", builtin_is_true);
register_builtin_predicate(aTHX_ ":is_false", builtin_is_false);
register_builtin_predicate(aTHX_ ":is_ref", builtin_is_ref);
register_builtin_predicate(aTHX_ ":is_array", builtin_is_array);
register_builtin_predicate(aTHX_ ":is_hash", builtin_is_hash);
register_builtin_predicate(aTHX_ ":is_code", builtin_is_code);
register_builtin_predicate(aTHX_ ":is_positive", builtin_is_positive);
register_builtin_predicate(aTHX_ ":is_negative", builtin_is_negative);
register_builtin_predicate(aTHX_ ":is_zero", builtin_is_zero);
register_builtin_predicate(aTHX_ ":is_even", builtin_is_even);
register_builtin_predicate(aTHX_ ":is_odd", builtin_is_odd);
register_builtin_predicate(aTHX_ ":is_empty", builtin_is_empty);
register_builtin_predicate(aTHX_ ":is_nonempty", builtin_is_nonempty);
register_builtin_predicate(aTHX_ ":is_string", builtin_is_string);
register_builtin_predicate(aTHX_ ":is_number", builtin_is_number);
register_builtin_predicate(aTHX_ ":is_integer", builtin_is_integer);
}
/* ============================================
Custom OP implementations - fastest path
============================================ */
/* identity: just return the top of stack */
static OP* pp_identity(pTHX) {
/* Value already on stack, nothing to do */
return NORMAL;
}
/* always: push stored value from op_targ index */
static OP* pp_always(pTHX) {
dSP;
IV idx = PL_op->op_targ;
XPUSHs(g_always_values[idx]);
RETURN;
}
/* clamp: 3 values on stack, return clamped */
static OP* pp_clamp(pTHX) {
dSP; dMARK; dORIGMARK;
SV *val_sv, *min_sv, *max_sv;
NV value, min, max, result;
/* We get 3 args on stack after the mark */
if (SP - MARK != 3) {
/* Fallback: just use direct POPs if no mark context */
SP = ORIGMARK;
PUTBACK;
/* Pop without mark - shouldn't happen in list context */
dSP;
max_sv = POPs;
min_sv = POPs;
val_sv = POPs;
} else {
val_sv = MARK[1];
min_sv = MARK[2];
max_sv = MARK[3];
SP = ORIGMARK; /* reset stack to before args */
}
xs/util/util.c view on Meta::CPAN
ST(0) = *svp;
XSRETURN(1);
}
}
}
XSRETURN_UNDEF;
}
/* Perl-level callback registration */
static XS(xs_register_callback) {
dXSARGS;
if (items != 2) croak("Usage: util::register_callback($name, \\&coderef)");
STRLEN name_len;
const char *name = SvPV(ST(0), name_len);
SV *coderef = ST(1);
if (!SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
croak("util::register_callback: second argument must be a coderef");
}
RegisteredCallback *cb;
SV *sv;
init_callback_registry(aTHX);
/* Check if already registered */
if (get_registered_callback(aTHX_ name)) {
croak("Callback '%s' is already registered", name);
}
Newxz(cb, 1, RegisteredCallback);
cb->name = savepv(name);
cb->predicate = NULL;
cb->mapper = NULL;
cb->reducer = NULL;
/* Store a copy of the coderef (RV to CV) */
cb->perl_callback = newSVsv(coderef);
sv = newSViv(PTR2IV(cb));
hv_store(g_callback_registry, name, name_len, sv, 0);
XSRETURN_YES;
}
/* Check if callback exists */
static XS(xs_has_callback) {
dXSARGS;
if (items != 1) croak("Usage: util::has_callback($name)");
STRLEN name_len;
const char *name = SvPV(ST(0), name_len);
if (has_callback(aTHX_ name)) {
XSRETURN_YES;
}
XSRETURN_NO;
}
/* List all callbacks */
static XS(xs_list_callbacks) {
dXSARGS;
PERL_UNUSED_ARG(items);
AV *result = list_callbacks(aTHX);
ST(0) = sv_2mortal(newRV_noinc((SV*)result));
XSRETURN(1);
}
/* ============================================
Import function - O(1) hash-based lookup
============================================ */
/* Export entry: supports XS functions, Perl coderefs, or both */
typedef struct {
XSUBADDR_t xs_func; /* XS function pointer (NULL for Perl-only) */
Perl_call_checker call_checker; /* Optional call checker for XS */
SV *perl_cv; /* Perl coderef (NULL for XS-only) */
} ExportEntry;
/* Global export hash - initialized at boot */
static HV *g_export_hash = NULL;
/* Register an XS export with optional call checker (internal) */
static void register_export(pTHX_ const char *name, XSUBADDR_t xs_func, Perl_call_checker checker) {
ExportEntry *entry;
Newx(entry, 1, ExportEntry);
entry->xs_func = xs_func;
entry->call_checker = checker;
entry->perl_cv = NULL;
(void)hv_store(g_export_hash, name, strlen(name), newSViv(PTR2IV(entry)), 0);
}
/* ============================================
Public API: Register custom exports
============================================ */
/* Register a Perl coderef as an export - called from Perl */
static XS(xs_register_export) {
dXSARGS;
if (items != 2)
croak("Usage: util::register_export($name, \\&coderef)");
STRLEN name_len;
char *name = SvPV(ST(0), name_len);
SV *cv_sv = ST(1);
/* Validate it's a coderef */
if (!SvROK(cv_sv) || SvTYPE(SvRV(cv_sv)) != SVt_PVCV)
croak("util::register_export: second argument must be a coderef");
/* Check if name already exists */
if (hv_exists(g_export_hash, name, name_len))
croak("util::register_export: '%s' is already registered", name);
/* Create entry for Perl coderef */
ExportEntry *entry;
Newx(entry, 1, ExportEntry);
entry->xs_func = NULL;
entry->call_checker = NULL;
entry->perl_cv = SvREFCNT_inc(cv_sv); /* Keep a reference */
(void)hv_store(g_export_hash, name, name_len, newSViv(PTR2IV(entry)), 0);
XSRETURN_YES;
xs/util/util.c view on Meta::CPAN
entry->call_checker = NULL;
entry->perl_cv = NULL;
(void)hv_store(g_export_hash, name, name_len, newSViv(PTR2IV(entry)), 0);
}
/* Initialize export hash at boot - called once */
static void init_export_hash(pTHX) {
g_export_hash = newHV();
/* Functional */
register_export(aTHX_ "memo", xs_memo, NULL);
register_export(aTHX_ "pipeline", xs_pipe, NULL);
register_export(aTHX_ "compose", xs_compose, NULL);
register_export(aTHX_ "lazy", xs_lazy, NULL);
register_export(aTHX_ "force", xs_force, NULL);
register_export(aTHX_ "dig", xs_dig, NULL);
register_export(aTHX_ "clamp", xs_clamp, clamp_call_checker);
register_export(aTHX_ "tap", xs_tap, NULL);
register_export(aTHX_ "identity", xs_identity, identity_call_checker);
register_export(aTHX_ "always", xs_always, NULL);
register_export(aTHX_ "noop", xs_noop, noop_call_checker);
register_export(aTHX_ "partial", xs_partial, NULL);
register_export(aTHX_ "negate", xs_negate, NULL);
register_export(aTHX_ "once", xs_once, NULL);
/* Stubs */
register_export(aTHX_ "stub_true", xs_stub_true, NULL);
register_export(aTHX_ "stub_false", xs_stub_false, NULL);
register_export(aTHX_ "stub_array", xs_stub_array, NULL);
register_export(aTHX_ "stub_hash", xs_stub_hash, NULL);
register_export(aTHX_ "stub_string", xs_stub_string, NULL);
register_export(aTHX_ "stub_zero", xs_stub_zero, NULL);
/* Null coalescing */
register_export(aTHX_ "nvl", xs_nvl, NULL);
register_export(aTHX_ "coalesce", xs_coalesce, NULL);
/* List operations */
register_export(aTHX_ "first", xs_first, NULL);
register_export(aTHX_ "firstr", xs_firstr, NULL);
register_export(aTHX_ "any", xs_any, NULL);
register_export(aTHX_ "all", xs_all, NULL);
register_export(aTHX_ "none", xs_none, NULL);
register_export(aTHX_ "final", xs_final, NULL);
#ifdef dMULTICALL
register_export(aTHX_ "first_inline", xs_first_inline, NULL);
#endif
/* Callback-based loop functions */
register_export(aTHX_ "any_cb", xs_any_cb, NULL);
register_export(aTHX_ "all_cb", xs_all_cb, NULL);
register_export(aTHX_ "none_cb", xs_none_cb, NULL);
register_export(aTHX_ "first_cb", xs_first_cb, NULL);
register_export(aTHX_ "grep_cb", xs_grep_cb, NULL);
register_export(aTHX_ "count_cb", xs_count_cb, NULL);
register_export(aTHX_ "partition_cb", xs_partition_cb, NULL);
register_export(aTHX_ "final_cb", xs_final_cb, NULL);
register_export(aTHX_ "register_callback", xs_register_callback, NULL);
register_export(aTHX_ "has_callback", xs_has_callback, NULL);
register_export(aTHX_ "list_callbacks", xs_list_callbacks, NULL);
/* Specialized predicates - first_* */
register_export(aTHX_ "first_gt", xs_first_gt, NULL);
register_export(aTHX_ "first_lt", xs_first_lt, NULL);
register_export(aTHX_ "first_ge", xs_first_ge, NULL);
register_export(aTHX_ "first_le", xs_first_le, NULL);
register_export(aTHX_ "first_eq", xs_first_eq, NULL);
register_export(aTHX_ "first_ne", xs_first_ne, NULL);
/* Specialized predicates - final_* */
register_export(aTHX_ "final_gt", xs_final_gt, NULL);
register_export(aTHX_ "final_lt", xs_final_lt, NULL);
register_export(aTHX_ "final_ge", xs_final_ge, NULL);
register_export(aTHX_ "final_le", xs_final_le, NULL);
register_export(aTHX_ "final_eq", xs_final_eq, NULL);
register_export(aTHX_ "final_ne", xs_final_ne, NULL);
/* Specialized predicates - any_* */
register_export(aTHX_ "any_gt", xs_any_gt, NULL);
register_export(aTHX_ "any_lt", xs_any_lt, NULL);
register_export(aTHX_ "any_ge", xs_any_ge, NULL);
register_export(aTHX_ "any_le", xs_any_le, NULL);
register_export(aTHX_ "any_eq", xs_any_eq, NULL);
register_export(aTHX_ "any_ne", xs_any_ne, NULL);
/* Specialized predicates - all_* */
register_export(aTHX_ "all_gt", xs_all_gt, NULL);
register_export(aTHX_ "all_lt", xs_all_lt, NULL);
register_export(aTHX_ "all_ge", xs_all_ge, NULL);
register_export(aTHX_ "all_le", xs_all_le, NULL);
register_export(aTHX_ "all_eq", xs_all_eq, NULL);
register_export(aTHX_ "all_ne", xs_all_ne, NULL);
/* Specialized predicates - none_* */
register_export(aTHX_ "none_gt", xs_none_gt, NULL);
register_export(aTHX_ "none_lt", xs_none_lt, NULL);
register_export(aTHX_ "none_ge", xs_none_ge, NULL);
register_export(aTHX_ "none_le", xs_none_le, NULL);
register_export(aTHX_ "none_eq", xs_none_eq, NULL);
register_export(aTHX_ "none_ne", xs_none_ne, NULL);
/* Collection functions */
register_export(aTHX_ "pick", xs_pick, NULL);
register_export(aTHX_ "pluck", xs_pluck, NULL);
register_export(aTHX_ "omit", xs_omit, NULL);
register_export(aTHX_ "uniq", xs_uniq, NULL);
register_export(aTHX_ "partition", xs_partition, NULL);
register_export(aTHX_ "defaults", xs_defaults, NULL);
register_export(aTHX_ "count", xs_count, NULL);
register_export(aTHX_ "replace_all", xs_replace_all, NULL);
/* Type predicates */
register_export(aTHX_ "is_ref", xs_is_ref, is_ref_call_checker);
register_export(aTHX_ "is_array", xs_is_array, is_array_call_checker);
register_export(aTHX_ "is_hash", xs_is_hash, is_hash_call_checker);
register_export(aTHX_ "is_code", xs_is_code, is_code_call_checker);
register_export(aTHX_ "is_defined", xs_is_defined, is_defined_call_checker);
register_export(aTHX_ "is_string", xs_is_string, is_string_call_checker);
/* String predicates */
xs/util/util.c view on Meta::CPAN
register_export(aTHX_ "max2", xs_max2, max2_call_checker);
}
static char* get_caller(pTHX) {
return HvNAME((HV*)CopSTASH(PL_curcop));
}
/* Fast O(1) import using hash lookup */
static XS(xs_import) {
dXSARGS;
char *pkg = get_caller(aTHX);
IV i;
STRLEN name_len;
char full[512];
for (i = 1; i < items; i++) {
char *name = SvPV(ST(i), name_len);
SV **entry_sv = hv_fetch(g_export_hash, name, name_len, 0);
if (!entry_sv || !*entry_sv) {
croak("util: unknown export '%s'", name);
}
ExportEntry *entry = INT2PTR(ExportEntry*, SvIV(*entry_sv));
snprintf(full, sizeof(full), "%s::%s", pkg, name);
if (entry->xs_func) {
/* XS function: create XS stub in caller's namespace.
* Note: We intentionally do NOT install call checkers on exported
* functions. Call checkers are compile-time optimizations that work
* by transforming the op tree. They work on util::* functions because
* those are installed at boot time before any user code compiles.
* Users who want compile-time optimization should call util::func()
* directly instead of importing. */
CV *cv = newXS(full, entry->xs_func, __FILE__);
PERL_UNUSED_VAR(cv);
} else if (entry->perl_cv) {
/* Perl coderef: create alias in caller's namespace */
GV *gv = gv_fetchpv(full, GV_ADD, SVt_PVCV);
if (gv) {
/* Get the actual CV from the reference */
CV *src_cv = (CV*)SvRV(entry->perl_cv);
/* Assign the CV to the glob's CODE slot */
SvREFCNT_inc((SV*)src_cv);
GvCV_set(gv, src_cv);
}
}
}
XSRETURN_EMPTY;
}
/* ============================================
Boot
============================================ */
XS_EXTERNAL(boot_util) {
dXSBOOTARGSXSAPIVERCHK;
PERL_UNUSED_VAR(items);
/* Initialize built-in loop callbacks */
init_builtin_callbacks(aTHX);
/* Register custom ops */
XopENTRY_set(&identity_xop, xop_name, "identity");
XopENTRY_set(&identity_xop, xop_desc, "identity passthrough");
Perl_custom_op_register(aTHX_ pp_identity, &identity_xop);
XopENTRY_set(&always_xop, xop_name, "always");
XopENTRY_set(&always_xop, xop_desc, "always return stored value");
Perl_custom_op_register(aTHX_ pp_always, &always_xop);
XopENTRY_set(&clamp_xop, xop_name, "clamp");
XopENTRY_set(&clamp_xop, xop_desc, "clamp value between min and max");
Perl_custom_op_register(aTHX_ pp_clamp, &clamp_xop);
/* Register type predicate custom ops */
XopENTRY_set(&is_ref_xop, xop_name, "is_ref");
XopENTRY_set(&is_ref_xop, xop_desc, "check if value is a reference");
Perl_custom_op_register(aTHX_ pp_is_ref, &is_ref_xop);
XopENTRY_set(&is_array_xop, xop_name, "is_array");
XopENTRY_set(&is_array_xop, xop_desc, "check if value is an arrayref");
Perl_custom_op_register(aTHX_ pp_is_array, &is_array_xop);
XopENTRY_set(&is_hash_xop, xop_name, "is_hash");
XopENTRY_set(&is_hash_xop, xop_desc, "check if value is a hashref");
Perl_custom_op_register(aTHX_ pp_is_hash, &is_hash_xop);
XopENTRY_set(&is_code_xop, xop_name, "is_code");
XopENTRY_set(&is_code_xop, xop_desc, "check if value is a coderef");
Perl_custom_op_register(aTHX_ pp_is_code, &is_code_xop);
XopENTRY_set(&is_defined_xop, xop_name, "is_defined");
XopENTRY_set(&is_defined_xop, xop_desc, "check if value is defined");
Perl_custom_op_register(aTHX_ pp_is_defined, &is_defined_xop);
/* Register string predicate custom ops */
XopENTRY_set(&is_empty_xop, xop_name, "is_empty");
XopENTRY_set(&is_empty_xop, xop_desc, "check if string is empty");
Perl_custom_op_register(aTHX_ pp_is_empty, &is_empty_xop);
XopENTRY_set(&starts_with_xop, xop_name, "starts_with");
XopENTRY_set(&starts_with_xop, xop_desc, "check if string starts with prefix");
Perl_custom_op_register(aTHX_ pp_starts_with, &starts_with_xop);
XopENTRY_set(&ends_with_xop, xop_name, "ends_with");
XopENTRY_set(&ends_with_xop, xop_desc, "check if string ends with suffix");
Perl_custom_op_register(aTHX_ pp_ends_with, &ends_with_xop);
/* Register boolean/truthiness custom ops */
XopENTRY_set(&is_true_xop, xop_name, "is_true");
XopENTRY_set(&is_true_xop, xop_desc, "check if value is truthy");
Perl_custom_op_register(aTHX_ pp_is_true, &is_true_xop);
XopENTRY_set(&is_false_xop, xop_name, "is_false");
XopENTRY_set(&is_false_xop, xop_desc, "check if value is falsy");
Perl_custom_op_register(aTHX_ pp_is_false, &is_false_xop);
XopENTRY_set(&bool_xop, xop_name, "bool");
XopENTRY_set(&bool_xop, xop_desc, "normalize to boolean");
Perl_custom_op_register(aTHX_ pp_bool, &bool_xop);
xs/util/util.c view on Meta::CPAN
/* Export registry API */
newXS("util::register_export", xs_register_export, __FILE__);
newXS("util::has_export", xs_has_export, __FILE__);
newXS("util::list_exports", xs_list_exports, __FILE__);
newXS("util::memo", xs_memo, __FILE__);
newXS("util::pipeline", xs_pipe, __FILE__);
newXS("util::compose", xs_compose, __FILE__);
newXS("util::lazy", xs_lazy, __FILE__);
newXS("util::force", xs_force, __FILE__);
newXS("util::dig", xs_dig, __FILE__);
{
CV *cv = newXS("util::clamp", xs_clamp, __FILE__);
cv_set_call_checker(cv, clamp_call_checker, (SV*)cv);
}
newXS("util::tap", xs_tap, __FILE__);
{
CV *cv = newXS("util::identity", xs_identity, __FILE__);
cv_set_call_checker(cv, identity_call_checker, (SV*)cv);
}
newXS("util::always", xs_always, __FILE__);
{
CV *cv = newXS("util::noop", xs_noop, __FILE__);
cv_set_call_checker(cv, noop_call_checker, (SV*)cv);
}
newXS("util::stub_true", xs_stub_true, __FILE__);
newXS("util::stub_false", xs_stub_false, __FILE__);
newXS("util::stub_array", xs_stub_array, __FILE__);
newXS("util::stub_hash", xs_stub_hash, __FILE__);
newXS("util::stub_string", xs_stub_string, __FILE__);
newXS("util::stub_zero", xs_stub_zero, __FILE__);
newXS("util::nvl", xs_nvl, __FILE__);
newXS("util::coalesce", xs_coalesce, __FILE__);
/* List functions */
newXS("util::first", xs_first, __FILE__);
newXS("util::firstr", xs_firstr, __FILE__);
newXS("util::any", xs_any, __FILE__);
newXS("util::all", xs_all, __FILE__);
newXS("util::none", xs_none, __FILE__);
#ifdef dMULTICALL
newXS("util::first_inline", xs_first_inline, __FILE__); /* experimental, 5.11+ only */
#endif
/* Named callback loop functions */
newXS("util::any_cb", xs_any_cb, __FILE__);
newXS("util::all_cb", xs_all_cb, __FILE__);
newXS("util::none_cb", xs_none_cb, __FILE__);
newXS("util::first_cb", xs_first_cb, __FILE__);
newXS("util::grep_cb", xs_grep_cb, __FILE__);
newXS("util::count_cb", xs_count_cb, __FILE__);
newXS("util::partition_cb", xs_partition_cb, __FILE__);
newXS("util::final_cb", xs_final_cb, __FILE__);
newXS("util::register_callback", xs_register_callback, __FILE__);
newXS("util::has_callback", xs_has_callback, __FILE__);
newXS("util::list_callbacks", xs_list_callbacks, __FILE__);
/* Specialized array predicates - pure C, no callback */
newXS("util::first_gt", xs_first_gt, __FILE__);
newXS("util::first_lt", xs_first_lt, __FILE__);
newXS("util::first_ge", xs_first_ge, __FILE__);
newXS("util::first_le", xs_first_le, __FILE__);
newXS("util::first_eq", xs_first_eq, __FILE__);
newXS("util::first_ne", xs_first_ne, __FILE__);
newXS("util::final", xs_final, __FILE__);
newXS("util::final_gt", xs_final_gt, __FILE__);
newXS("util::final_lt", xs_final_lt, __FILE__);
newXS("util::final_ge", xs_final_ge, __FILE__);
newXS("util::final_le", xs_final_le, __FILE__);
newXS("util::final_eq", xs_final_eq, __FILE__);
newXS("util::final_ne", xs_final_ne, __FILE__);
newXS("util::any_gt", xs_any_gt, __FILE__);
newXS("util::any_lt", xs_any_lt, __FILE__);
newXS("util::any_ge", xs_any_ge, __FILE__);
newXS("util::any_le", xs_any_le, __FILE__);
newXS("util::any_eq", xs_any_eq, __FILE__);
newXS("util::any_ne", xs_any_ne, __FILE__);
newXS("util::all_gt", xs_all_gt, __FILE__);
newXS("util::all_lt", xs_all_lt, __FILE__);
newXS("util::all_ge", xs_all_ge, __FILE__);
newXS("util::all_le", xs_all_le, __FILE__);
newXS("util::all_eq", xs_all_eq, __FILE__);
newXS("util::all_ne", xs_all_ne, __FILE__);
newXS("util::none_gt", xs_none_gt, __FILE__);
newXS("util::none_lt", xs_none_lt, __FILE__);
newXS("util::none_ge", xs_none_ge, __FILE__);
newXS("util::none_le", xs_none_le, __FILE__);
newXS("util::none_eq", xs_none_eq, __FILE__);
newXS("util::none_ne", xs_none_ne, __FILE__);
/* Functional combinators */
newXS("util::negate", xs_negate, __FILE__);
newXS("util::once", xs_once, __FILE__);
newXS("util::partial", xs_partial, __FILE__);
/* Data extraction */
newXS("util::pick", xs_pick, __FILE__);
newXS("util::pluck", xs_pluck, __FILE__);
newXS("util::omit", xs_omit, __FILE__);
newXS("util::uniq", xs_uniq, __FILE__);
newXS("util::partition", xs_partition, __FILE__);
newXS("util::defaults", xs_defaults, __FILE__);
/* Type predicates with call checkers */
{
CV *cv = newXS("util::is_ref", xs_is_ref, __FILE__);
cv_set_call_checker(cv, is_ref_call_checker, (SV*)cv);
}
{
CV *cv = newXS("util::is_array", xs_is_array, __FILE__);
cv_set_call_checker(cv, is_array_call_checker, (SV*)cv);
}
{
CV *cv = newXS("util::is_hash", xs_is_hash, __FILE__);
cv_set_call_checker(cv, is_hash_call_checker, (SV*)cv);
}
( run in 0.633 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )