File Coverage

FuncUtil.c
Criterion Covered Total %
statement 3292 3774 87.2
branch 1618 2664 60.7
condition n/a
subroutine n/a
pod n/a
total 4910 6438 76.2


line stmt bran cond sub pod time code
1             #define _GNU_SOURCE
2             #include "EXTERN.h"
3             #include "perl.h"
4             #include "XSUB.h"
5             #include "funcutil_compat.h"
6             #include "multicall_compat.h"
7             #include
8              
9             /* Portable memmem - use system version if available, else our own */
10             #ifndef HAVE_MEMMEM
11             #if defined(__GLIBC__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
12             #define HAVE_MEMMEM 1
13             #endif
14             #endif
15              
16             #if HAVE_MEMMEM
17             #define util_memmem memmem
18             #else
19             static void *util_memmem(const void *haystack, size_t haystacklen,
20             const void *needle, size_t needlelen) {
21             if (needlelen == 0) return (void*)haystack;
22             if (needlelen > haystacklen) return NULL;
23            
24             const char *h = (const char*)haystack;
25             const char *n = (const char*)needle;
26             const char *end = h + haystacklen - needlelen + 1;
27             char first = *n;
28            
29             for (; h < end; h++) {
30             if (*h == first && memcmp(h, n, needlelen) == 0) {
31             return (void*)h;
32             }
33             }
34             return NULL;
35             }
36             #endif
37              
38             /* ============================================
39             Custom op structures
40             ============================================ */
41              
42             static XOP identity_xop;
43             static XOP always_xop;
44             static XOP clamp_xop;
45             static XOP nvl_xop;
46             static XOP coalesce_xop;
47              
48             /* Type predicate custom ops - blazing fast, single SV flag check */
49             static XOP is_ref_xop;
50             static XOP is_array_xop;
51             static XOP is_hash_xop;
52             static XOP is_code_xop;
53             static XOP is_defined_xop;
54              
55             /* String predicate custom ops - direct SvPV/SvCUR access */
56             static XOP is_empty_xop;
57             static XOP starts_with_xop;
58             static XOP ends_with_xop;
59             /* Boolean/Truthiness custom ops - fast truth checks */
60             static XOP is_true_xop;
61             static XOP is_false_xop;
62             static XOP bool_xop;
63              
64             /* Extended type predicate custom ops */
65             static XOP is_num_xop;
66             static XOP is_int_xop;
67             static XOP is_blessed_xop;
68             static XOP is_scalar_ref_xop;
69             static XOP is_regex_xop;
70             static XOP is_glob_xop;
71             static XOP is_string_xop;
72              
73             /* Numeric predicate custom ops */
74             static XOP is_positive_xop;
75             static XOP is_negative_xop;
76             static XOP is_zero_xop;
77              
78             /* Numeric utility custom ops */
79             static XOP is_even_xop;
80             static XOP is_odd_xop;
81             static XOP is_between_xop;
82              
83             /* Collection custom ops - direct AvFILL/HvKEYS access */
84             static XOP is_empty_array_xop;
85             static XOP is_empty_hash_xop;
86             static XOP array_len_xop;
87             static XOP hash_size_xop;
88             static XOP array_first_xop;
89             static XOP array_last_xop;
90              
91             /* String manipulation custom ops */
92             static XOP trim_xop;
93             static XOP ltrim_xop;
94             static XOP rtrim_xop;
95              
96             /* Conditional custom ops */
97             static XOP maybe_xop;
98              
99             /* Numeric custom ops */
100             static XOP sign_xop;
101             static XOP min2_xop;
102             static XOP max2_xop;
103              
104             /* ============================================
105             Memoization structures
106             ============================================ */
107              
108             typedef struct {
109             SV *func; /* Original coderef */
110             HV *cache; /* Result cache */
111             IV hits; /* Cache hits (stats) */
112             IV misses; /* Cache misses (stats) */
113             } MemoizedFunc;
114              
115             static MemoizedFunc *g_memos = NULL;
116             static IV g_memo_size = 0;
117             static IV g_memo_count = 0;
118              
119             /* ============================================
120             Lazy evaluation structures
121             ============================================ */
122              
123             typedef struct {
124             SV *thunk; /* Deferred computation (coderef) */
125             SV *value; /* Cached result */
126             bool forced; /* Has been evaluated? */
127             } LazyValue;
128              
129             static LazyValue *g_lazies = NULL;
130             static IV g_lazy_size = 0;
131             static IV g_lazy_count = 0;
132              
133             /* ============================================
134             Always (constant) structures
135             ============================================ */
136              
137             static SV **g_always_values = NULL;
138             static IV g_always_size = 0;
139             static IV g_always_count = 0;
140              
141             /* ============================================
142             Once (execute once) structures
143             ============================================ */
144              
145             typedef struct {
146             SV *func; /* Original function */
147             SV *result; /* Cached result */
148             bool called; /* Has been called? */
149             } OnceFunc;
150              
151             static OnceFunc *g_onces = NULL;
152             static IV g_once_size = 0;
153             static IV g_once_count = 0;
154              
155             /* ============================================
156             Partial application structures
157             ============================================ */
158              
159             typedef struct {
160             SV *func; /* Original function */
161             AV *bound_args; /* Pre-bound arguments */
162             } PartialFunc;
163              
164             static PartialFunc *g_partials = NULL;
165             static IV g_partial_size = 0;
166             static IV g_partial_count = 0;
167              
168             /* ============================================
169             Loop callback registry structures
170             ============================================ */
171              
172             /* Function pointer types for loop callbacks */
173             typedef bool (*UtilPredicateFunc)(pTHX_ SV *elem);
174             typedef SV* (*UtilMapFunc)(pTHX_ SV *elem);
175             typedef SV* (*UtilReduceFunc)(pTHX_ SV *accum, SV *elem);
176              
177             /* Registered callback entry */
178             typedef struct {
179             char *name; /* Callback name (e.g., ":is_positive") */
180             UtilPredicateFunc predicate; /* C function for predicates */
181             UtilMapFunc mapper; /* C function for map */
182             UtilReduceFunc reducer; /* C function for reduce */
183             SV *perl_callback; /* Fallback Perl callback */
184             } RegisteredCallback;
185              
186             /* Global callback registry */
187             static HV *g_callback_registry = NULL;
188              
189             /* ============================================
190             Forward declarations
191             ============================================ */
192              
193             XS_INTERNAL(xs_memo_call);
194             XS_INTERNAL(xs_compose_call);
195             XS_INTERNAL(xs_always_call);
196             XS_INTERNAL(xs_negate_call);
197             XS_INTERNAL(xs_once_call);
198             XS_INTERNAL(xs_partial_call);
199              
200             /* ============================================
201             Magic destructor infrastructure
202             ============================================ */
203              
204             /* Magic free function for "once" wrappers */
205 1005           static int util_once_free(pTHX_ SV *sv, MAGIC *mg) {
206             PERL_UNUSED_ARG(sv);
207 1005           IV idx = mg->mg_len;
208 1005 50         if (idx >= 0 && idx < g_once_count) {
    50          
209 1005           OnceFunc *of = &g_onces[idx];
210 1005 50         if (of->func) {
211 0           SvREFCNT_dec(of->func);
212 0           of->func = NULL;
213             }
214 1005 50         if (of->result) {
215 1005           SvREFCNT_dec(of->result);
216 1005           of->result = NULL;
217             }
218 1005           of->called = FALSE;
219             }
220 1005           return 0;
221             }
222              
223             static MGVTBL util_once_vtbl = {
224             NULL, /* get */
225             NULL, /* set */
226             NULL, /* len */
227             NULL, /* clear */
228             util_once_free, /* free */
229             NULL, /* copy */
230             NULL, /* dup */
231             NULL /* local */
232             };
233              
234             /* Magic free function for "partial" wrappers */
235 1012           static int util_partial_free(pTHX_ SV *sv, MAGIC *mg) {
236             PERL_UNUSED_ARG(sv);
237 1012           IV idx = mg->mg_len;
238 1012 50         if (idx >= 0 && idx < g_partial_count) {
    50          
239 1012           PartialFunc *pf = &g_partials[idx];
240 1012 50         if (pf->func) {
241 1012           SvREFCNT_dec(pf->func);
242 1012           pf->func = NULL;
243             }
244 1012 50         if (pf->bound_args) {
245 1012           SvREFCNT_dec((SV*)pf->bound_args);
246 1012           pf->bound_args = NULL;
247             }
248             }
249 1012           return 0;
250             }
251              
252             static MGVTBL util_partial_vtbl = {
253             NULL, NULL, NULL, NULL, util_partial_free, NULL, NULL, NULL
254             };
255              
256             /* Magic free function for "memo" wrappers */
257 212           static int util_memo_free(pTHX_ SV *sv, MAGIC *mg) {
258             PERL_UNUSED_ARG(sv);
259 212           IV idx = mg->mg_len;
260 212 50         if (idx >= 0 && idx < g_memo_count) {
    50          
261 212           MemoizedFunc *mf = &g_memos[idx];
262 212 50         if (mf->func) {
263 212           SvREFCNT_dec(mf->func);
264 212           mf->func = NULL;
265             }
266 212 50         if (mf->cache) {
267 212           SvREFCNT_dec((SV*)mf->cache);
268 212           mf->cache = NULL;
269             }
270 212           mf->hits = 0;
271 212           mf->misses = 0;
272             }
273 212           return 0;
274             }
275              
276             static MGVTBL util_memo_vtbl = {
277             NULL, NULL, NULL, NULL, util_memo_free, NULL, NULL, NULL
278             };
279              
280             /* Magic free function for "lazy" wrappers */
281 1008           static int util_lazy_free(pTHX_ SV *sv, MAGIC *mg) {
282             PERL_UNUSED_ARG(sv);
283 1008           IV idx = mg->mg_len;
284 1008 50         if (idx >= 0 && idx < g_lazy_count) {
    50          
285 1008           LazyValue *lv = &g_lazies[idx];
286 1008 50         if (lv->thunk) {
287 0           SvREFCNT_dec(lv->thunk);
288 0           lv->thunk = NULL;
289             }
290 1008 50         if (lv->value) {
291 1008           SvREFCNT_dec(lv->value);
292 1008           lv->value = NULL;
293             }
294 1008           lv->forced = FALSE;
295             }
296 1008           return 0;
297             }
298              
299             static MGVTBL util_lazy_vtbl = {
300             NULL, NULL, NULL, NULL, util_lazy_free, NULL, NULL, NULL
301             };
302              
303             /* Magic free function for "compose" wrappers */
304 1010           static int util_compose_free(pTHX_ SV *sv, MAGIC *mg) {
305             PERL_UNUSED_ARG(sv);
306 1010           AV *funcs = (AV*)mg->mg_ptr;
307 1010 50         if (funcs) {
308 1010           SvREFCNT_dec((SV*)funcs);
309             }
310 1010           return 0;
311             }
312              
313             static MGVTBL util_compose_vtbl = {
314             NULL, NULL, NULL, NULL, util_compose_free, NULL, NULL, NULL
315             };
316              
317             /* Magic free function for "always" wrappers */
318 8           static int util_always_free(pTHX_ SV *sv, MAGIC *mg) {
319             PERL_UNUSED_ARG(sv);
320 8           IV idx = mg->mg_len;
321 8 50         if (idx >= 0 && idx < g_always_count && g_always_values[idx]) {
    50          
    50          
322 8           SvREFCNT_dec(g_always_values[idx]);
323 8           g_always_values[idx] = NULL;
324             }
325 8           return 0;
326             }
327              
328             static MGVTBL util_always_vtbl = {
329             NULL, NULL, NULL, NULL, util_always_free, NULL, NULL, NULL
330             };
331              
332             /* ============================================
333             Utility functions
334             ============================================ */
335              
336 213           static void ensure_memo_capacity(IV needed) {
337 213 100         if (needed >= g_memo_size) {
338 4 50         IV new_size = g_memo_size ? g_memo_size * 2 : 16;
339 4 50         while (new_size <= needed) new_size *= 2;
340 4 50         Renew(g_memos, new_size, MemoizedFunc);
341 4           g_memo_size = new_size;
342             }
343 213           }
344              
345 1008           static void ensure_lazy_capacity(IV needed) {
346 1008 100         if (needed >= g_lazy_size) {
347 6 50         IV new_size = g_lazy_size ? g_lazy_size * 2 : 16;
348 6 50         while (new_size <= needed) new_size *= 2;
349 6 50         Renew(g_lazies, new_size, LazyValue);
350 6           g_lazy_size = new_size;
351             }
352 1008           }
353              
354 8           static void ensure_always_capacity(IV needed) {
355 8 50         if (needed >= g_always_size) {
356 0 0         IV new_size = g_always_size ? g_always_size * 2 : 16;
357 0 0         while (new_size <= needed) new_size *= 2;
358 0 0         Renew(g_always_values, new_size, SV*);
359 0           g_always_size = new_size;
360             }
361 8           }
362              
363 1005           static void ensure_once_capacity(IV needed) {
364 1005 100         if (needed >= g_once_size) {
365 6 50         IV new_size = g_once_size ? g_once_size * 2 : 16;
366 6 50         while (new_size <= needed) new_size *= 2;
367 6 50         Renew(g_onces, new_size, OnceFunc);
368 6           g_once_size = new_size;
369             }
370 1005           }
371              
372 1012           static void ensure_partial_capacity(IV needed) {
373 1012 100         if (needed >= g_partial_size) {
374 6 50         IV new_size = g_partial_size ? g_partial_size * 2 : 16;
375 6 50         while (new_size <= needed) new_size *= 2;
376 6 50         Renew(g_partials, new_size, PartialFunc);
377 6           g_partial_size = new_size;
378             }
379 1012           }
380              
381             /* Build cache key from stack arguments */
382 849           static SV* build_cache_key(pTHX_ SV **args, IV count) {
383 849           SV *key = newSVpvs("");
384             IV i;
385 1699 100         for (i = 0; i < count; i++) {
386 850 100         if (i > 0) sv_catpvs(key, "\x00");
387 850 100         if (SvOK(args[i])) {
388             STRLEN len;
389 846           const char *pv = SvPV(args[i], len);
390 846           sv_catpvn(key, pv, len);
391             } else {
392 4           sv_catpvs(key, "\x01UNDEF\x01");
393             }
394             }
395 849           return key;
396             }
397              
398             /* ============================================
399             Built-in predicates for loop callbacks
400             (prefixed with ':' for built-in names)
401             ============================================ */
402              
403 16147           static bool builtin_is_defined(pTHX_ SV *elem) {
404 16147           return SvOK(elem) ? TRUE : FALSE;
405             }
406              
407 4044           static bool builtin_is_true(pTHX_ SV *elem) {
408 4044           return SvTRUE(elem) ? TRUE : FALSE;
409             }
410              
411 1042           static bool builtin_is_false(pTHX_ SV *elem) {
412 1042           return !SvTRUE(elem) ? TRUE : FALSE;
413             }
414              
415 15044           static bool builtin_is_ref(pTHX_ SV *elem) {
416 15044           return SvROK(elem) ? TRUE : FALSE;
417             }
418              
419 6026           static bool builtin_is_array(pTHX_ SV *elem) {
420 6026 100         return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVAV) ? TRUE : FALSE;
    100          
421             }
422              
423 7027           static bool builtin_is_hash(pTHX_ SV *elem) {
424 7027 100         return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVHV) ? TRUE : FALSE;
    100          
425             }
426              
427 23           static bool builtin_is_code(pTHX_ SV *elem) {
428 23 100         return (SvROK(elem) && SvTYPE(SvRV(elem)) == SVt_PVCV) ? TRUE : FALSE;
    100          
429             }
430              
431 2041259           static bool builtin_is_positive(pTHX_ SV *elem) {
432 2041259 50         if (SvIOK(elem)) return SvIV(elem) > 0;
433 0 0         if (SvNOK(elem)) return SvNV(elem) > 0;
434 0 0         if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) > 0;
    0          
435 0           return FALSE;
436             }
437              
438 19081           static bool builtin_is_negative(pTHX_ SV *elem) {
439 19081 50         if (SvIOK(elem)) return SvIV(elem) < 0;
440 0 0         if (SvNOK(elem)) return SvNV(elem) < 0;
441 0 0         if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) < 0;
    0          
442 0           return FALSE;
443             }
444              
445 15069           static bool builtin_is_zero(pTHX_ SV *elem) {
446 15069 50         if (SvIOK(elem)) return SvIV(elem) == 0;
447 0 0         if (SvNOK(elem)) return SvNV(elem) == 0.0;
448 0 0         if (SvPOK(elem) && looks_like_number(elem)) return SvNV(elem) == 0.0;
    0          
449 0           return FALSE;
450             }
451              
452 30113           static bool builtin_is_even(pTHX_ SV *elem) {
453 30113 50         if (!SvIOK(elem) && !SvNOK(elem)) {
    0          
454 0 0         if (!SvPOK(elem) || !looks_like_number(elem)) return FALSE;
    0          
455             }
456 30113           IV val = SvIV(elem);
457 30113           return (val % 2) == 0;
458             }
459              
460 1054           static bool builtin_is_odd(pTHX_ SV *elem) {
461 1054 50         if (!SvIOK(elem) && !SvNOK(elem)) {
    0          
462 0 0         if (!SvPOK(elem) || !looks_like_number(elem)) return FALSE;
    0          
463             }
464 1054           IV val = SvIV(elem);
465 1054           return (val % 2) != 0;
466             }
467              
468 7045           static bool builtin_is_empty(pTHX_ SV *elem) {
469 7045 100         if (!SvOK(elem)) return TRUE;
470 6038 100         if (SvROK(elem)) {
471 2016           SV *rv = SvRV(elem);
472 2016 100         if (SvTYPE(rv) == SVt_PVAV) return AvFILL((AV*)rv) < 0;
    50          
473 1008 50         if (SvTYPE(rv) == SVt_PVHV) return HvKEYS((HV*)rv) == 0;
    50          
474 0           return FALSE;
475             }
476 4022 100         if (SvPOK(elem)) return SvCUR(elem) == 0;
477 2000           return FALSE;
478             }
479              
480 20           static bool builtin_is_nonempty(pTHX_ SV *elem) {
481 20           return !builtin_is_empty(aTHX_ elem);
482             }
483              
484 2015           static bool builtin_is_string(pTHX_ SV *elem) {
485 2015 100         return (SvPOK(elem) && !SvIOK(elem) && !SvNOK(elem) && !SvROK(elem)) ? TRUE : FALSE;
    50          
    50          
    50          
486             }
487              
488 9005           static bool builtin_is_number(pTHX_ SV *elem) {
489 9005 100         if (SvIOK(elem) || SvNOK(elem)) return TRUE;
    100          
490 2 50         if (SvPOK(elem) && looks_like_number(elem)) return TRUE;
    100          
491 1           return FALSE;
492             }
493              
494 6           static bool builtin_is_integer(pTHX_ SV *elem) {
495 6 100         if (SvIOK(elem) && !SvNOK(elem)) return TRUE;
    50          
496 4 100         if (SvNOK(elem)) {
497 3           NV val = SvNV(elem);
498 3           return val == (NV)(IV)val;
499             }
500 1 50         if (SvPOK(elem) && looks_like_number(elem)) {
    50          
501 1           NV val = SvNV(elem);
502 1           return val == (NV)(IV)val;
503             }
504 0           return FALSE;
505             }
506              
507             /* ============================================
508             Callback registry functions
509             ============================================ */
510              
511 921           static void init_callback_registry(pTHX) {
512 921 100         if (!g_callback_registry) {
513 53           g_callback_registry = newHV();
514             }
515 921           }
516              
517             /* Cleanup callback registry during global destruction */
518 53           static void cleanup_callback_registry(pTHX_ void *data) {
519             HE *entry;
520             PERL_UNUSED_ARG(data);
521              
522 53 50         if (!g_callback_registry) return;
523              
524             /* During global destruction, just NULL out the registry pointer.
525             * Perl will handle freeing the SVs. Trying to free them ourselves
526             * can cause crashes due to destruction order issues. */
527 53 50         if (PL_dirty) {
528 53           g_callback_registry = NULL;
529 53           return;
530             }
531              
532             /* Normal cleanup (not during global destruction) */
533 0           hv_iterinit(g_callback_registry);
534 0 0         while ((entry = hv_iternext(g_callback_registry))) {
535 0           SV *sv = HeVAL(entry);
536 0 0         if (sv && SvOK(sv)) {
    0          
537 0           RegisteredCallback *cb = (RegisteredCallback*)SvIVX(sv);
538 0 0         if (cb) {
539 0 0         if (cb->perl_callback) {
540 0           SvREFCNT_dec(cb->perl_callback);
541 0           cb->perl_callback = NULL;
542             }
543 0 0         if (cb->name) {
544 0           Safefree(cb->name);
545 0           cb->name = NULL;
546             }
547 0           Safefree(cb);
548             }
549             }
550             }
551 0           SvREFCNT_dec((SV*)g_callback_registry);
552 0           g_callback_registry = NULL;
553             }
554              
555 41580           static RegisteredCallback* get_registered_callback(pTHX_ const char *name) {
556             SV **svp;
557 41580 50         if (!g_callback_registry) return NULL;
558 41580           svp = hv_fetch(g_callback_registry, name, strlen(name), 0);
559 41580 100         if (!svp || !SvOK(*svp)) return NULL;
    50          
560 39550           return (RegisteredCallback*)SvIVX(*svp);
561             }
562              
563             /* Register a built-in predicate */
564 901           static void register_builtin_predicate(pTHX_ const char *name, UtilPredicateFunc func) {
565             RegisteredCallback *cb;
566             SV *sv;
567              
568 901           init_callback_registry(aTHX);
569              
570 901           Newxz(cb, 1, RegisteredCallback);
571 901           cb->name = savepv(name);
572 901           cb->predicate = func;
573 901           cb->mapper = NULL;
574 901           cb->reducer = NULL;
575 901           cb->perl_callback = NULL;
576              
577 901           sv = newSViv(PTR2IV(cb));
578 901           hv_store(g_callback_registry, name, strlen(name), sv, 0);
579 901           }
580              
581             /* Public API for XS modules to register predicates */
582 0           PERL_CALLCONV void funcutil_register_predicate_xs(pTHX_ const char *name,
583             UtilPredicateFunc func) {
584             RegisteredCallback *cb;
585             SV *sv;
586              
587 0           init_callback_registry(aTHX);
588              
589             /* Check if already registered */
590 0 0         if (get_registered_callback(aTHX_ name)) {
591 0           croak("Callback '%s' is already registered", name);
592             }
593              
594 0           Newxz(cb, 1, RegisteredCallback);
595 0           cb->name = savepv(name);
596 0           cb->predicate = func;
597 0           cb->mapper = NULL;
598 0           cb->reducer = NULL;
599 0           cb->perl_callback = NULL;
600              
601 0           sv = newSViv(PTR2IV(cb));
602 0           hv_store(g_callback_registry, name, strlen(name), sv, 0);
603 0           }
604              
605             /* Public API for XS modules to register mappers */
606 0           PERL_CALLCONV void funcutil_register_mapper_xs(pTHX_ const char *name,
607             UtilMapFunc func) {
608             RegisteredCallback *cb;
609             SV *sv;
610              
611 0           init_callback_registry(aTHX);
612              
613 0 0         if (get_registered_callback(aTHX_ name)) {
614 0           croak("Callback '%s' is already registered", name);
615             }
616              
617 0           Newxz(cb, 1, RegisteredCallback);
618 0           cb->name = savepv(name);
619 0           cb->predicate = NULL;
620 0           cb->mapper = func;
621 0           cb->reducer = NULL;
622 0           cb->perl_callback = NULL;
623              
624 0           sv = newSViv(PTR2IV(cb));
625 0           hv_store(g_callback_registry, name, strlen(name), sv, 0);
626 0           }
627              
628             /* Public API for XS modules to register reducers */
629 0           PERL_CALLCONV void funcutil_register_reducer_xs(pTHX_ const char *name,
630             UtilReduceFunc func) {
631             RegisteredCallback *cb;
632             SV *sv;
633              
634 0           init_callback_registry(aTHX);
635              
636 0 0         if (get_registered_callback(aTHX_ name)) {
637 0           croak("Callback '%s' is already registered", name);
638             }
639              
640 0           Newxz(cb, 1, RegisteredCallback);
641 0           cb->name = savepv(name);
642 0           cb->predicate = NULL;
643 0           cb->mapper = NULL;
644 0           cb->reducer = func;
645 0           cb->perl_callback = NULL;
646              
647 0           sv = newSViv(PTR2IV(cb));
648 0           hv_store(g_callback_registry, name, strlen(name), sv, 0);
649 0           }
650              
651             /* Check if a callback exists */
652 6018           static bool has_callback(pTHX_ const char *name) {
653 6018           return get_registered_callback(aTHX_ name) != NULL;
654             }
655              
656             /* List all registered callbacks */
657 1006           static AV* list_callbacks(pTHX) {
658             AV *result;
659             HE *entry;
660              
661 1006           result = newAV();
662 1006 50         if (!g_callback_registry) return result;
663              
664 1006           hv_iterinit(g_callback_registry);
665 18116 100         while ((entry = hv_iternext(g_callback_registry))) {
666             I32 klen;
667 17110           char *key = hv_iterkey(entry, &klen);
668 17110           av_push(result, newSVpvn(key, klen));
669             }
670 1006           return result;
671             }
672              
673             /* Initialize built-in callbacks (called from BOOT) */
674 53           static void init_builtin_callbacks(pTHX) {
675 53           register_builtin_predicate(aTHX_ ":is_defined", builtin_is_defined);
676 53           register_builtin_predicate(aTHX_ ":is_true", builtin_is_true);
677 53           register_builtin_predicate(aTHX_ ":is_false", builtin_is_false);
678 53           register_builtin_predicate(aTHX_ ":is_ref", builtin_is_ref);
679 53           register_builtin_predicate(aTHX_ ":is_array", builtin_is_array);
680 53           register_builtin_predicate(aTHX_ ":is_hash", builtin_is_hash);
681 53           register_builtin_predicate(aTHX_ ":is_code", builtin_is_code);
682 53           register_builtin_predicate(aTHX_ ":is_positive", builtin_is_positive);
683 53           register_builtin_predicate(aTHX_ ":is_negative", builtin_is_negative);
684 53           register_builtin_predicate(aTHX_ ":is_zero", builtin_is_zero);
685 53           register_builtin_predicate(aTHX_ ":is_even", builtin_is_even);
686 53           register_builtin_predicate(aTHX_ ":is_odd", builtin_is_odd);
687 53           register_builtin_predicate(aTHX_ ":is_empty", builtin_is_empty);
688 53           register_builtin_predicate(aTHX_ ":is_nonempty", builtin_is_nonempty);
689 53           register_builtin_predicate(aTHX_ ":is_string", builtin_is_string);
690 53           register_builtin_predicate(aTHX_ ":is_number", builtin_is_number);
691 53           register_builtin_predicate(aTHX_ ":is_integer", builtin_is_integer);
692 53           }
693              
694             /* ============================================
695             Custom OP implementations - fastest path
696             ============================================ */
697              
698             /* identity: just return the top of stack */
699 0           static OP* pp_identity(pTHX) {
700             /* Value already on stack, nothing to do */
701 0           return NORMAL;
702             }
703              
704             /* always: push stored value from op_targ index */
705 0           static OP* pp_always(pTHX) {
706 0           dSP;
707 0           IV idx = PL_op->op_targ;
708 0 0         XPUSHs(g_always_values[idx]);
709 0           RETURN;
710             }
711              
712             /* clamp: 3 values on stack, return clamped */
713 30           static OP* pp_clamp(pTHX) {
714 30           dSP; dMARK; dORIGMARK;
715             SV *val_sv, *min_sv, *max_sv;
716             NV value, min, max, result;
717            
718             /* We get 3 args on stack after the mark */
719 30 50         if (SP - MARK != 3) {
720             /* Fallback: just use direct POPs if no mark context */
721 0           SP = ORIGMARK;
722 0           PUTBACK;
723             /* Pop without mark - shouldn't happen in list context */
724 0           dSP;
725 0           max_sv = POPs;
726 0           min_sv = POPs;
727 0           val_sv = POPs;
728             } else {
729 30           val_sv = MARK[1];
730 30           min_sv = MARK[2];
731 30           max_sv = MARK[3];
732 30           SP = ORIGMARK; /* reset stack to before args */
733             }
734              
735 30           value = SvNV(val_sv);
736 30           min = SvNV(min_sv);
737 30           max = SvNV(max_sv);
738              
739 30 100         if (value < min) {
740 6           result = min;
741 24 100         } else if (value > max) {
742 7           result = max;
743             } else {
744 17           result = value;
745             }
746            
747 30           PUSHs(sv_2mortal(newSVnv(result)));
748 30           RETURN;
749             }
750              
751             /* nvl: 2 values on stack, return first if defined */
752 0           static OP* pp_nvl(pTHX) {
753 0           dSP;
754 0           SV *def_sv = POPs;
755 0           SV *val_sv = TOPs;
756              
757 0 0         if (!SvOK(val_sv)) {
758 0           SETs(def_sv);
759             }
760 0           RETURN;
761             }
762              
763             /* ============================================
764             Type predicate custom ops - blazing fast!
765             These are the fastest possible type checks:
766             single SV flag check, no function call overhead
767             ============================================ */
768              
769             /* is_ref: check if value is a reference */
770 10           static OP* pp_is_ref(pTHX) {
771 10           dSP;
772 10           SV *sv = TOPs;
773 10 100         SETs(SvROK(sv) ? &PL_sv_yes : &PL_sv_no);
774 10           RETURN;
775             }
776              
777             /* is_array: check if value is an arrayref */
778 4           static OP* pp_is_array(pTHX) {
779 4           dSP;
780 4           SV *sv = TOPs;
781 4 100         SETs((SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) ? &PL_sv_yes : &PL_sv_no);
    100          
782 4           RETURN;
783             }
784              
785             /* is_hash: check if value is a hashref */
786 3           static OP* pp_is_hash(pTHX) {
787 3           dSP;
788 3           SV *sv = TOPs;
789 3 100         SETs((SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) ? &PL_sv_yes : &PL_sv_no);
    100          
790 3           RETURN;
791             }
792              
793             /* is_code: check if value is a coderef */
794 3           static OP* pp_is_code(pTHX) {
795 3           dSP;
796 3           SV *sv = TOPs;
797 3 100         SETs((SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) ? &PL_sv_yes : &PL_sv_no);
    100          
798 3           RETURN;
799             }
800              
801             /* is_defined: check if value is defined */
802 9           static OP* pp_is_defined(pTHX) {
803 9           dSP;
804 9           SV *sv = TOPs;
805 9 100         SETs(SvOK(sv) ? &PL_sv_yes : &PL_sv_no);
806 9           RETURN;
807             }
808              
809             /* ============================================
810             String predicate custom ops - blazing fast!
811             Direct SvPV/SvCUR access, no function overhead
812             ============================================ */
813              
814             /* is_empty: check if string is undefined or empty */
815 4           static OP* pp_is_empty(pTHX) {
816 4           dSP;
817 4           SV *sv = TOPs;
818             /* Empty if: undefined OR length is 0 */
819 4 100         if (!SvOK(sv)) {
820 1           SETs(&PL_sv_yes);
821             } else {
822             STRLEN len;
823 3           SvPV(sv, len);
824 3 100         SETs(len == 0 ? &PL_sv_yes : &PL_sv_no);
825             }
826 4           RETURN;
827             }
828              
829             /* starts_with: check if string starts with prefix */
830 13           static OP* pp_starts_with(pTHX) {
831 13           dSP;
832 13           SV *prefix_sv = POPs;
833 13           SV *str_sv = TOPs;
834              
835 13 50         if (!SvOK(str_sv) || !SvOK(prefix_sv)) {
    50          
836 0           SETs(&PL_sv_no);
837 0           RETURN;
838             }
839              
840             STRLEN str_len, prefix_len;
841 13           const char *str = SvPV(str_sv, str_len);
842 13           const char *prefix = SvPV(prefix_sv, prefix_len);
843              
844 13 50         if (prefix_len > str_len) {
845 0           SETs(&PL_sv_no);
846 13 100         } else if (prefix_len == 0) {
847 1           SETs(&PL_sv_yes); /* Empty prefix always matches */
848             } else {
849 12 100         SETs(memcmp(str, prefix, prefix_len) == 0 ? &PL_sv_yes : &PL_sv_no);
850             }
851 13           RETURN;
852             }
853              
854             /* ends_with: check if string ends with suffix */
855 4           static OP* pp_ends_with(pTHX) {
856 4           dSP;
857 4           SV *suffix_sv = POPs;
858 4           SV *str_sv = TOPs;
859              
860 4 50         if (!SvOK(str_sv) || !SvOK(suffix_sv)) {
    50          
861 0           SETs(&PL_sv_no);
862 0           RETURN;
863             }
864              
865             STRLEN str_len, suffix_len;
866 4           const char *str = SvPV(str_sv, str_len);
867 4           const char *suffix = SvPV(suffix_sv, suffix_len);
868              
869 4 50         if (suffix_len > str_len) {
870 0           SETs(&PL_sv_no);
871 4 100         } else if (suffix_len == 0) {
872 1           SETs(&PL_sv_yes); /* Empty suffix always matches */
873             } else {
874 3           const char *str_end = str + str_len - suffix_len;
875 3 100         SETs(memcmp(str_end, suffix, suffix_len) == 0 ? &PL_sv_yes : &PL_sv_no);
876             }
877 4           RETURN;
878             }
879              
880             /* ============================================
881             Boolean/Truthiness custom ops - blazing fast!
882             Direct SvTRUE check, minimal overhead
883             ============================================ */
884              
885             /* is_true: check if value is truthy (Perl truth semantics) */
886 5           static OP* pp_is_true(pTHX) {
887 5           dSP;
888 5           SV *sv = TOPs;
889 5 100         SETs(SvTRUE(sv) ? &PL_sv_yes : &PL_sv_no);
890 5           RETURN;
891             }
892              
893             /* is_false: check if value is falsy (Perl truth semantics) */
894 5           static OP* pp_is_false(pTHX) {
895 5           dSP;
896 5           SV *sv = TOPs;
897 5 100         SETs(SvTRUE(sv) ? &PL_sv_no : &PL_sv_yes);
898 5           RETURN;
899             }
900              
901             /* bool: normalize to boolean (1 or empty string) */
902 7           static OP* pp_bool(pTHX) {
903 7           dSP;
904 7           SV *sv = TOPs;
905 7 100         SETs(SvTRUE(sv) ? &PL_sv_yes : &PL_sv_no);
906 7           RETURN;
907             }
908              
909             /* ============================================
910             Extended type predicate custom ops - blazing fast!
911             ============================================ */
912              
913             /* is_num: check if value is numeric (has numeric value or looks like number) */
914 6           static OP* pp_is_num(pTHX) {
915 6           dSP;
916 6           SV *sv = TOPs;
917             /* SvNIOK: has numeric (NV or IV) value cached */
918             /* Also check looks_like_number for strings that can be numbers */
919 6 100         SETs((SvNIOK(sv) || looks_like_number(sv)) ? &PL_sv_yes : &PL_sv_no);
    100          
920 6           RETURN;
921             }
922              
923             /* is_int: check if value is an integer */
924 5           static OP* pp_is_int(pTHX) {
925 5           dSP;
926 5           SV *sv = TOPs;
927             /* SvIOK: has integer value cached */
928 5 100         if (SvIOK(sv)) {
929 3           SETs(&PL_sv_yes);
930 2 100         } else if (SvNOK(sv)) {
931             /* It's a float - check if it's a whole number */
932 1           NV nv = SvNV(sv);
933 1 50         SETs((nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no);
934 1 50         } else if (looks_like_number(sv)) {
935             /* String that looks like a number - check if integer */
936             STRLEN len;
937 0           const char *pv = SvPV(sv, len);
938             /* Simple check: no decimal point or exponent */
939 0           bool has_dot = FALSE;
940             STRLEN i;
941 0 0         for (i = 0; i < len; i++) {
942 0 0         if (pv[i] == '.' || pv[i] == 'e' || pv[i] == 'E') {
    0          
    0          
943 0           has_dot = TRUE;
944 0           break;
945             }
946             }
947 0 0         if (has_dot) {
948             /* Has decimal - check if value is actually integer */
949 0           NV nv = SvNV(sv);
950 0 0         SETs((nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no);
951             } else {
952 0           SETs(&PL_sv_yes);
953             }
954             } else {
955 1           SETs(&PL_sv_no);
956             }
957 5           RETURN;
958             }
959              
960             /* is_blessed: check if value is a blessed reference */
961 3           static OP* pp_is_blessed(pTHX) {
962 3           dSP;
963 3           SV *sv = TOPs;
964 3 100         SETs(sv_isobject(sv) ? &PL_sv_yes : &PL_sv_no);
965 3           RETURN;
966             }
967              
968             /* is_scalar_ref: check if value is a scalar reference (not array/hash/code/etc) */
969 3           static OP* pp_is_scalar_ref(pTHX) {
970 3           dSP;
971 3           SV *sv = TOPs;
972 3 100         if (SvROK(sv)) {
973 2           SV *rv = SvRV(sv);
974 2           svtype type = SvTYPE(rv);
975             /* Scalar refs are < SVt_PVAV (array) */
976 2 100         SETs((type < SVt_PVAV) ? &PL_sv_yes : &PL_sv_no);
977             } else {
978 1           SETs(&PL_sv_no);
979             }
980 3           RETURN;
981             }
982              
983             /* is_regex: check if value is a compiled regex */
984 3           static OP* pp_is_regex(pTHX) {
985 3           dSP;
986 3           SV *sv = TOPs;
987             /* SvRXOK: check if SV is a regex (qr//) - available since Perl 5.10 */
988 3 100         SETs(SvRXOK(sv) ? &PL_sv_yes : &PL_sv_no);
989 3           RETURN;
990             }
991              
992             /* is_glob: check if value is a glob (*foo) */
993 2           static OP* pp_is_glob(pTHX) {
994 2           dSP;
995 2           SV *sv = TOPs;
996 2 100         SETs((SvTYPE(sv) == SVt_PVGV) ? &PL_sv_yes : &PL_sv_no);
997 2           RETURN;
998             }
999              
1000             /* is_string: check if value is a plain scalar (defined, not a reference) */
1001 0           static OP* pp_is_string(pTHX) {
1002 0           dSP;
1003 0           SV *sv = TOPs;
1004 0 0         SETs((SvOK(sv) && !SvROK(sv)) ? &PL_sv_yes : &PL_sv_no);
    0          
1005 0           RETURN;
1006             }
1007              
1008             /* ============================================
1009             Numeric predicate custom ops - blazing fast!
1010             Direct SvNV comparison, minimal overhead
1011             ============================================ */
1012              
1013             /* is_positive: check if value is > 0 */
1014 8           static OP* pp_is_positive(pTHX) {
1015 8           dSP;
1016 8           SV *sv = TOPs;
1017 8 50         if (SvNIOK(sv) || looks_like_number(sv)) {
    0          
1018 8           NV nv = SvNV(sv);
1019 8 100         SETs((nv > 0) ? &PL_sv_yes : &PL_sv_no);
1020             } else {
1021 0           SETs(&PL_sv_no);
1022             }
1023 8           RETURN;
1024             }
1025              
1026             /* is_negative: check if value is < 0 */
1027 4           static OP* pp_is_negative(pTHX) {
1028 4           dSP;
1029 4           SV *sv = TOPs;
1030 4 50         if (SvNIOK(sv) || looks_like_number(sv)) {
    0          
1031 4           NV nv = SvNV(sv);
1032 4 100         SETs((nv < 0) ? &PL_sv_yes : &PL_sv_no);
1033             } else {
1034 0           SETs(&PL_sv_no);
1035             }
1036 4           RETURN;
1037             }
1038              
1039             /* is_zero: check if value is == 0 */
1040 4           static OP* pp_is_zero(pTHX) {
1041 4           dSP;
1042 4           SV *sv = TOPs;
1043 4 50         if (SvNIOK(sv) || looks_like_number(sv)) {
    0          
1044 4           NV nv = SvNV(sv);
1045 4 100         SETs((nv == 0) ? &PL_sv_yes : &PL_sv_no);
1046             } else {
1047 0           SETs(&PL_sv_no);
1048             }
1049 4           RETURN;
1050             }
1051              
1052             /* ============================================
1053             Numeric utility custom ops
1054             ============================================ */
1055              
1056             /* is_even: check if integer is even (single bitwise AND) */
1057 5           static OP* pp_is_even(pTHX) {
1058 5           dSP;
1059 5           SV *sv = TOPs;
1060 5 50         if (SvIOK(sv)) {
1061 5 100         SETs((SvIVX(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
1062 0 0         } else if (SvNIOK(sv)) {
1063 0           NV nv = SvNV(sv);
1064 0 0         if (nv == (NV)(IV)nv) {
1065 0 0         SETs(((IV)nv & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
1066             } else {
1067 0           SETs(&PL_sv_no);
1068             }
1069 0 0         } else if (looks_like_number(sv)) {
1070 0 0         SETs((SvIV(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no);
1071             } else {
1072 0           SETs(&PL_sv_no);
1073             }
1074 5           RETURN;
1075             }
1076              
1077             /* is_odd: check if integer is odd (single bitwise AND) */
1078 5           static OP* pp_is_odd(pTHX) {
1079 5           dSP;
1080 5           SV *sv = TOPs;
1081 5 50         if (SvIOK(sv)) {
1082 5 100         SETs((SvIVX(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
1083 0 0         } else if (SvNIOK(sv)) {
1084 0           NV nv = SvNV(sv);
1085 0 0         if (nv == (NV)(IV)nv) {
1086 0 0         SETs(((IV)nv & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
1087             } else {
1088 0           SETs(&PL_sv_no);
1089             }
1090 0 0         } else if (looks_like_number(sv)) {
1091 0 0         SETs((SvIV(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no);
1092             } else {
1093 0           SETs(&PL_sv_no);
1094             }
1095 5           RETURN;
1096             }
1097              
1098             /* is_between: check if value is between min and max (inclusive) */
1099 0           static OP* pp_is_between(pTHX) {
1100 0           dSP;
1101 0           SV *max_sv = POPs;
1102 0           SV *min_sv = POPs;
1103 0           SV *val_sv = TOPs;
1104              
1105 0 0         if (SvNIOK(val_sv) || looks_like_number(val_sv)) {
    0          
1106 0           NV val = SvNV(val_sv);
1107 0           NV min = SvNV(min_sv);
1108 0           NV max = SvNV(max_sv);
1109 0 0         SETs((val >= min && val <= max) ? &PL_sv_yes : &PL_sv_no);
    0          
1110             } else {
1111 0           SETs(&PL_sv_no);
1112             }
1113 0           RETURN;
1114             }
1115              
1116             /* ============================================
1117             Collection custom ops - direct AvFILL/HvKEYS access
1118             ============================================ */
1119              
1120             /* is_empty_array: check if arrayref is empty - direct AvFILL */
1121 3           static OP* pp_is_empty_array(pTHX) {
1122 3           dSP;
1123 3           SV *sv = TOPs;
1124 3 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    50          
1125 2           AV *av = (AV*)SvRV(sv);
1126 2 50         SETs(AvFILL(av) < 0 ? &PL_sv_yes : &PL_sv_no);
    100          
1127             } else {
1128 1           SETs(&PL_sv_no); /* Not an arrayref */
1129             }
1130 3           RETURN;
1131             }
1132              
1133             /* is_empty_hash: check if hashref is empty - direct HvKEYS */
1134 3           static OP* pp_is_empty_hash(pTHX) {
1135 3           dSP;
1136 3           SV *sv = TOPs;
1137 3 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
    50          
1138 2           HV *hv = (HV*)SvRV(sv);
1139 2 50         SETs(HvKEYS(hv) == 0 ? &PL_sv_yes : &PL_sv_no);
    100          
1140             } else {
1141 1           SETs(&PL_sv_no); /* Not a hashref */
1142             }
1143 3           RETURN;
1144             }
1145              
1146             /* array_len: get array length - direct AvFILL + 1 */
1147 3           static OP* pp_array_len(pTHX) {
1148 3           dSP;
1149 3           SV *sv = TOPs;
1150 3 50         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    50          
1151 3           AV *av = (AV*)SvRV(sv);
1152 3 50         SV *len = sv_2mortal(newSViv(AvFILL(av) + 1));
1153 3           SETs(len);
1154             } else {
1155 0           SETs(&PL_sv_undef); /* Not an arrayref */
1156             }
1157 3           RETURN;
1158             }
1159              
1160             /* hash_size: get hash key count - direct HvKEYS */
1161 3           static OP* pp_hash_size(pTHX) {
1162 3           dSP;
1163 3           SV *sv = TOPs;
1164 3 50         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
    50          
1165 3           HV *hv = (HV*)SvRV(sv);
1166 3 50         SV *size = sv_2mortal(newSViv(HvKEYS(hv)));
1167 3           SETs(size);
1168             } else {
1169 0           SETs(&PL_sv_undef); /* Not a hashref */
1170             }
1171 3           RETURN;
1172             }
1173              
1174             /* array_first: get first element without slice overhead */
1175 3           static OP* pp_array_first(pTHX) {
1176 3           dSP;
1177 3           SV *sv = TOPs;
1178 6 50         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    50          
1179 3           AV *av = (AV*)SvRV(sv);
1180 3 50         if (AvFILL(av) >= 0) {
    100          
1181 2           SV **elem = av_fetch(av, 0, 0);
1182 2 50         SETs(elem ? *elem : &PL_sv_undef);
1183             } else {
1184 1           SETs(&PL_sv_undef); /* Empty array */
1185             }
1186             } else {
1187 0           SETs(&PL_sv_undef); /* Not an arrayref */
1188             }
1189 3           RETURN;
1190             }
1191              
1192             /* array_last: get last element without slice overhead */
1193 3           static OP* pp_array_last(pTHX) {
1194 3           dSP;
1195 3           SV *sv = TOPs;
1196 6 50         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    50          
1197 3           AV *av = (AV*)SvRV(sv);
1198 3 50         IV last_idx = AvFILL(av);
1199 3 100         if (last_idx >= 0) {
1200 2           SV **elem = av_fetch(av, last_idx, 0);
1201 2 50         SETs(elem ? *elem : &PL_sv_undef);
1202             } else {
1203 1           SETs(&PL_sv_undef); /* Empty array */
1204             }
1205             } else {
1206 0           SETs(&PL_sv_undef); /* Not an arrayref */
1207             }
1208 3           RETURN;
1209             }
1210              
1211              
1212             /* ============================================
1213             String manipulation custom ops
1214             ============================================ */
1215              
1216             /* trim: remove leading/trailing whitespace */
1217 5           static OP* pp_trim(pTHX) {
1218 5           dSP;
1219 5           SV *sv = TOPs;
1220              
1221 5 50         if (!SvOK(sv)) {
1222 0           SETs(&PL_sv_undef);
1223 0           RETURN;
1224             }
1225              
1226             STRLEN len;
1227 5           const char *str = SvPV(sv, len);
1228 5           const char *start = str;
1229 5           const char *end = str + len;
1230              
1231             /* Skip leading whitespace */
1232 11 50         while (start < end && isSPACE(*start)) {
    100          
1233 6           start++;
1234             }
1235              
1236             /* Skip trailing whitespace */
1237 11 50         while (end > start && isSPACE(*(end - 1))) {
    100          
1238 6           end--;
1239             }
1240              
1241             /* Create new SV with trimmed content */
1242 5           SV *result = sv_2mortal(newSVpvn(start, end - start));
1243 5           SETs(result);
1244 5           RETURN;
1245             }
1246              
1247             /* ltrim: remove leading whitespace only */
1248 3           static OP* pp_ltrim(pTHX) {
1249 3           dSP;
1250 3           SV *sv = TOPs;
1251              
1252 3 50         if (!SvOK(sv)) {
1253 0           SETs(&PL_sv_undef);
1254 0           RETURN;
1255             }
1256              
1257             STRLEN len;
1258 3           const char *str = SvPV(sv, len);
1259 3           const char *start = str;
1260 3           const char *end = str + len;
1261              
1262             /* Skip leading whitespace */
1263 7 50         while (start < end && isSPACE(*start)) {
    100          
1264 4           start++;
1265             }
1266              
1267 3           SV *result = sv_2mortal(newSVpvn(start, end - start));
1268 3           SETs(result);
1269 3           RETURN;
1270             }
1271              
1272             /* rtrim: remove trailing whitespace only */
1273 3           static OP* pp_rtrim(pTHX) {
1274 3           dSP;
1275 3           SV *sv = TOPs;
1276              
1277 3 50         if (!SvOK(sv)) {
1278 0           SETs(&PL_sv_undef);
1279 0           RETURN;
1280             }
1281              
1282             STRLEN len;
1283 3           const char *str = SvPV(sv, len);
1284 3           const char *end = str + len;
1285              
1286             /* Skip trailing whitespace */
1287 7 50         while (end > str && isSPACE(*(end - 1))) {
    100          
1288 4           end--;
1289             }
1290              
1291 3           SV *result = sv_2mortal(newSVpvn(str, end - str));
1292 3           SETs(result);
1293 3           RETURN;
1294             }
1295              
1296             /* ============================================
1297             Conditional custom ops
1298             ============================================ */
1299              
1300             /* maybe: return $then if $val is defined, else undef */
1301 2           static OP* pp_maybe(pTHX) {
1302 2           dSP;
1303 2           SV *then_sv = POPs;
1304 2           SV *val_sv = TOPs;
1305              
1306 2 100         if (SvOK(val_sv)) {
1307 1           SETs(then_sv);
1308             } else {
1309 1           SETs(&PL_sv_undef);
1310             }
1311 2           RETURN;
1312             }
1313              
1314             /* ============================================
1315             Numeric custom ops
1316             ============================================ */
1317              
1318             /* sign: return -1, 0, or 1 based on value */
1319 3           static OP* pp_sign(pTHX) {
1320 3           dSP;
1321 3           SV *sv = TOPs;
1322              
1323 3 50         if (!SvNIOK(sv) && !looks_like_number(sv)) {
    0          
1324 0           SETs(&PL_sv_undef);
1325 0           RETURN;
1326             }
1327              
1328 3           NV nv = SvNV(sv);
1329 3 100         if (nv > 0) {
1330 1           SETs(sv_2mortal(newSViv(1)));
1331 2 100         } else if (nv < 0) {
1332 1           SETs(sv_2mortal(newSViv(-1)));
1333             } else {
1334 1           SETs(sv_2mortal(newSViv(0)));
1335             }
1336 3           RETURN;
1337             }
1338              
1339             /* min2: return smaller of two values */
1340 4           static OP* pp_min2(pTHX) {
1341 4           dSP;
1342 4           SV *b_sv = POPs;
1343 4           SV *a_sv = TOPs;
1344              
1345 4           NV a = SvNV(a_sv);
1346 4           NV b = SvNV(b_sv);
1347              
1348 4 100         SETs(a <= b ? a_sv : b_sv);
1349 4           RETURN;
1350             }
1351              
1352             /* max2: return larger of two values */
1353 4           static OP* pp_max2(pTHX) {
1354 4           dSP;
1355 4           SV *b_sv = POPs;
1356 4           SV *a_sv = TOPs;
1357              
1358 4           NV a = SvNV(a_sv);
1359 4           NV b = SvNV(b_sv);
1360              
1361 4 100         SETs(a >= b ? a_sv : b_sv);
1362 4           RETURN;
1363             }
1364              
1365              
1366             /* ============================================
1367             Call checkers - replace function calls with custom ops
1368             ============================================ */
1369              
1370             /*
1371             * Check if an op is accessing $_ (the default variable).
1372             * Custom ops now properly handle list context with marks,
1373             * but we still fall back to XS for $_ because of how map/grep
1374             * set up the op tree with $_ - the argument evaluation is different.
1375             * Returns TRUE if we should fall back to XS.
1376             */
1377 152           static bool op_is_dollar_underscore(pTHX_ OP *op) {
1378 152 50         if (!op) return FALSE;
1379            
1380             /* Check for $_ access: rv2sv -> gv for "_" */
1381 152 100         if (op->op_type == OP_RV2SV) {
1382 4           OP *gvop = cUNOPx(op)->op_first;
1383 4 50         if (gvop && gvop->op_type == OP_GV) {
    50          
1384 4           GV *gv = cGVOPx_gv(gvop);
1385 4 50         if (gv && GvNAMELEN(gv) == 1 && GvNAME(gv)[0] == '_') {
    50          
    50          
1386 4           return TRUE;
1387             }
1388             }
1389             }
1390            
1391 148           return FALSE;
1392             }
1393              
1394             /* identity call checker - replaces identity($x) with just $x */
1395 3           static OP* identity_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1396             OP *pushop, *argop, *cvop;
1397              
1398             PERL_UNUSED_ARG(namegv);
1399             PERL_UNUSED_ARG(ckobj);
1400              
1401             /* Get the argument list */
1402 3           pushop = cUNOPx(entersubop)->op_first;
1403 3 50         if (!OpHAS_SIBLING(pushop)) {
1404 3           pushop = cUNOPx(pushop)->op_first;
1405             }
1406              
1407             /* Find first real arg (skip pushmark) */
1408 3 50         argop = OpSIBLING(pushop);
1409              
1410             /* Find the cv op (last sibling) */
1411 3           cvop = argop;
1412 6 100         while (OpHAS_SIBLING(cvop)) {
1413 3 50         cvop = OpSIBLING(cvop);
1414             }
1415              
1416             /* Check for exactly one argument */
1417 3 50         if (argop != cvop && OpSIBLING(argop) == cvop) {
    50          
    50          
1418             /* Single arg - just return the arg itself */
1419 3           OP *arg = argop;
1420              
1421             /* If arg is $_, fall back to XS (map/grep context) */
1422 3 50         if (op_is_dollar_underscore(aTHX_ arg)) {
1423 0           return entersubop;
1424             }
1425              
1426             /* Detach arg from list */
1427 3           OpMORESIB_set(pushop, cvop);
1428 3           OpLASTSIB_set(arg, NULL);
1429              
1430 3           op_free(entersubop);
1431 3           return arg; /* Just return the argument op directly! */
1432             }
1433              
1434             /* Fall through to XS for edge cases */
1435 0           return entersubop;
1436             }
1437              
1438             /* clamp call checker - replaces clamp($v, $min, $max) with custom op */
1439 8           static OP* clamp_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1440             OP *pushop, *arg1, *arg2, *arg3, *cvop;
1441             OP *listop;
1442              
1443             PERL_UNUSED_ARG(namegv);
1444             PERL_UNUSED_ARG(ckobj);
1445              
1446             /* Get the argument list */
1447 8           pushop = cUNOPx(entersubop)->op_first;
1448 8 50         if (!OpHAS_SIBLING(pushop)) {
1449 8           pushop = cUNOPx(pushop)->op_first;
1450             }
1451              
1452             /* Find args (skip pushmark) */
1453 8 50         arg1 = OpSIBLING(pushop); /* value */
1454 8 50         if (!arg1) return entersubop;
1455              
1456 8 50         arg2 = OpSIBLING(arg1); /* min */
1457 8 50         if (!arg2) return entersubop;
1458              
1459 8 50         arg3 = OpSIBLING(arg2); /* max */
1460 8 50         if (!arg3) return entersubop;
1461              
1462 8 50         cvop = OpSIBLING(arg3); /* cv op (should be last) */
1463 8 50         if (!cvop || OpHAS_SIBLING(cvop)) return entersubop;
    50          
1464              
1465             /*
1466             * If arg1 is accessing $_, we're likely in map/grep.
1467             * The custom op doesn't work correctly in these contexts.
1468             * Fall back to XS.
1469             */
1470 8 100         if (op_is_dollar_underscore(aTHX_ arg1)) {
1471 2           return entersubop;
1472             }
1473              
1474             /* Detach args from the entersub tree */
1475 6           OpMORESIB_set(pushop, cvop);
1476              
1477             /* Chain arg1 -> arg2 -> arg3 */
1478 6           OpMORESIB_set(arg1, arg2);
1479 6           OpMORESIB_set(arg2, arg3);
1480 6           OpLASTSIB_set(arg3, NULL);
1481              
1482             /*
1483             * Create a LISTOP with 3 children for clamp.
1484             * We use op_convert_list to properly set up a list context.
1485             */
1486 6           listop = op_convert_list(OP_LIST, OPf_STACKED, arg1);
1487 6           listop->op_type = OP_CUSTOM;
1488 6           listop->op_ppaddr = pp_clamp;
1489 6           listop->op_flags = (listop->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR | OPf_STACKED;
1490 6           listop->op_targ = pad_alloc(OP_NULL, SVs_PADTMP);
1491              
1492 6           op_free(entersubop);
1493 6           return listop;
1494             }
1495              
1496             /* Generic call checker for single-arg type predicates */
1497 120           static OP* type_predicate_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj, OP* (*pp_func)(pTHX)) {
1498             OP *pushop, *argop, *cvop;
1499              
1500             PERL_UNUSED_ARG(namegv);
1501             PERL_UNUSED_ARG(ckobj);
1502              
1503             /* Get the argument list */
1504 120           pushop = cUNOPx(entersubop)->op_first;
1505 120 50         if (!OpHAS_SIBLING(pushop)) {
1506 120           pushop = cUNOPx(pushop)->op_first;
1507             }
1508              
1509             /* Find first real arg (skip pushmark) */
1510 120 50         argop = OpSIBLING(pushop);
1511              
1512             /* Find the cv op (last sibling) */
1513 120           cvop = argop;
1514 240 100         while (OpHAS_SIBLING(cvop)) {
1515 120 50         cvop = OpSIBLING(cvop);
1516             }
1517              
1518             /* Check for exactly one argument */
1519 120 50         if (argop != cvop && OpSIBLING(argop) == cvop) {
    50          
    50          
1520 120           OP *arg = argop;
1521              
1522             /* If arg is $_, fall back to XS (map/grep context) */
1523 120 100         if (op_is_dollar_underscore(aTHX_ arg)) {
1524 1           return entersubop;
1525             }
1526              
1527             /* Detach arg from list */
1528 119           OpMORESIB_set(pushop, cvop);
1529 119           OpLASTSIB_set(arg, NULL);
1530              
1531             /* Create unary custom op with arg as child.
1532             Build as OP_NULL first, then convert to OP_CUSTOM — calling
1533             newUNOP(OP_CUSTOM, ...) directly trips the
1534             Perl_newUNOP: Assertion `(PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP'
1535             on -DDEBUGGING perls because OP_CUSTOM has no fixed class. */
1536 119           OP *newop = newUNOP(OP_NULL, 0, arg);
1537 119           newop->op_type = OP_CUSTOM;
1538 119           newop->op_ppaddr = pp_func;
1539              
1540 119           op_free(entersubop);
1541 119           return newop;
1542             }
1543              
1544             /* Fall through to XS for edge cases */
1545 0           return entersubop;
1546             }
1547              
1548             /* Individual call checkers for each type predicate */
1549 6           static OP* is_ref_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1550 6           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_ref);
1551             }
1552              
1553 4           static OP* is_array_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1554 4           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_array);
1555             }
1556              
1557 3           static OP* is_hash_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1558 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_hash);
1559             }
1560              
1561 3           static OP* is_code_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1562 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_code);
1563             }
1564              
1565 5           static OP* is_defined_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1566 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_defined);
1567             }
1568              
1569             /* String predicate call checkers */
1570 4           static OP* is_empty_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1571 4           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_empty);
1572             }
1573              
1574             /* Generic two-arg string predicate call checker */
1575 21           static OP* two_arg_string_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj, OP* (*pp_func)(pTHX)) {
1576             OP *pushop, *arg1, *arg2, *cvop;
1577              
1578             PERL_UNUSED_ARG(namegv);
1579             PERL_UNUSED_ARG(ckobj);
1580              
1581             /* Get the argument list */
1582 21           pushop = cUNOPx(entersubop)->op_first;
1583 21 50         if (!OpHAS_SIBLING(pushop)) {
1584 21           pushop = cUNOPx(pushop)->op_first;
1585             }
1586              
1587             /* Find args (skip pushmark) */
1588 21 50         arg1 = OpSIBLING(pushop); /* string */
1589 21 50         if (!arg1) return entersubop;
1590              
1591 21 50         arg2 = OpSIBLING(arg1); /* prefix/suffix */
1592 21 50         if (!arg2) return entersubop;
1593              
1594 21 50         cvop = OpSIBLING(arg2); /* cv op (should be last) */
1595 21 50         if (!cvop || OpHAS_SIBLING(cvop)) return entersubop;
    50          
1596              
1597             /* If arg1 is $_, fall back to XS (map/grep context) */
1598 21 100         if (op_is_dollar_underscore(aTHX_ arg1)) {
1599 1           return entersubop;
1600             }
1601              
1602             /* Detach args from the entersub tree */
1603 20           OpMORESIB_set(pushop, cvop);
1604              
1605             /* Chain arg1 -> arg2 */
1606 20           OpMORESIB_set(arg1, arg2);
1607 20           OpLASTSIB_set(arg2, NULL);
1608              
1609             /*
1610             * Create a custom BINOP-style op.
1611             * Use newBINOP to create a proper binary op structure where
1612             * both arguments are children. The optimizer won't eliminate
1613             * children of an op that's going to use them.
1614             */
1615 20           OP *binop = newBINOP(OP_NULL, 0, arg1, arg2);
1616 20           binop->op_type = OP_CUSTOM;
1617 20           binop->op_ppaddr = pp_func;
1618 20           binop->op_flags = OPf_WANT_SCALAR | OPf_KIDS | OPf_STACKED;
1619              
1620 20           op_free(entersubop);
1621 20           return binop;
1622             }
1623              
1624 7           static OP* starts_with_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1625 7           return two_arg_string_call_checker(aTHX_ entersubop, namegv, ckobj, pp_starts_with);
1626             }
1627              
1628 4           static OP* ends_with_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1629 4           return two_arg_string_call_checker(aTHX_ entersubop, namegv, ckobj, pp_ends_with);
1630             }
1631              
1632             /* Boolean/Truthiness call checkers */
1633 5           static OP* is_true_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1634 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_true);
1635             }
1636              
1637 5           static OP* is_false_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1638 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_false);
1639             }
1640              
1641 7           static OP* bool_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1642 7           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_bool);
1643             }
1644              
1645             /* Extended type predicate call checkers */
1646 6           static OP* is_num_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1647 6           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_num);
1648             }
1649              
1650 5           static OP* is_int_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1651 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_int);
1652             }
1653              
1654 3           static OP* is_blessed_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1655 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_blessed);
1656             }
1657              
1658 3           static OP* is_scalar_ref_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1659 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_scalar_ref);
1660             }
1661              
1662 3           static OP* is_regex_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1663 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_regex);
1664             }
1665              
1666 2           static OP* is_glob_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1667 2           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_glob);
1668             }
1669              
1670 0           static OP* is_string_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1671 0           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_string);
1672             }
1673              
1674             /* Numeric predicate call checkers */
1675 5           static OP* is_positive_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1676 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_positive);
1677             }
1678              
1679 4           static OP* is_negative_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1680 4           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_negative);
1681             }
1682              
1683 4           static OP* is_zero_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1684 4           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_zero);
1685             }
1686              
1687             /* Numeric utility call checkers */
1688 6           static OP* is_even_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1689 6           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_even);
1690             }
1691              
1692 5           static OP* is_odd_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1693 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_odd);
1694             }
1695              
1696             /* is_between needs 3 args - use same pattern as clamp */
1697 5           static OP* is_between_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1698             /* 3-arg ops are complex to optimize with custom ops.
1699             * Fall back to XS function for now. */
1700             PERL_UNUSED_ARG(namegv);
1701             PERL_UNUSED_ARG(ckobj);
1702 5           return entersubop;
1703             }
1704              
1705             /* Collection call checkers */
1706 3           static OP* is_empty_array_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1707 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_empty_array);
1708             }
1709              
1710 3           static OP* is_empty_hash_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1711 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_is_empty_hash);
1712             }
1713              
1714 3           static OP* array_len_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1715 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_array_len);
1716             }
1717              
1718 3           static OP* hash_size_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1719 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_hash_size);
1720             }
1721              
1722 3           static OP* array_first_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1723 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_array_first);
1724             }
1725              
1726 3           static OP* array_last_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1727 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_array_last);
1728             }
1729              
1730             /* trim uses single-arg pattern */
1731 5           static OP* trim_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1732 5           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_trim);
1733             }
1734              
1735 3           static OP* ltrim_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1736 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_ltrim);
1737             }
1738              
1739 3           static OP* rtrim_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1740 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_rtrim);
1741             }
1742              
1743             /* maybe uses two-arg pattern */
1744 2           static OP* maybe_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1745 2           return two_arg_string_call_checker(aTHX_ entersubop, namegv, ckobj, pp_maybe);
1746             }
1747              
1748             /* Numeric ops */
1749 3           static OP* sign_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1750 3           return type_predicate_call_checker(aTHX_ entersubop, namegv, ckobj, pp_sign);
1751             }
1752              
1753 4           static OP* min2_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1754 4           return two_arg_string_call_checker(aTHX_ entersubop, namegv, ckobj, pp_min2);
1755             }
1756              
1757 4           static OP* max2_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
1758 4           return two_arg_string_call_checker(aTHX_ entersubop, namegv, ckobj, pp_max2);
1759             }
1760              
1761             /* ============================================
1762             Memo implementation
1763             ============================================ */
1764              
1765 213           XS_INTERNAL(xs_memo) {
1766 213           dXSARGS;
1767 213 50         if (items != 1) croak("Usage: Func::Util::memo(\\&func)");
1768              
1769 213           SV *func = ST(0);
1770 213 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
1771 0           croak("Func::Util::memo requires a coderef");
1772             }
1773              
1774             /* Allocate memo slot */
1775 213           IV idx = g_memo_count++;
1776 213           ensure_memo_capacity(idx);
1777              
1778 213           MemoizedFunc *mf = &g_memos[idx];
1779 213           mf->func = SvREFCNT_inc_simple_NN(func);
1780 213           mf->cache = newHV();
1781 213           mf->hits = 0;
1782 213           mf->misses = 0;
1783              
1784             /* Create wrapper CV */
1785 213           CV *wrapper = newXS(NULL, xs_memo_call, __FILE__);
1786 213           CvXSUBANY(wrapper).any_iv = idx;
1787              
1788             /* Attach magic for cleanup when wrapper is freed */
1789 213           sv_magicext((SV*)wrapper, NULL, PERL_MAGIC_ext, &util_memo_vtbl, NULL, idx);
1790              
1791 213           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
1792 213           XSRETURN(1);
1793             }
1794              
1795 849           XS_INTERNAL(xs_memo_call) {
1796 849           dXSARGS;
1797 849           IV idx = CvXSUBANY(cv).any_iv;
1798 849           MemoizedFunc *mf = &g_memos[idx];
1799              
1800             /* Build cache key from arguments */
1801 849           SV *key = build_cache_key(aTHX_ &ST(0), items);
1802             STRLEN key_len;
1803 849           const char *key_pv = SvPV(key, key_len);
1804              
1805             /* Check cache */
1806 849           SV **cached = hv_fetch(mf->cache, key_pv, key_len, 0);
1807 849 100         if (cached && SvOK(*cached)) {
    50          
1808 421           mf->hits++;
1809 421           SvREFCNT_dec_NN(key);
1810 421 50         if (SvROK(*cached) && SvTYPE(SvRV(*cached)) == SVt_PVAV) {
    0          
1811 0           AV *av = (AV*)SvRV(*cached);
1812 0           IV len = av_len(av) + 1;
1813             IV i;
1814 0 0         EXTEND(SP, len);
    0          
1815 0 0         for (i = 0; i < len; i++) {
1816 0           SV **elem = av_fetch(av, i, 0);
1817 0 0         ST(i) = elem ? *elem : &PL_sv_undef;
1818             }
1819 0           XSRETURN(len);
1820             } else {
1821 421           ST(0) = *cached;
1822 421           XSRETURN(1);
1823             }
1824             }
1825              
1826 428           mf->misses++;
1827              
1828 428           ENTER;
1829 428           SAVETMPS;
1830 428 50         PUSHMARK(SP);
1831              
1832             IV i;
1833 428 50         EXTEND(SP, items);
    50          
1834 857 100         for (i = 0; i < items; i++) {
1835 429           PUSHs(ST(i));
1836             }
1837 428           PUTBACK;
1838              
1839 428           IV count = call_sv(mf->func, G_ARRAY);
1840              
1841 428           SPAGAIN;
1842              
1843 428 50         if (count == 1) {
1844 428           SV *result = SvREFCNT_inc(POPs);
1845 428           hv_store(mf->cache, key_pv, key_len, result, 0);
1846 428           PUTBACK;
1847 428 50         FREETMPS;
1848 428           LEAVE;
1849 428           SvREFCNT_dec_NN(key);
1850 428           ST(0) = result;
1851 428           XSRETURN(1);
1852 0 0         } else if (count > 0) {
1853 0           AV *av = newAV();
1854 0           av_extend(av, count - 1);
1855 0 0         for (i = count - 1; i >= 0; i--) {
1856 0           av_store(av, i, SvREFCNT_inc(POPs));
1857             }
1858 0           SV *result = newRV_noinc((SV*)av);
1859 0           hv_store(mf->cache, key_pv, key_len, result, 0);
1860 0           PUTBACK;
1861 0 0         FREETMPS;
1862 0           LEAVE;
1863 0           SvREFCNT_dec_NN(key);
1864 0 0         for (i = 0; i < count; i++) {
1865 0           SV **elem = av_fetch(av, i, 0);
1866 0 0         ST(i) = elem ? *elem : &PL_sv_undef;
1867             }
1868 0           XSRETURN(count);
1869             } else {
1870 0           hv_store(mf->cache, key_pv, key_len, &PL_sv_undef, 0);
1871 0           PUTBACK;
1872 0 0         FREETMPS;
1873 0           LEAVE;
1874 0           SvREFCNT_dec_NN(key);
1875 0           XSRETURN_EMPTY;
1876             }
1877             }
1878              
1879             /* ============================================
1880             Pipe/Compose implementation
1881             ============================================ */
1882              
1883 1011           XS_INTERNAL(xs_pipe) {
1884 1011           dXSARGS;
1885 1011 50         if (items < 2) croak("Usage: Func::Util::pipeline($value, \\&fn1, \\&fn2, ...)");
1886              
1887 1011           SV *value = SvREFCNT_inc(ST(0));
1888             IV i;
1889              
1890 4036 100         for (i = 1; i < items; i++) {
1891 3025           SV *func = ST(i);
1892 3025 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
1893 0           SvREFCNT_dec(value);
1894 0           croak("Func::Util::pipeline: argument %d is not a coderef", (int)i);
1895             }
1896              
1897 3025           ENTER;
1898 3025           SAVETMPS;
1899 3025 50         PUSHMARK(SP);
1900 3025 50         XPUSHs(value);
1901 3025           PUTBACK;
1902              
1903 3025           call_sv(func, G_SCALAR);
1904              
1905 3025           SPAGAIN;
1906 3025           SV *new_value = POPs;
1907 3025           SvREFCNT_inc(new_value);
1908 3025           PUTBACK;
1909 3025 100         FREETMPS;
1910 3025           LEAVE;
1911              
1912 3025           SvREFCNT_dec(value);
1913 3025           value = new_value;
1914             }
1915              
1916 1011           ST(0) = sv_2mortal(value);
1917 1011           XSRETURN(1);
1918             }
1919              
1920 1010           XS_INTERNAL(xs_compose) {
1921 1010           dXSARGS;
1922 1010 50         if (items < 1) croak("Usage: Func::Util::compose(\\&fn1, \\&fn2, ...)");
1923              
1924 1010           AV *funcs = newAV();
1925 1010           av_extend(funcs, items - 1);
1926             IV i;
1927 4030 100         for (i = 0; i < items; i++) {
1928 3020           SV *func = ST(i);
1929 3020 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
1930 0           croak("Func::Util::compose: argument %d is not a coderef", (int)(i+1));
1931             }
1932 3020           av_store(funcs, i, SvREFCNT_inc_simple_NN(func));
1933             }
1934              
1935 1010           CV *wrapper = newXS(NULL, xs_compose_call, __FILE__);
1936 1010           CvXSUBANY(wrapper).any_ptr = (void*)funcs;
1937              
1938             /* Attach magic for cleanup when wrapper is freed - pass AV via mg_ptr */
1939 1010           sv_magicext((SV*)wrapper, NULL, PERL_MAGIC_ext, &util_compose_vtbl, (char*)funcs, 0);
1940              
1941 1010           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
1942 1010           XSRETURN(1);
1943             }
1944              
1945 1011           XS_INTERNAL(xs_compose_call) {
1946 1011           dXSARGS;
1947 1011           AV *funcs = (AV*)CvXSUBANY(cv).any_ptr;
1948 1011           IV func_count = av_len(funcs) + 1;
1949              
1950 1011           SV *value = NULL;
1951              
1952             IV i;
1953 4033 100         for (i = func_count - 1; i >= 0; i--) {
1954 3022           SV **func_ptr = av_fetch(funcs, i, 0);
1955 3022 50         if (!func_ptr) continue;
1956              
1957 3022           ENTER;
1958 3022           SAVETMPS;
1959 3022 50         PUSHMARK(SP);
1960              
1961 3022 100         if (i == func_count - 1) {
1962             IV j;
1963 1011 50         EXTEND(SP, items);
    50          
1964 2022 100         for (j = 0; j < items; j++) {
1965 1011           PUSHs(ST(j));
1966             }
1967             } else {
1968 2011 50         XPUSHs(value);
1969             }
1970 3022           PUTBACK;
1971              
1972 3022           call_sv(*func_ptr, G_SCALAR);
1973              
1974 3022           SPAGAIN;
1975 3022           SV *new_value = POPs;
1976 3022           SvREFCNT_inc(new_value);
1977 3022           PUTBACK;
1978 3022 100         FREETMPS;
1979 3022           LEAVE;
1980              
1981 3022 100         if (value) SvREFCNT_dec(value);
1982 3022           value = new_value;
1983             }
1984              
1985 1011 50         ST(0) = value ? sv_2mortal(value) : &PL_sv_undef;
1986 1011           XSRETURN(1);
1987             }
1988              
1989             /* ============================================
1990             Lazy evaluation implementation
1991             ============================================ */
1992              
1993 1008           XS_INTERNAL(xs_lazy) {
1994 1008           dXSARGS;
1995 1008 50         if (items != 1) croak("Usage: Func::Util::lazy(sub { ... })");
1996              
1997 1008           SV *thunk = ST(0);
1998 1008 50         if (!SvROK(thunk) || SvTYPE(SvRV(thunk)) != SVt_PVCV) {
    50          
1999 0           croak("Func::Util::lazy requires a coderef");
2000             }
2001              
2002 1008           IV idx = g_lazy_count++;
2003 1008           ensure_lazy_capacity(idx);
2004              
2005 1008           LazyValue *lv = &g_lazies[idx];
2006 1008           lv->thunk = SvREFCNT_inc_simple_NN(thunk);
2007 1008           lv->value = NULL;
2008 1008           lv->forced = FALSE;
2009              
2010 1008           SV *obj = newSViv(idx);
2011 1008           SV *ref = newRV_noinc(obj);
2012 1008           sv_bless(ref, gv_stashpv("Func::Util::Lazy", GV_ADD));
2013              
2014             /* Attach magic for cleanup when lazy object is freed */
2015 1008           sv_magicext(obj, NULL, PERL_MAGIC_ext, &util_lazy_vtbl, NULL, idx);
2016              
2017 1008           ST(0) = sv_2mortal(ref);
2018 1008           XSRETURN(1);
2019             }
2020              
2021 2018           XS_INTERNAL(xs_force) {
2022 2018           dXSARGS;
2023 2018 50         if (items != 1) croak("Usage: Func::Util::force($lazy)");
2024              
2025 2018           SV *lazy = ST(0);
2026              
2027 2018 100         if (!SvROK(lazy) || !sv_derived_from(lazy, "Func::Util::Lazy")) {
    100          
2028 5           ST(0) = lazy;
2029 5           XSRETURN(1);
2030             }
2031              
2032 2013           IV idx = SvIV(SvRV(lazy));
2033 2013 50         if (idx < 0 || idx >= g_lazy_count) {
    50          
2034 0           croak("Func::Util::force: invalid lazy value");
2035             }
2036              
2037 2013           LazyValue *lv = &g_lazies[idx];
2038              
2039 2013 100         if (lv->forced) {
2040 1005           ST(0) = lv->value;
2041 1005           XSRETURN(1);
2042             }
2043              
2044 1008           ENTER;
2045 1008           SAVETMPS;
2046 1008 50         PUSHMARK(SP);
2047 1008           PUTBACK;
2048              
2049 1008           call_sv(lv->thunk, G_SCALAR);
2050              
2051 1008           SPAGAIN;
2052 1008           lv->value = SvREFCNT_inc(POPs);
2053 1008           lv->forced = TRUE;
2054 1008           PUTBACK;
2055 1008 50         FREETMPS;
2056 1008           LEAVE;
2057              
2058 1008           SvREFCNT_dec(lv->thunk);
2059 1008           lv->thunk = NULL;
2060              
2061 1008           ST(0) = lv->value;
2062 1008           XSRETURN(1);
2063             }
2064              
2065             /* ============================================
2066             Safe navigation (dig) implementation
2067             ============================================ */
2068              
2069 19124           XS_INTERNAL(xs_dig) {
2070 19124           dXSARGS;
2071 19124 50         if (items < 2) croak("Usage: Func::Util::dig($hash, @keys)");
2072              
2073 19124           SV *current = ST(0);
2074             IV i;
2075              
2076 60471 100         for (i = 1; i < items; i++) {
2077 47354 100         if (!SvROK(current) || SvTYPE(SvRV(current)) != SVt_PVHV) {
    100          
2078 6007           XSRETURN_UNDEF;
2079             }
2080              
2081 44353           HV *hv = (HV*)SvRV(current);
2082 44353           SV *key = ST(i);
2083             STRLEN key_len;
2084 44353           const char *key_pv = SvPV(key, key_len);
2085              
2086 44353           SV **val = hv_fetch(hv, key_pv, key_len, 0);
2087 44353 100         if (!val || !SvOK(*val)) {
    100          
2088 3006           XSRETURN_UNDEF;
2089             }
2090              
2091 41347           current = *val;
2092             }
2093              
2094 13117           ST(0) = current;
2095 13117           XSRETURN(1);
2096             }
2097              
2098             /* ============================================
2099             Tap implementation
2100             ============================================ */
2101              
2102 12105           XS_INTERNAL(xs_tap) {
2103 12105           dXSARGS;
2104 12105 50         if (items != 2) croak("Usage: Func::Util::tap(\\&block, $value)");
2105              
2106 12105           SV *func = ST(0);
2107 12105           SV *value = ST(1);
2108              
2109 12105 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
2110 0           croak("Func::Util::tap: first argument must be a coderef");
2111             }
2112              
2113 12105           ENTER;
2114 12105           SAVETMPS;
2115 12105           SAVE_DEFSV;
2116 12105           DEFSV_set(value);
2117              
2118 12105 50         PUSHMARK(SP);
2119 12105 50         XPUSHs(value);
2120 12105           PUTBACK;
2121              
2122 12105           call_sv(func, G_DISCARD | G_VOID);
2123              
2124 12105           SPAGAIN;
2125 12105 50         FREETMPS;
2126 12105           LEAVE;
2127              
2128 12105           ST(0) = value;
2129 12105           XSRETURN(1);
2130             }
2131              
2132             /* ============================================
2133             Clamp XS fallback
2134             ============================================ */
2135              
2136 18161           XS_INTERNAL(xs_clamp) {
2137 18161           dXSARGS;
2138             NV value, min, max, result;
2139 18161 50         if (items != 3) croak("Usage: Func::Util::clamp($value, $min, $max)");
2140              
2141 18161           value = SvNV(ST(0));
2142 18161           min = SvNV(ST(1));
2143 18161           max = SvNV(ST(2));
2144              
2145 18161 100         if (value < min) {
2146 3014           result = min;
2147 15147 100         } else if (value > max) {
2148 3014           result = max;
2149             } else {
2150 12133           result = value;
2151             }
2152              
2153 18161           ST(0) = sv_2mortal(newSVnv(result));
2154 18161           XSRETURN(1);
2155             }
2156              
2157             /* ============================================
2158             Identity XS fallback
2159             ============================================ */
2160              
2161 16119           XS_INTERNAL(xs_identity) {
2162 16119           dXSARGS;
2163 16119 50         if (items != 1) croak("Usage: Func::Util::identity($value)");
2164 16119           XSRETURN(1);
2165             }
2166              
2167             /* ============================================
2168             Always implementation
2169             ============================================ */
2170              
2171 8           XS_INTERNAL(xs_always) {
2172 8           dXSARGS;
2173 8 50         if (items != 1) croak("Usage: Func::Util::always($value)");
2174              
2175 8           IV idx = g_always_count++;
2176 8           ensure_always_capacity(idx);
2177              
2178 8           g_always_values[idx] = SvREFCNT_inc_simple_NN(ST(0));
2179              
2180 8           CV *wrapper = newXS(NULL, xs_always_call, __FILE__);
2181 8           CvXSUBANY(wrapper).any_iv = idx;
2182              
2183             /* Attach magic for cleanup when wrapper is freed */
2184 8           sv_magicext((SV*)wrapper, NULL, PERL_MAGIC_ext, &util_always_vtbl, NULL, idx);
2185              
2186 8           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
2187 8           XSRETURN(1);
2188             }
2189              
2190 4014           XS_INTERNAL(xs_always_call) {
2191 4014           dXSARGS;
2192             PERL_UNUSED_VAR(items);
2193 4014           IV idx = CvXSUBANY(cv).any_iv;
2194              
2195 4014           ST(0) = g_always_values[idx];
2196 4014           XSRETURN(1);
2197             }
2198              
2199             /* ============================================
2200             Stub/noop functions - return constants
2201             ============================================ */
2202              
2203             /* pp_noop - custom op that returns undef */
2204 2           static OP* pp_noop(pTHX) {
2205 2           dSP;
2206 2 50         XPUSHs(&PL_sv_undef);
2207 2           RETURN;
2208             }
2209              
2210             /* noop call checker - replace with ultra-fast custom op */
2211 2           static OP* noop_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
2212             OP *newop;
2213             PERL_UNUSED_ARG(namegv);
2214             PERL_UNUSED_ARG(ckobj);
2215              
2216 2           op_free(entersubop);
2217              
2218 2           NewOp(1101, newop, 1, OP);
2219 2           newop->op_type = OP_CUSTOM;
2220 2           newop->op_ppaddr = pp_noop;
2221 2           newop->op_flags = OPf_WANT_SCALAR;
2222 2           newop->op_next = newop;
2223              
2224 2           return newop;
2225             }
2226              
2227             /* noop() - does nothing, returns undef. Ignores all arguments. */
2228 4004           XS_INTERNAL(xs_noop) {
2229 4004           dXSARGS;
2230             PERL_UNUSED_VAR(items);
2231 4004           XSRETURN_UNDEF;
2232             }
2233              
2234             /* stub_true() - always returns true (1) */
2235 12105           XS_INTERNAL(xs_stub_true) {
2236 12105           dXSARGS;
2237             PERL_UNUSED_VAR(items);
2238 12105           XSRETURN_YES;
2239             }
2240              
2241             /* stub_false() - always returns false ('') */
2242 12105           XS_INTERNAL(xs_stub_false) {
2243 12105           dXSARGS;
2244             PERL_UNUSED_VAR(items);
2245 12105           XSRETURN_NO;
2246             }
2247              
2248             /* stub_array() - returns empty arrayref in scalar context, empty list in list context */
2249 12105           XS_INTERNAL(xs_stub_array) {
2250 12105           dXSARGS;
2251             PERL_UNUSED_VAR(items);
2252 12105 100         if (GIMME_V == G_ARRAY) {
2253 10102           XSRETURN_EMPTY;
2254             }
2255 2003           ST(0) = sv_2mortal(newRV_noinc((SV*)newAV()));
2256 2003           XSRETURN(1);
2257             }
2258              
2259             /* stub_hash() - returns empty hashref in scalar context, empty list in list context */
2260 12105           XS_INTERNAL(xs_stub_hash) {
2261 12105           dXSARGS;
2262             PERL_UNUSED_VAR(items);
2263 12105 100         if (GIMME_V == G_ARRAY) {
2264 10102           XSRETURN_EMPTY;
2265             }
2266 2003           ST(0) = sv_2mortal(newRV_noinc((SV*)newHV()));
2267 2003           XSRETURN(1);
2268             }
2269              
2270             /* stub_string() - always returns empty string '' */
2271 12103           XS_INTERNAL(xs_stub_string) {
2272 12103           dXSARGS;
2273             PERL_UNUSED_VAR(items);
2274             /* Return shared empty string constant - XSRETURN_NO returns '' */
2275 12103           XSRETURN_NO;
2276             }
2277              
2278             /* stub_zero() - always returns 0 */
2279 12104           XS_INTERNAL(xs_stub_zero) {
2280 12104           dXSARGS;
2281             PERL_UNUSED_VAR(items);
2282             /* Return shared 0 SV */
2283 12104           ST(0) = &PL_sv_zero;
2284 12104           XSRETURN(1);
2285             }
2286              
2287             /* ============================================
2288             Functional combinators
2289             ============================================ */
2290              
2291             /* negate(\&pred) - returns a function that returns the opposite */
2292 1008           XS_INTERNAL(xs_negate) {
2293 1008           dXSARGS;
2294 1008 50         if (items != 1) croak("Usage: Func::Util::negate(\\&predicate)");
2295              
2296 1008           SV *pred = ST(0);
2297 1008 50         if (!SvROK(pred) || SvTYPE(SvRV(pred)) != SVt_PVCV) {
    50          
2298 0           croak("Func::Util::negate: argument must be a coderef");
2299             }
2300              
2301 1008           CV *wrapper = newXS(NULL, xs_negate_call, __FILE__);
2302 1008           CvXSUBANY(wrapper).any_ptr = SvREFCNT_inc_simple_NN(pred);
2303              
2304 1008           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
2305 1008           XSRETURN(1);
2306             }
2307              
2308 12113           XS_INTERNAL(xs_negate_call) {
2309 12113           dXSARGS;
2310 12113           SV *pred = (SV*)CvXSUBANY(cv).any_ptr;
2311              
2312 12113           ENTER;
2313 12113           SAVETMPS;
2314 12113 50         PUSHMARK(SP);
2315              
2316             IV i;
2317 12113 50         EXTEND(SP, items);
    50          
2318 24226 100         for (i = 0; i < items; i++) {
2319 12113           PUSHs(ST(i));
2320             }
2321 12113           PUTBACK;
2322              
2323 12113           call_sv(pred, G_SCALAR);
2324              
2325 12113           SPAGAIN;
2326 12113           SV *result = POPs;
2327 12113           bool val = SvTRUE(result);
2328 12113           PUTBACK;
2329 12113 50         FREETMPS;
2330 12113           LEAVE;
2331              
2332 12113 100         ST(0) = val ? &PL_sv_no : &PL_sv_yes;
2333 12113           XSRETURN(1);
2334             }
2335              
2336             /* once(\&f) - execute once, cache forever */
2337 1005           XS_INTERNAL(xs_once) {
2338 1005           dXSARGS;
2339 1005 50         if (items != 1) croak("Usage: Func::Util::once(\\&func)");
2340              
2341 1005           SV *func = ST(0);
2342 1005 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
2343 0           croak("Func::Util::once: argument must be a coderef");
2344             }
2345              
2346 1005           IV idx = g_once_count++;
2347 1005           ensure_once_capacity(idx);
2348              
2349 1005           OnceFunc *of = &g_onces[idx];
2350 1005           of->func = SvREFCNT_inc_simple_NN(func);
2351 1005           of->result = NULL;
2352 1005           of->called = FALSE;
2353              
2354 1005           CV *wrapper = newXS(NULL, xs_once_call, __FILE__);
2355 1005           CvXSUBANY(wrapper).any_iv = idx;
2356              
2357             /* Attach magic for cleanup when wrapper is freed */
2358 1005           sv_magicext((SV*)wrapper, NULL, PERL_MAGIC_ext, &util_once_vtbl, NULL, idx);
2359              
2360 1005           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
2361 1005           XSRETURN(1);
2362             }
2363              
2364 3015           XS_INTERNAL(xs_once_call) {
2365 3015           dXSARGS;
2366             PERL_UNUSED_VAR(items);
2367 3015           IV idx = CvXSUBANY(cv).any_iv;
2368 3015           OnceFunc *of = &g_onces[idx];
2369              
2370 3015 100         if (of->called) {
2371 2010 50         ST(0) = of->result ? of->result : &PL_sv_undef;
2372 2010           XSRETURN(1);
2373             }
2374              
2375 1005           ENTER;
2376 1005           SAVETMPS;
2377 1005 50         PUSHMARK(SP);
2378 1005           PUTBACK;
2379              
2380 1005           call_sv(of->func, G_SCALAR);
2381              
2382 1005           SPAGAIN;
2383 1005           of->result = SvREFCNT_inc(POPs);
2384 1005           of->called = TRUE;
2385 1005           PUTBACK;
2386 1005 50         FREETMPS;
2387 1005           LEAVE;
2388              
2389             /* Free the original function, no longer needed */
2390 1005           SvREFCNT_dec(of->func);
2391 1005           of->func = NULL;
2392              
2393 1005           ST(0) = of->result;
2394 1005           XSRETURN(1);
2395             }
2396              
2397             /* partial(\&f, @bound) - bind first N args */
2398 1012           XS_INTERNAL(xs_partial) {
2399 1012           dXSARGS;
2400 1012 50         if (items < 1) croak("Usage: Func::Util::partial(\\&func, @bound_args)");
2401              
2402 1012           SV *func = ST(0);
2403 1012 50         if (!SvROK(func) || SvTYPE(SvRV(func)) != SVt_PVCV) {
    50          
2404 0           croak("Func::Util::partial: first argument must be a coderef");
2405             }
2406              
2407 1012           IV idx = g_partial_count++;
2408 1012           ensure_partial_capacity(idx);
2409              
2410 1012           PartialFunc *pf = &g_partials[idx];
2411 1012           pf->func = SvREFCNT_inc_simple_NN(func);
2412 1012           pf->bound_args = newAV();
2413              
2414             /* Store bound arguments */
2415             IV i;
2416 2024 100         for (i = 1; i < items; i++) {
2417 1012           av_push(pf->bound_args, SvREFCNT_inc_simple_NN(ST(i)));
2418             }
2419              
2420 1012           CV *wrapper = newXS(NULL, xs_partial_call, __FILE__);
2421 1012           CvXSUBANY(wrapper).any_iv = idx;
2422              
2423             /* Attach magic for cleanup when wrapper is freed */
2424 1012           sv_magicext((SV*)wrapper, NULL, PERL_MAGIC_ext, &util_partial_vtbl, NULL, idx);
2425              
2426 1012           ST(0) = sv_2mortal(newRV_noinc((SV*)wrapper));
2427 1012           XSRETURN(1);
2428             }
2429              
2430 2016           XS_INTERNAL(xs_partial_call) {
2431 2016           dXSARGS;
2432 2016           IV idx = CvXSUBANY(cv).any_iv;
2433 2016           PartialFunc *pf = &g_partials[idx];
2434              
2435 2016           IV bound_count = av_len(pf->bound_args) + 1;
2436 2016           IV total = bound_count + items;
2437              
2438 2016           ENTER;
2439 2016           SAVETMPS;
2440 2016 50         PUSHMARK(SP);
2441              
2442 2016 50         EXTEND(SP, total);
    50          
2443              
2444             /* Push bound args first */
2445             IV i;
2446 4032 100         for (i = 0; i < bound_count; i++) {
2447 2016           SV **elem = av_fetch(pf->bound_args, i, 0);
2448 2016 50         PUSHs(elem ? *elem : &PL_sv_undef);
2449             }
2450              
2451             /* Push call-time args */
2452 4031 100         for (i = 0; i < items; i++) {
2453 2015           PUSHs(ST(i));
2454             }
2455 2016           PUTBACK;
2456              
2457 2016           IV count = call_sv(pf->func, G_SCALAR);
2458              
2459 2016           SPAGAIN;
2460 2016 50         SV *result = count > 0 ? POPs : &PL_sv_undef;
2461 2016           SvREFCNT_inc(result);
2462 2016           PUTBACK;
2463 2016 50         FREETMPS;
2464 2016           LEAVE;
2465              
2466 2016           ST(0) = sv_2mortal(result);
2467 2016           XSRETURN(1);
2468             }
2469              
2470             /* ============================================
2471             Data extraction functions
2472             ============================================ */
2473              
2474             /* pick($hash, @keys) - extract subset of keys
2475             * Returns hashref in scalar context, flattened list in list context */
2476 12722           XS_INTERNAL(xs_pick) {
2477 12722           dXSARGS;
2478 12722 50         if (items < 1) croak("Usage: Func::Util::pick(\\%%hash, @keys)");
2479              
2480 12722           SV *href = ST(0);
2481 12722 50         if (!SvROK(href) || SvTYPE(SvRV(href)) != SVt_PVHV) {
    50          
2482 0           croak("Func::Util::pick: first argument must be a hashref");
2483             }
2484              
2485 12722           HV *src = (HV*)SvRV(href);
2486 12722           HV *dest = newHV();
2487              
2488             IV i;
2489 38566 100         for (i = 1; i < items; i++) {
2490 25844           SV *key = ST(i);
2491             STRLEN key_len;
2492 25844           const char *key_pv = SvPV(key, key_len);
2493              
2494 25844           SV **val = hv_fetch(src, key_pv, key_len, 0);
2495 25844 100         if (val && SvOK(*val)) {
    100          
2496 24238           hv_store(dest, key_pv, key_len, SvREFCNT_inc(*val), 0);
2497             }
2498             }
2499              
2500             /* Check calling context */
2501 12722 100         if (GIMME_V == G_ARRAY) {
2502             /* List context - return flattened key-value pairs */
2503 10100 50         IV n = HvUSEDKEYS(dest);
2504 10100           SP -= items; /* Reset stack pointer */
2505 10100 50         EXTEND(SP, n * 2);
    50          
2506              
2507 10100           hv_iterinit(dest);
2508             HE *he;
2509 30300 100         while ((he = hv_iternext(dest)) != NULL) {
2510             STRLEN klen;
2511 20200 50         const char *key = HePV(he, klen);
2512 20200           mPUSHp(key, klen);
2513 20200           mPUSHs(SvREFCNT_inc(HeVAL(he)));
2514             }
2515 10100           SvREFCNT_dec((SV*)dest); /* Free the temp hash */
2516 10100           PUTBACK;
2517 10100           return;
2518             }
2519              
2520             /* Scalar context - return hashref */
2521 2622           ST(0) = sv_2mortal(newRV_noinc((SV*)dest));
2522 2622           XSRETURN(1);
2523             }
2524              
2525             /* pluck(\@hashes, $field) - extract field from each hash */
2526 2211           XS_INTERNAL(xs_pluck) {
2527 2211           dXSARGS;
2528 2211 50         if (items != 2) croak("Usage: Func::Util::pluck(\\@array, $field)");
2529              
2530 2211           SV *aref = ST(0);
2531 2211 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
2532 0           croak("Func::Util::pluck: first argument must be an arrayref");
2533             }
2534              
2535 2211           SV *field = ST(1);
2536             STRLEN field_len;
2537 2211           const char *field_pv = SvPV(field, field_len);
2538              
2539 2211           AV *src = (AV*)SvRV(aref);
2540 2211           IV len = av_len(src) + 1;
2541 2211           AV *dest = newAV();
2542 2211           av_extend(dest, len - 1);
2543              
2544             IV i;
2545 8836 100         for (i = 0; i < len; i++) {
2546 6625           SV **elem = av_fetch(src, i, 0);
2547 13250 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
2548 6625           HV *hv = (HV*)SvRV(*elem);
2549 6625           SV **val = hv_fetch(hv, field_pv, field_len, 0);
2550 6625 100         if (val && SvOK(*val)) {
    50          
2551 5422           av_push(dest, SvREFCNT_inc(*val));
2552             } else {
2553 1203           av_push(dest, &PL_sv_undef);
2554             }
2555             } else {
2556 0           av_push(dest, &PL_sv_undef);
2557             }
2558             }
2559              
2560 2211           ST(0) = sv_2mortal(newRV_noinc((SV*)dest));
2561 2211           XSRETURN(1);
2562             }
2563              
2564             /* omit($hash, @keys) - exclude subset of keys (inverse of pick)
2565             * Returns hashref in scalar context, flattened list in list context */
2566 12710           XS_INTERNAL(xs_omit) {
2567 12710           dXSARGS;
2568 12710 50         if (items < 1) croak("Usage: Func::Util::omit(\\%%hash, @keys)");
2569              
2570 12710           SV *href = ST(0);
2571 12710 50         if (!SvROK(href) || SvTYPE(SvRV(href)) != SVt_PVHV) {
    50          
2572 0           croak("Func::Util::omit: first argument must be a hashref");
2573             }
2574              
2575 12710           HV *src = (HV*)SvRV(href);
2576 12710           HV *dest = newHV();
2577              
2578             /* Build exclusion set for O(1) lookup */
2579 12710           HV *exclude = newHV();
2580             IV i;
2581 28025 100         for (i = 1; i < items; i++) {
2582 15315           SV *key = ST(i);
2583             STRLEN key_len;
2584 15315           const char *key_pv = SvPV(key, key_len);
2585 15315           hv_store(exclude, key_pv, key_len, &PL_sv_yes, 0);
2586             }
2587              
2588             /* Iterate source, copy non-excluded keys */
2589 12710           hv_iterinit(src);
2590             HE *entry;
2591 53838 100         while ((entry = hv_iternext(src)) != NULL) {
2592 41128           SV *key = hv_iterkeysv(entry);
2593             STRLEN key_len;
2594 41128           const char *key_pv = SvPV(key, key_len);
2595              
2596 41128 100         if (!hv_exists(exclude, key_pv, key_len)) {
2597 26219           SV *val = hv_iterval(src, entry);
2598 26219 50         if (SvOK(val)) {
2599 26219           hv_store(dest, key_pv, key_len, SvREFCNT_inc(val), 0);
2600             }
2601             }
2602             }
2603              
2604 12710           SvREFCNT_dec((SV*)exclude);
2605              
2606             /* Check calling context */
2607 12710 100         if (GIMME_V == G_ARRAY) {
2608             /* List context - return flattened key-value pairs */
2609 10100 50         IV n = HvUSEDKEYS(dest);
2610 10100           SP -= items; /* Reset stack pointer */
2611 10100 50         EXTEND(SP, n * 2);
    50          
2612              
2613 10100           hv_iterinit(dest);
2614             HE *he;
2615 30300 100         while ((he = hv_iternext(dest)) != NULL) {
2616             STRLEN klen;
2617 20200 50         const char *key = HePV(he, klen);
2618 20200           mPUSHp(key, klen);
2619 20200           mPUSHs(SvREFCNT_inc(HeVAL(he)));
2620             }
2621 10100           SvREFCNT_dec((SV*)dest); /* Free the temp hash */
2622 10100           PUTBACK;
2623 10100           return;
2624             }
2625              
2626             /* Scalar context - return hashref */
2627 2610           ST(0) = sv_2mortal(newRV_noinc((SV*)dest));
2628 2610           XSRETURN(1);
2629             }
2630              
2631             /* uniq(@list) - return unique elements (preserves order) */
2632 2626           XS_INTERNAL(xs_uniq) {
2633 2626           dXSARGS;
2634              
2635 2626 100         if (items == 0) {
2636 1           XSRETURN(0);
2637             }
2638              
2639 2625 100         if (items == 1) {
2640 1611           XSRETURN(1);
2641             }
2642              
2643             /* For small lists, use simple O(n^2) - faster due to no hash overhead */
2644 1014 100         if (items <= 8) {
2645 13           IV out = 0;
2646             IV i, j;
2647 77 100         for (i = 0; i < items; i++) {
2648 64           SV *elem = ST(i);
2649             STRLEN len_i;
2650 64 100         const char *key_i = SvOK(elem) ? SvPV_const(elem, len_i) : "\x00UNDEF\x00";
2651 64 100         if (!SvOK(elem)) len_i = 7;
2652            
2653 64           bool dup = FALSE;
2654 131 100         for (j = 0; j < out; j++) {
2655 91           SV *prev = ST(j);
2656             STRLEN len_j;
2657 91 100         const char *key_j = SvOK(prev) ? SvPV_const(prev, len_j) : "\x00UNDEF\x00";
2658 91 100         if (!SvOK(prev)) len_j = 7;
2659            
2660 91 100         if (len_i == len_j && memcmp(key_i, key_j, len_i) == 0) {
    100          
2661 24           dup = TRUE;
2662 24           break;
2663             }
2664             }
2665 64 100         if (!dup) ST(out++) = elem;
2666             }
2667 13           XSRETURN(out);
2668             }
2669              
2670 1001           HV *seen = newHV();
2671 1001           IV out = 0;
2672 1001           hv_ksplit(seen, items);
2673              
2674             IV i;
2675 11011 100         for (i = 0; i < items; i++) {
2676 10010           SV *elem = ST(i);
2677             STRLEN len;
2678             const char *key;
2679             U32 hash;
2680              
2681 10010 50         key = SvOK(elem) ? SvPV_const(elem, len) : (len = 7, "\x00UNDEF\x00");
2682              
2683 10010 50         PERL_HASH(hash, key, len);
2684              
2685 10010 100         if (!hv_common(seen, NULL, key, len, 0, HV_FETCH_ISEXISTS, NULL, hash)) {
2686 4004           hv_common(seen, NULL, key, len, 0, HV_FETCH_ISSTORE, &PL_sv_yes, hash);
2687 4004           ST(out++) = elem;
2688             }
2689             }
2690              
2691 1001           SvREFCNT_dec_NN((SV*)seen);
2692 1001           XSRETURN(out);
2693             }
2694              
2695             /* partition(\&pred, @list) - split into [matches], [non-matches] */
2696 2210           XS_INTERNAL(xs_partition) {
2697 2210           dXSARGS;
2698 2210 50         if (items < 1) croak("Usage: Func::Util::partition(\\&block, @list)");
2699              
2700 2210           SV *block = ST(0);
2701 2210 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
2702 0           croak("Func::Util::partition: first argument must be a coderef");
2703             }
2704              
2705 2210           IV list_len = items - 1;
2706            
2707 2210 100         if (list_len == 0) {
2708 1           AV *pass = newAV();
2709 1           AV *fail = newAV();
2710 1           AV *outer = newAV();
2711 1           av_push(outer, newRV_noinc((SV*)pass));
2712 1           av_push(outer, newRV_noinc((SV*)fail));
2713 1           ST(0) = sv_2mortal(newRV_noinc((SV*)outer));
2714 1           XSRETURN(1);
2715             }
2716              
2717 2209           AV *pass = newAV();
2718 2209           AV *fail = newAV();
2719 2209           av_extend(pass, list_len >> 1);
2720 2209           av_extend(fail, list_len >> 1);
2721              
2722 2209 50         SV *orig_defsv = DEFSV;
2723              
2724             IV i;
2725 4452 100         for (i = 1; i < items; i++) {
2726 2243           SV *elem = ST(i);
2727              
2728 2243           DEFSV_set(elem);
2729              
2730 2243           ENTER;
2731 2243           SAVETMPS;
2732 2243 50         PUSHMARK(SP);
2733 2243 50         XPUSHs(elem);
2734 2243           PUTBACK;
2735              
2736 2243           call_sv(block, G_SCALAR);
2737              
2738 2243           SPAGAIN;
2739 2243           SV *result = POPs;
2740 2243           bool matched = SvTRUE(result);
2741 2243           PUTBACK;
2742 2243 50         FREETMPS;
2743 2243           LEAVE;
2744              
2745 2243 100         if (matched) {
2746 2222           av_push(pass, SvREFCNT_inc_simple_NN(elem));
2747             } else {
2748 21           av_push(fail, SvREFCNT_inc_simple_NN(elem));
2749             }
2750             }
2751              
2752 2209           DEFSV_set(orig_defsv);
2753              
2754 2209           AV *outer = newAV();
2755 2209           av_push(outer, newRV_noinc((SV*)pass));
2756 2209           av_push(outer, newRV_noinc((SV*)fail));
2757              
2758 2209           ST(0) = sv_2mortal(newRV_noinc((SV*)outer));
2759 2209           XSRETURN(1);
2760             }
2761              
2762             /* defaults($hash, $defaults) - fill in missing keys from defaults
2763             * Returns hashref in scalar context, flattened list in list context */
2764 11507           XS_INTERNAL(xs_defaults) {
2765 11507           dXSARGS;
2766 11507 50         if (items != 2) croak("Usage: Func::Util::defaults(\\%%hash, \\%%defaults)");
2767              
2768 11507           SV *href = ST(0);
2769 11507           SV *dref = ST(1);
2770              
2771 11507 50         if (!SvROK(href) || SvTYPE(SvRV(href)) != SVt_PVHV) {
    50          
2772 0           croak("Func::Util::defaults: first argument must be a hashref");
2773             }
2774 11507 50         if (!SvROK(dref) || SvTYPE(SvRV(dref)) != SVt_PVHV) {
    50          
2775 0           croak("Func::Util::defaults: second argument must be a hashref");
2776             }
2777              
2778 11507           HV *src = (HV*)SvRV(href);
2779 11507           HV *def = (HV*)SvRV(dref);
2780              
2781             /* Pre-size dest hash */
2782 11507 50         IV src_keys = HvUSEDKEYS(src);
2783 11507 50         IV def_keys = HvUSEDKEYS(def);
2784 11507           HV *dest = newHV();
2785 11507           hv_ksplit(dest, src_keys + def_keys);
2786              
2787             /* Copy all from source first */
2788 11507           hv_iterinit(src);
2789             HE *entry;
2790 24014 100         while ((entry = hv_iternext(src)) != NULL) {
2791             STRLEN key_len;
2792 12507 50         const char *key_pv = HePV(entry, key_len);
2793 12507           SV *val = HeVAL(entry);
2794 12507           hv_store(dest, key_pv, key_len, SvREFCNT_inc_simple_NN(val), HeHASH(entry));
2795             }
2796              
2797             /* Fill in missing from defaults - use pre-computed hash */
2798 11507           hv_iterinit(def);
2799 35918 100         while ((entry = hv_iternext(def)) != NULL) {
2800             STRLEN key_len;
2801 24411 50         const char *key_pv = HePV(entry, key_len);
2802 24411           U32 hash = HeHASH(entry);
2803              
2804             /* Check if exists and is defined in dest */
2805 24411           SV **existing = hv_fetch(dest, key_pv, key_len, 0);
2806 24411 100         if (!existing || !SvOK(*existing)) {
    100          
2807 12909           SV *val = HeVAL(entry);
2808 12909           hv_store(dest, key_pv, key_len, SvREFCNT_inc_simple_NN(val), hash);
2809             }
2810             }
2811              
2812             /* Check calling context */
2813 11507 100         if (GIMME_V == G_ARRAY) {
2814             /* List context - return flattened key-value pairs */
2815 10100 50         IV n = HvUSEDKEYS(dest);
2816 10100           SP -= items; /* Reset stack pointer */
2817 10100 50         EXTEND(SP, n * 2);
    50          
2818              
2819 10100           hv_iterinit(dest);
2820             HE *he;
2821 30300 100         while ((he = hv_iternext(dest)) != NULL) {
2822             STRLEN klen;
2823 20200 50         const char *key = HePV(he, klen);
2824 20200           mPUSHp(key, klen);
2825 20200           mPUSHs(SvREFCNT_inc(HeVAL(he)));
2826             }
2827 10100           SvREFCNT_dec((SV*)dest); /* Free the temp hash */
2828 10100           PUTBACK;
2829 10100           return;
2830             }
2831              
2832             /* Scalar context - return hashref */
2833 1407           ST(0) = sv_2mortal(newRV_noinc((SV*)dest));
2834 1407           XSRETURN(1);
2835             }
2836              
2837             /* ============================================
2838             Null coalescing functions
2839             ============================================ */
2840              
2841             /* nvl($x, $default) - return $x if defined, else $default */
2842 20128           XS_INTERNAL(xs_nvl) {
2843 20128           dXSARGS;
2844 20128 50         if (items != 2) croak("Usage: Func::Util::nvl($value, $default)");
2845              
2846 20128           SV *val = ST(0);
2847 20128 100         if (SvOK(val)) {
2848 8010           XSRETURN(1); /* Return first arg */
2849             }
2850 12118           ST(0) = ST(1);
2851 12118           XSRETURN(1);
2852             }
2853              
2854             /* coalesce($a, $b, ...) - return first defined value */
2855 18116           XS_INTERNAL(xs_coalesce) {
2856 18116           dXSARGS;
2857 18116 50         if (items < 1) croak("Usage: Func::Util::coalesce($val, ...)");
2858              
2859             IV i;
2860 48332 100         for (i = 0; i < items; i++) {
2861 47329 100         if (SvOK(ST(i))) {
2862 17113           ST(0) = ST(i);
2863 17113           XSRETURN(1);
2864             }
2865             }
2866             /* All undefined, return undef */
2867 1003           ST(0) = &PL_sv_undef;
2868 1003           XSRETURN(1);
2869             }
2870              
2871             /* ============================================
2872             List functions (first, any, all, none)
2873              
2874             These use MULTICALL for pure Perl subs which is significantly
2875             faster than call_sv() for repeated invocations.
2876              
2877             For XS subs, we fall back to call_sv().
2878             ============================================ */
2879              
2880             /* Inline CALLRUNOPS - experimental optimization to skip function call overhead.
2881             Use cautiously - this inlines the runops loop directly. */
2882             #define INLINE_RUNOPS() \
2883             STMT_START { \
2884             OP *_inline_op = PL_op; \
2885             while ((_inline_op = _inline_op->op_ppaddr(aTHX))) ; \
2886             } STMT_END
2887              
2888             /* ============================================
2889             Specialized array predicates - pure C, no callback
2890             These are blazing fast because they avoid all Perl callback overhead
2891             ============================================ */
2892              
2893             /* first_gt(\@array, $threshold) or first_gt(\@array, $key, $threshold)
2894             first element > threshold, pure C
2895             With key: first hash where hash->{key} > threshold */
2896 3027           XS_INTERNAL(xs_first_gt) {
2897 3027           dXSARGS;
2898 3027 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_gt(\\@array, $threshold) or first_gt(\\@array, $key, $threshold)");
    50          
2899              
2900 3027           SV *aref = ST(0);
2901 3027 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
2902 0           croak("Func::Util::first_gt: first argument must be an arrayref");
2903             }
2904              
2905 3027           AV *av = (AV *)SvRV(aref);
2906 3027           SSize_t len = av_len(av) + 1;
2907             SSize_t i;
2908              
2909 3027 100         if (items == 2) {
2910             /* Simple array of scalars */
2911 2026           NV threshold = SvNV(ST(1));
2912 12105 100         for (i = 0; i < len; i++) {
2913 11097           SV **elem = av_fetch(av, i, 0);
2914 11097 50         if (elem && SvNV(*elem) > threshold) {
    100          
2915 1018           ST(0) = *elem;
2916 1018           XSRETURN(1);
2917             }
2918             }
2919             } else {
2920             /* Array of hashes with key */
2921 1001           char *key = SvPV_nolen(ST(1));
2922 1001           NV threshold = SvNV(ST(2));
2923 2002 50         for (i = 0; i < len; i++) {
2924 2002           SV **elem = av_fetch(av, i, 0);
2925 2002 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
2926 2002           HV *hv = (HV *)SvRV(*elem);
2927 2002           SV **val = hv_fetch(hv, key, strlen(key), 0);
2928 2002 50         if (val && SvNV(*val) > threshold) {
    100          
2929 1001           ST(0) = *elem;
2930 1001           XSRETURN(1);
2931             }
2932             }
2933             }
2934             }
2935              
2936 1008           XSRETURN_UNDEF;
2937             }
2938              
2939             /* first_lt(\@array, $threshold) or first_lt(\@array, $key, $threshold)
2940             first element < threshold, pure C */
2941 3012           XS_INTERNAL(xs_first_lt) {
2942 3012           dXSARGS;
2943 3012 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_lt(\\@array, $threshold) or first_lt(\\@array, $key, $threshold)");
    50          
2944              
2945 3012           SV *aref = ST(0);
2946 3012 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
2947 0           croak("Func::Util::first_lt: first argument must be an arrayref");
2948             }
2949              
2950 3012           AV *av = (AV *)SvRV(aref);
2951 3012           SSize_t len = av_len(av) + 1;
2952             SSize_t i;
2953              
2954 3012 100         if (items == 2) {
2955 2011           NV threshold = SvNV(ST(1));
2956 9038 100         for (i = 0; i < len; i++) {
2957 8034           SV **elem = av_fetch(av, i, 0);
2958 8034 50         if (elem && SvNV(*elem) < threshold) {
    100          
2959 1007           ST(0) = *elem;
2960 1007           XSRETURN(1);
2961             }
2962             }
2963             } else {
2964 1001           char *key = SvPV_nolen(ST(1));
2965 1001           NV threshold = SvNV(ST(2));
2966 1001 50         for (i = 0; i < len; i++) {
2967 1001           SV **elem = av_fetch(av, i, 0);
2968 1001 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
2969 1001           HV *hv = (HV *)SvRV(*elem);
2970 1001           SV **val = hv_fetch(hv, key, strlen(key), 0);
2971 1001 50         if (val && SvNV(*val) < threshold) {
    50          
2972 1001           ST(0) = *elem;
2973 1001           XSRETURN(1);
2974             }
2975             }
2976             }
2977             }
2978              
2979 1004           XSRETURN_UNDEF;
2980             }
2981              
2982             /* first_eq(\@array, $value) or first_eq(\@array, $key, $value)
2983             first element == value (numeric), pure C */
2984 3012           XS_INTERNAL(xs_first_eq) {
2985 3012           dXSARGS;
2986 3012 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_eq(\\@array, $value) or first_eq(\\@array, $key, $value)");
    50          
2987              
2988 3012           SV *aref = ST(0);
2989 3012 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
2990 0           croak("Func::Util::first_eq: first argument must be an arrayref");
2991             }
2992              
2993 3012           AV *av = (AV *)SvRV(aref);
2994 3012           SSize_t len = av_len(av) + 1;
2995             SSize_t i;
2996              
2997 3012 100         if (items == 2) {
2998 2011           NV target = SvNV(ST(1));
2999 11047 100         for (i = 0; i < len; i++) {
3000 10043           SV **elem = av_fetch(av, i, 0);
3001 10043 50         if (elem && SvNV(*elem) == target) {
    100          
3002 1007           ST(0) = *elem;
3003 1007           XSRETURN(1);
3004             }
3005             }
3006             } else {
3007 1001           char *key = SvPV_nolen(ST(1));
3008 1001           NV target = SvNV(ST(2));
3009 2003 50         for (i = 0; i < len; i++) {
3010 2003           SV **elem = av_fetch(av, i, 0);
3011 2003 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3012 2003           HV *hv = (HV *)SvRV(*elem);
3013 2003           SV **val = hv_fetch(hv, key, strlen(key), 0);
3014 2003 50         if (val && SvNV(*val) == target) {
    100          
3015 1001           ST(0) = *elem;
3016 1001           XSRETURN(1);
3017             }
3018             }
3019             }
3020             }
3021              
3022 1004           XSRETURN_UNDEF;
3023             }
3024              
3025             /* first_ge(\@array, $threshold) or first_ge(\@array, $key, $threshold)
3026             first element >= threshold, pure C */
3027 3014           XS_INTERNAL(xs_first_ge) {
3028 3014           dXSARGS;
3029 3014 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_ge(\\@array, $threshold) or first_ge(\\@array, $key, $threshold)");
    50          
3030              
3031 3014           SV *aref = ST(0);
3032 3014 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3033 0           croak("Func::Util::first_ge: first argument must be an arrayref");
3034             }
3035              
3036 3014           AV *av = (AV *)SvRV(aref);
3037 3014           SSize_t len = av_len(av) + 1;
3038             SSize_t i;
3039              
3040 3014 100         if (items == 2) {
3041 2013           NV threshold = SvNV(ST(1));
3042 11051 100         for (i = 0; i < len; i++) {
3043 10048           SV **elem = av_fetch(av, i, 0);
3044 10048 50         if (elem && SvNV(*elem) >= threshold) {
    100          
3045 1010           ST(0) = *elem;
3046 1010           XSRETURN(1);
3047             }
3048             }
3049             } else {
3050 1001           char *key = SvPV_nolen(ST(1));
3051 1001           NV threshold = SvNV(ST(2));
3052 1002 50         for (i = 0; i < len; i++) {
3053 1002           SV **elem = av_fetch(av, i, 0);
3054 1002 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3055 1002           HV *hv = (HV *)SvRV(*elem);
3056 1002           SV **val = hv_fetch(hv, key, strlen(key), 0);
3057 1002 50         if (val && SvNV(*val) >= threshold) {
    100          
3058 1001           ST(0) = *elem;
3059 1001           XSRETURN(1);
3060             }
3061             }
3062             }
3063             }
3064              
3065 1003           XSRETURN_UNDEF;
3066             }
3067              
3068             /* first_le(\@array, $threshold) or first_le(\@array, $key, $threshold)
3069             first element <= threshold, pure C */
3070 3009           XS_INTERNAL(xs_first_le) {
3071 3009           dXSARGS;
3072 3009 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_le(\\@array, $threshold) or first_le(\\@array, $key, $threshold)");
    50          
3073              
3074 3009           SV *aref = ST(0);
3075 3009 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3076 0           croak("Func::Util::first_le: first argument must be an arrayref");
3077             }
3078              
3079 3009           AV *av = (AV *)SvRV(aref);
3080 3009           SSize_t len = av_len(av) + 1;
3081             SSize_t i;
3082              
3083 3009 100         if (items == 2) {
3084 2009           NV threshold = SvNV(ST(1));
3085 9027 100         for (i = 0; i < len; i++) {
3086 8024           SV **elem = av_fetch(av, i, 0);
3087 8024 50         if (elem && SvNV(*elem) <= threshold) {
    100          
3088 1006           ST(0) = *elem;
3089 1006           XSRETURN(1);
3090             }
3091             }
3092             } else {
3093 1000           char *key = SvPV_nolen(ST(1));
3094 1000           NV threshold = SvNV(ST(2));
3095 1000 50         for (i = 0; i < len; i++) {
3096 1000           SV **elem = av_fetch(av, i, 0);
3097 1000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3098 1000           HV *hv = (HV *)SvRV(*elem);
3099 1000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3100 1000 50         if (val && SvNV(*val) <= threshold) {
    50          
3101 1000           ST(0) = *elem;
3102 1000           XSRETURN(1);
3103             }
3104             }
3105             }
3106             }
3107              
3108 1003           XSRETURN_UNDEF;
3109             }
3110              
3111             /* first_ne(\@array, $value) or first_ne(\@array, $key, $value)
3112             first element != value (numeric), pure C */
3113 2007           XS_INTERNAL(xs_first_ne) {
3114 2007           dXSARGS;
3115 2007 50         if (items < 2 || items > 3) croak("Usage: Func::Util::first_ne(\\@array, $value) or first_ne(\\@array, $key, $value)");
    50          
3116              
3117 2007           SV *aref = ST(0);
3118 2007 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3119 0           croak("Func::Util::first_ne: first argument must be an arrayref");
3120             }
3121              
3122 2007           AV *av = (AV *)SvRV(aref);
3123 2007           SSize_t len = av_len(av) + 1;
3124             SSize_t i;
3125              
3126 2007 100         if (items == 2) {
3127 1007           NV target = SvNV(ST(1));
3128 2020 100         for (i = 0; i < len; i++) {
3129 2018           SV **elem = av_fetch(av, i, 0);
3130 2018 50         if (elem && SvNV(*elem) != target) {
    100          
3131 1005           ST(0) = *elem;
3132 1005           XSRETURN(1);
3133             }
3134             }
3135             } else {
3136 1000           char *key = SvPV_nolen(ST(1));
3137 1000           NV target = SvNV(ST(2));
3138 2000 50         for (i = 0; i < len; i++) {
3139 2000           SV **elem = av_fetch(av, i, 0);
3140 2000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3141 2000           HV *hv = (HV *)SvRV(*elem);
3142 2000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3143 2000 50         if (val && SvNV(*val) != target) {
    100          
3144 1000           ST(0) = *elem;
3145 1000           XSRETURN(1);
3146             }
3147             }
3148             }
3149             }
3150              
3151 2           XSRETURN_UNDEF;
3152             }
3153              
3154             /* ============================================
3155             final_* - like first_* but iterates backwards
3156             ============================================ */
3157              
3158             /* final_gt(\@array, $threshold) or final_gt(\@array, $key, $threshold)
3159             last element > threshold, pure C, backwards iteration */
3160 3012           XS_INTERNAL(xs_final_gt) {
3161 3012           dXSARGS;
3162 3012 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_gt(\\@array, $threshold) or final_gt(\\@array, $key, $threshold)");
    50          
3163              
3164 3012           SV *aref = ST(0);
3165 3012 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3166 0           croak("Func::Util::final_gt: first argument must be an arrayref");
3167             }
3168              
3169 3012           AV *av = (AV *)SvRV(aref);
3170 3012           SSize_t len = av_len(av) + 1;
3171             SSize_t i;
3172              
3173 3012 100         if (items == 2) {
3174 2011           NV threshold = SvNV(ST(1));
3175 9028 100         for (i = len - 1; i >= 0; i--) {
3176 8023           SV **elem = av_fetch(av, i, 0);
3177 8023 50         if (elem && SvNV(*elem) > threshold) {
    100          
3178 1006           ST(0) = *elem;
3179 1006           XSRETURN(1);
3180             }
3181             }
3182             } else {
3183 1001           char *key = SvPV_nolen(ST(1));
3184 1001           NV threshold = SvNV(ST(2));
3185 1001 50         for (i = len - 1; i >= 0; i--) {
3186 1001           SV **elem = av_fetch(av, i, 0);
3187 1001 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3188 1001           HV *hv = (HV *)SvRV(*elem);
3189 1001           SV **val = hv_fetch(hv, key, strlen(key), 0);
3190 1001 50         if (val && SvNV(*val) > threshold) {
    50          
3191 1001           ST(0) = *elem;
3192 1001           XSRETURN(1);
3193             }
3194             }
3195             }
3196             }
3197              
3198 1005           XSRETURN_UNDEF;
3199             }
3200              
3201             /* final_lt(\@array, $threshold) or final_lt(\@array, $key, $threshold) */
3202 3011           XS_INTERNAL(xs_final_lt) {
3203 3011           dXSARGS;
3204 3011 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_lt(\\@array, $threshold) or final_lt(\\@array, $key, $threshold)");
    50          
3205              
3206 3011           SV *aref = ST(0);
3207 3011 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3208 0           croak("Func::Util::final_lt: first argument must be an arrayref");
3209             }
3210              
3211 3011           AV *av = (AV *)SvRV(aref);
3212 3011           SSize_t len = av_len(av) + 1;
3213             SSize_t i;
3214              
3215 3011 100         if (items == 2) {
3216 2010           NV threshold = SvNV(ST(1));
3217 12036 100         for (i = len - 1; i >= 0; i--) {
3218 11033           SV **elem = av_fetch(av, i, 0);
3219 11033 50         if (elem && SvNV(*elem) < threshold) {
    100          
3220 1007           ST(0) = *elem;
3221 1007           XSRETURN(1);
3222             }
3223             }
3224             } else {
3225 1001           char *key = SvPV_nolen(ST(1));
3226 1001           NV threshold = SvNV(ST(2));
3227 2001 50         for (i = len - 1; i >= 0; i--) {
3228 2001           SV **elem = av_fetch(av, i, 0);
3229 2001 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3230 2001           HV *hv = (HV *)SvRV(*elem);
3231 2001           SV **val = hv_fetch(hv, key, strlen(key), 0);
3232 2001 50         if (val && SvNV(*val) < threshold) {
    100          
3233 1001           ST(0) = *elem;
3234 1001           XSRETURN(1);
3235             }
3236             }
3237             }
3238             }
3239              
3240 1003           XSRETURN_UNDEF;
3241             }
3242              
3243             /* final_ge(\@array, $threshold) or final_ge(\@array, $key, $threshold) */
3244 2005           XS_INTERNAL(xs_final_ge) {
3245 2005           dXSARGS;
3246 2005 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_ge(\\@array, $threshold) or final_ge(\\@array, $key, $threshold)");
    50          
3247              
3248 2005           SV *aref = ST(0);
3249 2005 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3250 0           croak("Func::Util::final_ge: first argument must be an arrayref");
3251             }
3252              
3253 2005           AV *av = (AV *)SvRV(aref);
3254 2005           SSize_t len = av_len(av) + 1;
3255             SSize_t i;
3256              
3257 2005 100         if (items == 2) {
3258 1005           NV threshold = SvNV(ST(1));
3259 1017 100         for (i = len - 1; i >= 0; i--) {
3260 1015           SV **elem = av_fetch(av, i, 0);
3261 1015 50         if (elem && SvNV(*elem) >= threshold) {
    100          
3262 1003           ST(0) = *elem;
3263 1003           XSRETURN(1);
3264             }
3265             }
3266             } else {
3267 1000           char *key = SvPV_nolen(ST(1));
3268 1000           NV threshold = SvNV(ST(2));
3269 1000 50         for (i = len - 1; i >= 0; i--) {
3270 1000           SV **elem = av_fetch(av, i, 0);
3271 1000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3272 1000           HV *hv = (HV *)SvRV(*elem);
3273 1000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3274 1000 50         if (val && SvNV(*val) >= threshold) {
    50          
3275 1000           ST(0) = *elem;
3276 1000           XSRETURN(1);
3277             }
3278             }
3279             }
3280             }
3281              
3282 2           XSRETURN_UNDEF;
3283             }
3284              
3285             /* final_le(\@array, $threshold) or final_le(\@array, $key, $threshold) */
3286 2006           XS_INTERNAL(xs_final_le) {
3287 2006           dXSARGS;
3288 2006 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_le(\\@array, $threshold) or final_le(\\@array, $key, $threshold)");
    50          
3289              
3290 2006           SV *aref = ST(0);
3291 2006 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3292 0           croak("Func::Util::final_le: first argument must be an arrayref");
3293             }
3294              
3295 2006           AV *av = (AV *)SvRV(aref);
3296 2006           SSize_t len = av_len(av) + 1;
3297             SSize_t i;
3298              
3299 2006 100         if (items == 2) {
3300 1006           NV threshold = SvNV(ST(1));
3301 3016 100         for (i = len - 1; i >= 0; i--) {
3302 3015           SV **elem = av_fetch(av, i, 0);
3303 3015 50         if (elem && SvNV(*elem) <= threshold) {
    100          
3304 1005           ST(0) = *elem;
3305 1005           XSRETURN(1);
3306             }
3307             }
3308             } else {
3309 1000           char *key = SvPV_nolen(ST(1));
3310 1000           NV threshold = SvNV(ST(2));
3311 2000 50         for (i = len - 1; i >= 0; i--) {
3312 2000           SV **elem = av_fetch(av, i, 0);
3313 2000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3314 2000           HV *hv = (HV *)SvRV(*elem);
3315 2000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3316 2000 50         if (val && SvNV(*val) <= threshold) {
    100          
3317 1000           ST(0) = *elem;
3318 1000           XSRETURN(1);
3319             }
3320             }
3321             }
3322             }
3323              
3324 1           XSRETURN_UNDEF;
3325             }
3326              
3327             /* final_eq(\@array, $value) or final_eq(\@array, $key, $value) */
3328 2006           XS_INTERNAL(xs_final_eq) {
3329 2006           dXSARGS;
3330 2006 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_eq(\\@array, $value) or final_eq(\\@array, $key, $value)");
    50          
3331              
3332 2006           SV *aref = ST(0);
3333 2006 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3334 0           croak("Func::Util::final_eq: first argument must be an arrayref");
3335             }
3336              
3337 2006           AV *av = (AV *)SvRV(aref);
3338 2006           SSize_t len = av_len(av) + 1;
3339             SSize_t i;
3340              
3341 2006 100         if (items == 2) {
3342 1006           NV target = SvNV(ST(1));
3343 3025 100         for (i = len - 1; i >= 0; i--) {
3344 3023           SV **elem = av_fetch(av, i, 0);
3345 3023 50         if (elem && SvNV(*elem) == target) {
    100          
3346 1004           ST(0) = *elem;
3347 1004           XSRETURN(1);
3348             }
3349             }
3350             } else {
3351 1000           char *key = SvPV_nolen(ST(1));
3352 1000           NV target = SvNV(ST(2));
3353 3000 50         for (i = len - 1; i >= 0; i--) {
3354 3000           SV **elem = av_fetch(av, i, 0);
3355 3000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3356 3000           HV *hv = (HV *)SvRV(*elem);
3357 3000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3358 3000 50         if (val && SvNV(*val) == target) {
    100          
3359 1000           ST(0) = *elem;
3360 1000           XSRETURN(1);
3361             }
3362             }
3363             }
3364             }
3365              
3366 2           XSRETURN_UNDEF;
3367             }
3368              
3369             /* final_ne(\@array, $value) or final_ne(\@array, $key, $value) */
3370 2004           XS_INTERNAL(xs_final_ne) {
3371 2004           dXSARGS;
3372 2004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::final_ne(\\@array, $value) or final_ne(\\@array, $key, $value)");
    50          
3373              
3374 2004           SV *aref = ST(0);
3375 2004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3376 0           croak("Func::Util::final_ne: first argument must be an arrayref");
3377             }
3378              
3379 2004           AV *av = (AV *)SvRV(aref);
3380 2004           SSize_t len = av_len(av) + 1;
3381             SSize_t i;
3382              
3383 2004 100         if (items == 2) {
3384 1004           NV target = SvNV(ST(1));
3385 2009 100         for (i = len - 1; i >= 0; i--) {
3386 2008           SV **elem = av_fetch(av, i, 0);
3387 2008 50         if (elem && SvNV(*elem) != target) {
    100          
3388 1003           ST(0) = *elem;
3389 1003           XSRETURN(1);
3390             }
3391             }
3392             } else {
3393 1000           char *key = SvPV_nolen(ST(1));
3394 1000           NV target = SvNV(ST(2));
3395 2000 50         for (i = len - 1; i >= 0; i--) {
3396 2000           SV **elem = av_fetch(av, i, 0);
3397 2000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3398 2000           HV *hv = (HV *)SvRV(*elem);
3399 2000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3400 2000 50         if (val && SvNV(*val) != target) {
    100          
3401 1000           ST(0) = *elem;
3402 1000           XSRETURN(1);
3403             }
3404             }
3405             }
3406             }
3407              
3408 1           XSRETURN_UNDEF;
3409             }
3410              
3411             /* any_gt(\@array, $threshold) or any_gt(\@array, $key, $threshold)
3412             true if any element > threshold, pure C */
3413 3015           XS_INTERNAL(xs_any_gt) {
3414 3015           dXSARGS;
3415 3015 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_gt(\\@array, $threshold) or any_gt(\\@array, $key, $threshold)");
    50          
3416              
3417 3015           SV *aref = ST(0);
3418 3015 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3419 0           croak("Func::Util::any_gt: first argument must be an arrayref");
3420             }
3421              
3422 3015           AV *av = (AV *)SvRV(aref);
3423 3015           SSize_t len = av_len(av) + 1;
3424             SSize_t i;
3425              
3426 3015 100         if (items == 2) {
3427 2013           NV threshold = SvNV(ST(1));
3428 15056 100         for (i = 0; i < len; i++) {
3429 14048           SV **elem = av_fetch(av, i, 0);
3430 14048 50         if (elem && SvNV(*elem) > threshold) {
    100          
3431 1005           XSRETURN_YES;
3432             }
3433             }
3434             } else {
3435 1002           char *key = SvPV_nolen(ST(1));
3436 1002           NV threshold = SvNV(ST(2));
3437 4005 100         for (i = 0; i < len; i++) {
3438 4004           SV **elem = av_fetch(av, i, 0);
3439 4004 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3440 4004           HV *hv = (HV *)SvRV(*elem);
3441 4004           SV **val = hv_fetch(hv, key, strlen(key), 0);
3442 4004 50         if (val && SvNV(*val) > threshold) {
    100          
3443 1001           XSRETURN_YES;
3444             }
3445             }
3446             }
3447             }
3448              
3449 1009           XSRETURN_NO;
3450             }
3451              
3452             /* any_lt(\@array, $threshold) or any_lt(\@array, $key, $threshold) */
3453 3021           XS_INTERNAL(xs_any_lt) {
3454 3021           dXSARGS;
3455 3021 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_lt(\\@array, $threshold) or any_lt(\\@array, $key, $threshold)");
    50          
3456              
3457 3021           SV *aref = ST(0);
3458 3021 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3459 0           croak("Func::Util::any_lt: first argument must be an arrayref");
3460             }
3461              
3462 3021           AV *av = (AV *)SvRV(aref);
3463 3021           SSize_t len = av_len(av) + 1;
3464             SSize_t i;
3465              
3466 3021 100         if (items == 2) {
3467 2021           NV threshold = SvNV(ST(1));
3468 9049 100         for (i = 0; i < len; i++) {
3469 8044           SV **elem = av_fetch(av, i, 0);
3470 8044 50         if (elem && SvNV(*elem) < threshold) {
    100          
3471 1016           XSRETURN_YES;
3472             }
3473             }
3474             } else {
3475 1000           char *key = SvPV_nolen(ST(1));
3476 1000           NV threshold = SvNV(ST(2));
3477 3000 50         for (i = 0; i < len; i++) {
3478 3000           SV **elem = av_fetch(av, i, 0);
3479 3000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3480 3000           HV *hv = (HV *)SvRV(*elem);
3481 3000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3482 3000 50         if (val && SvNV(*val) < threshold) {
    100          
3483 1000           XSRETURN_YES;
3484             }
3485             }
3486             }
3487             }
3488              
3489 1005           XSRETURN_NO;
3490             }
3491              
3492             /* any_ge(\@array, $threshold) or any_ge(\@array, $key, $threshold) */
3493 2007           XS_INTERNAL(xs_any_ge) {
3494 2007           dXSARGS;
3495 2007 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_ge(\\@array, $threshold) or any_ge(\\@array, $key, $threshold)");
    50          
3496              
3497 2007           SV *aref = ST(0);
3498 2007 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3499 0           croak("Func::Util::any_ge: first argument must be an arrayref");
3500             }
3501              
3502 2007           AV *av = (AV *)SvRV(aref);
3503 2007           SSize_t len = av_len(av) + 1;
3504             SSize_t i;
3505              
3506 2007 100         if (items == 2) {
3507 1007           NV threshold = SvNV(ST(1));
3508 7037 100         for (i = 0; i < len; i++) {
3509 7035           SV **elem = av_fetch(av, i, 0);
3510 7035 50         if (elem && SvNV(*elem) >= threshold) {
    100          
3511 1005           XSRETURN_YES;
3512             }
3513             }
3514             } else {
3515 1000           char *key = SvPV_nolen(ST(1));
3516 1000           NV threshold = SvNV(ST(2));
3517 4000 50         for (i = 0; i < len; i++) {
3518 4000           SV **elem = av_fetch(av, i, 0);
3519 4000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3520 4000           HV *hv = (HV *)SvRV(*elem);
3521 4000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3522 4000 50         if (val && SvNV(*val) >= threshold) {
    100          
3523 1000           XSRETURN_YES;
3524             }
3525             }
3526             }
3527             }
3528              
3529 2           XSRETURN_NO;
3530             }
3531              
3532             /* any_le(\@array, $threshold) or any_le(\@array, $key, $threshold) */
3533 2005           XS_INTERNAL(xs_any_le) {
3534 2005           dXSARGS;
3535 2005 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_le(\\@array, $threshold) or any_le(\\@array, $key, $threshold)");
    50          
3536              
3537 2005           SV *aref = ST(0);
3538 2005 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3539 0           croak("Func::Util::any_le: first argument must be an arrayref");
3540             }
3541              
3542 2005           AV *av = (AV *)SvRV(aref);
3543 2005           SSize_t len = av_len(av) + 1;
3544             SSize_t i;
3545              
3546 2005 100         if (items == 2) {
3547 1005           NV threshold = SvNV(ST(1));
3548 1018 100         for (i = 0; i < len; i++) {
3549 1016           SV **elem = av_fetch(av, i, 0);
3550 1016 50         if (elem && SvNV(*elem) <= threshold) {
    100          
3551 1003           XSRETURN_YES;
3552             }
3553             }
3554             } else {
3555 1000           char *key = SvPV_nolen(ST(1));
3556 1000           NV threshold = SvNV(ST(2));
3557 3000 50         for (i = 0; i < len; i++) {
3558 3000           SV **elem = av_fetch(av, i, 0);
3559 3000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3560 3000           HV *hv = (HV *)SvRV(*elem);
3561 3000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3562 3000 50         if (val && SvNV(*val) <= threshold) {
    100          
3563 1000           XSRETURN_YES;
3564             }
3565             }
3566             }
3567             }
3568              
3569 2           XSRETURN_NO;
3570             }
3571              
3572             /* any_eq(\@array, $value) or any_eq(\@array, $key, $value) */
3573 3009           XS_INTERNAL(xs_any_eq) {
3574 3009           dXSARGS;
3575 3009 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_eq(\\@array, $value) or any_eq(\\@array, $key, $value)");
    50          
3576              
3577 3009           SV *aref = ST(0);
3578 3009 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3579 0           croak("Func::Util::any_eq: first argument must be an arrayref");
3580             }
3581              
3582 3009           AV *av = (AV *)SvRV(aref);
3583 3009           SSize_t len = av_len(av) + 1;
3584             SSize_t i;
3585              
3586 3009 100         if (items == 2) {
3587 2009           NV target = SvNV(ST(1));
3588 12037 100         for (i = 0; i < len; i++) {
3589 11033           SV **elem = av_fetch(av, i, 0);
3590 11033 50         if (elem && SvNV(*elem) == target) {
    100          
3591 1005           XSRETURN_YES;
3592             }
3593             }
3594             } else {
3595 1000           char *key = SvPV_nolen(ST(1));
3596 1000           NV target = SvNV(ST(2));
3597 1000 50         for (i = 0; i < len; i++) {
3598 1000           SV **elem = av_fetch(av, i, 0);
3599 1000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3600 1000           HV *hv = (HV *)SvRV(*elem);
3601 1000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3602 1000 50         if (val && SvNV(*val) == target) {
    50          
3603 1000           XSRETURN_YES;
3604             }
3605             }
3606             }
3607             }
3608              
3609 1004           XSRETURN_NO;
3610             }
3611              
3612             /* any_ne(\@array, $value) or any_ne(\@array, $key, $value) */
3613 2004           XS_INTERNAL(xs_any_ne) {
3614 2004           dXSARGS;
3615 2004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::any_ne(\\@array, $value) or any_ne(\\@array, $key, $value)");
    50          
3616              
3617 2004           SV *aref = ST(0);
3618 2004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3619 0           croak("Func::Util::any_ne: first argument must be an arrayref");
3620             }
3621              
3622 2004           AV *av = (AV *)SvRV(aref);
3623 2004           SSize_t len = av_len(av) + 1;
3624             SSize_t i;
3625              
3626 2004 100         if (items == 2) {
3627 1004           NV target = SvNV(ST(1));
3628 2010 100         for (i = 0; i < len; i++) {
3629 2009           SV **elem = av_fetch(av, i, 0);
3630 2009 50         if (elem && SvNV(*elem) != target) {
    100          
3631 1003           XSRETURN_YES;
3632             }
3633             }
3634             } else {
3635 1000           char *key = SvPV_nolen(ST(1));
3636 1000           NV target = SvNV(ST(2));
3637 2000 50         for (i = 0; i < len; i++) {
3638 2000           SV **elem = av_fetch(av, i, 0);
3639 2000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3640 2000           HV *hv = (HV *)SvRV(*elem);
3641 2000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3642 2000 50         if (val && SvNV(*val) != target) {
    100          
3643 1000           XSRETURN_YES;
3644             }
3645             }
3646             }
3647             }
3648              
3649 1           XSRETURN_NO;
3650             }
3651              
3652             /* all_gt(\@array, $n) - true if all elements > n, pure C */
3653             /* all_gt(\@array, $threshold) or all_gt(\@array, $key, $threshold)
3654             true if all elements > threshold, pure C */
3655 3013           XS_INTERNAL(xs_all_gt) {
3656 3013           dXSARGS;
3657 3013 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_gt(\\@array, $threshold) or all_gt(\\@array, $key, $threshold)");
    50          
3658              
3659 3013           SV *aref = ST(0);
3660 3013 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3661 0           croak("Func::Util::all_gt: first argument must be an arrayref");
3662             }
3663              
3664 3013           AV *av = (AV *)SvRV(aref);
3665 3013           SSize_t len = av_len(av) + 1;
3666             SSize_t i;
3667              
3668 3013 100         if (len == 0) XSRETURN_YES; /* vacuous truth */
3669              
3670 3010 100         if (items == 2) {
3671 2010           NV threshold = SvNV(ST(1));
3672 9038 100         for (i = 0; i < len; i++) {
3673 8033           SV **elem = av_fetch(av, i, 0);
3674 8033 50         if (!elem || SvNV(*elem) <= threshold) {
    100          
3675 1005           XSRETURN_NO;
3676             }
3677             }
3678             } else {
3679 1000           char *key = SvPV_nolen(ST(1));
3680 1000           NV threshold = SvNV(ST(2));
3681 5000 100         for (i = 0; i < len; i++) {
3682 4000           SV **elem = av_fetch(av, i, 0);
3683 4000 50         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    50          
    50          
3684 0           XSRETURN_NO;
3685             }
3686 4000           HV *hv = (HV *)SvRV(*elem);
3687 4000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3688 4000 50         if (!val || SvNV(*val) <= threshold) {
    50          
3689 0           XSRETURN_NO;
3690             }
3691             }
3692             }
3693              
3694 2005           XSRETURN_YES;
3695             }
3696              
3697             /* all_lt(\@array, $threshold) or all_lt(\@array, $key, $threshold) */
3698 3009           XS_INTERNAL(xs_all_lt) {
3699 3009           dXSARGS;
3700 3009 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_lt(\\@array, $threshold) or all_lt(\\@array, $key, $threshold)");
    50          
3701              
3702 3009           SV *aref = ST(0);
3703 3009 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3704 0           croak("Func::Util::all_lt: first argument must be an arrayref");
3705             }
3706              
3707 3009           AV *av = (AV *)SvRV(aref);
3708 3009           SSize_t len = av_len(av) + 1;
3709             SSize_t i;
3710              
3711 3009 100         if (len == 0) XSRETURN_YES;
3712              
3713 3008 100         if (items == 2) {
3714 2008           NV threshold = SvNV(ST(1));
3715 11044 100         for (i = 0; i < len; i++) {
3716 10040           SV **elem = av_fetch(av, i, 0);
3717 10040 50         if (!elem || SvNV(*elem) >= threshold) {
    100          
3718 1004           XSRETURN_NO;
3719             }
3720             }
3721             } else {
3722 1000           char *key = SvPV_nolen(ST(1));
3723 1000           NV threshold = SvNV(ST(2));
3724 5000 100         for (i = 0; i < len; i++) {
3725 4000           SV **elem = av_fetch(av, i, 0);
3726 4000 50         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    50          
    50          
3727 0           XSRETURN_NO;
3728             }
3729 4000           HV *hv = (HV *)SvRV(*elem);
3730 4000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3731 4000 50         if (!val || SvNV(*val) >= threshold) {
    50          
3732 0           XSRETURN_NO;
3733             }
3734             }
3735             }
3736              
3737 2004           XSRETURN_YES;
3738             }
3739              
3740             /* all_ge(\@array, $threshold) or all_ge(\@array, $key, $threshold) */
3741 3019           XS_INTERNAL(xs_all_ge) {
3742 3019           dXSARGS;
3743 3019 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_ge(\\@array, $threshold) or all_ge(\\@array, $key, $threshold)");
    50          
3744              
3745 3019           SV *aref = ST(0);
3746 3019 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3747 0           croak("Func::Util::all_ge: first argument must be an arrayref");
3748             }
3749              
3750 3019           AV *av = (AV *)SvRV(aref);
3751 3019           SSize_t len = av_len(av) + 1;
3752             SSize_t i;
3753              
3754 3019 50         if (len == 0) XSRETURN_YES;
3755              
3756 3019 100         if (items == 2) {
3757 2017           NV threshold = SvNV(ST(1));
3758 9102 100         for (i = 0; i < len; i++) {
3759 8089           SV **elem = av_fetch(av, i, 0);
3760 8089 50         if (!elem || SvNV(*elem) < threshold) {
    100          
3761 1004           XSRETURN_NO;
3762             }
3763             }
3764             } else {
3765 1002           char *key = SvPV_nolen(ST(1));
3766 1002           NV threshold = SvNV(ST(2));
3767 5004 100         for (i = 0; i < len; i++) {
3768 4003           SV **elem = av_fetch(av, i, 0);
3769 4003 50         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    50          
    50          
3770 0           XSRETURN_NO;
3771             }
3772 4003           HV *hv = (HV *)SvRV(*elem);
3773 4003           SV **val = hv_fetch(hv, key, strlen(key), 0);
3774 4003 50         if (!val || SvNV(*val) < threshold) {
    100          
3775 1           XSRETURN_NO;
3776             }
3777             }
3778             }
3779              
3780 2014           XSRETURN_YES;
3781             }
3782              
3783             /* all_le(\@array, $threshold) or all_le(\@array, $key, $threshold) */
3784 3004           XS_INTERNAL(xs_all_le) {
3785 3004           dXSARGS;
3786 3004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_le(\\@array, $threshold) or all_le(\\@array, $key, $threshold)");
    50          
3787              
3788 3004           SV *aref = ST(0);
3789 3004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3790 0           croak("Func::Util::all_le: first argument must be an arrayref");
3791             }
3792              
3793 3004           AV *av = (AV *)SvRV(aref);
3794 3004           SSize_t len = av_len(av) + 1;
3795             SSize_t i;
3796              
3797 3004 50         if (len == 0) XSRETURN_YES;
3798              
3799 3004 100         if (items == 2) {
3800 2004           NV threshold = SvNV(ST(1));
3801 12025 100         for (i = 0; i < len; i++) {
3802 11023           SV **elem = av_fetch(av, i, 0);
3803 11023 50         if (!elem || SvNV(*elem) > threshold) {
    100          
3804 1002           XSRETURN_NO;
3805             }
3806             }
3807             } else {
3808 1000           char *key = SvPV_nolen(ST(1));
3809 1000           NV threshold = SvNV(ST(2));
3810 5000 100         for (i = 0; i < len; i++) {
3811 4000           SV **elem = av_fetch(av, i, 0);
3812 4000 50         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    50          
    50          
3813 0           XSRETURN_NO;
3814             }
3815 4000           HV *hv = (HV *)SvRV(*elem);
3816 4000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3817 4000 50         if (!val || SvNV(*val) > threshold) {
    50          
3818 0           XSRETURN_NO;
3819             }
3820             }
3821             }
3822              
3823 2002           XSRETURN_YES;
3824             }
3825              
3826             /* all_eq(\@array, $value) or all_eq(\@array, $key, $value) */
3827 2007           XS_INTERNAL(xs_all_eq) {
3828 2007           dXSARGS;
3829 2007 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_eq(\\@array, $value) or all_eq(\\@array, $key, $value)");
    50          
3830              
3831 2007           SV *aref = ST(0);
3832 2007 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3833 0           croak("Func::Util::all_eq: first argument must be an arrayref");
3834             }
3835              
3836 2007           AV *av = (AV *)SvRV(aref);
3837 2007           SSize_t len = av_len(av) + 1;
3838             SSize_t i;
3839              
3840 2007 100         if (len == 0) XSRETURN_YES;
3841              
3842 2006 50         if (items == 2) {
3843 2006           NV target = SvNV(ST(1));
3844 6018 100         for (i = 0; i < len; i++) {
3845 5014           SV **elem = av_fetch(av, i, 0);
3846 5014 50         if (!elem || SvNV(*elem) != target) {
    100          
3847 1002           XSRETURN_NO;
3848             }
3849             }
3850             } else {
3851 0           char *key = SvPV_nolen(ST(1));
3852 0           NV target = SvNV(ST(2));
3853 0 0         for (i = 0; i < len; i++) {
3854 0           SV **elem = av_fetch(av, i, 0);
3855 0 0         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    0          
    0          
3856 0           XSRETURN_NO;
3857             }
3858 0           HV *hv = (HV *)SvRV(*elem);
3859 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
3860 0 0         if (!val || SvNV(*val) != target) {
    0          
3861 0           XSRETURN_NO;
3862             }
3863             }
3864             }
3865              
3866 1004           XSRETURN_YES;
3867             }
3868              
3869             /* all_ne(\@array, $value) or all_ne(\@array, $key, $value) */
3870 2004           XS_INTERNAL(xs_all_ne) {
3871 2004           dXSARGS;
3872 2004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::all_ne(\\@array, $value) or all_ne(\\@array, $key, $value)");
    50          
3873              
3874 2004           SV *aref = ST(0);
3875 2004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3876 0           croak("Func::Util::all_ne: first argument must be an arrayref");
3877             }
3878              
3879 2004           AV *av = (AV *)SvRV(aref);
3880 2004           SSize_t len = av_len(av) + 1;
3881             SSize_t i;
3882              
3883 2004 50         if (len == 0) XSRETURN_YES;
3884              
3885 2004 50         if (items == 2) {
3886 2004           NV target = SvNV(ST(1));
3887 11020 100         for (i = 0; i < len; i++) {
3888 10018           SV **elem = av_fetch(av, i, 0);
3889 10018 50         if (!elem || SvNV(*elem) == target) {
    100          
3890 1002           XSRETURN_NO;
3891             }
3892             }
3893             } else {
3894 0           char *key = SvPV_nolen(ST(1));
3895 0           NV target = SvNV(ST(2));
3896 0 0         for (i = 0; i < len; i++) {
3897 0           SV **elem = av_fetch(av, i, 0);
3898 0 0         if (!elem || !SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVHV) {
    0          
    0          
3899 0           XSRETURN_NO;
3900             }
3901 0           HV *hv = (HV *)SvRV(*elem);
3902 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
3903 0 0         if (!val || SvNV(*val) == target) {
    0          
3904 0           XSRETURN_NO;
3905             }
3906             }
3907             }
3908              
3909 1002           XSRETURN_YES;
3910             }
3911              
3912             /* none_gt(\@array, $threshold) or none_gt(\@array, $key, $threshold)
3913             true if no element > threshold, pure C */
3914 3011           XS_INTERNAL(xs_none_gt) {
3915 3011           dXSARGS;
3916 3011 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_gt(\\@array, $threshold) or none_gt(\\@array, $key, $threshold)");
    50          
3917              
3918 3011           SV *aref = ST(0);
3919 3011 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3920 0           croak("Func::Util::none_gt: first argument must be an arrayref");
3921             }
3922              
3923 3011           AV *av = (AV *)SvRV(aref);
3924 3011           SSize_t len = av_len(av) + 1;
3925             SSize_t i;
3926              
3927 3011 100         if (items == 2) {
3928 2011           NV threshold = SvNV(ST(1));
3929 12046 100         for (i = 0; i < len; i++) {
3930 11039           SV **elem = av_fetch(av, i, 0);
3931 11039 50         if (elem && SvNV(*elem) > threshold) {
    100          
3932 1004           XSRETURN_NO;
3933             }
3934             }
3935             } else {
3936 1000           char *key = SvPV_nolen(ST(1));
3937 1000           NV threshold = SvNV(ST(2));
3938 5000 100         for (i = 0; i < len; i++) {
3939 4000           SV **elem = av_fetch(av, i, 0);
3940 4000 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3941 4000           HV *hv = (HV *)SvRV(*elem);
3942 4000           SV **val = hv_fetch(hv, key, strlen(key), 0);
3943 4000 50         if (val && SvNV(*val) > threshold) {
    50          
3944 0           XSRETURN_NO;
3945             }
3946             }
3947             }
3948             }
3949              
3950 2007           XSRETURN_YES;
3951             }
3952              
3953             /* none_lt(\@array, $threshold) or none_lt(\@array, $key, $threshold) */
3954 3010           XS_INTERNAL(xs_none_lt) {
3955 3010           dXSARGS;
3956 3010 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_lt(\\@array, $threshold) or none_lt(\\@array, $key, $threshold)");
    50          
3957              
3958 3010           SV *aref = ST(0);
3959 3010 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
3960 0           croak("Func::Util::none_lt: first argument must be an arrayref");
3961             }
3962              
3963 3010           AV *av = (AV *)SvRV(aref);
3964 3010           SSize_t len = av_len(av) + 1;
3965             SSize_t i;
3966              
3967 3010 100         if (items == 2) {
3968 2008           NV threshold = SvNV(ST(1));
3969 9036 100         for (i = 0; i < len; i++) {
3970 8031           SV **elem = av_fetch(av, i, 0);
3971 8031 50         if (elem && SvNV(*elem) < threshold) {
    100          
3972 1003           XSRETURN_NO;
3973             }
3974             }
3975             } else {
3976 1002           char *key = SvPV_nolen(ST(1));
3977 1002           NV threshold = SvNV(ST(2));
3978 5004 100         for (i = 0; i < len; i++) {
3979 4003           SV **elem = av_fetch(av, i, 0);
3980 4003 50         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    50          
    50          
3981 4003           HV *hv = (HV *)SvRV(*elem);
3982 4003           SV **val = hv_fetch(hv, key, strlen(key), 0);
3983 4003 50         if (val && SvNV(*val) < threshold) {
    100          
3984 1           XSRETURN_NO;
3985             }
3986             }
3987             }
3988             }
3989              
3990 2006           XSRETURN_YES;
3991             }
3992              
3993             /* none_ge(\@array, $threshold) or none_ge(\@array, $key, $threshold) */
3994 2004           XS_INTERNAL(xs_none_ge) {
3995 2004           dXSARGS;
3996 2004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_ge(\\@array, $threshold) or none_ge(\\@array, $key, $threshold)");
    50          
3997              
3998 2004           SV *aref = ST(0);
3999 2004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4000 0           croak("Func::Util::none_ge: first argument must be an arrayref");
4001             }
4002              
4003 2004           AV *av = (AV *)SvRV(aref);
4004 2004           SSize_t len = av_len(av) + 1;
4005             SSize_t i;
4006              
4007 2004 50         if (items == 2) {
4008 2004           NV threshold = SvNV(ST(1));
4009 9025 100         for (i = 0; i < len; i++) {
4010 8023           SV **elem = av_fetch(av, i, 0);
4011 8023 50         if (elem && SvNV(*elem) >= threshold) {
    100          
4012 1002           XSRETURN_NO;
4013             }
4014             }
4015             } else {
4016 0           char *key = SvPV_nolen(ST(1));
4017 0           NV threshold = SvNV(ST(2));
4018 0 0         for (i = 0; i < len; i++) {
4019 0           SV **elem = av_fetch(av, i, 0);
4020 0 0         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    0          
    0          
4021 0           HV *hv = (HV *)SvRV(*elem);
4022 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
4023 0 0         if (val && SvNV(*val) >= threshold) {
    0          
4024 0           XSRETURN_NO;
4025             }
4026             }
4027             }
4028             }
4029              
4030 1002           XSRETURN_YES;
4031             }
4032              
4033             /* none_le(\@array, $threshold) or none_le(\@array, $key, $threshold) */
4034 2004           XS_INTERNAL(xs_none_le) {
4035 2004           dXSARGS;
4036 2004 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_le(\\@array, $threshold) or none_le(\\@array, $key, $threshold)");
    50          
4037              
4038 2004           SV *aref = ST(0);
4039 2004 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4040 0           croak("Func::Util::none_le: first argument must be an arrayref");
4041             }
4042              
4043 2004           AV *av = (AV *)SvRV(aref);
4044 2004           SSize_t len = av_len(av) + 1;
4045             SSize_t i;
4046              
4047 2004 50         if (items == 2) {
4048 2004           NV threshold = SvNV(ST(1));
4049 9017 100         for (i = 0; i < len; i++) {
4050 8015           SV **elem = av_fetch(av, i, 0);
4051 8015 50         if (elem && SvNV(*elem) <= threshold) {
    100          
4052 1002           XSRETURN_NO;
4053             }
4054             }
4055             } else {
4056 0           char *key = SvPV_nolen(ST(1));
4057 0           NV threshold = SvNV(ST(2));
4058 0 0         for (i = 0; i < len; i++) {
4059 0           SV **elem = av_fetch(av, i, 0);
4060 0 0         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    0          
    0          
4061 0           HV *hv = (HV *)SvRV(*elem);
4062 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
4063 0 0         if (val && SvNV(*val) <= threshold) {
    0          
4064 0           XSRETURN_NO;
4065             }
4066             }
4067             }
4068             }
4069              
4070 1002           XSRETURN_YES;
4071             }
4072              
4073             /* none_eq(\@array, $value) or none_eq(\@array, $key, $value) */
4074 2008           XS_INTERNAL(xs_none_eq) {
4075 2008           dXSARGS;
4076 2008 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_eq(\\@array, $value) or none_eq(\\@array, $key, $value)");
    50          
4077              
4078 2008           SV *aref = ST(0);
4079 2008 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4080 0           croak("Func::Util::none_eq: first argument must be an arrayref");
4081             }
4082              
4083 2008           AV *av = (AV *)SvRV(aref);
4084 2008           SSize_t len = av_len(av) + 1;
4085             SSize_t i;
4086              
4087 2008 50         if (items == 2) {
4088 2008           NV target = SvNV(ST(1));
4089 11037 100         for (i = 0; i < len; i++) {
4090 10032           SV **elem = av_fetch(av, i, 0);
4091 10032 50         if (elem && SvNV(*elem) == target) {
    100          
4092 1003           XSRETURN_NO;
4093             }
4094             }
4095             } else {
4096 0           char *key = SvPV_nolen(ST(1));
4097 0           NV target = SvNV(ST(2));
4098 0 0         for (i = 0; i < len; i++) {
4099 0           SV **elem = av_fetch(av, i, 0);
4100 0 0         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    0          
    0          
4101 0           HV *hv = (HV *)SvRV(*elem);
4102 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
4103 0 0         if (val && SvNV(*val) == target) {
    0          
4104 0           XSRETURN_NO;
4105             }
4106             }
4107             }
4108             }
4109              
4110 1005           XSRETURN_YES;
4111             }
4112              
4113             /* none_ne(\@array, $value) or none_ne(\@array, $key, $value) */
4114 2005           XS_INTERNAL(xs_none_ne) {
4115 2005           dXSARGS;
4116 2005 50         if (items < 2 || items > 3) croak("Usage: Func::Util::none_ne(\\@array, $value) or none_ne(\\@array, $key, $value)");
    50          
4117              
4118 2005           SV *aref = ST(0);
4119 2005 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4120 0           croak("Func::Util::none_ne: first argument must be an arrayref");
4121             }
4122              
4123 2005           AV *av = (AV *)SvRV(aref);
4124 2005           SSize_t len = av_len(av) + 1;
4125             SSize_t i;
4126              
4127 2005 50         if (items == 2) {
4128 2005           NV target = SvNV(ST(1));
4129 6015 100         for (i = 0; i < len; i++) {
4130 5012           SV **elem = av_fetch(av, i, 0);
4131 5012 50         if (elem && SvNV(*elem) != target) {
    100          
4132 1002           XSRETURN_NO;
4133             }
4134             }
4135             } else {
4136 0           char *key = SvPV_nolen(ST(1));
4137 0           NV target = SvNV(ST(2));
4138 0 0         for (i = 0; i < len; i++) {
4139 0           SV **elem = av_fetch(av, i, 0);
4140 0 0         if (elem && SvROK(*elem) && SvTYPE(SvRV(*elem)) == SVt_PVHV) {
    0          
    0          
4141 0           HV *hv = (HV *)SvRV(*elem);
4142 0           SV **val = hv_fetch(hv, key, strlen(key), 0);
4143 0 0         if (val && SvNV(*val) != target) {
    0          
4144 0           XSRETURN_NO;
4145             }
4146             }
4147             }
4148             }
4149              
4150 1003           XSRETURN_YES;
4151             }
4152              
4153             /* firstr(\&block, \@array) - first with arrayref, no stack flattening */
4154 3012           XS_INTERNAL(xs_firstr) {
4155 3012           dXSARGS;
4156 3012 50         if (items != 2) croak("Usage: Func::Util::firstr(\\&block, \\@array)");
4157              
4158 3012           SV *block = ST(0);
4159 3012           SV *aref = ST(1);
4160              
4161 3012 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4162 0           croak("Func::Util::firstr: first argument must be a coderef");
4163             }
4164 3012 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4165 0           croak("Func::Util::firstr: second argument must be an arrayref");
4166             }
4167              
4168 3012           CV *block_cv = (CV *)SvRV(block);
4169 3012           AV *av = (AV *)SvRV(aref);
4170 3012           SSize_t len = av_len(av) + 1;
4171             SSize_t i;
4172              
4173 3012 50         if (len == 0) {
4174 0           XSRETURN_UNDEF;
4175             }
4176              
4177             #ifdef dMULTICALL
4178 3012 50         if (!CvISXSUB(block_cv)) {
4179             dMULTICALL;
4180 3012           I32 gimme = G_SCALAR;
4181              
4182 3012           SAVESPTR(GvSV(PL_defgv));
4183 3012 50         PUSH_MULTICALL(block_cv);
4184              
4185 11045 100         for (i = 0; i < len; i++) {
4186 10045           SV **elem = av_fetch(av, i, 0);
4187 10045 50         if (!elem) continue;
4188              
4189 10045           SV *def_sv = GvSV(PL_defgv) = *elem;
4190 10045           SvTEMP_off(def_sv);
4191              
4192 10045           MULTICALL;
4193              
4194 10045 100         if (SvTRUE(*PL_stack_sp)) {
4195 2012 50         POP_MULTICALL;
4196 2012           ST(0) = *elem;
4197 2012           XSRETURN(1);
4198             }
4199             }
4200              
4201 1000 50         POP_MULTICALL;
4202 1000           XSRETURN_UNDEF;
4203             }
4204             #endif
4205              
4206             /* Fallback for XS subs */
4207 0 0         for (i = 0; i < len; i++) {
4208 0           SV **elem = av_fetch(av, i, 0);
4209 0 0         if (!elem) continue;
4210              
4211 0           dSP;
4212 0           GvSV(PL_defgv) = *elem;
4213              
4214 0 0         PUSHMARK(SP);
4215 0           call_sv((SV*)block_cv, G_SCALAR);
4216              
4217 0 0         if (SvTRUE(*PL_stack_sp)) {
4218 0           ST(0) = *elem;
4219 0           XSRETURN(1);
4220             }
4221             }
4222              
4223 0           XSRETURN_UNDEF;
4224             }
4225              
4226             /* final(\&block, \@array) - last element where block returns true (backwards iteration) */
4227 2014           XS_INTERNAL(xs_final) {
4228 2014           dXSARGS;
4229 2014 50         if (items != 2) croak("Usage: Func::Util::final(\\&block, \\@array)");
4230              
4231 2014           SV *block = ST(0);
4232 2014           SV *aref = ST(1);
4233              
4234 2014 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4235 0           croak("Func::Util::final: first argument must be a coderef");
4236             }
4237 2014 50         if (!SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV) {
    50          
4238 0           croak("Func::Util::final: second argument must be an arrayref");
4239             }
4240              
4241 2014           CV *block_cv = (CV *)SvRV(block);
4242 2014           AV *av = (AV *)SvRV(aref);
4243 2014           SSize_t len = av_len(av) + 1;
4244             SSize_t i;
4245              
4246 2014 100         if (len == 0) {
4247 2           XSRETURN_UNDEF;
4248             }
4249              
4250             #ifdef dMULTICALL
4251 2012 50         if (!CvISXSUB(block_cv)) {
4252             dMULTICALL;
4253 2012           I32 gimme = G_SCALAR;
4254              
4255 2012           SAVESPTR(GvSV(PL_defgv));
4256 2012 50         PUSH_MULTICALL(block_cv);
4257              
4258             /* Iterate backwards for speed */
4259 9029 100         for (i = len - 1; i >= 0; i--) {
4260 8026           SV **elem = av_fetch(av, i, 0);
4261 8026 50         if (!elem) continue;
4262              
4263 8026           SV *def_sv = GvSV(PL_defgv) = *elem;
4264 8026           SvTEMP_off(def_sv);
4265              
4266 8026           MULTICALL;
4267              
4268 8026 100         if (SvTRUE(*PL_stack_sp)) {
4269 1009 50         POP_MULTICALL;
4270 1009           ST(0) = *elem;
4271 1009           XSRETURN(1);
4272             }
4273             }
4274              
4275 1003 50         POP_MULTICALL;
4276 1003           XSRETURN_UNDEF;
4277             }
4278             #endif
4279              
4280             /* Fallback for XS subs - backwards */
4281 0 0         for (i = len - 1; i >= 0; i--) {
4282 0           SV **elem = av_fetch(av, i, 0);
4283 0 0         if (!elem) continue;
4284              
4285 0           dSP;
4286 0           GvSV(PL_defgv) = *elem;
4287              
4288 0 0         PUSHMARK(SP);
4289 0           call_sv((SV*)block_cv, G_SCALAR);
4290              
4291 0 0         if (SvTRUE(*PL_stack_sp)) {
4292 0           ST(0) = *elem;
4293 0           XSRETURN(1);
4294             }
4295             }
4296              
4297 0           XSRETURN_UNDEF;
4298             }
4299              
4300             /* first { block } @list - return first element where block returns true */
4301 13118           XS_INTERNAL(xs_first) {
4302 13118           dXSARGS;
4303 13118 50         if (items < 1) croak("Usage: Func::Util::first(\\&block, @list)");
4304              
4305 13118           SV *block = ST(0);
4306 13118 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4307 0           croak("Func::Util::first: first argument must be a coderef");
4308             }
4309              
4310 13118           CV *block_cv = (CV *)SvRV(block);
4311             /* Store args from stack base before any stack manipulation */
4312 13118           SV **args = &PL_stack_base[ax];
4313             IV index;
4314              
4315             /* Empty list - return undef */
4316 13118 100         if (items <= 1) {
4317 2           XSRETURN_UNDEF;
4318             }
4319              
4320             /* Use MULTICALL for pure Perl subs - much faster than call_sv */
4321             #ifdef dMULTICALL
4322 13116 50         if (!CvISXSUB(block_cv)) {
4323             dMULTICALL;
4324 13116           I32 gimme = G_SCALAR;
4325              
4326 13116           SAVESPTR(GvSV(PL_defgv));
4327 13116 50         PUSH_MULTICALL(block_cv);
4328              
4329 33340 100         for (index = 1; index < items; index++) {
4330 33336           SV *def_sv = GvSV(PL_defgv) = args[index];
4331 33336           SvTEMP_off(def_sv);
4332              
4333 33336           MULTICALL;
4334              
4335 33336 100         if (SvTRUE(*PL_stack_sp)) {
4336 13112 50         POP_MULTICALL;
4337 13112           ST(0) = ST(index);
4338 13112           XSRETURN(1);
4339             }
4340             }
4341              
4342 4 50         POP_MULTICALL;
4343 4           XSRETURN_UNDEF;
4344             }
4345             #endif
4346              
4347             /* Fallback for XS subs */
4348 0 0         for (index = 1; index < items; index++) {
4349 0           dSP;
4350 0           GvSV(PL_defgv) = args[index];
4351              
4352 0 0         PUSHMARK(SP);
4353 0           call_sv((SV*)block_cv, G_SCALAR);
4354              
4355 0 0         if (SvTRUE(*PL_stack_sp)) {
4356 0           ST(0) = ST(index);
4357 0           XSRETURN(1);
4358             }
4359             }
4360              
4361 0           XSRETURN_UNDEF;
4362             }
4363              
4364             /* any { block } @list - return true if any element matches */
4365 13126           XS_INTERNAL(xs_any) {
4366 13126           dXSARGS;
4367 13126 50         if (items < 1) croak("Usage: Func::Util::any(\\&block, @list)");
4368              
4369 13126           SV *block = ST(0);
4370 13126 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4371 0           croak("Func::Util::any: first argument must be a coderef");
4372             }
4373              
4374 13126           CV *block_cv = (CV *)SvRV(block);
4375 13126           SV **args = &PL_stack_base[ax];
4376             IV index;
4377              
4378             /* Empty list returns false */
4379 13126 100         if (items <= 1) {
4380 2           XSRETURN_NO;
4381             }
4382              
4383             #ifdef dMULTICALL
4384 13124 50         if (!CvISXSUB(block_cv)) {
4385             dMULTICALL;
4386 13124           I32 gimme = G_SCALAR;
4387              
4388 13124           SAVESPTR(GvSV(PL_defgv));
4389 13124 50         PUSH_MULTICALL(block_cv);
4390              
4391 33345 100         for (index = 1; index < items; index++) {
4392 33341           SV *def_sv = GvSV(PL_defgv) = args[index];
4393 33341           SvTEMP_off(def_sv);
4394              
4395 33341           MULTICALL;
4396              
4397 33341 100         if (SvTRUE(*PL_stack_sp)) {
4398 13120 50         POP_MULTICALL;
4399 13120           XSRETURN_YES;
4400             }
4401             }
4402              
4403 4 50         POP_MULTICALL;
4404 4           XSRETURN_NO;
4405             }
4406             #endif
4407              
4408 0 0         for (index = 1; index < items; index++) {
4409 0           dSP;
4410 0           GvSV(PL_defgv) = args[index];
4411              
4412 0 0         PUSHMARK(SP);
4413 0           call_sv((SV*)block_cv, G_SCALAR);
4414              
4415 0 0         if (SvTRUE(*PL_stack_sp)) {
4416 0           XSRETURN_YES;
4417             }
4418             }
4419              
4420 0           XSRETURN_NO;
4421             }
4422              
4423             /* all { block } @list - return true if all elements match */
4424 13116           XS_INTERNAL(xs_all) {
4425 13116           dXSARGS;
4426 13116 50         if (items < 1) croak("Usage: Func::Util::all(\\&block, @list)");
4427              
4428 13116           SV *block = ST(0);
4429 13116 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4430 0           croak("Func::Util::all: first argument must be a coderef");
4431             }
4432              
4433 13116           CV *block_cv = (CV *)SvRV(block);
4434 13116           SV **args = &PL_stack_base[ax];
4435             IV index;
4436              
4437             /* Empty list returns true (vacuous truth) */
4438 13116 100         if (items <= 1) {
4439 2           XSRETURN_YES;
4440             }
4441              
4442             #ifdef dMULTICALL
4443 13114 50         if (!CvISXSUB(block_cv)) {
4444             dMULTICALL;
4445 13114           I32 gimme = G_SCALAR;
4446              
4447 13114           SAVESPTR(GvSV(PL_defgv));
4448 13114 50         PUSH_MULTICALL(block_cv);
4449              
4450 66645 100         for (index = 1; index < items; index++) {
4451 53537           SV *def_sv = GvSV(PL_defgv) = args[index];
4452 53537           SvTEMP_off(def_sv);
4453              
4454 53537           MULTICALL;
4455              
4456 53537 100         if (!SvTRUE(*PL_stack_sp)) {
4457 6 50         POP_MULTICALL;
4458 6           XSRETURN_NO;
4459             }
4460             }
4461              
4462 13108 50         POP_MULTICALL;
4463 13108           XSRETURN_YES;
4464             }
4465             #endif
4466              
4467 0 0         for (index = 1; index < items; index++) {
4468 0           dSP;
4469 0           GvSV(PL_defgv) = args[index];
4470              
4471 0 0         PUSHMARK(SP);
4472 0           call_sv((SV*)block_cv, G_SCALAR);
4473              
4474 0 0         if (!SvTRUE(*PL_stack_sp)) {
4475 0           XSRETURN_NO;
4476             }
4477             }
4478              
4479 0           XSRETURN_YES;
4480             }
4481              
4482             /* none { block } @list - return true if no elements match */
4483 13114           XS_INTERNAL(xs_none) {
4484 13114           dXSARGS;
4485 13114 50         if (items < 1) croak("Usage: Func::Util::none(\\&block, @list)");
4486              
4487 13114           SV *block = ST(0);
4488 13114 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4489 0           croak("Func::Util::none: first argument must be a coderef");
4490             }
4491              
4492 13114           CV *block_cv = (CV *)SvRV(block);
4493 13114           SV **args = &PL_stack_base[ax];
4494             IV index;
4495              
4496             /* Empty list returns true (no elements match = vacuous truth) */
4497 13114 100         if (items <= 1) {
4498 2           XSRETURN_YES;
4499             }
4500              
4501             #ifdef dMULTICALL
4502 13112 50         if (!CvISXSUB(block_cv)) {
4503             dMULTICALL;
4504 13112           I32 gimme = G_SCALAR;
4505              
4506 13112           SAVESPTR(GvSV(PL_defgv));
4507 13112 50         PUSH_MULTICALL(block_cv);
4508              
4509 63638 100         for (index = 1; index < items; index++) {
4510 53532           SV *def_sv = GvSV(PL_defgv) = args[index];
4511 53532           SvTEMP_off(def_sv);
4512              
4513 53532           MULTICALL;
4514              
4515 53532 100         if (SvTRUE(*PL_stack_sp)) {
4516 3006 50         POP_MULTICALL;
4517 3006           XSRETURN_NO;
4518             }
4519             }
4520              
4521 10106 50         POP_MULTICALL;
4522 10106           XSRETURN_YES;
4523             }
4524             #endif
4525              
4526 0 0         for (index = 1; index < items; index++) {
4527 0           dSP;
4528 0           GvSV(PL_defgv) = args[index];
4529              
4530 0 0         PUSHMARK(SP);
4531 0           call_sv((SV*)block_cv, G_SCALAR);
4532              
4533 0 0         if (SvTRUE(*PL_stack_sp)) {
4534 0           XSRETURN_NO;
4535             }
4536             }
4537              
4538 0           XSRETURN_YES;
4539             }
4540              
4541             /* ============================================
4542             Experimental: Inlined MULTICALL versions for benchmarking
4543              
4544             These versions inline the runops loop to skip the CALLRUNOPS
4545             function call overhead. For testing only.
4546             ============================================ */
4547              
4548             /* first_inline - experimental version with inlined runops loop
4549             * Requires MULTICALL API (5.11+) */
4550             #ifdef dMULTICALL
4551 6           XS_INTERNAL(xs_first_inline) {
4552 6           dXSARGS;
4553 6 50         if (items < 1) croak("Usage: Func::Util::first_inline(\\&block, @list)");
4554              
4555 6           SV *block = ST(0);
4556 6 50         if (!SvROK(block) || SvTYPE(SvRV(block)) != SVt_PVCV) {
    50          
4557 0           croak("Func::Util::first_inline: first argument must be a coderef");
4558             }
4559              
4560 6           CV *the_cv = (CV *)SvRV(block);
4561              
4562 6 100         if (items == 1) {
4563 1           XSRETURN_UNDEF;
4564             }
4565              
4566             /* Only works with pure Perl subs */
4567 5 50         if (CvISXSUB(the_cv)) {
4568 0           croak("Func::Util::first_inline: only works with pure Perl subs");
4569             }
4570              
4571 5           SV **args = &ST(1);
4572 5           IV num_args = items - 1;
4573             IV i;
4574              
4575             /* Use standard MULTICALL API for compatibility */
4576             dMULTICALL;
4577 5           I32 gimme = G_SCALAR;
4578              
4579 5 50         PUSH_MULTICALL(the_cv);
4580              
4581             /* Save and setup $_ */
4582 5           SAVESPTR(GvSV(PL_defgv));
4583              
4584 25 100         for (i = 0; i < num_args; i++) {
4585 24           SV *elem = args[i];
4586 24           GvSV(PL_defgv) = elem;
4587 24           SvTEMP_off(elem);
4588              
4589 24           MULTICALL;
4590              
4591 24 100         if (SvTRUE(*PL_stack_sp)) {
4592             /* Found it - cleanup and return */
4593 4 50         POP_MULTICALL;
4594 4           SPAGAIN;
4595              
4596 4           ST(0) = elem;
4597 4           XSRETURN(1);
4598             }
4599             }
4600              
4601             /* Cleanup */
4602 1 50         POP_MULTICALL;
4603 1           SPAGAIN;
4604              
4605 1           XSRETURN_UNDEF;
4606             }
4607             #endif /* dMULTICALL */
4608              
4609              
4610             /* ============================================
4611             Type predicate XS fallbacks
4612             ============================================ */
4613              
4614 17123           XS_INTERNAL(xs_is_ref) {
4615 17123           dXSARGS;
4616 17123 50         if (items != 1) croak("Usage: Func::Util::is_ref($value)");
4617 17123 100         ST(0) = SvROK(ST(0)) ? &PL_sv_yes : &PL_sv_no;
4618 17123           XSRETURN(1);
4619             }
4620              
4621 17132           XS_INTERNAL(xs_is_array) {
4622 17132           dXSARGS;
4623 17132 50         if (items != 1) croak("Usage: Func::Util::is_array($value)");
4624 17132           SV *sv = ST(0);
4625 17132 100         ST(0) = (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) ? &PL_sv_yes : &PL_sv_no;
    100          
4626 17132           XSRETURN(1);
4627             }
4628              
4629 17131           XS_INTERNAL(xs_is_hash) {
4630 17131           dXSARGS;
4631 17131 50         if (items != 1) croak("Usage: Func::Util::is_hash($value)");
4632 17131           SV *sv = ST(0);
4633 17131 100         ST(0) = (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) ? &PL_sv_yes : &PL_sv_no;
    100          
4634 17131           XSRETURN(1);
4635             }
4636              
4637 17117           XS_INTERNAL(xs_is_code) {
4638 17117           dXSARGS;
4639 17117 50         if (items != 1) croak("Usage: Func::Util::is_code($value)");
4640 17117           SV *sv = ST(0);
4641 17117 100         ST(0) = (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) ? &PL_sv_yes : &PL_sv_no;
    100          
4642 17117           XSRETURN(1);
4643             }
4644              
4645 17118           XS_INTERNAL(xs_is_defined) {
4646 17118           dXSARGS;
4647 17118 50         if (items != 1) croak("Usage: Func::Util::is_defined($value)");
4648 17118 100         ST(0) = SvOK(ST(0)) ? &PL_sv_yes : &PL_sv_no;
4649 17118           XSRETURN(1);
4650             }
4651              
4652             /* ============================================
4653             String predicate XS fallbacks
4654             ============================================ */
4655              
4656 12016           XS_INTERNAL(xs_is_empty) {
4657 12016           dXSARGS;
4658 12016 50         if (items != 1) croak("Usage: Func::Util::is_empty($value)");
4659 12016           SV *sv = ST(0);
4660 12016 100         if (!SvOK(sv)) {
4661 2002           ST(0) = &PL_sv_yes;
4662             } else {
4663             STRLEN len;
4664 10014           SvPV(sv, len);
4665 10014 100         ST(0) = len == 0 ? &PL_sv_yes : &PL_sv_no;
4666             }
4667 12016           XSRETURN(1);
4668             }
4669              
4670 19124           XS_INTERNAL(xs_starts_with) {
4671 19124           dXSARGS;
4672 19124 50         if (items != 2) croak("Usage: Func::Util::starts_with($string, $prefix)");
4673              
4674 19124           SV *str_sv = ST(0);
4675 19124           SV *prefix_sv = ST(1);
4676              
4677 19124 100         if (!SvOK(str_sv) || !SvOK(prefix_sv)) {
    100          
4678 1003           ST(0) = &PL_sv_no;
4679 1003           XSRETURN(1);
4680             }
4681              
4682             STRLEN str_len, prefix_len;
4683 18121           const char *str = SvPV(str_sv, str_len);
4684 18121           const char *prefix = SvPV(prefix_sv, prefix_len);
4685              
4686 18121 100         if (prefix_len > str_len) {
4687 3002           ST(0) = &PL_sv_no;
4688 15119 100         } else if (prefix_len == 0) {
4689 1002           ST(0) = &PL_sv_yes;
4690             } else {
4691 14117 100         ST(0) = memcmp(str, prefix, prefix_len) == 0 ? &PL_sv_yes : &PL_sv_no;
4692             }
4693 18121           XSRETURN(1);
4694             }
4695              
4696 19122           XS_INTERNAL(xs_ends_with) {
4697 19122           dXSARGS;
4698 19122 50         if (items != 2) croak("Usage: Func::Util::ends_with($string, $suffix)");
4699              
4700 19122           SV *str_sv = ST(0);
4701 19122           SV *suffix_sv = ST(1);
4702              
4703 19122 100         if (!SvOK(str_sv) || !SvOK(suffix_sv)) {
    100          
4704 1003           ST(0) = &PL_sv_no;
4705 1003           XSRETURN(1);
4706             }
4707              
4708             STRLEN str_len, suffix_len;
4709 18119           const char *str = SvPV(str_sv, str_len);
4710 18119           const char *suffix = SvPV(suffix_sv, suffix_len);
4711              
4712 18119 100         if (suffix_len > str_len) {
4713 3002           ST(0) = &PL_sv_no;
4714 15117 100         } else if (suffix_len == 0) {
4715 1002           ST(0) = &PL_sv_yes;
4716             } else {
4717 14115           const char *str_end = str + str_len - suffix_len;
4718 14115 100         ST(0) = memcmp(str_end, suffix, suffix_len) == 0 ? &PL_sv_yes : &PL_sv_no;
4719             }
4720 18119           XSRETURN(1);
4721             }
4722              
4723             /* count: count occurrences of substring using memmem */
4724 2000           XS_INTERNAL(xs_count) {
4725 2000           dXSARGS;
4726 2000 50         if (items != 2) croak("Usage: Func::Util::count($string, $substring)");
4727              
4728 2000           SV *str_sv = ST(0);
4729 2000           SV *needle_sv = ST(1);
4730              
4731 2000 50         if (!SvOK(str_sv) || !SvOK(needle_sv)) {
    50          
4732 0           ST(0) = sv_2mortal(newSViv(0));
4733 0           XSRETURN(1);
4734             }
4735              
4736             STRLEN str_len, needle_len;
4737 2000           const char *str = SvPV_const(str_sv, str_len);
4738 2000           const char *needle = SvPV_const(needle_sv, needle_len);
4739              
4740 2000 50         if (needle_len == 0 || needle_len > str_len) {
    50          
4741 2000           ST(0) = sv_2mortal(newSViv(0));
4742 2000           XSRETURN(1);
4743             }
4744              
4745 0           IV count = 0;
4746 0           const char *p = str;
4747 0           const char *end = str + str_len;
4748 0           STRLEN remaining = str_len;
4749              
4750 0 0         while (remaining >= needle_len) {
4751 0           const char *found = (const char *)util_memmem(p, remaining, needle, needle_len);
4752 0 0         if (!found) break;
4753 0           count++;
4754             /* Move past the match (non-overlapping) */
4755 0           p = found + needle_len;
4756 0           remaining = end - p;
4757             }
4758              
4759 0           ST(0) = sv_2mortal(newSViv(count));
4760 0           XSRETURN(1);
4761             }
4762              
4763             /* replace_all: replace all occurrences of old with new using memmem */
4764 5026           XS_INTERNAL(xs_replace_all) {
4765 5026           dXSARGS;
4766 5026 50         if (items != 3) croak("Usage: Func::Util::replace_all($string, $old, $new)");
4767              
4768 5026           SV *str_sv = ST(0);
4769 5026           SV *old_sv = ST(1);
4770 5026           SV *new_sv = ST(2);
4771              
4772             /* Handle undef - return undef */
4773 5026 50         if (!SvOK(str_sv)) {
4774 0           ST(0) = &PL_sv_undef;
4775 0           XSRETURN(1);
4776             }
4777              
4778             STRLEN str_len, old_len, new_len;
4779 5026           const char *str = SvPV_const(str_sv, str_len);
4780 5026           const char *old = SvPV_const(old_sv, old_len);
4781 5026           const char *replacement = SvPV_const(new_sv, new_len);
4782              
4783             /* Empty search string or not found - return original */
4784 5026 100         if (old_len == 0 || old_len > str_len) {
    100          
4785 1002           ST(0) = sv_2mortal(newSVpvn(str, str_len));
4786 1002           XSRETURN(1);
4787             }
4788              
4789             /* First pass: count occurrences to pre-size buffer */
4790 4024           IV count = 0;
4791 4024           const char *p = str;
4792 4024           const char *end = str + str_len;
4793 4024           STRLEN remaining = str_len;
4794              
4795 11061 100         while (remaining >= old_len) {
4796 9052           const char *found = (const char *)util_memmem(p, remaining, old, old_len);
4797 9052 100         if (!found) break;
4798 7037           count++;
4799 7037           p = found + old_len;
4800 7037           remaining = end - p;
4801             }
4802              
4803 4024 100         if (count == 0) {
4804             /* No matches - return copy of original */
4805 1002           ST(0) = sv_2mortal(newSVpvn(str, str_len));
4806 1002           XSRETURN(1);
4807             }
4808              
4809             /* Calculate result size and allocate */
4810 3022           STRLEN result_len = str_len + count * (new_len - old_len);
4811 3022           SV *result = sv_2mortal(newSV(result_len + 1));
4812 3022           SvPOK_on(result);
4813 3022           char *out = SvPVX(result);
4814 3022           char *out_ptr = out;
4815              
4816             /* Second pass: build result */
4817 3022           p = str;
4818 3022           remaining = str_len;
4819              
4820 10059 100         while (remaining >= old_len) {
4821 8050           const char *found = (const char *)util_memmem(p, remaining, old, old_len);
4822 8050 100         if (!found) break;
4823              
4824             /* Copy text before match */
4825 7037           STRLEN before_len = found - p;
4826 7037 100         if (before_len > 0) {
4827 2025           memcpy(out_ptr, p, before_len);
4828 2025           out_ptr += before_len;
4829             }
4830              
4831             /* Copy replacement */
4832 7037 100         if (new_len > 0) {
4833 5035           memcpy(out_ptr, replacement, new_len);
4834 5035           out_ptr += new_len;
4835             }
4836              
4837 7037           p = found + old_len;
4838 7037           remaining = end - p;
4839             }
4840              
4841             /* Copy remaining text after last match */
4842 3022 100         if (remaining > 0) {
4843 1016           memcpy(out_ptr, p, remaining);
4844 1016           out_ptr += remaining;
4845             }
4846              
4847 3022           *out_ptr = '\0';
4848 3022           SvCUR_set(result, out_ptr - out);
4849              
4850 3022           ST(0) = result;
4851 3022           XSRETURN(1);
4852             }
4853              
4854             /* before: get text before first occurrence of delimiter */
4855 0           XS_INTERNAL(xs_before) {
4856 0           dXSARGS;
4857 0 0         if (items != 2) croak("Usage: Func::Util::before($string, $delimiter)");
4858              
4859 0           SV *str_sv = ST(0);
4860 0           SV *delim_sv = ST(1);
4861              
4862 0 0         if (!SvOK(str_sv)) {
4863 0           ST(0) = &PL_sv_undef;
4864 0           XSRETURN(1);
4865             }
4866              
4867             STRLEN str_len, delim_len;
4868 0           const char *str = SvPV_const(str_sv, str_len);
4869 0           const char *delim = SvPV_const(delim_sv, delim_len);
4870              
4871 0 0         if (delim_len == 0 || delim_len > str_len) {
    0          
4872 0           ST(0) = sv_2mortal(newSVpvn(str, str_len));
4873 0           XSRETURN(1);
4874             }
4875              
4876 0           const char *found = (const char *)util_memmem(str, str_len, delim, delim_len);
4877 0 0         if (found) {
4878 0           ST(0) = sv_2mortal(newSVpvn(str, found - str));
4879             } else {
4880 0           ST(0) = sv_2mortal(newSVpvn(str, str_len));
4881             }
4882 0           XSRETURN(1);
4883             }
4884              
4885             /* after: get text after first occurrence of delimiter */
4886 0           XS_INTERNAL(xs_after) {
4887 0           dXSARGS;
4888 0 0         if (items != 2) croak("Usage: Func::Util::after($string, $delimiter)");
4889              
4890 0           SV *str_sv = ST(0);
4891 0           SV *delim_sv = ST(1);
4892              
4893 0 0         if (!SvOK(str_sv)) {
4894 0           ST(0) = &PL_sv_undef;
4895 0           XSRETURN(1);
4896             }
4897              
4898             STRLEN str_len, delim_len;
4899 0           const char *str = SvPV_const(str_sv, str_len);
4900 0           const char *delim = SvPV_const(delim_sv, delim_len);
4901              
4902 0 0         if (delim_len == 0 || delim_len > str_len) {
    0          
4903 0           ST(0) = sv_2mortal(newSVpvn("", 0));
4904 0           XSRETURN(1);
4905             }
4906              
4907 0           const char *found = (const char *)util_memmem(str, str_len, delim, delim_len);
4908 0 0         if (found) {
4909 0           const char *after_delim = found + delim_len;
4910 0           ST(0) = sv_2mortal(newSVpvn(after_delim, str + str_len - after_delim));
4911             } else {
4912 0           ST(0) = sv_2mortal(newSVpvn("", 0));
4913             }
4914 0           XSRETURN(1);
4915             }
4916              
4917             /* ============================================
4918             Boolean/Truthiness XS fallbacks
4919             ============================================ */
4920              
4921 24129           XS_INTERNAL(xs_is_true) {
4922 24129           dXSARGS;
4923 24129 50         if (items != 1) croak("Usage: Func::Util::is_true($value)");
4924 24129 100         ST(0) = SvTRUE(ST(0)) ? &PL_sv_yes : &PL_sv_no;
4925 24129           XSRETURN(1);
4926             }
4927              
4928 22118           XS_INTERNAL(xs_is_false) {
4929 22118           dXSARGS;
4930 22118 50         if (items != 1) croak("Usage: Func::Util::is_false($value)");
4931 22118 100         ST(0) = SvTRUE(ST(0)) ? &PL_sv_no : &PL_sv_yes;
4932 22118           XSRETURN(1);
4933             }
4934              
4935 30119           XS_INTERNAL(xs_bool) {
4936 30119           dXSARGS;
4937 30119 50         if (items != 1) croak("Usage: Func::Util::bool($value)");
4938 30119 100         ST(0) = SvTRUE(ST(0)) ? &PL_sv_yes : &PL_sv_no;
4939 30119           XSRETURN(1);
4940             }
4941              
4942             /* ============================================
4943             Extended type predicate XS fallbacks
4944             ============================================ */
4945              
4946 19155           XS_INTERNAL(xs_is_num) {
4947 19155           dXSARGS;
4948 19155 50         if (items != 1) croak("Usage: Func::Util::is_num($value)");
4949 19155           SV *sv = ST(0);
4950 19155 100         ST(0) = (SvNIOK(sv) || looks_like_number(sv)) ? &PL_sv_yes : &PL_sv_no;
    100          
4951 19155           XSRETURN(1);
4952             }
4953              
4954 17120           XS_INTERNAL(xs_is_int) {
4955 17120           dXSARGS;
4956 17120 50         if (items != 1) croak("Usage: Func::Util::is_int($value)");
4957 17120           SV *sv = ST(0);
4958 17120 100         if (SvIOK(sv)) {
4959 14106           ST(0) = &PL_sv_yes;
4960 3014 100         } else if (SvNOK(sv)) {
4961 3009           NV nv = SvNV(sv);
4962 3009 100         ST(0) = (nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no;
4963 5 100         } else if (looks_like_number(sv)) {
4964             STRLEN len;
4965 2           const char *pv = SvPV(sv, len);
4966 2           bool has_dot = FALSE;
4967             STRLEN i;
4968 6 100         for (i = 0; i < len; i++) {
4969 4 50         if (pv[i] == '.' || pv[i] == 'e' || pv[i] == 'E') {
    50          
    50          
4970 0           has_dot = TRUE;
4971 0           break;
4972             }
4973             }
4974 2 50         if (has_dot) {
4975 0           NV nv = SvNV(sv);
4976 0 0         ST(0) = (nv == (NV)(IV)nv) ? &PL_sv_yes : &PL_sv_no;
4977             } else {
4978 2           ST(0) = &PL_sv_yes;
4979             }
4980             } else {
4981 3           ST(0) = &PL_sv_no;
4982             }
4983 17120           XSRETURN(1);
4984             }
4985              
4986 6011           XS_INTERNAL(xs_is_blessed) {
4987 6011           dXSARGS;
4988 6011 50         if (items != 1) croak("Usage: Func::Util::is_blessed($value)");
4989 6011 100         ST(0) = sv_isobject(ST(0)) ? &PL_sv_yes : &PL_sv_no;
4990 6011           XSRETURN(1);
4991             }
4992              
4993 4009           XS_INTERNAL(xs_is_scalar_ref) {
4994 4009           dXSARGS;
4995 4009 50         if (items != 1) croak("Usage: Func::Util::is_scalar_ref($value)");
4996 4009           SV *sv = ST(0);
4997 4009 100         if (SvROK(sv)) {
4998 4006           SV *rv = SvRV(sv);
4999 4006           svtype type = SvTYPE(rv);
5000 4006 100         ST(0) = (type < SVt_PVAV) ? &PL_sv_yes : &PL_sv_no;
5001             } else {
5002 3           ST(0) = &PL_sv_no;
5003             }
5004 4009           XSRETURN(1);
5005             }
5006              
5007 6009           XS_INTERNAL(xs_is_regex) {
5008 6009           dXSARGS;
5009 6009 50         if (items != 1) croak("Usage: Func::Util::is_regex($value)");
5010 6009 100         ST(0) = SvRXOK(ST(0)) ? &PL_sv_yes : &PL_sv_no;
5011 6009           XSRETURN(1);
5012             }
5013              
5014 6008           XS_INTERNAL(xs_is_glob) {
5015 6008           dXSARGS;
5016 6008 50         if (items != 1) croak("Usage: Func::Util::is_glob($value)");
5017 6008 100         ST(0) = (SvTYPE(ST(0)) == SVt_PVGV) ? &PL_sv_yes : &PL_sv_no;
5018 6008           XSRETURN(1);
5019             }
5020              
5021 8017           XS_INTERNAL(xs_is_string) {
5022 8017           dXSARGS;
5023 8017 50         if (items != 1) croak("Usage: Func::Util::is_string($value)");
5024 8017           SV *sv = ST(0);
5025 8017 100         ST(0) = (SvOK(sv) && !SvROK(sv)) ? &PL_sv_yes : &PL_sv_no;
    100          
5026 8017           XSRETURN(1);
5027             }
5028              
5029             /* ============================================
5030             Numeric predicate XS fallbacks
5031             ============================================ */
5032              
5033 15123           XS_INTERNAL(xs_is_positive) {
5034 15123           dXSARGS;
5035 15123 50         if (items != 1) croak("Usage: Func::Util::is_positive($value)");
5036 15123           SV *sv = ST(0);
5037 15123 100         if (SvNIOK(sv) || looks_like_number(sv)) {
    50          
5038 15121           NV nv = SvNV(sv);
5039 15121 100         ST(0) = (nv > 0) ? &PL_sv_yes : &PL_sv_no;
5040             } else {
5041 2           ST(0) = &PL_sv_no;
5042             }
5043 15123           XSRETURN(1);
5044             }
5045              
5046 13122           XS_INTERNAL(xs_is_negative) {
5047 13122           dXSARGS;
5048 13122 50         if (items != 1) croak("Usage: Func::Util::is_negative($value)");
5049 13122           SV *sv = ST(0);
5050 13122 100         if (SvNIOK(sv) || looks_like_number(sv)) {
    50          
5051 13120           NV nv = SvNV(sv);
5052 13120 100         ST(0) = (nv < 0) ? &PL_sv_yes : &PL_sv_no;
5053             } else {
5054 2           ST(0) = &PL_sv_no;
5055             }
5056 13122           XSRETURN(1);
5057             }
5058              
5059 13123           XS_INTERNAL(xs_is_zero) {
5060 13123           dXSARGS;
5061 13123 50         if (items != 1) croak("Usage: Func::Util::is_zero($value)");
5062 13123           SV *sv = ST(0);
5063 13123 100         if (SvNIOK(sv) || looks_like_number(sv)) {
    100          
5064 13121           NV nv = SvNV(sv);
5065 13121 100         ST(0) = (nv == 0) ? &PL_sv_yes : &PL_sv_no;
5066             } else {
5067 2           ST(0) = &PL_sv_no;
5068             }
5069 13123           XSRETURN(1);
5070             }
5071              
5072             /* ============================================
5073             Numeric utility XS fallbacks
5074             ============================================ */
5075              
5076 18156           XS_INTERNAL(xs_is_even) {
5077 18156           dXSARGS;
5078 18156 50         if (items != 1) croak("Usage: Func::Util::is_even($value)");
5079 18156           SV *sv = ST(0);
5080 18156 100         if (SvIOK(sv)) {
5081 18144 100         ST(0) = (SvIVX(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
5082 12 100         } else if (SvNIOK(sv)) {
5083 5           NV nv = SvNV(sv);
5084 5 100         if (nv == (NV)(IV)nv) {
5085 3 100         ST(0) = ((IV)nv & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
5086             } else {
5087 2           ST(0) = &PL_sv_no;
5088             }
5089 7 100         } else if (looks_like_number(sv)) {
5090 2 50         ST(0) = (SvIV(sv) & 1) == 0 ? &PL_sv_yes : &PL_sv_no;
5091             } else {
5092 5           ST(0) = &PL_sv_no;
5093             }
5094 18156           XSRETURN(1);
5095             }
5096              
5097 18155           XS_INTERNAL(xs_is_odd) {
5098 18155           dXSARGS;
5099 18155 50         if (items != 1) croak("Usage: Func::Util::is_odd($value)");
5100 18155           SV *sv = ST(0);
5101 18155 100         if (SvIOK(sv)) {
5102 18144 100         ST(0) = (SvIVX(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
5103 11 100         } else if (SvNIOK(sv)) {
5104 5           NV nv = SvNV(sv);
5105 5 100         if (nv == (NV)(IV)nv) {
5106 3 100         ST(0) = ((IV)nv & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
5107             } else {
5108 2           ST(0) = &PL_sv_no;
5109             }
5110 6 100         } else if (looks_like_number(sv)) {
5111 2 50         ST(0) = (SvIV(sv) & 1) == 1 ? &PL_sv_yes : &PL_sv_no;
5112             } else {
5113 4           ST(0) = &PL_sv_no;
5114             }
5115 18155           XSRETURN(1);
5116             }
5117              
5118 15070           XS_INTERNAL(xs_is_between) {
5119 15070           dXSARGS;
5120 15070 50         if (items != 3) croak("Usage: Func::Util::is_between($value, $min, $max)");
5121 15070           SV *val_sv = ST(0);
5122 15070           SV *min_sv = ST(1);
5123 15070           SV *max_sv = ST(2);
5124              
5125 15070 100         if (SvNIOK(val_sv) || looks_like_number(val_sv)) {
    100          
5126 15066           NV val = SvNV(val_sv);
5127 15066           NV min = SvNV(min_sv);
5128 15066           NV max = SvNV(max_sv);
5129 15066 100         ST(0) = (val >= min && val <= max) ? &PL_sv_yes : &PL_sv_no;
    100          
5130             } else {
5131 4           ST(0) = &PL_sv_no;
5132             }
5133 15070           XSRETURN(1);
5134             }
5135              
5136             /* ============================================
5137             Collection XS fallbacks
5138             ============================================ */
5139              
5140 4008           XS_INTERNAL(xs_is_empty_array) {
5141 4008           dXSARGS;
5142 4008 50         if (items != 1) croak("Usage: Func::Util::is_empty_array($arrayref)");
5143 4008           SV *sv = ST(0);
5144 4008 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    100          
5145 4004           AV *av = (AV*)SvRV(sv);
5146 4004 50         ST(0) = AvFILL(av) < 0 ? &PL_sv_yes : &PL_sv_no;
    100          
5147             } else {
5148 4           ST(0) = &PL_sv_no;
5149             }
5150 4008           XSRETURN(1);
5151             }
5152              
5153 5008           XS_INTERNAL(xs_is_empty_hash) {
5154 5008           dXSARGS;
5155 5008 50         if (items != 1) croak("Usage: Func::Util::is_empty_hash($hashref)");
5156 5008           SV *sv = ST(0);
5157 5008 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
    100          
5158 5004           HV *hv = (HV*)SvRV(sv);
5159 5004 50         ST(0) = HvKEYS(hv) == 0 ? &PL_sv_yes : &PL_sv_no;
    100          
5160             } else {
5161 4           ST(0) = &PL_sv_no;
5162             }
5163 5008           XSRETURN(1);
5164             }
5165              
5166 14126           XS_INTERNAL(xs_array_len) {
5167 14126           dXSARGS;
5168 14126 50         if (items != 1) croak("Usage: Func::Util::array_len($arrayref)");
5169 14126           SV *sv = ST(0);
5170 14126 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    100          
5171 13123           AV *av = (AV*)SvRV(sv);
5172 13123 50         ST(0) = sv_2mortal(newSViv(AvFILL(av) + 1));
5173             } else {
5174 1003           ST(0) = &PL_sv_undef;
5175             }
5176 14126           XSRETURN(1);
5177             }
5178              
5179 4018           XS_INTERNAL(xs_hash_size) {
5180 4018           dXSARGS;
5181 4018 50         if (items != 1) croak("Usage: Func::Util::hash_size($hashref)");
5182 4018           SV *sv = ST(0);
5183 4018 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
    100          
5184 3015           HV *hv = (HV*)SvRV(sv);
5185 3015 50         ST(0) = sv_2mortal(newSViv(HvKEYS(hv)));
5186             } else {
5187 1003           ST(0) = &PL_sv_undef;
5188             }
5189 4018           XSRETURN(1);
5190             }
5191              
5192 13114           XS_INTERNAL(xs_array_first) {
5193 13114           dXSARGS;
5194 13114 50         if (items != 1) croak("Usage: Func::Util::array_first($arrayref)");
5195 13114           SV *sv = ST(0);
5196 26225 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    100          
5197 13111           AV *av = (AV*)SvRV(sv);
5198 13111 50         if (AvFILL(av) >= 0) {
    100          
5199 12110           SV **elem = av_fetch(av, 0, 0);
5200 12110 50         ST(0) = elem ? *elem : &PL_sv_undef;
5201             } else {
5202 1001           ST(0) = &PL_sv_undef;
5203             }
5204             } else {
5205 3           ST(0) = &PL_sv_undef;
5206             }
5207 13114           XSRETURN(1);
5208             }
5209              
5210 13113           XS_INTERNAL(xs_array_last) {
5211 13113           dXSARGS;
5212 13113 50         if (items != 1) croak("Usage: Func::Util::array_last($arrayref)");
5213 13113           SV *sv = ST(0);
5214 26223 100         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
    100          
5215 13110           AV *av = (AV*)SvRV(sv);
5216 13110 50         IV last_idx = AvFILL(av);
5217 13110 100         if (last_idx >= 0) {
5218 12109           SV **elem = av_fetch(av, last_idx, 0);
5219 12109 50         ST(0) = elem ? *elem : &PL_sv_undef;
5220             } else {
5221 1001           ST(0) = &PL_sv_undef;
5222             }
5223             } else {
5224 3           ST(0) = &PL_sv_undef;
5225             }
5226 13113           XSRETURN(1);
5227             }
5228              
5229             /* ============================================
5230             String manipulation XS fallbacks
5231             ============================================ */
5232              
5233 20141           XS_INTERNAL(xs_trim) {
5234 20141           dXSARGS;
5235 20141 50         if (items != 1) croak("Usage: Func::Util::trim($string)");
5236              
5237 20141           SV *sv = ST(0);
5238 20141 100         if (!SvOK(sv)) {
5239 1001           ST(0) = &PL_sv_undef;
5240 1001           XSRETURN(1);
5241             }
5242              
5243             STRLEN len;
5244 19140           const char *str = SvPV(sv, len);
5245 19140           const char *start = str;
5246 19140           const char *end = str + len;
5247              
5248             /* Skip leading whitespace */
5249 50410 100         while (start < end && isSPACE(*start)) {
    100          
5250 31270           start++;
5251             }
5252              
5253             /* Skip trailing whitespace */
5254 47401 100         while (end > start && isSPACE(*(end - 1))) {
    100          
5255 28261           end--;
5256             }
5257              
5258 19140           ST(0) = sv_2mortal(newSVpvn(start, end - start));
5259 19140           XSRETURN(1);
5260             }
5261              
5262 4013           XS_INTERNAL(xs_ltrim) {
5263 4013           dXSARGS;
5264 4013 50         if (items != 1) croak("Usage: Func::Util::ltrim($string)");
5265              
5266 4013           SV *sv = ST(0);
5267 4013 100         if (!SvOK(sv)) {
5268 1           ST(0) = &PL_sv_undef;
5269 1           XSRETURN(1);
5270             }
5271              
5272             STRLEN len;
5273 4012           const char *str = SvPV(sv, len);
5274 4012           const char *start = str;
5275 4012           const char *end = str + len;
5276              
5277 8031 100         while (start < end && isSPACE(*start)) {
    100          
5278 4019           start++;
5279             }
5280              
5281 4012           ST(0) = sv_2mortal(newSVpvn(start, end - start));
5282 4012           XSRETURN(1);
5283             }
5284              
5285 4013           XS_INTERNAL(xs_rtrim) {
5286 4013           dXSARGS;
5287 4013 50         if (items != 1) croak("Usage: Func::Util::rtrim($string)");
5288              
5289 4013           SV *sv = ST(0);
5290 4013 100         if (!SvOK(sv)) {
5291 1           ST(0) = &PL_sv_undef;
5292 1           XSRETURN(1);
5293             }
5294              
5295             STRLEN len;
5296 4012           const char *str = SvPV(sv, len);
5297 4012           const char *end = str + len;
5298              
5299 8026 100         while (end > str && isSPACE(*(end - 1))) {
    100          
5300 4014           end--;
5301             }
5302              
5303 4012           ST(0) = sv_2mortal(newSVpvn(str, end - str));
5304 4012           XSRETURN(1);
5305             }
5306              
5307             /* ============================================
5308             Conditional XS fallbacks
5309             ============================================ */
5310              
5311 10028           XS_INTERNAL(xs_maybe) {
5312 10028           dXSARGS;
5313 10028 50         if (items != 2) croak("Usage: Func::Util::maybe($value, $then)");
5314              
5315 10028           SV *val = ST(0);
5316 10028 100         if (SvOK(val)) {
5317 8023           ST(0) = ST(1);
5318             } else {
5319 2005           ST(0) = &PL_sv_undef;
5320             }
5321 10028           XSRETURN(1);
5322             }
5323              
5324             /* ============================================
5325             Numeric XS fallbacks
5326             ============================================ */
5327              
5328 21131           XS_INTERNAL(xs_sign) {
5329 21131           dXSARGS;
5330 21131 50         if (items != 1) croak("Usage: Func::Util::sign($number)");
5331              
5332 21131           SV *sv = ST(0);
5333 21131 100         if (!SvNIOK(sv) && !looks_like_number(sv)) {
    100          
5334 2           ST(0) = &PL_sv_undef;
5335 2           XSRETURN(1);
5336             }
5337              
5338 21129           NV nv = SvNV(sv);
5339 21129 100         if (nv > 0) {
5340 4011           ST(0) = sv_2mortal(newSViv(1));
5341 17118 100         } else if (nv < 0) {
5342 14113           ST(0) = sv_2mortal(newSViv(-1));
5343             } else {
5344 3005           ST(0) = sv_2mortal(newSViv(0));
5345             }
5346 21129           XSRETURN(1);
5347             }
5348              
5349 15116           XS_INTERNAL(xs_min2) {
5350 15116           dXSARGS;
5351 15116 50         if (items != 2) croak("Usage: Func::Util::min2($a, $b)");
5352              
5353 15116           NV a = SvNV(ST(0));
5354 15116           NV b = SvNV(ST(1));
5355              
5356 15116 100         ST(0) = a <= b ? ST(0) : ST(1);
5357 15116           XSRETURN(1);
5358             }
5359              
5360 15116           XS_INTERNAL(xs_max2) {
5361 15116           dXSARGS;
5362 15116 50         if (items != 2) croak("Usage: Func::Util::max2($a, $b)");
5363              
5364 15116           NV a = SvNV(ST(0));
5365 15116           NV b = SvNV(ST(1));
5366              
5367 15116 100         ST(0) = a >= b ? ST(0) : ST(1);
5368 15116           XSRETURN(1);
5369             }
5370              
5371             /* ============================================
5372             Named callback loop functions
5373             These accept a callback name instead of coderef
5374             ============================================ */
5375              
5376             /* any_cb(\@list, ':predicate') - true if any element matches */
5377 11130           XS_INTERNAL(xs_any_cb) {
5378 11130           dXSARGS;
5379 11130 50         if (items != 2) croak("Usage: Func::Util::any_cb(\\@list, $callback_name)");
5380              
5381 11130           SV *list_sv = ST(0);
5382 11130 100         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    100          
5383 3           croak("Func::Util::any_cb: first argument must be an arrayref");
5384             }
5385 11127           AV *list = (AV*)SvRV(list_sv);
5386              
5387             STRLEN name_len;
5388 11127           const char *name = SvPV(ST(1), name_len);
5389              
5390 11127           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5391 11127 100         if (!cb) {
5392 2           croak("Func::Util::any_cb: unknown callback '%s'", name);
5393             }
5394 11125 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5395 0           croak("Func::Util::any_cb: callback '%s' is not a predicate", name);
5396             }
5397              
5398 11125           IV len = av_len(list) + 1;
5399             IV i;
5400              
5401 11125 100         if (cb->predicate) {
5402             /* Fast C path */
5403 35174 100         for (i = 0; i < len; i++) {
5404 35172           SV **svp = av_fetch(list, i, 0);
5405 35172 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5406 10123           XSRETURN_YES;
5407             }
5408             }
5409 1000 50         } else if (cb->perl_callback) {
5410             /* Perl callback fallback - use isolated stack scope */
5411 7000 50         for (i = 0; i < len; i++) {
5412 7000           SV **svp = av_fetch(list, i, 0);
5413 7000 50         if (!svp) continue;
5414              
5415 7000           bool matches = FALSE;
5416             {
5417 7000           dSP;
5418             int count;
5419             SV *result;
5420              
5421 7000           ENTER;
5422 7000           SAVETMPS;
5423              
5424 7000 50         PUSHMARK(SP);
5425 7000 50         XPUSHs(*svp);
5426 7000           PUTBACK;
5427              
5428 7000           count = call_sv(cb->perl_callback, G_SCALAR);
5429              
5430 7000           SPAGAIN;
5431 7000 50         if (count > 0) {
5432 7000           result = POPs;
5433 7000           matches = SvTRUE(result);
5434             }
5435 7000           PUTBACK;
5436              
5437 7000 50         FREETMPS;
5438 7000           LEAVE;
5439             }
5440              
5441 7000 100         if (matches) {
5442 1000           XSRETURN_YES;
5443             }
5444             }
5445             }
5446              
5447 2           XSRETURN_NO;
5448             }
5449              
5450             /* all_cb(\@list, ':predicate') - true if all elements match */
5451 3128           XS_INTERNAL(xs_all_cb) {
5452 3128           dXSARGS;
5453 3128 50         if (items != 2) croak("Usage: Func::Util::all_cb(\\@list, $callback_name)");
5454              
5455 3128           SV *list_sv = ST(0);
5456 3128 50         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5457 0           croak("Func::Util::all_cb: first argument must be an arrayref");
5458             }
5459 3128           AV *list = (AV*)SvRV(list_sv);
5460              
5461             STRLEN name_len;
5462 3128           const char *name = SvPV(ST(1), name_len);
5463              
5464 3128           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5465 3128 100         if (!cb) {
5466 1           croak("Func::Util::all_cb: unknown callback '%s'", name);
5467             }
5468 3127 50         if (!cb->predicate && !cb->perl_callback) {
    0          
5469 0           croak("Func::Util::all_cb: callback '%s' is not a predicate", name);
5470             }
5471              
5472 3127           IV len = av_len(list) + 1;
5473             IV i;
5474              
5475             /* Empty list returns true (vacuous truth) */
5476 3127 100         if (len == 0) {
5477 5           XSRETURN_YES;
5478             }
5479              
5480 3122 50         if (cb->predicate) {
5481 1021228 100         for (i = 0; i < len; i++) {
5482 1019114           SV **svp = av_fetch(list, i, 0);
5483 1019114 50         if (!svp || !cb->predicate(aTHX_ *svp)) {
    100          
5484 1008           XSRETURN_NO;
5485             }
5486             }
5487 0 0         } else if (cb->perl_callback) {
5488 0 0         for (i = 0; i < len; i++) {
5489 0           SV **svp = av_fetch(list, i, 0);
5490 0 0         if (!svp) { XSRETURN_NO; }
5491 0           bool matches = FALSE;
5492             {
5493 0           dSP;
5494             int count;
5495             SV *result;
5496 0           ENTER; SAVETMPS;
5497 0 0         PUSHMARK(SP);
5498 0 0         XPUSHs(*svp);
5499 0           PUTBACK;
5500 0           count = call_sv(cb->perl_callback, G_SCALAR);
5501 0           SPAGAIN;
5502 0 0         if (count > 0) {
5503 0           result = POPs;
5504 0           matches = SvTRUE(result);
5505             }
5506 0           PUTBACK;
5507 0 0         FREETMPS; LEAVE;
5508             }
5509 0 0         if (!matches) {
5510 0           XSRETURN_NO;
5511             }
5512             }
5513             }
5514              
5515 2114           XSRETURN_YES;
5516             }
5517              
5518             /* none_cb(\@list, ':predicate') - true if no elements match */
5519 2012           XS_INTERNAL(xs_none_cb) {
5520 2012           dXSARGS;
5521 2012 50         if (items != 2) croak("Usage: Func::Util::none_cb(\\@list, $callback_name)");
5522              
5523 2012           SV *list_sv = ST(0);
5524 2012 50         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5525 0           croak("Func::Util::none_cb: first argument must be an arrayref");
5526             }
5527 2012           AV *list = (AV*)SvRV(list_sv);
5528              
5529             STRLEN name_len;
5530 2012           const char *name = SvPV(ST(1), name_len);
5531              
5532 2012           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5533 2012 100         if (!cb) {
5534 1           croak("Func::Util::none_cb: unknown callback '%s'", name);
5535             }
5536 2011 50         if (!cb->predicate && !cb->perl_callback) {
    0          
5537 0           croak("Func::Util::none_cb: callback '%s' is not a predicate", name);
5538             }
5539              
5540 2011           IV len = av_len(list) + 1;
5541             IV i;
5542              
5543 2011 50         if (cb->predicate) {
5544 14027 100         for (i = 0; i < len; i++) {
5545 13021           SV **svp = av_fetch(list, i, 0);
5546 13021 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5547 1005           XSRETURN_NO;
5548             }
5549             }
5550 0 0         } else if (cb->perl_callback) {
5551 0 0         for (i = 0; i < len; i++) {
5552 0           SV **svp = av_fetch(list, i, 0);
5553 0 0         if (!svp) continue;
5554 0           bool matches = FALSE;
5555             {
5556 0           dSP;
5557             int count;
5558             SV *result;
5559 0           ENTER; SAVETMPS;
5560 0 0         PUSHMARK(SP);
5561 0 0         XPUSHs(*svp);
5562 0           PUTBACK;
5563 0           count = call_sv(cb->perl_callback, G_SCALAR);
5564 0           SPAGAIN;
5565 0 0         if (count > 0) {
5566 0           result = POPs;
5567 0           matches = SvTRUE(result);
5568             }
5569 0           PUTBACK;
5570 0 0         FREETMPS; LEAVE;
5571             }
5572 0 0         if (matches) {
5573 0           XSRETURN_NO;
5574             }
5575             }
5576             }
5577              
5578 1006           XSRETURN_YES;
5579             }
5580              
5581             /* first_cb(\@list, ':predicate') - first matching element */
5582 5043           XS_INTERNAL(xs_first_cb) {
5583 5043           dXSARGS;
5584 5043 50         if (items != 2) croak("Usage: Func::Util::first_cb(\\@list, $callback_name)");
5585              
5586 5043           SV *list_sv = ST(0);
5587 5043 50         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5588 0           croak("Func::Util::first_cb: first argument must be an arrayref");
5589             }
5590 5043           AV *list = (AV*)SvRV(list_sv);
5591              
5592             STRLEN name_len;
5593 5043           const char *name = SvPV(ST(1), name_len);
5594              
5595 5043           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5596 5043 100         if (!cb) {
5597 1           croak("Func::Util::first_cb: unknown callback '%s'", name);
5598             }
5599 5042 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5600 0           croak("Func::Util::first_cb: callback '%s' is not a predicate", name);
5601             }
5602              
5603 5042           IV len = av_len(list) + 1;
5604             IV i;
5605              
5606 5042 100         if (cb->predicate) {
5607 10082 100         for (i = 0; i < len; i++) {
5608 10080           SV **svp = av_fetch(list, i, 0);
5609 10080 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5610 4030           ST(0) = *svp;
5611 4030           XSRETURN(1);
5612             }
5613             }
5614 1010 50         } else if (cb->perl_callback) {
5615 7014 100         for (i = 0; i < len; i++) {
5616 7012           SV **svp = av_fetch(list, i, 0);
5617 7012 50         if (!svp) continue;
5618 7012           bool matches = FALSE;
5619             {
5620 7012           dSP;
5621             int count;
5622             SV *result;
5623 7012           ENTER; SAVETMPS;
5624 7012 50         PUSHMARK(SP);
5625 7012 50         XPUSHs(*svp);
5626 7012           PUTBACK;
5627 7012           count = call_sv(cb->perl_callback, G_SCALAR);
5628 7012           SPAGAIN;
5629 7012 50         if (count > 0) {
5630 7012           result = POPs;
5631 7012           matches = SvTRUE(result);
5632             }
5633 7012           PUTBACK;
5634 7012 50         FREETMPS; LEAVE;
5635             }
5636 7012 100         if (matches) {
5637 1008           ST(0) = *svp;
5638 1008           XSRETURN(1);
5639             }
5640             }
5641             }
5642              
5643 4           XSRETURN_UNDEF;
5644             }
5645              
5646             /* grep_cb(\@list, ':predicate') - all matching elements */
5647 3037           XS_INTERNAL(xs_grep_cb) {
5648 3037           dXSARGS;
5649 3037 50         if (items != 2) croak("Usage: Func::Util::grep_cb(\\@list, $callback_name)");
5650              
5651 3037           SV *list_sv = ST(0);
5652 3037 50         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5653 0           croak("Func::Util::grep_cb: first argument must be an arrayref");
5654             }
5655 3037           AV *list = (AV*)SvRV(list_sv);
5656              
5657             STRLEN name_len;
5658 3037           const char *name = SvPV(ST(1), name_len);
5659              
5660 3037           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5661 3037 100         if (!cb) {
5662 1           croak("Func::Util::grep_cb: unknown callback '%s'", name);
5663             }
5664 3036 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5665 0           croak("Func::Util::grep_cb: callback '%s' is not a predicate", name);
5666             }
5667              
5668 3036           IV len = av_len(list) + 1;
5669             IV i;
5670 3036           IV count = 0;
5671              
5672             /* Collect matching elements in a temporary array first */
5673 3036           AV *results = newAV();
5674 3036           sv_2mortal((SV*)results);
5675              
5676 3036 100         if (cb->predicate) {
5677 30175 100         for (i = 0; i < len; i++) {
5678 27151           SV **svp = av_fetch(list, i, 0);
5679 27151 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5680 13075           av_push(results, SvREFCNT_inc(*svp));
5681 13075           count++;
5682             }
5683             }
5684 12 50         } else if (cb->perl_callback) {
5685 88 100         for (i = 0; i < len; i++) {
5686 76           SV **svp = av_fetch(list, i, 0);
5687 76 50         if (!svp) continue;
5688 76           SV *elem = *svp;
5689 76           bool matches = FALSE;
5690             {
5691 76           dSP;
5692             int call_count;
5693             SV *result;
5694 76           ENTER; SAVETMPS;
5695 76 50         PUSHMARK(SP);
5696 76 50         XPUSHs(elem);
5697 76           PUTBACK;
5698 76           call_count = call_sv(cb->perl_callback, G_SCALAR);
5699 76           SPAGAIN;
5700 76 50         if (call_count > 0) {
5701 76           result = POPs;
5702 76           matches = SvTRUE(result);
5703             }
5704 76           PUTBACK;
5705 76 50         FREETMPS; LEAVE;
5706             }
5707 76 100         if (matches) {
5708 39           av_push(results, SvREFCNT_inc(elem));
5709 39           count++;
5710             }
5711             }
5712             }
5713              
5714             /* Now push all results to the stack */
5715 3036           SP -= items;
5716 16150 100         for (i = 0; i < count; i++) {
5717 13114           SV **svp = av_fetch(results, i, 0);
5718 13114 50         if (svp) {
5719 13114 50         XPUSHs(sv_2mortal(SvREFCNT_inc(*svp)));
5720             }
5721             }
5722              
5723 3036           PUTBACK;
5724 3036           XSRETURN(count);
5725             }
5726              
5727             /* count_cb(\@list, ':predicate') - count matching elements */
5728 6165           XS_INTERNAL(xs_count_cb) {
5729 6165           dXSARGS;
5730 6165 50         if (items != 2) croak("Usage: Func::Util::count_cb(\\@list, $callback_name)");
5731              
5732 6165           SV *list_sv = ST(0);
5733 6165 50         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5734 0           croak("Func::Util::count_cb: first argument must be an arrayref");
5735             }
5736 6165           AV *list = (AV*)SvRV(list_sv);
5737              
5738             STRLEN name_len;
5739 6165           const char *name = SvPV(ST(1), name_len);
5740              
5741 6165           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5742 6165 100         if (!cb) {
5743 1           croak("Func::Util::count_cb: unknown callback '%s'", name);
5744             }
5745 6164 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5746 0           croak("Func::Util::count_cb: callback '%s' is not a predicate", name);
5747             }
5748              
5749 6164           IV len = av_len(list) + 1;
5750             IV i;
5751 6164           IV count = 0;
5752              
5753 6164 100         if (cb->predicate) {
5754 1046549 100         for (i = 0; i < len; i++) {
5755 1041389           SV **svp = av_fetch(list, i, 0);
5756 1041389 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5757 1022177           count++;
5758             }
5759             }
5760 1004 50         } else if (cb->perl_callback) {
5761 10033 100         for (i = 0; i < len; i++) {
5762 9029           SV **svp = av_fetch(list, i, 0);
5763 9029 50         if (!svp) continue;
5764 9029           bool matches = FALSE;
5765             {
5766 9029           dSP;
5767             int call_count;
5768             SV *result;
5769 9029           ENTER; SAVETMPS;
5770 9029 50         PUSHMARK(SP);
5771 9029 50         XPUSHs(*svp);
5772 9029           PUTBACK;
5773 9029           call_count = call_sv(cb->perl_callback, G_SCALAR);
5774 9029           SPAGAIN;
5775 9029 50         if (call_count > 0) {
5776 9029           result = POPs;
5777 9029           matches = SvTRUE(result);
5778             }
5779 9029           PUTBACK;
5780 9029 50         FREETMPS; LEAVE;
5781             }
5782 9029 100         if (matches) {
5783 3010           count++;
5784             }
5785             }
5786             }
5787              
5788 6164           XSRETURN_IV(count);
5789             }
5790              
5791             /* partition_cb(\@list, ':predicate') - split into [matches], [non-matches] */
5792 2013           XS_INTERNAL(xs_partition_cb) {
5793 2013           dXSARGS;
5794 2013 50         if (items != 2) croak("Usage: Func::Util::partition_cb(\\@list, $callback_name)");
5795              
5796 2013           SV *list_sv = ST(0);
5797 2013 100         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5798 1           croak("Func::Util::partition_cb: first argument must be an arrayref");
5799             }
5800 2012           AV *list = (AV*)SvRV(list_sv);
5801              
5802             STRLEN name_len;
5803 2012           const char *name = SvPV(ST(1), name_len);
5804              
5805 2012           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5806 2012 100         if (!cb) {
5807 1           croak("Func::Util::partition_cb: unknown callback '%s'", name);
5808             }
5809 2011 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5810 0           croak("Func::Util::partition_cb: callback '%s' is not a predicate", name);
5811             }
5812              
5813 2011           IV len = av_len(list) + 1;
5814 2011           AV *pass = newAV();
5815 2011           AV *fail = newAV();
5816 2011           av_extend(pass, len >> 1);
5817 2011           av_extend(fail, len >> 1);
5818              
5819             IV i;
5820 2011 100         if (cb->predicate) {
5821 20049 100         for (i = 0; i < len; i++) {
5822 18040           SV **svp = av_fetch(list, i, 0);
5823 18040 50         if (!svp) continue;
5824 18040 100         if (cb->predicate(aTHX_ *svp)) {
5825 11020           av_push(pass, SvREFCNT_inc_simple_NN(*svp));
5826             } else {
5827 7020           av_push(fail, SvREFCNT_inc_simple_NN(*svp));
5828             }
5829             }
5830 2 50         } else if (cb->perl_callback) {
5831 11 100         for (i = 0; i < len; i++) {
5832 9           SV **svp = av_fetch(list, i, 0);
5833 9 50         if (!svp) continue;
5834 9           bool matches = FALSE;
5835             {
5836 9           dSP;
5837             int call_count;
5838             SV *result;
5839              
5840 9           ENTER;
5841 9           SAVETMPS;
5842              
5843 9 50         PUSHMARK(SP);
5844 9 50         XPUSHs(*svp);
5845 9           PUTBACK;
5846              
5847 9           call_count = call_sv(cb->perl_callback, G_SCALAR);
5848              
5849 9           SPAGAIN;
5850 9 50         if (call_count > 0) {
5851 9           result = POPs;
5852 9           matches = SvTRUE(result);
5853             }
5854 9           PUTBACK;
5855              
5856 9 50         FREETMPS;
5857 9           LEAVE;
5858             }
5859 9 100         if (matches) {
5860 4           av_push(pass, SvREFCNT_inc_simple_NN(*svp));
5861             } else {
5862 5           av_push(fail, SvREFCNT_inc_simple_NN(*svp));
5863             }
5864             }
5865             }
5866              
5867             /* Return list of two arrayrefs */
5868 2011           ST(0) = sv_2mortal(newRV_noinc((SV*)pass));
5869 2011           ST(1) = sv_2mortal(newRV_noinc((SV*)fail));
5870 2011           XSRETURN(2);
5871             }
5872              
5873             /* final_cb(\@list, ':predicate') - find last matching element */
5874 3019           XS_INTERNAL(xs_final_cb) {
5875 3019           dXSARGS;
5876 3019 50         if (items != 2) croak("Usage: Func::Util::final_cb(\\@list, $callback_name)");
5877              
5878 3019           SV *list_sv = ST(0);
5879 3019 100         if (!SvROK(list_sv) || SvTYPE(SvRV(list_sv)) != SVt_PVAV) {
    50          
5880 1           croak("Func::Util::final_cb: first argument must be an arrayref");
5881             }
5882 3018           AV *list = (AV*)SvRV(list_sv);
5883              
5884             STRLEN name_len;
5885 3018           const char *name = SvPV(ST(1), name_len);
5886              
5887 3018           RegisteredCallback *cb = get_registered_callback(aTHX_ name);
5888 3018 100         if (!cb) {
5889 1           croak("Func::Util::final_cb: unknown callback '%s'", name);
5890             }
5891 3017 100         if (!cb->predicate && !cb->perl_callback) {
    50          
5892 0           croak("Func::Util::final_cb: callback '%s' is not a predicate", name);
5893             }
5894              
5895 3017           IV len = av_len(list) + 1;
5896             IV i;
5897              
5898 3017 100         if (cb->predicate) {
5899             /* Search from end - C predicate path */
5900 10039 100         for (i = len - 1; i >= 0; i--) {
5901 10033           SV **svp = av_fetch(list, i, 0);
5902 10033 50         if (svp && cb->predicate(aTHX_ *svp)) {
    100          
5903 3010           ST(0) = *svp;
5904 3010           XSRETURN(1);
5905             }
5906             }
5907 1 50         } else if (cb->perl_callback) {
5908             /* Search from end - Perl callback path */
5909 1 50         for (i = len - 1; i >= 0; i--) {
5910 1           SV **svp = av_fetch(list, i, 0);
5911 1 50         if (!svp) continue;
5912 1           bool matches = FALSE;
5913             {
5914 1           dSP;
5915             int count;
5916             SV *result;
5917 1           ENTER; SAVETMPS;
5918 1 50         PUSHMARK(SP);
5919 1 50         XPUSHs(*svp);
5920 1           PUTBACK;
5921 1           count = call_sv(cb->perl_callback, G_SCALAR);
5922 1           SPAGAIN;
5923 1 50         if (count > 0) {
5924 1           result = POPs;
5925 1           matches = SvTRUE(result);
5926             }
5927 1           PUTBACK;
5928 1 50         FREETMPS; LEAVE;
5929             }
5930 1 50         if (matches) {
5931 1           ST(0) = *svp;
5932 1           XSRETURN(1);
5933             }
5934             }
5935             }
5936              
5937 6           XSRETURN_UNDEF;
5938             }
5939              
5940             /* Perl-level callback registration */
5941 20           XS_INTERNAL(xs_register_callback) {
5942 20           dXSARGS;
5943 20 50         if (items != 2) croak("Usage: Func::Util::register_callback($name, \\&coderef)");
5944              
5945             STRLEN name_len;
5946 20           const char *name = SvPV(ST(0), name_len);
5947              
5948 20           SV *coderef = ST(1);
5949 20 50         if (!SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
    50          
5950 0           croak("Func::Util::register_callback: second argument must be a coderef");
5951             }
5952              
5953             RegisteredCallback *cb;
5954             SV *sv;
5955              
5956 20           init_callback_registry(aTHX);
5957              
5958             /* Check if already registered */
5959 20 100         if (get_registered_callback(aTHX_ name)) {
5960 3           croak("Callback '%s' is already registered", name);
5961             }
5962              
5963 17           Newxz(cb, 1, RegisteredCallback);
5964 17           cb->name = savepv(name);
5965 17           cb->predicate = NULL;
5966 17           cb->mapper = NULL;
5967 17           cb->reducer = NULL;
5968             /* Store a copy of the coderef (RV to CV) */
5969 17           cb->perl_callback = newSVsv(coderef);
5970              
5971 17           sv = newSViv(PTR2IV(cb));
5972 17           hv_store(g_callback_registry, name, name_len, sv, 0);
5973              
5974 17           XSRETURN_YES;
5975             }
5976              
5977             /* Check if callback exists */
5978 6018           XS_INTERNAL(xs_has_callback) {
5979 6018           dXSARGS;
5980 6018 50         if (items != 1) croak("Usage: Func::Util::has_callback($name)");
5981              
5982             STRLEN name_len;
5983 6018           const char *name = SvPV(ST(0), name_len);
5984              
5985 6018 100         if (has_callback(aTHX_ name)) {
5986 4014           XSRETURN_YES;
5987             }
5988 2004           XSRETURN_NO;
5989             }
5990              
5991             /* List all callbacks */
5992 1006           XS_INTERNAL(xs_list_callbacks) {
5993 1006           dXSARGS;
5994             PERL_UNUSED_ARG(items);
5995              
5996 1006           AV *result = list_callbacks(aTHX);
5997 1006           ST(0) = sv_2mortal(newRV_noinc((SV*)result));
5998 1006           XSRETURN(1);
5999             }
6000              
6001             /* ============================================
6002             Import function - O(1) hash-based lookup
6003             ============================================ */
6004              
6005             /* Export entry: supports XS functions, Perl coderefs, or both */
6006             typedef struct {
6007             XSUBADDR_t xs_func; /* XS function pointer (NULL for Perl-only) */
6008             Perl_call_checker call_checker; /* Optional call checker for XS */
6009             SV *perl_cv; /* Perl coderef (NULL for XS-only) */
6010             } ExportEntry;
6011              
6012             /* Global export hash - initialized at boot */
6013             static HV *g_export_hash = NULL;
6014              
6015             /* Register an XS export with optional call checker (internal) */
6016 6095           static void register_export(pTHX_ const char *name, XSUBADDR_t xs_func, Perl_call_checker checker) {
6017             ExportEntry *entry;
6018 6095           Newx(entry, 1, ExportEntry);
6019 6095           entry->xs_func = xs_func;
6020 6095           entry->call_checker = checker;
6021 6095           entry->perl_cv = NULL;
6022 6095           (void)hv_store(g_export_hash, name, strlen(name), newSViv(PTR2IV(entry)), 0);
6023 6095           }
6024              
6025             /* ============================================
6026             Public API: Register custom exports
6027             ============================================ */
6028              
6029             /* Register a Perl coderef as an export - called from Perl */
6030 15           XS_INTERNAL(xs_register_export) {
6031 15           dXSARGS;
6032 15 50         if (items != 2)
6033 0           croak("Usage: Func::Util::register_export($name, \\&coderef)");
6034              
6035             STRLEN name_len;
6036 15           char *name = SvPV(ST(0), name_len);
6037 15           SV *cv_sv = ST(1);
6038              
6039             /* Validate it's a coderef */
6040 15 100         if (!SvROK(cv_sv) || SvTYPE(SvRV(cv_sv)) != SVt_PVCV)
    100          
6041 3           croak("Func::Util::register_export: second argument must be a coderef");
6042              
6043             /* Check if name already exists */
6044 12 100         if (hv_exists(g_export_hash, name, name_len))
6045 1           croak("Func::Util::register_export: '%s' is already registered", name);
6046              
6047             /* Create entry for Perl coderef */
6048             ExportEntry *entry;
6049 11           Newx(entry, 1, ExportEntry);
6050 11           entry->xs_func = NULL;
6051 11           entry->call_checker = NULL;
6052 11           entry->perl_cv = SvREFCNT_inc(cv_sv); /* Keep a reference */
6053              
6054 11           (void)hv_store(g_export_hash, name, name_len, newSViv(PTR2IV(entry)), 0);
6055              
6056 11           XSRETURN_YES;
6057             }
6058              
6059             /* Check if an export name is registered */
6060 17           XS_INTERNAL(xs_has_export) {
6061 17           dXSARGS;
6062 17 50         if (items != 1)
6063 0           croak("Usage: Func::Util::has_export($name)");
6064              
6065             STRLEN name_len;
6066 17           char *name = SvPV(ST(0), name_len);
6067              
6068 17 100         if (hv_exists(g_export_hash, name, name_len)) {
6069 14           XSRETURN_YES;
6070             } else {
6071 3           XSRETURN_NO;
6072             }
6073             }
6074              
6075             /* List all registered export names */
6076 3           XS_INTERNAL(xs_list_exports) {
6077 3           dXSARGS;
6078             PERL_UNUSED_ARG(items);
6079              
6080 3           AV *result = newAV();
6081             HE *entry;
6082              
6083 3           hv_iterinit(g_export_hash);
6084 357 100         while ((entry = hv_iternext(g_export_hash))) {
6085 354           SV *key = hv_iterkeysv(entry);
6086 354           av_push(result, SvREFCNT_inc(key));
6087             }
6088              
6089 3           ST(0) = sv_2mortal(newRV_noinc((SV*)result));
6090 3           XSRETURN(1);
6091             }
6092              
6093             /* ============================================
6094             C API for XS modules to register exports
6095             ============================================ */
6096              
6097             /*
6098             * Register an XS function as a util export.
6099             * Call this from your BOOT section:
6100             * funcutil_register_export_xs(aTHX_ "my_func", xs_my_func);
6101             */
6102 7           void funcutil_register_export_xs(pTHX_ const char *name, XSUBADDR_t xs_func) {
6103 7 50         if (!g_export_hash) {
6104 0           croak("funcutil_register_export_xs: Func::Util module not yet loaded");
6105             }
6106              
6107 7           STRLEN name_len = strlen(name);
6108 7 50         if (hv_exists(g_export_hash, name, name_len)) {
6109 0           croak("funcutil_register_export_xs: '%s' is already registered", name);
6110             }
6111              
6112             ExportEntry *entry;
6113 7           Newx(entry, 1, ExportEntry);
6114 7           entry->xs_func = xs_func;
6115 7           entry->call_checker = NULL;
6116 7           entry->perl_cv = NULL;
6117              
6118 7           (void)hv_store(g_export_hash, name, name_len, newSViv(PTR2IV(entry)), 0);
6119 7           }
6120              
6121             /* Initialize export hash at boot - called once */
6122 53           static void init_export_hash(pTHX) {
6123 53           g_export_hash = newHV();
6124              
6125             /* Functional */
6126 53           register_export(aTHX_ "memo", xs_memo, NULL);
6127 53           register_export(aTHX_ "pipeline", xs_pipe, NULL);
6128 53           register_export(aTHX_ "compose", xs_compose, NULL);
6129 53           register_export(aTHX_ "lazy", xs_lazy, NULL);
6130 53           register_export(aTHX_ "force", xs_force, NULL);
6131 53           register_export(aTHX_ "dig", xs_dig, NULL);
6132 53           register_export(aTHX_ "clamp", xs_clamp, clamp_call_checker);
6133 53           register_export(aTHX_ "tap", xs_tap, NULL);
6134 53           register_export(aTHX_ "identity", xs_identity, identity_call_checker);
6135 53           register_export(aTHX_ "always", xs_always, NULL);
6136 53           register_export(aTHX_ "noop", xs_noop, noop_call_checker);
6137 53           register_export(aTHX_ "partial", xs_partial, NULL);
6138 53           register_export(aTHX_ "negate", xs_negate, NULL);
6139 53           register_export(aTHX_ "once", xs_once, NULL);
6140              
6141             /* Stubs */
6142 53           register_export(aTHX_ "stub_true", xs_stub_true, NULL);
6143 53           register_export(aTHX_ "stub_false", xs_stub_false, NULL);
6144 53           register_export(aTHX_ "stub_array", xs_stub_array, NULL);
6145 53           register_export(aTHX_ "stub_hash", xs_stub_hash, NULL);
6146 53           register_export(aTHX_ "stub_string", xs_stub_string, NULL);
6147 53           register_export(aTHX_ "stub_zero", xs_stub_zero, NULL);
6148              
6149             /* Null coalescing */
6150 53           register_export(aTHX_ "nvl", xs_nvl, NULL);
6151 53           register_export(aTHX_ "coalesce", xs_coalesce, NULL);
6152              
6153             /* List operations */
6154 53           register_export(aTHX_ "first", xs_first, NULL);
6155 53           register_export(aTHX_ "firstr", xs_firstr, NULL);
6156 53           register_export(aTHX_ "any", xs_any, NULL);
6157 53           register_export(aTHX_ "all", xs_all, NULL);
6158 53           register_export(aTHX_ "none", xs_none, NULL);
6159 53           register_export(aTHX_ "final", xs_final, NULL);
6160             #ifdef dMULTICALL
6161 53           register_export(aTHX_ "first_inline", xs_first_inline, NULL);
6162             #endif
6163              
6164             /* Callback-based loop functions */
6165 53           register_export(aTHX_ "any_cb", xs_any_cb, NULL);
6166 53           register_export(aTHX_ "all_cb", xs_all_cb, NULL);
6167 53           register_export(aTHX_ "none_cb", xs_none_cb, NULL);
6168 53           register_export(aTHX_ "first_cb", xs_first_cb, NULL);
6169 53           register_export(aTHX_ "grep_cb", xs_grep_cb, NULL);
6170 53           register_export(aTHX_ "count_cb", xs_count_cb, NULL);
6171 53           register_export(aTHX_ "partition_cb", xs_partition_cb, NULL);
6172 53           register_export(aTHX_ "final_cb", xs_final_cb, NULL);
6173 53           register_export(aTHX_ "register_callback", xs_register_callback, NULL);
6174 53           register_export(aTHX_ "has_callback", xs_has_callback, NULL);
6175 53           register_export(aTHX_ "list_callbacks", xs_list_callbacks, NULL);
6176              
6177             /* Specialized predicates - first_* */
6178 53           register_export(aTHX_ "first_gt", xs_first_gt, NULL);
6179 53           register_export(aTHX_ "first_lt", xs_first_lt, NULL);
6180 53           register_export(aTHX_ "first_ge", xs_first_ge, NULL);
6181 53           register_export(aTHX_ "first_le", xs_first_le, NULL);
6182 53           register_export(aTHX_ "first_eq", xs_first_eq, NULL);
6183 53           register_export(aTHX_ "first_ne", xs_first_ne, NULL);
6184              
6185             /* Specialized predicates - final_* */
6186 53           register_export(aTHX_ "final_gt", xs_final_gt, NULL);
6187 53           register_export(aTHX_ "final_lt", xs_final_lt, NULL);
6188 53           register_export(aTHX_ "final_ge", xs_final_ge, NULL);
6189 53           register_export(aTHX_ "final_le", xs_final_le, NULL);
6190 53           register_export(aTHX_ "final_eq", xs_final_eq, NULL);
6191 53           register_export(aTHX_ "final_ne", xs_final_ne, NULL);
6192              
6193             /* Specialized predicates - any_* */
6194 53           register_export(aTHX_ "any_gt", xs_any_gt, NULL);
6195 53           register_export(aTHX_ "any_lt", xs_any_lt, NULL);
6196 53           register_export(aTHX_ "any_ge", xs_any_ge, NULL);
6197 53           register_export(aTHX_ "any_le", xs_any_le, NULL);
6198 53           register_export(aTHX_ "any_eq", xs_any_eq, NULL);
6199 53           register_export(aTHX_ "any_ne", xs_any_ne, NULL);
6200              
6201             /* Specialized predicates - all_* */
6202 53           register_export(aTHX_ "all_gt", xs_all_gt, NULL);
6203 53           register_export(aTHX_ "all_lt", xs_all_lt, NULL);
6204 53           register_export(aTHX_ "all_ge", xs_all_ge, NULL);
6205 53           register_export(aTHX_ "all_le", xs_all_le, NULL);
6206 53           register_export(aTHX_ "all_eq", xs_all_eq, NULL);
6207 53           register_export(aTHX_ "all_ne", xs_all_ne, NULL);
6208              
6209             /* Specialized predicates - none_* */
6210 53           register_export(aTHX_ "none_gt", xs_none_gt, NULL);
6211 53           register_export(aTHX_ "none_lt", xs_none_lt, NULL);
6212 53           register_export(aTHX_ "none_ge", xs_none_ge, NULL);
6213 53           register_export(aTHX_ "none_le", xs_none_le, NULL);
6214 53           register_export(aTHX_ "none_eq", xs_none_eq, NULL);
6215 53           register_export(aTHX_ "none_ne", xs_none_ne, NULL);
6216              
6217             /* Collection functions */
6218 53           register_export(aTHX_ "pick", xs_pick, NULL);
6219 53           register_export(aTHX_ "pluck", xs_pluck, NULL);
6220 53           register_export(aTHX_ "omit", xs_omit, NULL);
6221 53           register_export(aTHX_ "uniq", xs_uniq, NULL);
6222 53           register_export(aTHX_ "partition", xs_partition, NULL);
6223 53           register_export(aTHX_ "defaults", xs_defaults, NULL);
6224 53           register_export(aTHX_ "count", xs_count, NULL);
6225 53           register_export(aTHX_ "replace_all", xs_replace_all, NULL);
6226              
6227             /* Type predicates */
6228 53           register_export(aTHX_ "is_ref", xs_is_ref, is_ref_call_checker);
6229 53           register_export(aTHX_ "is_array", xs_is_array, is_array_call_checker);
6230 53           register_export(aTHX_ "is_hash", xs_is_hash, is_hash_call_checker);
6231 53           register_export(aTHX_ "is_code", xs_is_code, is_code_call_checker);
6232 53           register_export(aTHX_ "is_defined", xs_is_defined, is_defined_call_checker);
6233 53           register_export(aTHX_ "is_string", xs_is_string, is_string_call_checker);
6234              
6235             /* String predicates */
6236 53           register_export(aTHX_ "is_empty", xs_is_empty, is_empty_call_checker);
6237 53           register_export(aTHX_ "starts_with", xs_starts_with, starts_with_call_checker);
6238 53           register_export(aTHX_ "ends_with", xs_ends_with, ends_with_call_checker);
6239 53           register_export(aTHX_ "trim", xs_trim, trim_call_checker);
6240 53           register_export(aTHX_ "ltrim", xs_ltrim, ltrim_call_checker);
6241 53           register_export(aTHX_ "rtrim", xs_rtrim, rtrim_call_checker);
6242              
6243             /* Boolean predicates */
6244 53           register_export(aTHX_ "is_true", xs_is_true, is_true_call_checker);
6245 53           register_export(aTHX_ "is_false", xs_is_false, is_false_call_checker);
6246 53           register_export(aTHX_ "bool", xs_bool, bool_call_checker);
6247              
6248             /* Extended type predicates */
6249 53           register_export(aTHX_ "is_num", xs_is_num, is_num_call_checker);
6250 53           register_export(aTHX_ "is_int", xs_is_int, is_int_call_checker);
6251 53           register_export(aTHX_ "is_blessed", xs_is_blessed, is_blessed_call_checker);
6252 53           register_export(aTHX_ "is_scalar_ref", xs_is_scalar_ref, is_scalar_ref_call_checker);
6253 53           register_export(aTHX_ "is_regex", xs_is_regex, is_regex_call_checker);
6254 53           register_export(aTHX_ "is_glob", xs_is_glob, is_glob_call_checker);
6255              
6256             /* Numeric predicates */
6257 53           register_export(aTHX_ "is_positive", xs_is_positive, is_positive_call_checker);
6258 53           register_export(aTHX_ "is_negative", xs_is_negative, is_negative_call_checker);
6259 53           register_export(aTHX_ "is_zero", xs_is_zero, is_zero_call_checker);
6260 53           register_export(aTHX_ "is_even", xs_is_even, is_even_call_checker);
6261 53           register_export(aTHX_ "is_odd", xs_is_odd, is_odd_call_checker);
6262 53           register_export(aTHX_ "is_between", xs_is_between, is_between_call_checker);
6263              
6264             /* Collection predicates */
6265 53           register_export(aTHX_ "is_empty_array", xs_is_empty_array, is_empty_array_call_checker);
6266 53           register_export(aTHX_ "is_empty_hash", xs_is_empty_hash, is_empty_hash_call_checker);
6267 53           register_export(aTHX_ "array_len", xs_array_len, array_len_call_checker);
6268 53           register_export(aTHX_ "hash_size", xs_hash_size, hash_size_call_checker);
6269 53           register_export(aTHX_ "array_first", xs_array_first, array_first_call_checker);
6270 53           register_export(aTHX_ "array_last", xs_array_last, array_last_call_checker);
6271              
6272             /* Conditional/numeric ops */
6273 53           register_export(aTHX_ "maybe", xs_maybe, maybe_call_checker);
6274 53           register_export(aTHX_ "sign", xs_sign, sign_call_checker);
6275 53           register_export(aTHX_ "min2", xs_min2, min2_call_checker);
6276 53           register_export(aTHX_ "max2", xs_max2, max2_call_checker);
6277 53           }
6278              
6279 85           static char* get_caller(pTHX) {
6280 85 50         return HvNAME((HV*)CopSTASH(PL_curcop));
    50          
    50          
    0          
    50          
    50          
6281             }
6282              
6283             /* Fast O(1) import using hash lookup */
6284 85           XS_INTERNAL(xs_import) {
6285 85           dXSARGS;
6286 85           char *pkg = get_caller(aTHX);
6287             IV i;
6288             STRLEN name_len;
6289             char full[512];
6290              
6291 539 100         for (i = 1; i < items; i++) {
6292 456           char *name = SvPV(ST(i), name_len);
6293 456           SV **entry_sv = hv_fetch(g_export_hash, name, name_len, 0);
6294              
6295 456 100         if (!entry_sv || !*entry_sv) {
    50          
6296 2           croak("util: unknown export '%s'", name);
6297             }
6298              
6299 454           ExportEntry *entry = INT2PTR(ExportEntry*, SvIV(*entry_sv));
6300 454           snprintf(full, sizeof(full), "%s::%s", pkg, name);
6301              
6302 454 100         if (entry->xs_func) {
6303             /* XS function: create XS stub in caller's namespace.
6304             * Note: We intentionally do NOT install call checkers on exported
6305             * functions. Call checkers are compile-time optimizations that work
6306             * by transforming the op tree. They work on util::* functions because
6307             * those are installed at boot time before any user code compiles.
6308             * Users who want compile-time optimization should call util::func()
6309             * directly instead of importing. */
6310 446           CV *cv = newXS(full, entry->xs_func, __FILE__);
6311             PERL_UNUSED_VAR(cv);
6312 8 50         } else if (entry->perl_cv) {
6313             /* Perl coderef: create alias in caller's namespace */
6314 8           GV *gv = gv_fetchpv(full, GV_ADD, SVt_PVCV);
6315 8 50         if (gv) {
6316             /* Get the actual CV from the reference */
6317 8           CV *src_cv = (CV*)SvRV(entry->perl_cv);
6318             /* Assign the CV to the glob's CODE slot */
6319 8           SvREFCNT_inc((SV*)src_cv);
6320 8           GvCV_set(gv, src_cv);
6321             }
6322             }
6323             }
6324              
6325 83           XSRETURN_EMPTY;
6326             }
6327              
6328             /* ============================================
6329             Boot
6330             ============================================ */
6331              
6332 53           XS_EXTERNAL(boot_Func__Util) {
6333 53           dXSBOOTARGSXSAPIVERCHK;
6334             PERL_UNUSED_VAR(items);
6335              
6336             /* Initialize built-in loop callbacks */
6337 53           init_builtin_callbacks(aTHX);
6338              
6339             /* Register custom ops */
6340 53           XopENTRY_set(&identity_xop, xop_name, "identity");
6341 53           XopENTRY_set(&identity_xop, xop_desc, "identity passthrough");
6342 53           Perl_custom_op_register(aTHX_ pp_identity, &identity_xop);
6343              
6344 53           XopENTRY_set(&always_xop, xop_name, "always");
6345 53           XopENTRY_set(&always_xop, xop_desc, "always return stored value");
6346 53           Perl_custom_op_register(aTHX_ pp_always, &always_xop);
6347              
6348 53           XopENTRY_set(&clamp_xop, xop_name, "clamp");
6349 53           XopENTRY_set(&clamp_xop, xop_desc, "clamp value between min and max");
6350 53           Perl_custom_op_register(aTHX_ pp_clamp, &clamp_xop);
6351              
6352             /* Register type predicate custom ops */
6353 53           XopENTRY_set(&is_ref_xop, xop_name, "is_ref");
6354 53           XopENTRY_set(&is_ref_xop, xop_desc, "check if value is a reference");
6355 53           Perl_custom_op_register(aTHX_ pp_is_ref, &is_ref_xop);
6356              
6357 53           XopENTRY_set(&is_array_xop, xop_name, "is_array");
6358 53           XopENTRY_set(&is_array_xop, xop_desc, "check if value is an arrayref");
6359 53           Perl_custom_op_register(aTHX_ pp_is_array, &is_array_xop);
6360              
6361 53           XopENTRY_set(&is_hash_xop, xop_name, "is_hash");
6362 53           XopENTRY_set(&is_hash_xop, xop_desc, "check if value is a hashref");
6363 53           Perl_custom_op_register(aTHX_ pp_is_hash, &is_hash_xop);
6364              
6365 53           XopENTRY_set(&is_code_xop, xop_name, "is_code");
6366 53           XopENTRY_set(&is_code_xop, xop_desc, "check if value is a coderef");
6367 53           Perl_custom_op_register(aTHX_ pp_is_code, &is_code_xop);
6368              
6369 53           XopENTRY_set(&is_defined_xop, xop_name, "is_defined");
6370 53           XopENTRY_set(&is_defined_xop, xop_desc, "check if value is defined");
6371 53           Perl_custom_op_register(aTHX_ pp_is_defined, &is_defined_xop);
6372              
6373             /* Register string predicate custom ops */
6374 53           XopENTRY_set(&is_empty_xop, xop_name, "is_empty");
6375 53           XopENTRY_set(&is_empty_xop, xop_desc, "check if string is empty");
6376 53           Perl_custom_op_register(aTHX_ pp_is_empty, &is_empty_xop);
6377              
6378 53           XopENTRY_set(&starts_with_xop, xop_name, "starts_with");
6379 53           XopENTRY_set(&starts_with_xop, xop_desc, "check if string starts with prefix");
6380 53           Perl_custom_op_register(aTHX_ pp_starts_with, &starts_with_xop);
6381              
6382 53           XopENTRY_set(&ends_with_xop, xop_name, "ends_with");
6383 53           XopENTRY_set(&ends_with_xop, xop_desc, "check if string ends with suffix");
6384 53           Perl_custom_op_register(aTHX_ pp_ends_with, &ends_with_xop);
6385              
6386             /* Register boolean/truthiness custom ops */
6387 53           XopENTRY_set(&is_true_xop, xop_name, "is_true");
6388 53           XopENTRY_set(&is_true_xop, xop_desc, "check if value is truthy");
6389 53           Perl_custom_op_register(aTHX_ pp_is_true, &is_true_xop);
6390              
6391 53           XopENTRY_set(&is_false_xop, xop_name, "is_false");
6392 53           XopENTRY_set(&is_false_xop, xop_desc, "check if value is falsy");
6393 53           Perl_custom_op_register(aTHX_ pp_is_false, &is_false_xop);
6394              
6395 53           XopENTRY_set(&bool_xop, xop_name, "bool");
6396 53           XopENTRY_set(&bool_xop, xop_desc, "normalize to boolean");
6397 53           Perl_custom_op_register(aTHX_ pp_bool, &bool_xop);
6398              
6399             /* Register extended type predicate custom ops */
6400 53           XopENTRY_set(&is_num_xop, xop_name, "is_num");
6401 53           XopENTRY_set(&is_num_xop, xop_desc, "check if value is numeric");
6402 53           Perl_custom_op_register(aTHX_ pp_is_num, &is_num_xop);
6403              
6404 53           XopENTRY_set(&is_int_xop, xop_name, "is_int");
6405 53           XopENTRY_set(&is_int_xop, xop_desc, "check if value is integer");
6406 53           Perl_custom_op_register(aTHX_ pp_is_int, &is_int_xop);
6407              
6408 53           XopENTRY_set(&is_blessed_xop, xop_name, "is_blessed");
6409 53           XopENTRY_set(&is_blessed_xop, xop_desc, "check if value is blessed");
6410 53           Perl_custom_op_register(aTHX_ pp_is_blessed, &is_blessed_xop);
6411              
6412 53           XopENTRY_set(&is_scalar_ref_xop, xop_name, "is_scalar_ref");
6413 53           XopENTRY_set(&is_scalar_ref_xop, xop_desc, "check if value is scalar reference");
6414 53           Perl_custom_op_register(aTHX_ pp_is_scalar_ref, &is_scalar_ref_xop);
6415              
6416 53           XopENTRY_set(&is_regex_xop, xop_name, "is_regex");
6417 53           XopENTRY_set(&is_regex_xop, xop_desc, "check if value is compiled regex");
6418 53           Perl_custom_op_register(aTHX_ pp_is_regex, &is_regex_xop);
6419              
6420 53           XopENTRY_set(&is_glob_xop, xop_name, "is_glob");
6421 53           XopENTRY_set(&is_glob_xop, xop_desc, "check if value is glob");
6422 53           Perl_custom_op_register(aTHX_ pp_is_glob, &is_glob_xop);
6423              
6424 53           XopENTRY_set(&is_string_xop, xop_name, "is_string");
6425 53           XopENTRY_set(&is_string_xop, xop_desc, "check if value is plain scalar");
6426 53           Perl_custom_op_register(aTHX_ pp_is_string, &is_string_xop);
6427              
6428             /* Register numeric predicate custom ops */
6429 53           XopENTRY_set(&is_positive_xop, xop_name, "is_positive");
6430 53           XopENTRY_set(&is_positive_xop, xop_desc, "check if value is positive");
6431 53           Perl_custom_op_register(aTHX_ pp_is_positive, &is_positive_xop);
6432              
6433 53           XopENTRY_set(&is_negative_xop, xop_name, "is_negative");
6434 53           XopENTRY_set(&is_negative_xop, xop_desc, "check if value is negative");
6435 53           Perl_custom_op_register(aTHX_ pp_is_negative, &is_negative_xop);
6436              
6437 53           XopENTRY_set(&is_zero_xop, xop_name, "is_zero");
6438 53           XopENTRY_set(&is_zero_xop, xop_desc, "check if value is zero");
6439 53           Perl_custom_op_register(aTHX_ pp_is_zero, &is_zero_xop);
6440              
6441             /* Register numeric utility custom ops */
6442 53           XopENTRY_set(&is_even_xop, xop_name, "is_even");
6443 53           XopENTRY_set(&is_even_xop, xop_desc, "check if integer is even");
6444 53           Perl_custom_op_register(aTHX_ pp_is_even, &is_even_xop);
6445              
6446 53           XopENTRY_set(&is_odd_xop, xop_name, "is_odd");
6447 53           XopENTRY_set(&is_odd_xop, xop_desc, "check if integer is odd");
6448 53           Perl_custom_op_register(aTHX_ pp_is_odd, &is_odd_xop);
6449              
6450 53           XopENTRY_set(&is_between_xop, xop_name, "is_between");
6451 53           XopENTRY_set(&is_between_xop, xop_desc, "check if value is between min and max");
6452 53           Perl_custom_op_register(aTHX_ pp_is_between, &is_between_xop);
6453              
6454             /* Register collection custom ops */
6455 53           XopENTRY_set(&is_empty_array_xop, xop_name, "is_empty_array");
6456 53           XopENTRY_set(&is_empty_array_xop, xop_desc, "check if arrayref is empty");
6457 53           Perl_custom_op_register(aTHX_ pp_is_empty_array, &is_empty_array_xop);
6458              
6459 53           XopENTRY_set(&is_empty_hash_xop, xop_name, "is_empty_hash");
6460 53           XopENTRY_set(&is_empty_hash_xop, xop_desc, "check if hashref is empty");
6461 53           Perl_custom_op_register(aTHX_ pp_is_empty_hash, &is_empty_hash_xop);
6462              
6463 53           XopENTRY_set(&array_len_xop, xop_name, "array_len");
6464 53           XopENTRY_set(&array_len_xop, xop_desc, "get array length");
6465 53           Perl_custom_op_register(aTHX_ pp_array_len, &array_len_xop);
6466              
6467 53           XopENTRY_set(&hash_size_xop, xop_name, "hash_size");
6468 53           XopENTRY_set(&hash_size_xop, xop_desc, "get hash key count");
6469 53           Perl_custom_op_register(aTHX_ pp_hash_size, &hash_size_xop);
6470              
6471 53           XopENTRY_set(&array_first_xop, xop_name, "array_first");
6472 53           XopENTRY_set(&array_first_xop, xop_desc, "get first array element");
6473 53           Perl_custom_op_register(aTHX_ pp_array_first, &array_first_xop);
6474              
6475 53           XopENTRY_set(&array_last_xop, xop_name, "array_last");
6476 53           XopENTRY_set(&array_last_xop, xop_desc, "get last array element");
6477 53           Perl_custom_op_register(aTHX_ pp_array_last, &array_last_xop);
6478              
6479             /* Register string manipulation custom ops */
6480 53           XopENTRY_set(&trim_xop, xop_name, "trim");
6481 53           XopENTRY_set(&trim_xop, xop_desc, "trim whitespace from string");
6482 53           Perl_custom_op_register(aTHX_ pp_trim, &trim_xop);
6483              
6484 53           XopENTRY_set(<rim_xop, xop_name, "ltrim");
6485 53           XopENTRY_set(<rim_xop, xop_desc, "trim leading whitespace");
6486 53           Perl_custom_op_register(aTHX_ pp_ltrim, <rim_xop);
6487              
6488 53           XopENTRY_set(&rtrim_xop, xop_name, "rtrim");
6489 53           XopENTRY_set(&rtrim_xop, xop_desc, "trim trailing whitespace");
6490 53           Perl_custom_op_register(aTHX_ pp_rtrim, &rtrim_xop);
6491              
6492             /* Register conditional custom ops */
6493 53           XopENTRY_set(&maybe_xop, xop_name, "maybe");
6494 53           XopENTRY_set(&maybe_xop, xop_desc, "return value if defined");
6495 53           Perl_custom_op_register(aTHX_ pp_maybe, &maybe_xop);
6496              
6497             /* Register numeric custom ops */
6498 53           XopENTRY_set(&sign_xop, xop_name, "sign");
6499 53           XopENTRY_set(&sign_xop, xop_desc, "return sign of number");
6500 53           Perl_custom_op_register(aTHX_ pp_sign, &sign_xop);
6501              
6502 53           XopENTRY_set(&min2_xop, xop_name, "min2");
6503 53           XopENTRY_set(&min2_xop, xop_desc, "return smaller of two values");
6504 53           Perl_custom_op_register(aTHX_ pp_min2, &min2_xop);
6505              
6506 53           XopENTRY_set(&max2_xop, xop_name, "max2");
6507 53           XopENTRY_set(&max2_xop, xop_desc, "return larger of two values");
6508 53           Perl_custom_op_register(aTHX_ pp_max2, &max2_xop);
6509              
6510             /* Initialize memo storage */
6511 53           g_memo_size = 16;
6512 53 50         Newxz(g_memos, g_memo_size, MemoizedFunc);
6513              
6514             /* Initialize lazy storage */
6515 53           g_lazy_size = 16;
6516 53 50         Newxz(g_lazies, g_lazy_size, LazyValue);
6517              
6518             /* Initialize always storage */
6519 53           g_always_size = 16;
6520 53 50         Newxz(g_always_values, g_always_size, SV*);
6521              
6522             /* Initialize once storage */
6523 53           g_once_size = 16;
6524 53 50         Newxz(g_onces, g_once_size, OnceFunc);
6525              
6526             /* Initialize partial storage */
6527 53           g_partial_size = 16;
6528 53 50         Newxz(g_partials, g_partial_size, PartialFunc);
6529              
6530             /* Initialize export hash for O(1) import lookup */
6531 53           init_export_hash(aTHX);
6532              
6533             /* Export functions */
6534 53           newXS("Func::Util::import", xs_import, __FILE__);
6535              
6536             /* Export registry API */
6537 53           newXS("Func::Util::register_export", xs_register_export, __FILE__);
6538 53           newXS("Func::Util::has_export", xs_has_export, __FILE__);
6539 53           newXS("Func::Util::list_exports", xs_list_exports, __FILE__);
6540              
6541 53           newXS("Func::Util::memo", xs_memo, __FILE__);
6542 53           newXS("Func::Util::pipeline", xs_pipe, __FILE__);
6543 53           newXS("Func::Util::compose", xs_compose, __FILE__);
6544 53           newXS("Func::Util::lazy", xs_lazy, __FILE__);
6545 53           newXS("Func::Util::force", xs_force, __FILE__);
6546 53           newXS("Func::Util::dig", xs_dig, __FILE__);
6547            
6548             {
6549 53           CV *cv = newXS("Func::Util::clamp", xs_clamp, __FILE__);
6550 53           cv_set_call_checker(cv, clamp_call_checker, (SV*)cv);
6551             }
6552            
6553 53           newXS("Func::Util::tap", xs_tap, __FILE__);
6554              
6555             {
6556 53           CV *cv = newXS("Func::Util::identity", xs_identity, __FILE__);
6557 53           cv_set_call_checker(cv, identity_call_checker, (SV*)cv);
6558             }
6559              
6560 53           newXS("Func::Util::always", xs_always, __FILE__);
6561             {
6562 53           CV *cv = newXS("Func::Util::noop", xs_noop, __FILE__);
6563 53           cv_set_call_checker(cv, noop_call_checker, (SV*)cv);
6564             }
6565 53           newXS("Func::Util::stub_true", xs_stub_true, __FILE__);
6566 53           newXS("Func::Util::stub_false", xs_stub_false, __FILE__);
6567 53           newXS("Func::Util::stub_array", xs_stub_array, __FILE__);
6568 53           newXS("Func::Util::stub_hash", xs_stub_hash, __FILE__);
6569 53           newXS("Func::Util::stub_string", xs_stub_string, __FILE__);
6570 53           newXS("Func::Util::stub_zero", xs_stub_zero, __FILE__);
6571 53           newXS("Func::Util::nvl", xs_nvl, __FILE__);
6572 53           newXS("Func::Util::coalesce", xs_coalesce, __FILE__);
6573              
6574             /* List functions */
6575 53           newXS("Func::Util::first", xs_first, __FILE__);
6576 53           newXS("Func::Util::firstr", xs_firstr, __FILE__);
6577 53           newXS("Func::Util::any", xs_any, __FILE__);
6578 53           newXS("Func::Util::all", xs_all, __FILE__);
6579 53           newXS("Func::Util::none", xs_none, __FILE__);
6580             #ifdef dMULTICALL
6581 53           newXS("Func::Util::first_inline", xs_first_inline, __FILE__); /* experimental, 5.11+ only */
6582             #endif
6583              
6584             /* Named callback loop functions */
6585 53           newXS("Func::Util::any_cb", xs_any_cb, __FILE__);
6586 53           newXS("Func::Util::all_cb", xs_all_cb, __FILE__);
6587 53           newXS("Func::Util::none_cb", xs_none_cb, __FILE__);
6588 53           newXS("Func::Util::first_cb", xs_first_cb, __FILE__);
6589 53           newXS("Func::Util::grep_cb", xs_grep_cb, __FILE__);
6590 53           newXS("Func::Util::count_cb", xs_count_cb, __FILE__);
6591 53           newXS("Func::Util::partition_cb", xs_partition_cb, __FILE__);
6592 53           newXS("Func::Util::final_cb", xs_final_cb, __FILE__);
6593 53           newXS("Func::Util::register_callback", xs_register_callback, __FILE__);
6594 53           newXS("Func::Util::has_callback", xs_has_callback, __FILE__);
6595 53           newXS("Func::Util::list_callbacks", xs_list_callbacks, __FILE__);
6596              
6597             /* Specialized array predicates - pure C, no callback */
6598 53           newXS("Func::Util::first_gt", xs_first_gt, __FILE__);
6599 53           newXS("Func::Util::first_lt", xs_first_lt, __FILE__);
6600 53           newXS("Func::Util::first_ge", xs_first_ge, __FILE__);
6601 53           newXS("Func::Util::first_le", xs_first_le, __FILE__);
6602 53           newXS("Func::Util::first_eq", xs_first_eq, __FILE__);
6603 53           newXS("Func::Util::first_ne", xs_first_ne, __FILE__);
6604 53           newXS("Func::Util::final", xs_final, __FILE__);
6605 53           newXS("Func::Util::final_gt", xs_final_gt, __FILE__);
6606 53           newXS("Func::Util::final_lt", xs_final_lt, __FILE__);
6607 53           newXS("Func::Util::final_ge", xs_final_ge, __FILE__);
6608 53           newXS("Func::Util::final_le", xs_final_le, __FILE__);
6609 53           newXS("Func::Util::final_eq", xs_final_eq, __FILE__);
6610 53           newXS("Func::Util::final_ne", xs_final_ne, __FILE__);
6611 53           newXS("Func::Util::any_gt", xs_any_gt, __FILE__);
6612 53           newXS("Func::Util::any_lt", xs_any_lt, __FILE__);
6613 53           newXS("Func::Util::any_ge", xs_any_ge, __FILE__);
6614 53           newXS("Func::Util::any_le", xs_any_le, __FILE__);
6615 53           newXS("Func::Util::any_eq", xs_any_eq, __FILE__);
6616 53           newXS("Func::Util::any_ne", xs_any_ne, __FILE__);
6617 53           newXS("Func::Util::all_gt", xs_all_gt, __FILE__);
6618 53           newXS("Func::Util::all_lt", xs_all_lt, __FILE__);
6619 53           newXS("Func::Util::all_ge", xs_all_ge, __FILE__);
6620 53           newXS("Func::Util::all_le", xs_all_le, __FILE__);
6621 53           newXS("Func::Util::all_eq", xs_all_eq, __FILE__);
6622 53           newXS("Func::Util::all_ne", xs_all_ne, __FILE__);
6623 53           newXS("Func::Util::none_gt", xs_none_gt, __FILE__);
6624 53           newXS("Func::Util::none_lt", xs_none_lt, __FILE__);
6625 53           newXS("Func::Util::none_ge", xs_none_ge, __FILE__);
6626 53           newXS("Func::Util::none_le", xs_none_le, __FILE__);
6627 53           newXS("Func::Util::none_eq", xs_none_eq, __FILE__);
6628 53           newXS("Func::Util::none_ne", xs_none_ne, __FILE__);
6629              
6630             /* Functional combinators */
6631 53           newXS("Func::Util::negate", xs_negate, __FILE__);
6632 53           newXS("Func::Util::once", xs_once, __FILE__);
6633 53           newXS("Func::Util::partial", xs_partial, __FILE__);
6634              
6635             /* Data extraction */
6636 53           newXS("Func::Util::pick", xs_pick, __FILE__);
6637 53           newXS("Func::Util::pluck", xs_pluck, __FILE__);
6638 53           newXS("Func::Util::omit", xs_omit, __FILE__);
6639 53           newXS("Func::Util::uniq", xs_uniq, __FILE__);
6640 53           newXS("Func::Util::partition", xs_partition, __FILE__);
6641 53           newXS("Func::Util::defaults", xs_defaults, __FILE__);
6642              
6643             /* Type predicates with call checkers */
6644             {
6645 53           CV *cv = newXS("Func::Util::is_ref", xs_is_ref, __FILE__);
6646 53           cv_set_call_checker(cv, is_ref_call_checker, (SV*)cv);
6647             }
6648             {
6649 53           CV *cv = newXS("Func::Util::is_array", xs_is_array, __FILE__);
6650 53           cv_set_call_checker(cv, is_array_call_checker, (SV*)cv);
6651             }
6652             {
6653 53           CV *cv = newXS("Func::Util::is_hash", xs_is_hash, __FILE__);
6654 53           cv_set_call_checker(cv, is_hash_call_checker, (SV*)cv);
6655             }
6656             {
6657 53           CV *cv = newXS("Func::Util::is_code", xs_is_code, __FILE__);
6658 53           cv_set_call_checker(cv, is_code_call_checker, (SV*)cv);
6659             }
6660             {
6661 53           CV *cv = newXS("Func::Util::is_defined", xs_is_defined, __FILE__);
6662 53           cv_set_call_checker(cv, is_defined_call_checker, (SV*)cv);
6663             }
6664              
6665             /* String predicates with call checkers */
6666             {
6667 53           CV *cv = newXS("Func::Util::is_empty", xs_is_empty, __FILE__);
6668 53           cv_set_call_checker(cv, is_empty_call_checker, (SV*)cv);
6669             }
6670             {
6671 53           CV *cv = newXS("Func::Util::starts_with", xs_starts_with, __FILE__);
6672 53           cv_set_call_checker(cv, starts_with_call_checker, (SV*)cv);
6673             }
6674             {
6675 53           CV *cv = newXS("Func::Util::ends_with", xs_ends_with, __FILE__);
6676 53           cv_set_call_checker(cv, ends_with_call_checker, (SV*)cv);
6677             }
6678 53           newXS("Func::Util::count", xs_count, __FILE__);
6679 53           newXS("Func::Util::replace_all", xs_replace_all, __FILE__);
6680              
6681             /* Boolean/Truthiness predicates with call checkers */
6682             {
6683 53           CV *cv = newXS("Func::Util::is_true", xs_is_true, __FILE__);
6684 53           cv_set_call_checker(cv, is_true_call_checker, (SV*)cv);
6685             }
6686             {
6687 53           CV *cv = newXS("Func::Util::is_false", xs_is_false, __FILE__);
6688 53           cv_set_call_checker(cv, is_false_call_checker, (SV*)cv);
6689             }
6690             {
6691 53           CV *cv = newXS("Func::Util::bool", xs_bool, __FILE__);
6692 53           cv_set_call_checker(cv, bool_call_checker, (SV*)cv);
6693             }
6694              
6695             /* Extended type predicates with call checkers */
6696             {
6697 53           CV *cv = newXS("Func::Util::is_num", xs_is_num, __FILE__);
6698 53           cv_set_call_checker(cv, is_num_call_checker, (SV*)cv);
6699             }
6700             {
6701 53           CV *cv = newXS("Func::Util::is_int", xs_is_int, __FILE__);
6702 53           cv_set_call_checker(cv, is_int_call_checker, (SV*)cv);
6703             }
6704             {
6705 53           CV *cv = newXS("Func::Util::is_blessed", xs_is_blessed, __FILE__);
6706 53           cv_set_call_checker(cv, is_blessed_call_checker, (SV*)cv);
6707             }
6708             {
6709 53           CV *cv = newXS("Func::Util::is_scalar_ref", xs_is_scalar_ref, __FILE__);
6710 53           cv_set_call_checker(cv, is_scalar_ref_call_checker, (SV*)cv);
6711             }
6712             {
6713 53           CV *cv = newXS("Func::Util::is_regex", xs_is_regex, __FILE__);
6714 53           cv_set_call_checker(cv, is_regex_call_checker, (SV*)cv);
6715             }
6716             {
6717 53           CV *cv = newXS("Func::Util::is_glob", xs_is_glob, __FILE__);
6718 53           cv_set_call_checker(cv, is_glob_call_checker, (SV*)cv);
6719             }
6720              
6721             /* Numeric predicates with call checkers */
6722             {
6723 53           CV *cv = newXS("Func::Util::is_positive", xs_is_positive, __FILE__);
6724 53           cv_set_call_checker(cv, is_positive_call_checker, (SV*)cv);
6725             }
6726             {
6727 53           CV *cv = newXS("Func::Util::is_negative", xs_is_negative, __FILE__);
6728 53           cv_set_call_checker(cv, is_negative_call_checker, (SV*)cv);
6729             }
6730             {
6731 53           CV *cv = newXS("Func::Util::is_zero", xs_is_zero, __FILE__);
6732 53           cv_set_call_checker(cv, is_zero_call_checker, (SV*)cv);
6733             }
6734              
6735             /* Numeric utility ops with call checkers */
6736             {
6737 53           CV *cv = newXS("Func::Util::is_even", xs_is_even, __FILE__);
6738 53           cv_set_call_checker(cv, is_even_call_checker, (SV*)cv);
6739             }
6740             {
6741 53           CV *cv = newXS("Func::Util::is_odd", xs_is_odd, __FILE__);
6742 53           cv_set_call_checker(cv, is_odd_call_checker, (SV*)cv);
6743             }
6744             {
6745 53           CV *cv = newXS("Func::Util::is_between", xs_is_between, __FILE__);
6746 53           cv_set_call_checker(cv, is_between_call_checker, (SV*)cv);
6747             }
6748              
6749             /* Collection ops with call checkers */
6750             {
6751 53           CV *cv = newXS("Func::Util::is_empty_array", xs_is_empty_array, __FILE__);
6752 53           cv_set_call_checker(cv, is_empty_array_call_checker, (SV*)cv);
6753             }
6754             {
6755 53           CV *cv = newXS("Func::Util::is_empty_hash", xs_is_empty_hash, __FILE__);
6756 53           cv_set_call_checker(cv, is_empty_hash_call_checker, (SV*)cv);
6757             }
6758             {
6759 53           CV *cv = newXS("Func::Util::array_len", xs_array_len, __FILE__);
6760 53           cv_set_call_checker(cv, array_len_call_checker, (SV*)cv);
6761             }
6762             {
6763 53           CV *cv = newXS("Func::Util::hash_size", xs_hash_size, __FILE__);
6764 53           cv_set_call_checker(cv, hash_size_call_checker, (SV*)cv);
6765             }
6766             {
6767 53           CV *cv = newXS("Func::Util::array_first", xs_array_first, __FILE__);
6768 53           cv_set_call_checker(cv, array_first_call_checker, (SV*)cv);
6769             }
6770             {
6771 53           CV *cv = newXS("Func::Util::array_last", xs_array_last, __FILE__);
6772 53           cv_set_call_checker(cv, array_last_call_checker, (SV*)cv);
6773             }
6774              
6775             /* String manipulation ops with call checkers */
6776             {
6777 53           CV *cv = newXS("Func::Util::trim", xs_trim, __FILE__);
6778 53           cv_set_call_checker(cv, trim_call_checker, (SV*)cv);
6779             }
6780             {
6781 53           CV *cv = newXS("Func::Util::ltrim", xs_ltrim, __FILE__);
6782 53           cv_set_call_checker(cv, ltrim_call_checker, (SV*)cv);
6783             }
6784             {
6785 53           CV *cv = newXS("Func::Util::rtrim", xs_rtrim, __FILE__);
6786 53           cv_set_call_checker(cv, rtrim_call_checker, (SV*)cv);
6787             }
6788              
6789             /* Conditional ops with call checkers */
6790             {
6791 53           CV *cv = newXS("Func::Util::maybe", xs_maybe, __FILE__);
6792 53           cv_set_call_checker(cv, maybe_call_checker, (SV*)cv);
6793             }
6794              
6795             /* Numeric ops with call checkers */
6796             {
6797 53           CV *cv = newXS("Func::Util::sign", xs_sign, __FILE__);
6798 53           cv_set_call_checker(cv, sign_call_checker, (SV*)cv);
6799             }
6800             {
6801 53           CV *cv = newXS("Func::Util::min2", xs_min2, __FILE__);
6802 53           cv_set_call_checker(cv, min2_call_checker, (SV*)cv);
6803             }
6804             {
6805 53           CV *cv = newXS("Func::Util::max2", xs_max2, __FILE__);
6806 53           cv_set_call_checker(cv, max2_call_checker, (SV*)cv);
6807             }
6808              
6809             /* Register cleanup for global destruction */
6810 53           Perl_call_atexit(aTHX_ cleanup_callback_registry, NULL);
6811              
6812 53           Perl_xs_boot_epilog(aTHX_ ax);
6813 53           }