view release on metacpan or  search on metacpan

xs/util/util.c  view on Meta::CPAN

    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 */
    register_export(aTHX_ "is_empty", xs_is_empty, is_empty_call_checker);
    register_export(aTHX_ "starts_with", xs_starts_with, starts_with_call_checker);
    register_export(aTHX_ "ends_with", xs_ends_with, ends_with_call_checker);
    register_export(aTHX_ "trim", xs_trim, trim_call_checker);
    register_export(aTHX_ "ltrim", xs_ltrim, ltrim_call_checker);
    register_export(aTHX_ "rtrim", xs_rtrim, rtrim_call_checker);

    /* Boolean predicates */
    register_export(aTHX_ "is_true", xs_is_true, is_true_call_checker);
    register_export(aTHX_ "is_false", xs_is_false, is_false_call_checker);
    register_export(aTHX_ "bool", xs_bool, bool_call_checker);

    /* Extended type predicates */
    register_export(aTHX_ "is_num", xs_is_num, is_num_call_checker);
    register_export(aTHX_ "is_int", xs_is_int, is_int_call_checker);
    register_export(aTHX_ "is_blessed", xs_is_blessed, is_blessed_call_checker);
    register_export(aTHX_ "is_scalar_ref", xs_is_scalar_ref, is_scalar_ref_call_checker);
    register_export(aTHX_ "is_regex", xs_is_regex, is_regex_call_checker);
    register_export(aTHX_ "is_glob", xs_is_glob, is_glob_call_checker);

    /* Numeric predicates */
    register_export(aTHX_ "is_positive", xs_is_positive, is_positive_call_checker);
    register_export(aTHX_ "is_negative", xs_is_negative, is_negative_call_checker);
    register_export(aTHX_ "is_zero", xs_is_zero, is_zero_call_checker);
    register_export(aTHX_ "is_even", xs_is_even, is_even_call_checker);
    register_export(aTHX_ "is_odd", xs_is_odd, is_odd_call_checker);
    register_export(aTHX_ "is_between", xs_is_between, is_between_call_checker);

    /* Collection predicates */
    register_export(aTHX_ "is_empty_array", xs_is_empty_array, is_empty_array_call_checker);
    register_export(aTHX_ "is_empty_hash", xs_is_empty_hash, is_empty_hash_call_checker);
    register_export(aTHX_ "array_len", xs_array_len, array_len_call_checker);
    register_export(aTHX_ "hash_size", xs_hash_size, hash_size_call_checker);
    register_export(aTHX_ "array_first", xs_array_first, array_first_call_checker);
    register_export(aTHX_ "array_last", xs_array_last, array_last_call_checker);

    /* Conditional/numeric ops */
    register_export(aTHX_ "maybe", xs_maybe, maybe_call_checker);
    register_export(aTHX_ "sign", xs_sign, sign_call_checker);
    register_export(aTHX_ "min2", xs_min2, min2_call_checker);
    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);