#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "include/object_compat.h"

/* Object flags - stored in mg_private */
#define OBJ_FLAG_LOCKED  0x01
#define OBJ_FLAG_FROZEN  0x02

/* Built-in type IDs for inline checks */
typedef enum {
    TYPE_NONE = 0,
    TYPE_ANY,
    TYPE_DEFINED,
    TYPE_STR,
    TYPE_INT,
    TYPE_NUM,
    TYPE_BOOL,
    TYPE_ARRAYREF,
    TYPE_HASHREF,
    TYPE_CODEREF,
    TYPE_OBJECT,
    TYPE_CUSTOM       /* Uses registered or callback check */
} BuiltinTypeID;

/* Type check/coerce function signatures for external plugins */
typedef bool (*ObjectTypeCheckFunc)(pTHX_ SV *val);
typedef SV*  (*ObjectTypeCoerceFunc)(pTHX_ SV *val);

/* Registered type entry (for plugins) */
typedef struct {
    char *name;
    ObjectTypeCheckFunc check;      /* C function for type check */
    ObjectTypeCoerceFunc coerce;    /* C function for coercion */
    SV *perl_check;                 /* Fallback Perl callback */
    SV *perl_coerce;                /* Fallback Perl coercion */
} RegisteredType;

/* Per-slot specification - parsed from "name:Type:default(val)" */
typedef struct {
    char *name;
    BuiltinTypeID type_id;          /* Built-in type or TYPE_CUSTOM */
    RegisteredType *registered;     /* For external XS types */
    SV *default_sv;                 /* Default value (immutable, refcnt'd) */
    SV *trigger_cb;                 /* Trigger callback */
    SV *coerce_cb;                  /* Coercion callback (Perl) */
    SV *builder_name;               /* Builder method name for lazy attrs */
    U8 is_required;                 /* Croak if not provided in new() */
    U8 is_readonly;                 /* Croak if set after new() */
    U8 is_lazy;                     /* Build on first access, not at new() */
    U8 has_default;
    U8 has_trigger;
    U8 has_coerce;
    U8 has_type;
    U8 has_builder;                 /* Has builder method */
    U8 has_clearer;                 /* Generate clear_X method */
    U8 has_predicate;               /* Generate has_X method */
} SlotSpec;

/* Custom op definitions */
static XOP object_new_xop;
static XOP object_get_xop;
static XOP object_set_xop;
static XOP object_set_typed_xop;

/* Per-class metadata */
typedef struct ClassMeta_s ClassMeta;  /* Forward declaration */

/* Method modifier chain - linked list for each type */
typedef struct MethodModifier_s {
    SV *callback;
    struct MethodModifier_s *next;
} MethodModifier;

/* Modified method wrapper */
typedef struct {
    CV *original_cv;
    MethodModifier *before_chain;
    MethodModifier *after_chain;
    MethodModifier *around_chain;
} ModifiedMethod;

/* Role metadata */
typedef struct {
    char *role_name;
    char **required_methods;   /* Methods consuming class MUST have */
    IV required_count;
    SlotSpec **slots;          /* Slots the role provides */
    IV slot_count;
    HV *stash;                 /* Role's stash for provided methods */
} RoleMeta;

/* Per-class metadata */
struct ClassMeta_s {
    char *class_name;
    HV *prop_to_idx;      /* property name -> slot index */
    char **idx_to_prop;   /* slot index -> property name */
    IV slot_count;
    HV *stash;            /* cached stash pointer */
    /* Type system extensions */
    SlotSpec **slots;     /* Per-slot specifications, NULL if no specs */
    U8 has_any_types;     /* Quick check: any slot has type checking? */
    U8 has_any_defaults;  /* Quick check: any slot has defaults? */
    U8 has_any_triggers;  /* Quick check: any slot has triggers? */
    U8 has_any_required;  /* Quick check: any slot is required? */
    U8 has_any_lazy;      /* Quick check: any slot is lazy? */
    /* Singleton support */
    SV *singleton_instance;  /* Cached singleton instance, NULL if not a singleton */
    U8 is_singleton;         /* Flag: class is a singleton */
    /* DEMOLISH support - only set if class has DEMOLISH method */
    CV *demolish_cv;         /* Cached DEMOLISH method, NULL if none */
    /* Role support */
    RoleMeta **consumed_roles;  /* Array of consumed roles, NULL if none */
    IV role_count;
    /* Method modifier registry - only allocated if modifiers are used */
    HV *modified_methods;    /* method name -> ModifiedMethod*, NULL if none */
};

/* Global class registry */
static HV *g_class_registry = NULL;  /* class name -> ClassMeta* */

/* Global type registry for external plugins */
static HV *g_type_registry = NULL;   /* type name -> RegisteredType* */

/* Global role registry */
static HV *g_role_registry = NULL;   /* role name -> RoleMeta* */

/* Forward declaration for FuncAccessorData */
typedef struct FuncAccessorData_s FuncAccessorData;

/* Global registry for function accessor data (to avoid storing pointers in op_targ) */
static FuncAccessorData **g_func_accessor_registry = NULL;
static IV g_func_accessor_count = 0;
static IV g_func_accessor_capacity = 0;

/* Forward declarations */
static ClassMeta* get_class_meta(pTHX_ const char *class_name, STRLEN len);
static void install_constructor(pTHX_ const char *class_name, ClassMeta *meta);
static void install_accessor(pTHX_ const char *class_name, const char *prop_name, IV idx);
static void install_accessor_typed(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta);
static void install_clearer(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta);
static void install_predicate(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta);
static void install_destroy_wrapper(pTHX_ const char *class_name, ClassMeta *meta);
static RoleMeta* get_role_meta(pTHX_ const char *role_name, STRLEN len);

/* ============================================
   Built-in type checking (inline)
   ============================================ */

OBJECT_INLINE BuiltinTypeID parse_builtin_type(const char *type_str, STRLEN len) {
    if (len == 3 && strEQ(type_str, "Str")) return TYPE_STR;
    if (len == 3 && strEQ(type_str, "Int")) return TYPE_INT;
    if (len == 3 && strEQ(type_str, "Num")) return TYPE_NUM;
    if (len == 3 && strEQ(type_str, "Any")) return TYPE_ANY;
    if (len == 4 && strEQ(type_str, "Bool")) return TYPE_BOOL;
    if (len == 6 && strEQ(type_str, "Object")) return TYPE_OBJECT;
    if (len == 7 && strEQ(type_str, "Defined")) return TYPE_DEFINED;
    if (len == 7 && strEQ(type_str, "CodeRef")) return TYPE_CODEREF;
    if (len == 7 && strEQ(type_str, "HashRef")) return TYPE_HASHREF;
    if (len == 8 && strEQ(type_str, "ArrayRef")) return TYPE_ARRAYREF;
    return TYPE_NONE;  /* Unknown - could be custom */
}

/* Inline type check - returns true if value passes check */
OBJECT_INLINE bool check_builtin_type(pTHX_ SV *val, BuiltinTypeID type_id) {
    switch (type_id) {
        case TYPE_ANY:
            return true;
        case TYPE_DEFINED:
            /* SvOK checks if defined, but be defensive for older Perls */
            /* where constant 0 might have edge cases */
            return SvOK(val) || SvIOK(val) || SvNOK(val) || SvPOK(val);
        case TYPE_STR:
            return SvOK(val) && !SvROK(val);  /* defined non-ref */
        case TYPE_INT:
            if (SvIOK(val)) return true;
            if (SvPOK(val)) {
                /* String that looks like integer */
                STRLEN len;
                const char *pv;
                const char *p;

                pv = SvPV(val, len);
                if (len == 0) return false;
                p = pv;
                if (*p == '-' || *p == '+') p++;
                while (*p && *p >= '0' && *p <= '9') p++;
                return p == pv + len;
            }
            return false;
        case TYPE_NUM:
            return SvNIOK(val) || (SvPOK(val) && looks_like_number(val));
        case TYPE_BOOL:
            /* Accept 0, 1, "", or boolean SVs */
            if (SvIOK(val)) {
                IV iv = SvIV(val);
                return iv == 0 || iv == 1;
            }
            return SvTRUE(val) || !SvOK(val) || (SvPOK(val) && SvCUR(val) == 0);
        case TYPE_ARRAYREF:
            return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV;
        case TYPE_HASHREF:
            return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV;
        case TYPE_CODEREF:
            return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV;
        case TYPE_OBJECT:
            return SvROK(val) && sv_isobject(val);
        default:
            return true;  /* No check or unknown */
    }
}

/* Get type name for error messages */
static const char* type_id_to_name(BuiltinTypeID type_id) {
    switch (type_id) {
        case TYPE_ANY: return "Any";
        case TYPE_DEFINED: return "Defined";
        case TYPE_STR: return "Str";
        case TYPE_INT: return "Int";
        case TYPE_NUM: return "Num";
        case TYPE_BOOL: return "Bool";
        case TYPE_ARRAYREF: return "ArrayRef";
        case TYPE_HASHREF: return "HashRef";
        case TYPE_CODEREF: return "CodeRef";
        case TYPE_OBJECT: return "Object";
        case TYPE_CUSTOM: return "custom";
        default: return "unknown";
    }
}

/* Check a value against a slot's type constraint (handles both C and Perl callbacks) */
static bool check_slot_type(pTHX_ SV *val, SlotSpec *spec) {
    if (!spec || !spec->has_type) return true;
    
    if (spec->type_id != TYPE_CUSTOM) {
        return check_builtin_type(aTHX_ val, spec->type_id);
    }
    
    if (!spec->registered) return true;
    
    /* Try C function first (fast path - ~5 cycles) */
    if (spec->registered->check) {
        return spec->registered->check(aTHX_ val);
    }
    
    /* Fall back to Perl callback (~100 cycles) */
    if (spec->registered->perl_check) {
        dSP;
        int count;
        bool result = false;
        SV *result_sv;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(val);
        PUTBACK;
        count = call_sv(spec->registered->perl_check, G_SCALAR);
        SPAGAIN;
        if (count > 0) {
            result_sv = POPs;
            result = SvTRUE(result_sv);
        }
        PUTBACK;
        FREETMPS;
        LEAVE;
        return result;
    }
    
    return true;
}

/* ============================================
   Slot spec parser: "name:Type:default(val)"
   ============================================ */

static SlotSpec* parse_slot_spec(pTHX_ const char *spec_str, STRLEN len) {
    SlotSpec *spec;
    const char *p = spec_str;
    const char *end = spec_str + len;
    const char *name_start, *name_end;
    STRLEN name_len;

    Newxz(spec, 1, SlotSpec);

    /* Parse property name (before first ':') */
    name_start = p;
    while (p < end && *p != ':') p++;
    name_end = p;

    name_len = name_end - name_start;
    Newx(spec->name, name_len + 1, char);
    Copy(name_start, spec->name, name_len, char);
    spec->name[name_len] = '\0';
    
    /* Parse modifiers after name */
    while (p < end) {
        const char *mod_start;
        const char *arg_start;
        const char *arg_end;
        STRLEN mod_len;
        STRLEN arg_len;
        int paren_depth;

        if (*p == ':') p++;  /* Skip separator */
        if (p >= end) break;

        mod_start = p;

        /* Check for function-style modifiers: default(...), trigger(...) */
        while (p < end && *p != ':' && *p != '(') p++;

        mod_len = p - mod_start;

        if (p < end && *p == '(') {
            /* Function-style: default(value) or trigger(&callback) */
            p++;
            arg_start = p;
            paren_depth = 1;
            while (p < end && paren_depth > 0) {
                if (*p == '(') paren_depth++;
                else if (*p == ')') paren_depth--;
                p++;
            }
            arg_end = p - 1;  /* Before closing paren */
            arg_len = arg_end - arg_start;
            
            if (mod_len == 7 && strncmp(mod_start, "default", 7) == 0) {
                /* Parse default value */
                spec->has_default = 1;
                /* Simple default: copy as string and eval at runtime */
                /* For now, support literal numbers and strings */
                if (arg_len > 0) {
                    char *arg_copy;
                    Newx(arg_copy, arg_len + 1, char);
                    Copy(arg_start, arg_copy, arg_len, char);
                    arg_copy[arg_len] = '\0';
                    
                    /* Try to parse as number */
                    if (arg_copy[0] >= '0' && arg_copy[0] <= '9') {
                        if (strchr(arg_copy, '.')) {
                            spec->default_sv = newSVnv(atof(arg_copy));
                        } else {
                            spec->default_sv = newSViv(atoi(arg_copy));
                        }
                    } else if (arg_copy[0] == '-' && arg_len > 1) {
                        if (strchr(arg_copy, '.')) {
                            spec->default_sv = newSVnv(atof(arg_copy));
                        } else {
                            spec->default_sv = newSViv(atoi(arg_copy));
                        }
                    } else if (arg_copy[0] == '\'' || arg_copy[0] == '"') {
                        /* String literal - strip quotes */
                        if (arg_len >= 2) {
                            spec->default_sv = newSVpvn(arg_copy + 1, arg_len - 2);
                        } else {
                            spec->default_sv = newSVpvn("", 0);
                        }
                    } else if (strncmp(arg_copy, "undef", 5) == 0) {
                        spec->default_sv = newSV(0);
                    } else if (strncmp(arg_copy, "[]", 2) == 0) {
                        spec->default_sv = newRV_noinc((SV*)newAV());
                    } else if (strncmp(arg_copy, "{}", 2) == 0) {
                        spec->default_sv = newRV_noinc((SV*)newHV());
                    } else {
                        /* Default to string */
                        spec->default_sv = newSVpvn(arg_copy, arg_len);
                    }
                    Safefree(arg_copy);
                }
            } else if (mod_len == 7 && strncmp(mod_start, "trigger", 7) == 0) {
                /* trigger(&callback) - store callback name for later resolution */
                spec->has_trigger = 1;
                /* Note: callback resolution happens at runtime in Perl layer */
                /* For now, store as string - will be resolved in object.pm */
                if (arg_len > 0) {
                    char *cb_copy;
                    Newx(cb_copy, arg_len + 1, char);
                    Copy(arg_start, cb_copy, arg_len, char);
                    cb_copy[arg_len] = '\0';
                    /* Store as SV for later resolution */
                    spec->trigger_cb = newSVpvn(cb_copy, arg_len);
                    Safefree(cb_copy);
                }
            } else if (mod_len == 6 && strncmp(mod_start, "coerce", 6) == 0) {
                /* coerce(&callback) */
                spec->has_coerce = 1;
                if (arg_len > 0) {
                    char *cb_copy;
                    Newx(cb_copy, arg_len + 1, char);
                    Copy(arg_start, cb_copy, arg_len, char);
                    cb_copy[arg_len] = '\0';
                    spec->coerce_cb = newSVpvn(cb_copy, arg_len);
                    Safefree(cb_copy);
                }
            } else if (mod_len == 7 && strncmp(mod_start, "builder", 7) == 0) {
                /* builder(method_name) - lazy builder method */
                spec->has_builder = 1;
                spec->is_lazy = 1;  /* builder implies lazy */
                if (arg_len > 0) {
                    char *cb_copy;
                    Newx(cb_copy, arg_len + 1, char);
                    Copy(arg_start, cb_copy, arg_len, char);
                    cb_copy[arg_len] = '\0';
                    spec->builder_name = newSVpvn(cb_copy, arg_len);
                    Safefree(cb_copy);
                } else {
                    /* Default builder name: _build_<property> */
                    char build_name[256];
                    snprintf(build_name, sizeof(build_name), "_build_%s", spec->name);
                    spec->builder_name = newSVpv(build_name, 0);
                }
            }
        } else {
            /* Simple modifier: type name or flag */
            if (mod_len == 8 && strncmp(mod_start, "required", 8) == 0) {
                spec->is_required = 1;
            } else if (mod_len == 8 && strncmp(mod_start, "readonly", 8) == 0) {
                spec->is_readonly = 1;
            } else if (mod_len == 4 && strncmp(mod_start, "lazy", 4) == 0) {
                spec->is_lazy = 1;
            } else if (mod_len == 7 && strncmp(mod_start, "clearer", 7) == 0) {
                spec->has_clearer = 1;
            } else if (mod_len == 9 && strncmp(mod_start, "predicate", 9) == 0) {
                spec->has_predicate = 1;
            } else {
                /* Try as type name */
                char *type_copy;
                BuiltinTypeID type_id;

                Newx(type_copy, mod_len + 1, char);
                Copy(mod_start, type_copy, mod_len, char);
                type_copy[mod_len] = '\0';

                type_id = parse_builtin_type(type_copy, mod_len);
                if (type_id != TYPE_NONE) {
                    spec->type_id = type_id;
                    spec->has_type = 1;
                } else {
                    /* Check type registry for custom types */
                    if (g_type_registry) {
                        SV **svp = hv_fetch(g_type_registry, type_copy, mod_len, 0);
                        if (svp) {
                            spec->registered = INT2PTR(RegisteredType*, SvIV(*svp));
                            spec->type_id = TYPE_CUSTOM;
                            spec->has_type = 1;
                        }
                    }
                }
                Safefree(type_copy);
            }
        }
    }
    
    return spec;
}

/* Magic vtable for object flags */
static MGVTBL object_magic_vtbl = {
    NULL,  /* get */
    NULL,  /* set */
    NULL,  /* len */
    NULL,  /* clear */
    NULL,  /* free */
    NULL,  /* copy */
    NULL,  /* dup */
    NULL   /* local */
};

/* Get object magic (for flags) */
static MAGIC* get_object_magic(pTHX_ SV *obj) {
    MAGIC *mg;
    if (!SvROK(obj)) return NULL;
    mg = mg_find(SvRV(obj), PERL_MAGIC_ext);
    while (mg) {
        if (mg->mg_virtual == &object_magic_vtbl) return mg;
        mg = mg->mg_moremagic;
    }
    return NULL;
}

/* Add object magic */
static MAGIC* add_object_magic(pTHX_ SV *obj) {
    MAGIC *mg;
    SV *rv = SvRV(obj);
    mg = sv_magicext(rv, NULL, PERL_MAGIC_ext, &object_magic_vtbl, NULL, 0);
    mg->mg_private = 0;  /* flags */
    return mg;
}

/* ============================================
   Class definition and registration
   ============================================ */

static ClassMeta* create_class_meta(pTHX_ const char *class_name, STRLEN len) {
    ClassMeta *meta;
    Newxz(meta, 1, ClassMeta);
    Newxz(meta->class_name, len + 1, char);
    Copy(class_name, meta->class_name, len, char);
    meta->class_name[len] = '\0';
    meta->prop_to_idx = newHV();
    meta->idx_to_prop = NULL;
    meta->slot_count = 1;  /* slot 0 reserved for prototype */
    meta->stash = gv_stashpvn(class_name, len, GV_ADD);
    return meta;
}

static ClassMeta* get_class_meta(pTHX_ const char *class_name, STRLEN len) {
    SV **svp;
    if (!g_class_registry) return NULL;
    svp = hv_fetch(g_class_registry, class_name, len, 0);
    if (svp && SvIOK(*svp)) {
        return INT2PTR(ClassMeta*, SvIV(*svp));
    }
    return NULL;
}

static void register_class_meta(pTHX_ const char *class_name, STRLEN len, ClassMeta *meta) {
    if (!g_class_registry) {
        g_class_registry = newHV();
    }
    hv_store(g_class_registry, class_name, len, newSViv(PTR2IV(meta)), 0);
}

/* ============================================
   Custom OP: object constructor
   ============================================ */

/* pp_object_new - create new object, class info in op_targ, args on stack */
static OP* pp_object_new(pTHX) {
    dSP; dMARK;
    IV items = SP - MARK;
    ClassMeta *meta = INT2PTR(ClassMeta*, PL_op->op_targ);
    AV *obj_av;
    SV *obj_sv;
    IV i;
    U32 is_named = PL_op->op_private;  /* 1 = named pairs, 0 = positional */

    /* Create array with pre-extended size */
    obj_av = newAV();
    av_extend(obj_av, meta->slot_count - 1);

    /* Slot 0 = prototype (initially undef) */
    av_store(obj_av, 0, &PL_sv_undef);

    if (is_named) {
        /* Named pairs: name => value, name => value */
        for (i = 0; i < items; i += 2) {
            SV *key_sv = MARK[i + 1];
            SV *val_sv = (i + 1 < items) ? MARK[i + 2] : &PL_sv_undef;
            STRLEN key_len;
            const char *key = SvPV(key_sv, key_len);
            SV **idx_svp = hv_fetch(meta->prop_to_idx, key, key_len, 0);
            if (idx_svp && SvIOK(*idx_svp)) {
                IV idx = SvIV(*idx_svp);
                
                /* Type check on construction if slot has type */
                if (meta->slots && meta->slots[idx] && meta->slots[idx]->has_type) {
                    SlotSpec *spec = meta->slots[idx];
                    if (spec->type_id != TYPE_CUSTOM) {
                        if (!check_builtin_type(aTHX_ val_sv, spec->type_id)) {
                            croak("Type constraint failed for '%s' in new(): expected %s",
                                  spec->name, type_id_to_name(spec->type_id));
                        }
                    } else if (spec->registered && spec->registered->check) {
                        if (!spec->registered->check(aTHX_ val_sv)) {
                            croak("Type constraint failed for '%s' in new(): expected %s",
                                  spec->name, spec->registered->name);
                        }
                    }
                }
                av_store(obj_av, idx, newSVsv(val_sv));
            }
        }
    } else {
        /* Positional: value, value, value */
        for (i = 0; i < items && i < meta->slot_count - 1; i++) {
            IV idx = i + 1;
            SV *val_sv = MARK[i + 1];
            
            /* Type check on construction if slot has type */
            if (meta->slots && meta->slots[idx] && meta->slots[idx]->has_type) {
                SlotSpec *spec = meta->slots[idx];
                if (spec->type_id != TYPE_CUSTOM) {
                    if (!check_builtin_type(aTHX_ val_sv, spec->type_id)) {
                        croak("Type constraint failed for '%s' in new(): expected %s",
                              spec->name, type_id_to_name(spec->type_id));
                    }
                } else if (spec->registered && spec->registered->check) {
                    if (!spec->registered->check(aTHX_ val_sv)) {
                        croak("Type constraint failed for '%s' in new(): expected %s",
                              spec->name, spec->registered->name);
                    }
                }
            }
            av_store(obj_av, idx, newSVsv(val_sv));
        }
    }

    /* Fill unset slots with defaults or undef, check required */
    for (i = 1; i < meta->slot_count; i++) {
        SV **existing = av_fetch(obj_av, i, 0);
        if (!existing || !SvOK(*existing)) {
            SlotSpec *spec = (meta->slots) ? meta->slots[i] : NULL;
            
            if (spec && spec->is_required) {
                croak("Required slot '%s' not provided in new()", spec->name);
            }
            
            if (spec && spec->has_default && spec->default_sv) {
                /* Clone the default value (in case it's a reference) */
                if (SvROK(spec->default_sv)) {
                    /* For refs, create fresh copy each time */
                    if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVAV) {
                        av_store(obj_av, i, newRV_noinc((SV*)newAV()));
                    } else if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVHV) {
                        av_store(obj_av, i, newRV_noinc((SV*)newHV()));
                    } else {
                        av_store(obj_av, i, newSVsv(spec->default_sv));
                    }
                } else {
                    av_store(obj_av, i, newSVsv(spec->default_sv));
                }
            } else {
                av_store(obj_av, i, newSV(0));
            }
        }
    }

    /* Create blessed reference */
    obj_sv = newRV_noinc((SV*)obj_av);
    sv_bless(obj_sv, meta->stash);

    /* Magic for lock/freeze is added lazily when first needed */

    SP = MARK;
    XPUSHs(obj_sv);
    PUTBACK;
    return NORMAL;
}

/* ============================================
   Prototype chain resolution
   ============================================ */

#define MAX_PROTOTYPE_DEPTH 100

/* Resolve a property through the full prototype chain.
 * Returns the value if found, or &PL_sv_undef if not.
 * Detects circular references using depth limit and pointer tracking.
 */
static SV* resolve_property_chain(pTHX_ AV *av, IV idx) {
    int depth = 0;
    AV *visited[MAX_PROTOTYPE_DEPTH];  /* Simple stack-based cycle detection */
    int i;

    while (av && depth < MAX_PROTOTYPE_DEPTH) {
        SV **svp;

        /* Check for circular reference */
        for (i = 0; i < depth; i++) {
            if (visited[i] == av) {
                warn("Circular prototype reference detected");
                return &PL_sv_undef;
            }
        }
        visited[depth] = av;

        /* Try to fetch the property at this level */
        svp = av_fetch(av, idx, 0);
        if (svp && SvOK(*svp)) {
            return *svp;
        }

        /* Follow prototype chain (slot 0) */
        svp = av_fetch(av, 0, 0);
        if (!svp || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVAV) {
            break;
        }
        av = (AV*)SvRV(*svp);
        depth++;
    }

    if (depth >= MAX_PROTOTYPE_DEPTH) {
        warn("Prototype chain too deep (max %d levels)", MAX_PROTOTYPE_DEPTH);
    }

    return &PL_sv_undef;
}

/* ============================================
   Custom OP: property accessor (get)
   ============================================ */

static OP* pp_object_get(pTHX) {
    dSP;
    SV *obj = TOPs;
    IV idx = PL_op->op_targ;
    AV *av;
    SV *result;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }

    av = (AV*)SvRV(obj);
    result = resolve_property_chain(aTHX_ av, idx);
    SETs(result);
    RETURN;
}

/* ============================================
   Custom OP: property accessor (set)
   ============================================ */

static OP* pp_object_set(pTHX) {
    dSP;
    SV *val = POPs;
    SV *obj = TOPs;
    IV idx = PL_op->op_targ;
    AV *av;
    MAGIC *mg;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }

    av = (AV*)SvRV(obj);

    /* Check frozen/locked */
    mg = get_object_magic(aTHX_ obj);
    if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
        croak("Cannot modify frozen object");
    }

    av_store(av, idx, newSVsv(val));
    SETs(val);
    RETURN;
}

/* ============================================
   Custom OP: property accessor (set) with type check
   Uses op_private to store type ID for inline check
   ============================================ */

/* Helper struct to pass both idx and meta through op */
typedef struct {
    IV slot_idx;
    ClassMeta *meta;
} SlotOpData;

/* Helper struct for function-style accessors (cross-class support) */
struct FuncAccessorData_s {
    IV slot_idx;
    ClassMeta *expected_class;  /* Class this accessor expects */
    IV registry_id;             /* ID in g_func_accessor_registry */
};

/* Register a FuncAccessorData and return its ID */
static IV register_func_accessor_data(pTHX_ FuncAccessorData *data) {
    if (g_func_accessor_count >= g_func_accessor_capacity) {
        IV new_capacity = g_func_accessor_capacity ? g_func_accessor_capacity * 2 : 64;
        Renew(g_func_accessor_registry, new_capacity, FuncAccessorData*);
        g_func_accessor_capacity = new_capacity;
    }
    data->registry_id = g_func_accessor_count;
    g_func_accessor_registry[g_func_accessor_count] = data;
    return g_func_accessor_count++;
}

/* Look up FuncAccessorData by ID */
static FuncAccessorData* get_func_accessor_data(IV id) {
    if (id < 0 || id >= g_func_accessor_count) return NULL;
    return g_func_accessor_registry[id];
}

static OP* pp_object_set_typed(pTHX) {
    dSP;
    SV *val = POPs;
    SV *obj = TOPs;
    SlotOpData *data = INT2PTR(SlotOpData*, PL_op->op_targ);
    IV idx = data->slot_idx;
    ClassMeta *meta = data->meta;
    SlotSpec *spec = meta->slots[idx];
    AV *av;
    MAGIC *mg;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }

    av = (AV*)SvRV(obj);

    /* Check frozen/locked */
    mg = get_object_magic(aTHX_ obj);
    if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
        croak("Cannot modify frozen object");
    }

    /* Readonly check */
    if (spec->is_readonly) {
        croak("Cannot modify readonly slot '%s'", spec->name);
    }

    /* Coercion (if callback exists) */
    if (spec->has_coerce && spec->coerce_cb) {
        dSP;
        PUSHMARK(SP);
        XPUSHs(val);
        PUTBACK;
        call_sv(spec->coerce_cb, G_SCALAR);
        SPAGAIN;
        val = POPs;
        PUTBACK;
    }

    /* External XS type coercion (C function - fast path) */
    if (spec->type_id == TYPE_CUSTOM && spec->registered && spec->registered->coerce) {
        val = spec->registered->coerce(aTHX_ val);
    }

    /* Type check using helper (handles both C and Perl callbacks) */
    if (spec->has_type) {
        if (!check_slot_type(aTHX_ val, spec)) {
            const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
                ? spec->registered->name
                : type_id_to_name(spec->type_id);
            croak("Type constraint failed for '%s': expected %s",
                  spec->name, type_name);
        }
    }

    /* Trigger callback (old, new) */
    if (spec->has_trigger && spec->trigger_cb) {
        SV *oldval = *av_fetch(av, idx, 0);
        dSP;
        PUSHMARK(SP);
        XPUSHs(obj);
        XPUSHs(oldval);
        XPUSHs(val);
        PUTBACK;
        call_sv(spec->trigger_cb, G_DISCARD);
    }

    av_store(av, idx, newSVsv(val));
    SETs(val);
    RETURN;
}

/* ============================================
   Call checker for accessor
   ============================================ */

static OP* accessor_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
    IV idx = SvIV(ckobj);
    OP *pushop, *cvop, *selfop, *argop;
    OP *newop;

    PERL_UNUSED_ARG(namegv);

    pushop = cUNOPx(entersubop)->op_first;
    if (!OpHAS_SIBLING(pushop)) {
        pushop = cUNOPx(pushop)->op_first;
    }

    selfop = OpSIBLING(pushop);
    cvop = selfop;
    argop = selfop;
    while (OpHAS_SIBLING(cvop)) {
        argop = cvop;
        cvop = OpSIBLING(cvop);
    }

    /* Check if there's an argument after self (setter call) */
    if (argop != selfop) {
        /* Setter: $obj->name($value) */
        OP *valop = OpSIBLING(selfop);
        
        /* Detach self and val */
        OpMORESIB_set(pushop, cvop);
        OpLASTSIB_set(valop, NULL);
        OpLASTSIB_set(selfop, NULL);
        
        /* Create binop with self and val */
        newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
        newop->op_ppaddr = pp_object_set;
        newop->op_targ = idx;
        
        op_free(entersubop);
        return newop;
    } else {
        /* Getter: $obj->name */
        OpMORESIB_set(pushop, cvop);
        OpLASTSIB_set(selfop, NULL);
        
        newop = newUNOP(OP_CUSTOM, 0, selfop);
        newop->op_ppaddr = pp_object_get;
        newop->op_targ = idx;
        
        op_free(entersubop);
        return newop;
    }
}

/* ============================================
   XS Fallback functions
   ============================================ */

/* XS fallback for new (when call checker can't optimize) */
static XS(xs_object_new_fallback) {
    dXSARGS;
    ClassMeta *meta = INT2PTR(ClassMeta*, CvXSUBANY(cv).any_iv);
    AV *obj_av;
    SV *obj_sv;
    IV i;
    IV start_arg = 0;
    IV arg_count;
    int is_named = 0;

    /* Skip class name if passed as invocant (Cat->new or new Cat) */
    if (items > 0 && SvPOK(ST(0)) && !SvROK(ST(0))) {
        STRLEN len;
        const char *pv = SvPV(ST(0), len);
        if (strEQ(pv, meta->class_name)) {
            start_arg = 1;
        }
    }

    arg_count = items - start_arg;

    /* Detect named pairs: even count and first arg is a known property name */
    if (arg_count > 0 && (arg_count % 2) == 0 && SvPOK(ST(start_arg))) {
        STRLEN len;
        const char *pv = SvPV(ST(start_arg), len);
        if (hv_exists(meta->prop_to_idx, pv, len)) {
            is_named = 1;
        }
    }

    obj_av = newAV();
    av_extend(obj_av, meta->slot_count - 1);
    av_store(obj_av, 0, &PL_sv_undef);

    if (is_named) {
        /* Named pairs: name => value, name => value */
        for (i = start_arg; i < items; i += 2) {
            SV *key_sv = ST(i);
            SV *val_sv = (i + 1 < items) ? ST(i + 1) : &PL_sv_undef;
            STRLEN key_len;
            const char *key = SvPV(key_sv, key_len);
            SV **idx_svp = hv_fetch(meta->prop_to_idx, key, key_len, 0);
            if (idx_svp && SvIOK(*idx_svp)) {
                IV idx = SvIV(*idx_svp);
                
                /* Type check on construction if slot has type */
                if (meta->slots && meta->slots[idx]) {
                    SlotSpec *spec = meta->slots[idx];
                    if (!check_slot_type(aTHX_ val_sv, spec)) {
                        const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered) 
                            ? spec->registered->name 
                            : type_id_to_name(spec->type_id);
                        croak("Type constraint failed for '%s' in new(): expected %s",
                              spec->name, type_name);
                    }
                }
                av_store(obj_av, idx, newSVsv(val_sv));
            }
        }
    } else {
        /* Positional fallback - skip class name if present */
        for (i = start_arg; i < items && (i - start_arg) < meta->slot_count - 1; i++) {
            IV idx = (i - start_arg) + 1;
            SV *val_sv = ST(i);
            
            /* Type check on construction if slot has type */
            if (meta->slots && meta->slots[idx]) {
                SlotSpec *spec = meta->slots[idx];
                if (!check_slot_type(aTHX_ val_sv, spec)) {
                    const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered) 
                        ? spec->registered->name 
                        : type_id_to_name(spec->type_id);
                    croak("Type constraint failed for '%s' in new(): expected %s",
                          spec->name, type_name);
                }
            }
            av_store(obj_av, idx, newSVsv(val_sv));
        }
    }

    /* Fill unset slots with defaults or undef, check required */
    for (i = 1; i < meta->slot_count; i++) {
        SV **existing = av_fetch(obj_av, i, 0);
        if (!existing || !SvOK(*existing)) {
            SlotSpec *spec = (meta->slots) ? meta->slots[i] : NULL;
            
            if (spec && spec->is_required) {
                croak("Required slot '%s' not provided in new()", spec->name);
            }
            
            if (spec && spec->has_default && spec->default_sv) {
                /* Clone the default value (in case it's a reference) */
                if (SvROK(spec->default_sv)) {
                    /* For refs, create fresh copy each time */
                    if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVAV) {
                        av_store(obj_av, i, newRV_noinc((SV*)newAV()));
                    } else if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVHV) {
                        av_store(obj_av, i, newRV_noinc((SV*)newHV()));
                    } else {
                        av_store(obj_av, i, newSVsv(spec->default_sv));
                    }
                } else {
                    av_store(obj_av, i, newSVsv(spec->default_sv));
                }
            } else {
                av_store(obj_av, i, newSV(0));
            }
        }
    }

    obj_sv = newRV_noinc((SV*)obj_av);
    sv_bless(obj_sv, meta->stash);
    /* Magic for lock/freeze is added lazily when first needed */

    ST(0) = sv_2mortal(obj_sv);
    XSRETURN(1);
}

/* XS fallback accessor */
static XS(xs_accessor_fallback) {
    dXSARGS;
    IV idx = CvXSUBANY(cv).any_iv;
    SV *self = ST(0);
    AV *av;

    if (!SvROK(self) || SvTYPE(SvRV(self)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(self);

    if (items > 1) {
        /* Setter */
        MAGIC *mg = get_object_magic(aTHX_ self);
        if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
            croak("Cannot modify frozen object");
        }
        av_store(av, idx, newSVsv(ST(1)));
        ST(0) = ST(1);
        XSRETURN(1);
    } else {
        /* Getter - use prototype chain resolution */
        SV *result = resolve_property_chain(aTHX_ av, idx);
        ST(0) = result;
        XSRETURN(1);
    }
}

/* ============================================
   Install constructor into class
   ============================================ */

static void install_constructor(pTHX_ const char *class_name, ClassMeta *meta) {
    char full_name[256];
    CV *cv;

    snprintf(full_name, sizeof(full_name), "%s::new", class_name);
    
    /* Create a minimal CV that will be replaced by call checker */
    cv = newXS(full_name, xs_object_new_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(meta);
}

/* ============================================
   Custom OP: fast function-style getter
   op_targ = registry ID, reads object from stack
   ============================================ */
static XOP object_func_get_xop;
static XOP object_func_set_xop;

static OP* pp_object_func_get(pTHX) {
    dSP;
    SV *obj = TOPs;  /* peek, don't pop */
    FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
    IV idx;
    AV *av;
    SV **svp;

    if (!data) {
        croak("Internal error: invalid accessor data");
    }
    idx = data->slot_idx;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(obj);


    /* Validate object is of expected class (stash pointer comparison) */
    if (data->expected_class) {
        if (SvSTASH(SvRV(obj)) != data->expected_class->stash) {
            croak("Expected object of class '%s', got '%s'",
                  data->expected_class->class_name,
                  HvNAME(SvSTASH(SvRV(obj))));
        }
    }

    /* Bounds check */
    if (idx > av_len(av)) {
        SETs(&PL_sv_undef);
        RETURN;
    }

    svp = av_fetch(av, idx, 0);
    SETs((svp && SvOK(*svp)) ? *svp : &PL_sv_undef);
    RETURN;
}

static OP* pp_object_func_set(pTHX) {
    dSP;
    SV *val = POPs;  /* Pop value first */
    SV *obj = TOPs;  /* Object left on stack */
    FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
    IV idx;
    AV *av;

    if (!data) {
        croak("Internal error: invalid accessor data");
    }
    idx = data->slot_idx;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(obj);

    /* Validate object is of expected class (stash pointer comparison) */
    if (data->expected_class && SvSTASH(SvRV(obj)) != data->expected_class->stash) {
        croak("Expected object of class '%s', got '%s'",
              data->expected_class->class_name,
              HvNAME(SvSTASH(SvRV(obj))));
    }

    av_store(av, idx, newSVsv(val));

    SETs(val);  /* Replace object with value */
    RETURN;
}

/* Check if an op is "simple" (can be safely used in optimized accessor) */
OBJECT_INLINE bool is_simple_op(OP *op) {
    if (!op) return false;
    /* Simple ops: pad variables, constants, global variables */
    switch (op->op_type) {
        case OP_PADSV:    /* $lexical */
        case OP_CONST:    /* literal value */
        case OP_GV:       /* *glob */
        case OP_GVSV:     /* $global */
        case OP_AELEMFAST:/* $array[const] */
#if defined(OP_AELEMFAST_LEX) && OP_AELEMFAST_LEX != OP_AELEMFAST
        case OP_AELEMFAST_LEX:
#endif
        case OP_NULL:     /* Often wraps simple ops */
            return true;
        default:
            return false;
    }
}

/* Call checker for function-style accessor: name($obj) or name($obj, $val) */
static OP* func_accessor_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
    IV registry_id = SvIV(ckobj);
    FuncAccessorData *data = get_func_accessor_data(registry_id);
    OP *pushop, *cvop, *objop, *argop, *valop;
    OP *newop;

    PERL_UNUSED_ARG(namegv);

    if (!data) {
        return entersubop;  /* Fallback if data not found */
    }

    pushop = cUNOPx(entersubop)->op_first;
    if (!OpHAS_SIBLING(pushop)) {
        pushop = cUNOPx(pushop)->op_first;
    }

    /* Walk the op tree like the method-style accessor checker */
    objop = OpSIBLING(pushop);
    cvop = objop;
    argop = objop;
    while (OpHAS_SIBLING(cvop)) {
        argop = cvop;
        cvop = OpSIBLING(cvop);
    }

    /* Check if there's an argument after obj (setter call) */
    if (argop != objop) {
        /* Setter: name($obj, $val) - let XS fallback handle all setters
         * Force scalar context to prevent void context optimization */
        return op_contextualize(entersubop, G_SCALAR);
    }

    /* Getter: name($obj) - optimize only if objop is simple */
    if (!is_simple_op(objop)) {
        return entersubop;
    }

    OpMORESIB_set(pushop, cvop);
    OpLASTSIB_set(objop, NULL);

    newop = newUNOP(OP_CUSTOM, 0, objop);
    newop->op_ppaddr = pp_object_func_get;
    newop->op_targ = data->registry_id;  /* Store registry ID, not pointer */

    op_free(entersubop);
    return newop;
}

/* XS fallback for function-style accessor */
static XS(xs_func_accessor_fallback) {
    dXSARGS;
    FuncAccessorData *data = INT2PTR(FuncAccessorData*, CvXSUBANY(cv).any_iv);
    IV idx = data->slot_idx;
    SV *obj = ST(0);
    AV *av;

    if (!SvROK(obj) || SvTYPE(SvRV(obj)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(obj);

    /* Validate object is of expected class */
    if (data->expected_class && SvSTASH(SvRV(obj)) != data->expected_class->stash) {
        croak("Expected object of class '%s', got '%s'",
              data->expected_class->class_name,
              HvNAME(SvSTASH(SvRV(obj))));
    }

    if (items > 1) {
        av_store(av, idx, newSVsv(ST(1)));
        ST(0) = ST(1);
    } else {
        SV **svp = av_fetch(av, idx, 0);
        ST(0) = (svp && SvOK(*svp)) ? *svp : &PL_sv_undef;
    }
    XSRETURN(1);
}

/* Install function-style accessor in caller's namespace */
static void install_func_accessor(pTHX_ const char *pkg, const char *prop_name, IV idx, ClassMeta *expected_class) {
    char full_name[256];
    CV *cv;
    SV *ckobj;
    FuncAccessorData *data;
    IV registry_id;

    snprintf(full_name, sizeof(full_name), "%s::%s", pkg, prop_name);

    /* Check if this accessor already exists - skip to avoid redefinition warning.
     * This also preserves any user-defined subs that were defined before import. */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;  /* Already exists, skip to avoid redefinition warning */
    }

    /* Allocate data for this accessor and register it */
    Newx(data, 1, FuncAccessorData);
    data->slot_idx = idx;
    data->expected_class = expected_class;  /* NULL for same-class, set for cross-class */
    registry_id = register_func_accessor_data(aTHX_ data);

    cv = newXS(full_name, xs_func_accessor_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(data);  /* XS fallback still uses pointer directly */

    ckobj = newSViv(registry_id);
    cv_set_call_checker(cv, func_accessor_call_checker, ckobj);
}

/* Object::Proto::import_accessors("Class", "targetpkg") - import fast accessors */
static XS(xs_import_accessors) {
    dXSARGS;
    STRLEN class_len, pkg_len;
    const char *class_pv, *pkg_pv;
    ClassMeta *meta;
    IV i;
    int is_same_class;

    if (items < 1) croak("Usage: Object::Proto::import_accessors($class [, $package])");

    class_pv = SvPV(ST(0), class_len);

    if (items > 1) {
        pkg_pv = SvPV(ST(1), pkg_len);
    } else {
        /* Default to caller's package */
        pkg_pv = CopSTASHPV(PL_curcop);
        pkg_len = strlen(pkg_pv);
    }

    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        croak("Class '%s' not defined with Object::Proto::define", class_pv);
    }

    /* Check if importing into same class (skip validation for performance) */
    is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));

    /* Install function-style accessors for each property */
    for (i = 1; i < meta->slot_count; i++) {
        if (meta->idx_to_prop[i]) {
            /* Pass NULL for same-class (skip validation), meta for cross-class */
            install_func_accessor(aTHX_ pkg_pv, meta->idx_to_prop[i], i,
                                  is_same_class ? NULL : meta);
        }
    }

    XSRETURN_EMPTY;
}

/* Object::Proto::import_accessor("Class", "prop", "alias") - import single accessor with alias */
static XS(xs_import_accessor) {
    dXSARGS;
    STRLEN class_len, prop_len, alias_len, pkg_len;
    const char *class_pv, *prop_pv, *alias_pv, *pkg_pv;
    ClassMeta *meta;
    SV **idx_svp;
    IV idx;
    int is_same_class;

    if (items < 2) croak("Usage: Object::Proto::import_accessor($class, $prop [, $alias [, $package]])");

    class_pv = SvPV(ST(0), class_len);
    prop_pv = SvPV(ST(1), prop_len);

    /* Alias defaults to property name */
    if (items > 2 && SvOK(ST(2))) {
        alias_pv = SvPV(ST(2), alias_len);
    } else {
        alias_pv = prop_pv;
    }

    /* Package defaults to caller */
    if (items > 3) {
        pkg_pv = SvPV(ST(3), pkg_len);
    } else {
        pkg_pv = CopSTASHPV(PL_curcop);
        pkg_len = strlen(pkg_pv);
    }

    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        croak("Class '%s' not defined with Object::Proto::define", class_pv);
    }

    /* Look up property index */
    idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
    if (!idx_svp) {
        croak("Property '%s' not defined in class '%s'", prop_pv, class_pv);
    }
    idx = SvIV(*idx_svp);

    /* Check if importing into same class (skip validation for performance) */
    is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));

    /* Install with alias name - pass meta for cross-class validation */
    install_func_accessor(aTHX_ pkg_pv, alias_pv, idx,
                          is_same_class ? NULL : meta);

    XSRETURN_EMPTY;
}

/* Object::Proto::import() - export 'object' to caller's namespace */
static XS(xs_import) {
    dXSARGS;
    const char *caller_pkg;
    SV *full_name;
    CV *define_cv;
    GV *gv;

    PERL_UNUSED_VAR(items);

    /* Get caller's package */
    caller_pkg = CopSTASHPV(PL_curcop);

    /* Get Object::Proto::define */
    define_cv = get_cv("Object::Proto::define", 0);
    if (!define_cv) croak("Object::Proto::define not found");

    /* Create fully qualified name: caller::object */
    full_name = newSVpvf("%s::object", caller_pkg);

    /* Export: create alias in caller's namespace */
    gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
    if (GvCV(gv) == NULL) {
        GvCV_set(gv, (CV*)SvREFCNT_inc((SV*)define_cv));
        GvIMPORTED_CV_on(gv);
    }

    SvREFCNT_dec(full_name);
    XSRETURN_EMPTY;
}

/* ============================================
   Install accessor into class
   ============================================ */

static void install_accessor(pTHX_ const char *class_name, const char *prop_name, IV idx) {
    char full_name[256];
    CV *cv;
    SV *ckobj;

    snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);

    /* Check if accessor already exists to avoid redefinition warnings */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;  /* Already defined, skip */
    }

    cv = newXS(full_name, xs_accessor_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = idx;

    ckobj = newSViv(idx);
    cv_set_call_checker(cv, accessor_call_checker, ckobj);
}

/* XS fallback accessor with type checking */
static XS(xs_accessor_typed_fallback) {
    dXSARGS;
    SlotOpData *data = INT2PTR(SlotOpData*, CvXSUBANY(cv).any_iv);
    IV idx = data->slot_idx;
    ClassMeta *meta = data->meta;
    SlotSpec *spec = meta->slots[idx];
    SV *self = ST(0);
    AV *av;

    if (!SvROK(self) || SvTYPE(SvRV(self)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(self);

    if (items > 1) {
        /* Setter with type check */
        SV *val = ST(1);
        MAGIC *mg = get_object_magic(aTHX_ self);
        if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
            croak("Cannot modify frozen object");
        }
        
        if (spec->is_readonly) {
            croak("Cannot modify readonly slot '%s'", spec->name);
        }
        
        /* Type check */
        if (spec->has_type) {
            if (!check_slot_type(aTHX_ val, spec)) {
                const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
                    ? spec->registered->name
                    : type_id_to_name(spec->type_id);
                croak("Type constraint failed for '%s': expected %s",
                      spec->name, type_name);
            }
        }
        
        av_store(av, idx, newSVsv(val));
        ST(0) = val;
        XSRETURN(1);
    } else {
        /* Getter - use prototype chain resolution, handle lazy */
        SV *result = resolve_property_chain(aTHX_ av, idx);
        
        /* Lazy initialization: if undef and is_lazy, build/default on first access */
        if (spec->is_lazy && !SvOK(result)) {
            SV *built_val = NULL;
            
            if (spec->has_builder && spec->builder_name) {
                /* Call builder method */
                dSP;
                const char *builder = SvPV_nolen(spec->builder_name);
                int count;
                
                ENTER;
                SAVETMPS;
                PUSHMARK(SP);
                XPUSHs(self);
                PUTBACK;
                
                count = call_method(builder, G_SCALAR);
                
                SPAGAIN;
                if (count > 0) {
                    /* Copy the value BEFORE FREETMPS to avoid freed scalar issue */
                    built_val = newSVsv(POPs);
                } else {
                    built_val = newSV(0);  /* undef */
                }
                PUTBACK;
                FREETMPS;
                LEAVE;
            } else if (spec->has_default && spec->default_sv) {
                /* Use default value for lazy default */
                if (SvROK(spec->default_sv)) {
                    /* Clone reference types (arrays, hashes) */
                    SV *inner = SvRV(spec->default_sv);
                    if (SvTYPE(inner) == SVt_PVAV) {
                        built_val = newRV_noinc((SV*)newAV());
                    } else if (SvTYPE(inner) == SVt_PVHV) {
                        built_val = newRV_noinc((SV*)newHV());
                    } else {
                        built_val = newSVsv(spec->default_sv);
                    }
                } else {
                    built_val = newSVsv(spec->default_sv);
                }
            }
            
            if (built_val) {
                /* Type check the built value */
                if (spec->has_type && SvOK(built_val)) {
                    if (!check_slot_type(aTHX_ built_val, spec)) {
                        const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
                            ? spec->registered->name
                            : type_id_to_name(spec->type_id);
                        croak("Type constraint failed for lazy '%s': expected %s",
                              spec->name, type_name);
                    }
                }
                
                /* Store the built value - built_val already has correct refcount from newSVsv */
                av_store(av, idx, built_val);
                result = built_val;
            }
        }
        
        ST(0) = result;
        XSRETURN(1);
    }
}

/* Call checker for typed accessor */
static OP* accessor_typed_call_checker(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) {
    SlotOpData *data = INT2PTR(SlotOpData*, SvIV(ckobj));
    IV idx = data->slot_idx;
    OP *pushop, *cvop, *selfop, *argop;
    OP *newop;

    PERL_UNUSED_ARG(namegv);

    pushop = cUNOPx(entersubop)->op_first;
    if (!OpHAS_SIBLING(pushop)) {
        pushop = cUNOPx(pushop)->op_first;
    }

    selfop = OpSIBLING(pushop);
    cvop = selfop;
    argop = selfop;
    while (OpHAS_SIBLING(cvop)) {
        argop = cvop;
        cvop = OpSIBLING(cvop);
    }

    /* Check if there's an argument after self (setter call) */
    if (argop != selfop) {
        /* Setter: $obj->name($value) - use typed setter */
        OP *valop = OpSIBLING(selfop);
        
        OpMORESIB_set(pushop, cvop);
        OpLASTSIB_set(valop, NULL);
        OpLASTSIB_set(selfop, NULL);
        
        newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
        newop->op_ppaddr = pp_object_set_typed;
        newop->op_targ = PTR2IV(data);
        
        op_free(entersubop);
        return newop;
    } else {
        /* Getter: $obj->name - plain getter (no type check needed) */
        OpMORESIB_set(pushop, cvop);
        OpLASTSIB_set(selfop, NULL);
        
        newop = newUNOP(OP_CUSTOM, 0, selfop);
        newop->op_ppaddr = pp_object_get;
        newop->op_targ = idx;
        
        op_free(entersubop);
        return newop;
    }
}

/* Install typed accessor (with type check, triggers, etc.) */
static void install_accessor_typed(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta) {
    char full_name[256];
    CV *cv;
    SV *ckobj;
    SlotOpData *data;

    snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);

    /* Check if accessor already exists to avoid redefinition warnings */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;  /* Already defined, skip */
    }

    /* Allocate persistent data for this slot */
    Newx(data, 1, SlotOpData);
    data->slot_idx = idx;
    data->meta = meta;

    cv = newXS(full_name, xs_accessor_typed_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(data);

    ckobj = newSViv(PTR2IV(data));
    cv_set_call_checker(cv, accessor_typed_call_checker, ckobj);
}

/* XS fallback for clearer method (clear_X) */
static XS(xs_clearer_fallback) {
    dXSARGS;
    SlotOpData *data = INT2PTR(SlotOpData*, CvXSUBANY(cv).any_iv);
    IV idx = data->slot_idx;
    SV *self = ST(0);
    AV *av;
    MAGIC *mg;

    PERL_UNUSED_ARG(items);

    if (!SvROK(self) || SvTYPE(SvRV(self)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(self);

    /* Check frozen */
    mg = get_object_magic(aTHX_ self);
    if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
        croak("Cannot modify frozen object");
    }

    /* Clear the slot by setting to undef */
    av_store(av, idx, newSV(0));
    
    ST(0) = self;  /* Return self for chaining */
    XSRETURN(1);
}

/* Install clearer method (clear_X) */
static void install_clearer(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta) {
    char full_name[256];
    CV *cv;
    SlotOpData *data;

    snprintf(full_name, sizeof(full_name), "%s::clear_%s", class_name, prop_name);

    /* Check if method already exists */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;
    }

    Newx(data, 1, SlotOpData);
    data->slot_idx = idx;
    data->meta = meta;

    cv = newXS(full_name, xs_clearer_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(data);
}

/* XS fallback for predicate method (has_X) */
static XS(xs_predicate_fallback) {
    dXSARGS;
    SlotOpData *data = INT2PTR(SlotOpData*, CvXSUBANY(cv).any_iv);
    IV idx = data->slot_idx;
    SV *self = ST(0);
    AV *av;
    SV **svp;

    PERL_UNUSED_ARG(items);

    if (!SvROK(self) || SvTYPE(SvRV(self)) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(self);

    /* Check if slot has a defined value */
    svp = av_fetch(av, idx, 0);
    if (svp && SvOK(*svp)) {
        ST(0) = &PL_sv_yes;
    } else {
        ST(0) = &PL_sv_no;
    }
    XSRETURN(1);
}

/* Install predicate method (has_X) */
static void install_predicate(pTHX_ const char *class_name, const char *prop_name, IV idx, ClassMeta *meta) {
    char full_name[256];
    CV *cv;
    SlotOpData *data;

    snprintf(full_name, sizeof(full_name), "%s::has_%s", class_name, prop_name);

    /* Check if method already exists */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;
    }

    Newx(data, 1, SlotOpData);
    data->slot_idx = idx;
    data->meta = meta;

    cv = newXS(full_name, xs_predicate_fallback, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(data);
}

/* ============================================
   DEMOLISH Support (zero overhead if not used)
   ============================================ */

/* XS DESTROY wrapper that calls DEMOLISH */
static XS(xs_destroy_wrapper) {
    dXSARGS;
    ClassMeta *meta = INT2PTR(ClassMeta*, CvXSUBANY(cv).any_iv);
    SV *self = ST(0);
    
    PERL_UNUSED_VAR(items);
    
    if (meta && meta->demolish_cv) {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(self);
        PUTBACK;
        call_sv((SV*)meta->demolish_cv, G_DISCARD | G_EVAL);
        SPAGAIN;
        /* Ignore errors in DEMOLISH - don't die during destruction */
        if (SvTRUE(ERRSV)) {
            warn("Error in DEMOLISH: %s", SvPV_nolen(ERRSV));
        }
        FREETMPS;
        LEAVE;
    }
    
    XSRETURN_EMPTY;
}

/* Install DESTROY wrapper - only called if DEMOLISH exists */
static void install_destroy_wrapper(pTHX_ const char *class_name, ClassMeta *meta) {
    char full_name[256];
    CV *cv;
    
    snprintf(full_name, sizeof(full_name), "%s::DESTROY", class_name);
    
    /* Check if DESTROY already exists - don't override user's DESTROY */
    cv = get_cvn_flags(full_name, strlen(full_name), 0);
    if (cv) {
        return;  /* User has their own DESTROY, don't interfere */
    }
    
    cv = newXS(full_name, xs_destroy_wrapper, __FILE__);
    CvXSUBANY(cv).any_iv = PTR2IV(meta);
}

/* ============================================
   Role Support (zero overhead if not used)
   ============================================ */

static RoleMeta* get_role_meta(pTHX_ const char *role_name, STRLEN len) {
    SV **svp;
    if (!g_role_registry) return NULL;
    svp = hv_fetch(g_role_registry, role_name, len, 0);
    if (svp && SvIOK(*svp)) {
        return INT2PTR(RoleMeta*, SvIV(*svp));
    }
    return NULL;
}

static void register_role_meta(pTHX_ const char *role_name, STRLEN len, RoleMeta *meta) {
    if (!g_role_registry) {
        g_role_registry = newHV();
    }
    hv_store(g_role_registry, role_name, len, newSViv(PTR2IV(meta)), 0);
}

/* Copy a method from role stash to class stash */
static void copy_method(pTHX_ HV *from_stash, HV *to_stash, const char *method_name) {
    GV *from_gv;
    CV *cv;
    char full_name[512];
    GV *to_gv;
    
    from_gv = gv_fetchmeth(from_stash, method_name, strlen(method_name), 0);
    if (!from_gv || !(cv = GvCV(from_gv))) {
        return;  /* No such method in role */
    }
    
    /* Check if target already has this method */
    to_gv = gv_fetchmeth(to_stash, method_name, strlen(method_name), 0);
    if (to_gv && GvCV(to_gv)) {
        return;  /* Target already has method, don't override */
    }
    
    /* Install the CV in target stash */
    snprintf(full_name, sizeof(full_name), "%s::%s", HvNAME(to_stash), method_name);
    to_gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
    if (to_gv) {
        /* Share the CV between role and class */
        GvCV_set(to_gv, (CV*)SvREFCNT_inc((SV*)cv));
        GvCVGEN(to_gv) = 0;  /* Clear cache */
    }
}

/* Apply a role to a class */
static void apply_role_to_class(pTHX_ ClassMeta *class_meta, RoleMeta *role_meta) {
    IV i;
    HE *entry;
    
    /* Check required methods */
    for (i = 0; i < role_meta->required_count; i++) {
        const char *required = role_meta->required_methods[i];
        GV *gv = gv_fetchmeth(class_meta->stash, required, strlen(required), 0);
        if (!gv || !GvCV(gv)) {
            croak("Class '%s' does not implement required method '%s' from role '%s'",
                  class_meta->class_name, required, role_meta->role_name);
        }
    }
    
    /* Copy role's slots to class */
    for (i = 0; i < role_meta->slot_count; i++) {
        SlotSpec *role_slot = role_meta->slots[i];
        IV new_idx;
        SV **existing;
        
        /* Check for slot name conflict */
        existing = hv_fetch(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name), 0);
        if (existing) {
            croak("Slot conflict: '%s' already exists in class '%s' (from role '%s')",
                  role_slot->name, class_meta->class_name, role_meta->role_name);
        }
        
        /* Add slot to class */
        new_idx = class_meta->slot_count++;
        Renew(class_meta->slots, class_meta->slot_count, SlotSpec*);
        Renew(class_meta->idx_to_prop, class_meta->slot_count, char*);
        
        /* Copy slot spec */
        class_meta->slots[new_idx] = role_slot;  /* Share the spec */
        class_meta->idx_to_prop[new_idx] = role_slot->name;
        hv_store(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name), 
                 newSViv(new_idx), 0);
        
        /* Install accessor for this slot */
        if (role_slot->has_type || role_slot->has_trigger || role_slot->has_coerce || 
            role_slot->is_readonly || role_slot->is_lazy) {
            install_accessor_typed(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta);
        } else {
            install_accessor(aTHX_ class_meta->class_name, role_slot->name, new_idx);
        }
        
        if (role_slot->has_clearer) {
            install_clearer(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta);
        }
        if (role_slot->has_predicate) {
            install_predicate(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta);
        }
    }
    
    /* Copy role's methods to class */
    if (role_meta->stash) {
        hv_iterinit(role_meta->stash);
        while ((entry = hv_iternext(role_meta->stash))) {
            const char *name = HePV(entry, PL_na);
            /* Skip special entries and slots (already handled) */
            if (name[0] != '_' || strncmp(name, "_build_", 7) == 0) {
                copy_method(aTHX_ role_meta->stash, class_meta->stash, name);
            }
        }
    }
    
    /* Track consumed role */
    Renew(class_meta->consumed_roles, class_meta->role_count + 1, RoleMeta*);
    class_meta->consumed_roles[class_meta->role_count++] = role_meta;
}

/* ============================================
   Method Modifiers (zero overhead if not used)
   ============================================ */

/* Get or create modified method entry */
static ModifiedMethod* get_or_create_modified_method(pTHX_ ClassMeta *meta, const char *method_name) {
    SV **svp;
    ModifiedMethod *mod;
    STRLEN name_len = strlen(method_name);
    
    if (!meta->modified_methods) {
        meta->modified_methods = newHV();
    }
    
    svp = hv_fetch(meta->modified_methods, method_name, name_len, 0);
    if (svp && SvIOK(*svp)) {
        return INT2PTR(ModifiedMethod*, SvIV(*svp));
    }
    
    /* Create new modified method entry */
    Newxz(mod, 1, ModifiedMethod);
    
    /* Get the original CV */
    {
        GV *gv = gv_fetchmeth(meta->stash, method_name, name_len, 0);
        if (gv && GvCV(gv)) {
            mod->original_cv = GvCV(gv);
            SvREFCNT_inc((SV*)mod->original_cv);
        }
    }
    
    hv_store(meta->modified_methods, method_name, name_len, newSViv(PTR2IV(mod)), 0);
    return mod;
}

/* XS wrapper for modified methods */
static XS(xs_modified_method_wrapper) {
    dXSARGS;
    ModifiedMethod *mod = INT2PTR(ModifiedMethod*, CvXSUBANY(cv).any_iv);
    MethodModifier *m;
    int count = 0;
    I32 gimme = GIMME_V;
    AV *saved_args;
    AV *saved_results;
    int i;
    
    /* Save original arguments for before/after chains */
    saved_args = newAV();
    sv_2mortal((SV*)saved_args);
    for (i = 0; i < items; i++) {
        av_push(saved_args, SvREFCNT_inc(ST(i)));
    }
    
    /* Call before chain (in stack order - most recent first) */
    for (m = mod->before_chain; m; m = m->next) {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        for (i = 0; i <= av_len(saved_args); i++) {
            SV **svp = av_fetch(saved_args, i, 0);
            XPUSHs(svp ? *svp : &PL_sv_undef);
        }
        PUTBACK;
        call_sv(m->callback, G_DISCARD);
        FREETMPS;
        LEAVE;
    }
    
    /* Save results from original/around call */
    saved_results = newAV();
    sv_2mortal((SV*)saved_results);
    
    /* Call around chain (or original if no around) */
    if (mod->around_chain) {
        /* For around, we pass ($orig, $self, @args) */
        m = mod->around_chain;
        {
            dSP;
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
            XPUSHs(sv_2mortal(newRV_inc((SV*)mod->original_cv)));
            for (i = 0; i <= av_len(saved_args); i++) {
                SV **svp = av_fetch(saved_args, i, 0);
                XPUSHs(svp ? *svp : &PL_sv_undef);
            }
            PUTBACK;
            count = call_sv(m->callback, gimme == G_ARRAY ? G_LIST : G_SCALAR);
            SPAGAIN;
            /* Save results before LEAVE destroys them - they're on stack in reverse */
            for (i = 0; i < count; i++) {
                av_push(saved_results, newSVsv(POPs));
            }
            FREETMPS;
            LEAVE;
        }
    } else if (mod->original_cv) {
        /* Call original method */
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        for (i = 0; i <= av_len(saved_args); i++) {
            SV **svp = av_fetch(saved_args, i, 0);
            XPUSHs(svp ? *svp : &PL_sv_undef);
        }
        PUTBACK;
        count = call_sv((SV*)mod->original_cv, gimme == G_ARRAY ? G_LIST : G_SCALAR);
        SPAGAIN;
        /* Save results before LEAVE destroys them */
        for (i = 0; i < count; i++) {
            av_push(saved_results, newSVsv(POPs));
        }
        FREETMPS;
        LEAVE;
    }
    
    /* Call after chain (in order of registration) */
    for (m = mod->after_chain; m; m = m->next) {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        for (i = 0; i <= av_len(saved_args); i++) {
            SV **svp = av_fetch(saved_args, i, 0);
            XPUSHs(svp ? *svp : &PL_sv_undef);
        }
        PUTBACK;
        call_sv(m->callback, G_DISCARD);
        FREETMPS;
        LEAVE;
    }
    
    /* Put saved results back on stack (they were saved in reverse order) */
    {
        count = av_len(saved_results) + 1;
        for (i = count - 1; i >= 0; i--) {
            SV **svp = av_fetch(saved_results, i, 0);
            /* Use sv_mortalcopy to put a mortal copy on stack */
            ST(count - 1 - i) = sv_mortalcopy(svp ? *svp : &PL_sv_undef);
        }
    }
    
    XSRETURN(count);
}

/* Install the wrapper if not already done */
static void install_modifier_wrapper(pTHX_ ClassMeta *meta, const char *method_name, ModifiedMethod *mod) {
    char full_name[256];
    CV *existing_cv;
    
    snprintf(full_name, sizeof(full_name), "%s::%s", meta->class_name, method_name);
    
    existing_cv = get_cvn_flags(full_name, strlen(full_name), 0);
    
    /* Only install wrapper once - check if it's already our wrapper */
    if (existing_cv && CvXSUB(existing_cv) == xs_modified_method_wrapper) {
        return;  /* Already wrapped */
    }
    
    /* Install wrapper without "Subroutine redefined" warning */
    {
        GV *gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
        CV *cv = newXS_flags(NULL, xs_modified_method_wrapper, __FILE__, NULL, 0);
        CvXSUBANY(cv).any_iv = PTR2IV(mod);
        /* Silently replace the CV in the GV */
        if (GvCV(gv)) {
            SvREFCNT_dec(GvCV(gv));
        }
        GvCV_set(gv, cv);
    }
}

/* Add a modifier to a method */
static void add_modifier(pTHX_ ClassMeta *meta, const char *method_name, SV *callback, int type) {
    ModifiedMethod *mod;
    MethodModifier *new_mod;
    
    mod = get_or_create_modified_method(aTHX_ meta, method_name);
    
    Newx(new_mod, 1, MethodModifier);
    new_mod->callback = newSVsv(callback);
    new_mod->next = NULL;
    
    /* Add to appropriate chain */
    switch (type) {
        case 0:  /* before */
            new_mod->next = mod->before_chain;
            mod->before_chain = new_mod;
            break;
        case 1:  /* after */
            /* Add to end of after chain */
            if (!mod->after_chain) {
                mod->after_chain = new_mod;
            } else {
                MethodModifier *last = mod->after_chain;
                while (last->next) last = last->next;
                last->next = new_mod;
            }
            break;
        case 2:  /* around */
            /* around wraps previous around/original */
            new_mod->next = mod->around_chain;
            mod->around_chain = new_mod;
            break;
    }
    
    install_modifier_wrapper(aTHX_ meta, method_name, mod);
}

/* ============================================
   XS API Functions
   ============================================ */

static XS(xs_define) {
    dXSARGS;
    STRLEN class_len;
    const char *class_pv;
    ClassMeta *meta;
    IV i;
    
    if (items < 1) croak("Usage: Object::Proto::define($class, @properties)");
    
    class_pv = SvPV(ST(0), class_len);

    /* Get or create class meta */
    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        meta = create_class_meta(aTHX_ class_pv, class_len);
        register_class_meta(aTHX_ class_pv, class_len, meta);
    }

    /* Allocate property name array and slots array */
    Renew(meta->idx_to_prop, items, char*);
    Renew(meta->slots, items, SlotSpec*);
    for (i = 0; i < items; i++) {
        meta->slots[i] = NULL;
    }

    /* Register each property */
    for (i = 1; i < items; i++) {
        STRLEN spec_len;
        const char *spec_pv = SvPV(ST(i), spec_len);
        SlotSpec *spec;
        IV idx = meta->slot_count++;
        
        /* Parse the slot spec (e.g., "name:Str:required" or just "name") */
        spec = parse_slot_spec(aTHX_ spec_pv, spec_len);
        meta->slots[idx] = spec;
        
        /* Update class-level flags for fast path checks */
        if (spec->has_type) meta->has_any_types = 1;
        if (spec->has_default) meta->has_any_defaults = 1;
        if (spec->has_trigger) meta->has_any_triggers = 1;
        if (spec->is_required) meta->has_any_required = 1;

        /* Store name -> idx mapping (use parsed name, not full spec) */
        hv_store(meta->prop_to_idx, spec->name, strlen(spec->name), newSViv(idx), 0);

        /* Store idx -> name mapping */
        meta->idx_to_prop[idx] = spec->name;  /* Already allocated in parse_slot_spec */
        
        /* Update lazy flag */
        if (spec->is_lazy) meta->has_any_lazy = 1;

        /* Install accessor method - typed or plain depending on spec */
        if (spec->has_type || spec->has_trigger || spec->has_coerce || spec->is_readonly || spec->is_lazy) {
            install_accessor_typed(aTHX_ class_pv, spec->name, idx, meta);
        } else {
            install_accessor(aTHX_ class_pv, spec->name, idx);
        }
        
        /* Install clearer method if requested */
        if (spec->has_clearer) {
            install_clearer(aTHX_ class_pv, spec->name, idx, meta);
        }
        
        /* Install predicate method if requested */
        if (spec->has_predicate) {
            install_predicate(aTHX_ class_pv, spec->name, idx, meta);
        }
    }

    /* Install constructor */
    install_constructor(aTHX_ class_pv, meta);
    
    /* Check for DEMOLISH method - only set up destruction hook if class has one */
    {
        char demolish_name[256];
        CV *demolish_cv;
        snprintf(demolish_name, sizeof(demolish_name), "%s::DEMOLISH", class_pv);
        demolish_cv = get_cvn_flags(demolish_name, strlen(demolish_name), 0);
        if (demolish_cv) {
            meta->demolish_cv = demolish_cv;
            /* Install DESTROY wrapper that calls DEMOLISH */
            install_destroy_wrapper(aTHX_ class_pv, meta);
        }
    }
    
    XSRETURN_EMPTY;
}

static XS(xs_prototype) {
    dXSARGS;
    AV *av;
    SV **svp;
    
    if (items < 1) croak("Usage: Object::Proto::prototype($obj)");
    
    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(ST(0));
    svp = av_fetch(av, 0, 0);
    if (svp && SvOK(*svp)) {
        ST(0) = SvREFCNT_inc(*svp);
    } else {
        ST(0) = &PL_sv_undef;
    }
    XSRETURN(1);
}

static XS(xs_set_prototype) {
    dXSARGS;
    AV *av;
    MAGIC *mg;

    if (items < 2) croak("Usage: Object::Proto::set_prototype($obj, $proto)");

    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
        croak("Not an object");
    }
    av = (AV*)SvRV(ST(0));

    mg = get_object_magic(aTHX_ ST(0));
    if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
        croak("Cannot modify frozen object");
    }

    av_store(av, 0, newSVsv(ST(1)));
    XSRETURN_EMPTY;
}

/* Get the full prototype chain as an arrayref */
static XS(xs_prototype_chain) {
    dXSARGS;
    AV *av;
    AV *chain;
    AV *visited[MAX_PROTOTYPE_DEPTH];
    int depth = 0;
    int i;

    if (items < 1) croak("Usage: Object::Proto::prototype_chain($obj)");

    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
        croak("Not an object");
    }

    chain = newAV();
    av = (AV*)SvRV(ST(0));

    while (av && depth < MAX_PROTOTYPE_DEPTH) {
        SV **proto_svp;

        /* Check for circular reference */
        for (i = 0; i < depth; i++) {
            if (visited[i] == av) {
                goto done;  /* Cycle detected, stop */
            }
        }
        visited[depth] = av;

        /* Add this object to the chain */
        av_push(chain, newRV_inc((SV*)av));

        /* Follow prototype */
        proto_svp = av_fetch(av, 0, 0);
        if (!proto_svp || !SvROK(*proto_svp) || SvTYPE(SvRV(*proto_svp)) != SVt_PVAV) {
            break;
        }
        av = (AV*)SvRV(*proto_svp);
        depth++;
    }

done:
    ST(0) = sv_2mortal(newRV_noinc((SV*)chain));
    XSRETURN(1);
}

/* Check if object has a property in its own slots (not prototype) */
static XS(xs_has_own_property) {
    dXSARGS;
    AV *av;
    SV **svp;
    const char *class_name;
    STRLEN class_len;
    ClassMeta *meta;
    const char *prop_name;
    STRLEN prop_len;
    SV **idx_sv;

    if (items < 2) croak("Usage: Object::Proto::has_own_property($obj, $property)");

    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
        croak("Not an object");
    }

    av = (AV*)SvRV(ST(0));
    class_name = sv_reftype(SvRV(ST(0)), TRUE);
    class_len = strlen(class_name);

    meta = get_class_meta(aTHX_ class_name, class_len);
    if (!meta) {
        XSRETURN_NO;
    }

    prop_name = SvPV(ST(1), prop_len);
    idx_sv = hv_fetch(meta->prop_to_idx, prop_name, prop_len, 0);
    if (!idx_sv) {
        XSRETURN_NO;
    }

    /* Check if this slot has a defined value */
    svp = av_fetch(av, SvIV(*idx_sv), 0);
    if (svp && SvOK(*svp)) {
        XSRETURN_YES;
    }
    XSRETURN_NO;
}

/* Get the prototype depth (number of prototypes in chain) */
static XS(xs_prototype_depth) {
    dXSARGS;
    AV *av;
    AV *visited[MAX_PROTOTYPE_DEPTH];
    int depth = 0;
    int i;

    if (items < 1) croak("Usage: Object::Proto::prototype_depth($obj)");

    if (!SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
        croak("Not an object");
    }

    av = (AV*)SvRV(ST(0));

    while (av && depth < MAX_PROTOTYPE_DEPTH) {
        SV **proto_svp;

        /* Check for circular reference */
        for (i = 0; i < depth; i++) {
            if (visited[i] == av) {
                goto done;
            }
        }
        visited[depth] = av;

        proto_svp = av_fetch(av, 0, 0);
        if (!proto_svp || !SvROK(*proto_svp) || SvTYPE(SvRV(*proto_svp)) != SVt_PVAV) {
            break;
        }
        av = (AV*)SvRV(*proto_svp);
        depth++;
    }

done:
    XSRETURN_IV(depth);
}

static XS(xs_lock) {
    dXSARGS;
    MAGIC *mg;
    
    if (items < 1) croak("Usage: Object::Proto::lock($obj)");
    
    mg = get_object_magic(aTHX_ ST(0));
    if (!mg) mg = add_object_magic(aTHX_ ST(0));
    if (mg->mg_private & OBJ_FLAG_FROZEN) {
        croak("Object is frozen");
    }
    mg->mg_private |= OBJ_FLAG_LOCKED;
    XSRETURN_EMPTY;
}

static XS(xs_unlock) {
    dXSARGS;
    MAGIC *mg;
    
    if (items < 1) croak("Usage: Object::Proto::unlock($obj)");
    
    mg = get_object_magic(aTHX_ ST(0));
    if (mg) {
        if (mg->mg_private & OBJ_FLAG_FROZEN) {
            croak("Cannot unlock frozen object");
        }
        mg->mg_private &= ~OBJ_FLAG_LOCKED;
    }
    XSRETURN_EMPTY;
}

static XS(xs_freeze) {
    dXSARGS;
    MAGIC *mg;
    
    if (items < 1) croak("Usage: Object::Proto::freeze($obj)");
    
    mg = get_object_magic(aTHX_ ST(0));
    if (!mg) mg = add_object_magic(aTHX_ ST(0));
    mg->mg_private |= (OBJ_FLAG_FROZEN | OBJ_FLAG_LOCKED);
    XSRETURN_EMPTY;
}

static XS(xs_is_frozen) {
    dXSARGS;
    MAGIC *mg;
    
    if (items < 1) croak("Usage: Object::Proto::is_frozen($obj)");
    
    mg = get_object_magic(aTHX_ ST(0));
    if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
        XSRETURN_YES;
    }
    XSRETURN_NO;
}

static XS(xs_is_locked) {
    dXSARGS;
    MAGIC *mg;

    if (items < 1) croak("Usage: Object::Proto::is_locked($obj)");

    mg = get_object_magic(aTHX_ ST(0));
    if (mg && (mg->mg_private & OBJ_FLAG_LOCKED)) {
        XSRETURN_YES;
    }
    XSRETURN_NO;
}

/* ============================================
   Introspection API
   ============================================ */

/* Object::Proto::clone($obj) - create shallow copy of object */
static XS(xs_clone) {
    dXSARGS;
    AV *src_av, *dst_av;
    SV *src_obj, *dst_obj;
    const char *class_name;
    ClassMeta *meta;
    IV i, len;

    if (items < 1) croak("Usage: Object::Proto::clone($obj) or $obj->clone()");

    src_obj = ST(0);

    if (!SvROK(src_obj) || SvTYPE(SvRV(src_obj)) != SVt_PVAV || !SvOBJECT(SvRV(src_obj))) {
        croak("Object::Proto::clone: argument is not an object");
    }

    src_av = (AV*)SvRV(src_obj);

    /* Get class metadata from the blessed stash */
    class_name = HvNAME(SvSTASH(SvRV(src_obj)));
    meta = get_class_meta(aTHX_ class_name, strlen(class_name));

    /* Create new AV with same size */
    len = av_len(src_av);
    dst_av = newAV();
    av_extend(dst_av, len);

    /* Shallow copy all slots */
    for (i = 0; i <= len; i++) {
        SV **svp = av_fetch(src_av, i, 0);
        if (svp && SvOK(*svp)) {
            av_store(dst_av, i, newSVsv(*svp));
        } else {
            av_store(dst_av, i, newSV(0));
        }
    }

    /* Create blessed reference to same class (clone is NOT frozen/locked) */
    dst_obj = newRV_noinc((SV*)dst_av);
    sv_bless(dst_obj, meta ? meta->stash : SvSTASH(SvRV(src_obj)));

    ST(0) = sv_2mortal(dst_obj);
    XSRETURN(1);
}

/* Object::Proto::properties($class) - return property names for a class */
static XS(xs_properties) {
    dXSARGS;
    STRLEN class_len;
    const char *class_pv;
    ClassMeta *meta;
    IV i;

    if (items < 1) croak("Usage: Object::Proto::properties($class)");

    class_pv = SvPV(ST(0), class_len);

    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        /* Non-existent class: return empty list / 0 */
        if (GIMME_V == G_ARRAY) {
            XSRETURN_EMPTY;
        } else {
            XSRETURN_IV(0);
        }
    }

    if (GIMME_V == G_ARRAY) {
        /* List context: return property names */
        IV count = meta->slot_count - 1;  /* -1 because slot 0 is prototype */
        SP -= items;
        EXTEND(SP, count);

        for (i = 1; i < meta->slot_count; i++) {
            if (meta->idx_to_prop[i]) {
                PUSHs(sv_2mortal(newSVpv(meta->idx_to_prop[i], 0)));
            }
        }
        XSRETURN(count);
    } else {
        /* Scalar context: return count */
        XSRETURN_IV(meta->slot_count - 1);
    }
}

/* Object::Proto::slot_info($class, $property) - return hashref with slot metadata */
static XS(xs_slot_info) {
    dXSARGS;
    STRLEN class_len, prop_len;
    const char *class_pv, *prop_pv;
    ClassMeta *meta;
    SV **idx_svp;
    IV idx;
    SlotSpec *spec;
    HV *info;

    if (items < 2) croak("Usage: Object::Proto::slot_info($class, $property)");

    class_pv = SvPV(ST(0), class_len);
    prop_pv = SvPV(ST(1), prop_len);

    /* Look up class meta */
    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        XSRETURN_UNDEF;
    }

    /* Look up property index - O(1) hash lookup */
    idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
    if (!idx_svp) {
        XSRETURN_UNDEF;
    }
    idx = SvIV(*idx_svp);

    /* Build result hashref */
    info = newHV();

    /* Basic info always present */
    hv_store(info, "name", 4, newSVpv(prop_pv, prop_len), 0);
    hv_store(info, "index", 5, newSViv(idx), 0);

    /* Get slot spec if available */
    spec = (meta->slots && idx < meta->slot_count) ? meta->slots[idx] : NULL;

    if (spec && spec->has_type) {
        const char *type_name;
        if (spec->type_id == TYPE_CUSTOM && spec->registered) {
            type_name = spec->registered->name;
        } else {
            type_name = type_id_to_name(spec->type_id);
        }
        hv_store(info, "type", 4, newSVpv(type_name, 0), 0);
    }

    /* Boolean flags */
    hv_store(info, "is_required", 11, newSViv(spec ? spec->is_required : 0), 0);
    hv_store(info, "is_readonly", 11, newSViv(spec ? spec->is_readonly : 0), 0);
    hv_store(info, "is_lazy", 7, newSViv(spec ? spec->is_lazy : 0), 0);
    hv_store(info, "has_default", 11, newSViv(spec ? spec->has_default : 0), 0);
    hv_store(info, "has_trigger", 11, newSViv(spec ? spec->has_trigger : 0), 0);
    hv_store(info, "has_coerce", 10, newSViv(spec ? spec->has_coerce : 0), 0);
    hv_store(info, "has_builder", 11, newSViv(spec ? spec->has_builder : 0), 0);
    hv_store(info, "has_clearer", 11, newSViv(spec ? spec->has_clearer : 0), 0);
    hv_store(info, "has_predicate", 13, newSViv(spec ? spec->has_predicate : 0), 0);
    hv_store(info, "has_type", 8, newSViv(spec ? spec->has_type : 0), 0);

    /* Default value (if present) */
    if (spec && spec->has_default && spec->default_sv) {
        hv_store(info, "default", 7, newSVsv(spec->default_sv), 0);
    }

    /* Builder method name */
    if (spec && spec->has_builder && spec->builder_name) {
        hv_store(info, "builder", 7, newSVsv(spec->builder_name), 0);
    }

    ST(0) = sv_2mortal(newRV_noinc((SV*)info));
    XSRETURN(1);
}

/* ============================================
   Global cleanup
   ============================================ */

/* Cleanup during global destruction */
static void object_cleanup_globals(pTHX_ void *data) {
    PERL_UNUSED_ARG(data);

    /* During global destruction, just NULL out pointers.
     * Perl handles SV cleanup. Trying to free them ourselves
     * can cause crashes due to destruction order. */
    if (PL_dirty) {
        g_type_registry = NULL;
        g_class_registry = NULL;
        g_func_accessor_registry = NULL;
        return;
    }

    /* Normal cleanup - not during global destruction */
    /* Note: Full cleanup omitted for simplicity; Perl handles SV refcounts */
    g_type_registry = NULL;
    g_class_registry = NULL;
    g_func_accessor_registry = NULL;
}

/* ============================================
   Type Registry API
   ============================================ */

/* C-level registration for external XS modules (called from BOOT)
   This is the fast path - no Perl callback overhead */
PERL_CALLCONV void object_register_type_xs(pTHX_ const char *name, 
                                           ObjectTypeCheckFunc check,
                                           ObjectTypeCoerceFunc coerce) {
    RegisteredType *type;
    STRLEN name_len = strlen(name);
    
    if (!g_type_registry) {
        g_type_registry = newHV();
    }
    
    /* Check if already registered */
    SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
    if (existing) {
        croak("Type '%s' is already registered", name);
    }
    
    Newxz(type, 1, RegisteredType);
    Newx(type->name, name_len + 1, char);
    Copy(name, type->name, name_len, char);
    type->name[name_len] = '\0';
    
    type->check = check;    /* Direct C function pointer - no Perl overhead */
    type->coerce = coerce;  /* Direct C function pointer - no Perl overhead */
    type->perl_check = NULL;
    type->perl_coerce = NULL;
    
    hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
}

/* Getter for external modules to look up a registered type */
PERL_CALLCONV RegisteredType* object_get_registered_type(pTHX_ const char *name) {
    STRLEN name_len = strlen(name);
    if (!g_type_registry) return NULL;
    
    SV **svp = hv_fetch(g_type_registry, name, name_len, 0);
    if (svp && SvIOK(*svp)) {
        return INT2PTR(RegisteredType*, SvIV(*svp));
    }
    return NULL;
}

/* Object::Proto::register_type($name, $check_cb [, $coerce_cb]) */
static XS(xs_register_type) {
    dXSARGS;
    STRLEN name_len;
    const char *name;
    RegisteredType *type;
    
    if (items < 2) croak("Usage: Object::Proto::register_type($name, $check_cb [, $coerce_cb])");
    
    name = SvPV(ST(0), name_len);
    
    /* Check if already registered */
    if (g_type_registry) {
        SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
        if (existing) {
            croak("Type '%s' is already registered", name);
        }
    } else {
        g_type_registry = newHV();
    }
    
    Newxz(type, 1, RegisteredType);
    Newx(type->name, name_len + 1, char);
    Copy(name, type->name, name_len, char);
    type->name[name_len] = '\0';
    
    /* Store Perl check callback */
    type->perl_check = newSVsv(ST(1));
    SvREFCNT_inc(type->perl_check);
    
    /* Store Perl coerce callback if provided */
    if (items > 2 && SvOK(ST(2))) {
        type->perl_coerce = newSVsv(ST(2));
        SvREFCNT_inc(type->perl_coerce);
    }
    
    hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
    
    XSRETURN_YES;
}

/* Object::Proto::has_type($name) - check if a type is registered */
static XS(xs_has_type) {
    dXSARGS;
    STRLEN name_len;
    const char *name;
    
    if (items < 1) croak("Usage: Object::Proto::has_type($name)");
    
    name = SvPV(ST(0), name_len);
    
    /* Check built-in types */
    BuiltinTypeID builtin = parse_builtin_type(name, name_len);
    if (builtin != TYPE_NONE) {
        XSRETURN_YES;
    }
    
    /* Check registry */
    if (g_type_registry) {
        SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
        if (existing) {
            XSRETURN_YES;
        }
    }
    
    XSRETURN_NO;
}

/* Object::Proto::list_types() - return list of registered type names */
static XS(xs_list_types) {
    dXSARGS;
    AV *result = newAV();
    
    PERL_UNUSED_ARG(items);
    
    /* Add built-in types */
    av_push(result, newSVpvs("Any"));
    av_push(result, newSVpvs("Defined"));
    av_push(result, newSVpvs("Str"));
    av_push(result, newSVpvs("Int"));
    av_push(result, newSVpvs("Num"));
    av_push(result, newSVpvs("Bool"));
    av_push(result, newSVpvs("ArrayRef"));
    av_push(result, newSVpvs("HashRef"));
    av_push(result, newSVpvs("CodeRef"));
    av_push(result, newSVpvs("Object"));
    
    /* Add registered types */
    if (g_type_registry) {
        HE *he;
        hv_iterinit(g_type_registry);
        while ((he = hv_iternext(g_type_registry))) {
            av_push(result, newSVsv(hv_iterkeysv(he)));
        }
    }
    
    ST(0) = newRV_noinc((SV*)result);
    sv_2mortal(ST(0));
    XSRETURN(1);
}

/* ============================================
   Singleton support
   ============================================ */

/* XS implementation of instance() method for singletons */
static XS(xs_singleton_instance) {
    dXSARGS;
    ClassMeta *meta = INT2PTR(ClassMeta*, CvXSUBANY(cv).any_iv);

    PERL_UNUSED_ARG(items);

    if (!meta) {
        croak("Singleton metadata not found");
    }

    /* Return cached instance if it exists */
    if (meta->singleton_instance && SvOK(meta->singleton_instance)) {
        ST(0) = meta->singleton_instance;
        XSRETURN(1);
    }

    /* Create new instance */
    {
        dSP;
        int count;
        SV *obj;
        GV *build_gv;
        char full_build[256];

        ENTER;
        SAVETMPS;

        /* Call ClassName->new() */
        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv(meta->class_name, 0)));
        PUTBACK;

        count = call_method("new", G_SCALAR);

        SPAGAIN;

        if (count != 1) {
            croak("Singleton new() did not return object");
        }

        obj = POPs;
        SvREFCNT_inc(obj);  /* Keep the object alive */

        PUTBACK;

        /* Check for BUILD method and call it */
        snprintf(full_build, sizeof(full_build), "%s::BUILD", meta->class_name);
        build_gv = gv_fetchpv(full_build, 0, SVt_PVCV);
        if (build_gv && GvCV(build_gv)) {
            PUSHMARK(SP);
            XPUSHs(obj);
            PUTBACK;
            call_method("BUILD", G_VOID | G_DISCARD);
        }

        /* Cache the instance */
        meta->singleton_instance = obj;

        FREETMPS;
        LEAVE;

        ST(0) = obj;
        XSRETURN(1);
    }
}

/* ============================================
   Role API
   ============================================ */

/* Object::Proto::role("RoleName", @slot_specs) - define a role */
static XS(xs_role) {
    dXSARGS;
    STRLEN role_len;
    const char *role_pv;
    RoleMeta *meta;
    IV i;
    
    if (items < 1) croak("Usage: Object::Proto::role($role_name, @slot_specs)");
    
    role_pv = SvPV(ST(0), role_len);
    
    /* Check if role already exists */
    meta = get_role_meta(aTHX_ role_pv, role_len);
    if (meta) {
        croak("Role '%s' already defined", role_pv);
    }
    
    /* Create role meta */
    Newxz(meta, 1, RoleMeta);
    Newxz(meta->role_name, role_len + 1, char);
    Copy(role_pv, meta->role_name, role_len, char);
    meta->role_name[role_len] = '\0';
    meta->stash = gv_stashpvn(role_pv, role_len, GV_ADD);
    
    /* Allocate slots array */
    if (items > 1) {
        Newx(meta->slots, items - 1, SlotSpec*);
        meta->slot_count = 0;
        
        for (i = 1; i < items; i++) {
            STRLEN spec_len;
            const char *spec_pv = SvPV(ST(i), spec_len);
            SlotSpec *spec = parse_slot_spec(aTHX_ spec_pv, spec_len);
            meta->slots[meta->slot_count++] = spec;
        }
    }
    
    register_role_meta(aTHX_ role_pv, role_len, meta);
    
    XSRETURN_EMPTY;
}

/* Object::Proto::requires("RoleName", @method_names) - declare required methods */
static XS(xs_requires) {
    dXSARGS;
    STRLEN role_len;
    const char *role_pv;
    RoleMeta *meta;
    IV i;
    
    if (items < 2) croak("Usage: Object::Proto::requires($role_name, @method_names)");
    
    role_pv = SvPV(ST(0), role_len);
    meta = get_role_meta(aTHX_ role_pv, role_len);
    if (!meta) {
        croak("Role '%s' not defined", role_pv);
    }
    
    /* Add required methods */
    Renew(meta->required_methods, meta->required_count + items - 1, char*);
    for (i = 1; i < items; i++) {
        STRLEN name_len;
        const char *name_pv = SvPV(ST(i), name_len);
        Newx(meta->required_methods[meta->required_count], name_len + 1, char);
        Copy(name_pv, meta->required_methods[meta->required_count], name_len, char);
        meta->required_methods[meta->required_count][name_len] = '\0';
        meta->required_count++;
    }
    
    XSRETURN_EMPTY;
}

/* Object::Proto::with("ClassName", @role_names) - apply roles to a class */
static XS(xs_with) {
    dXSARGS;
    STRLEN class_len;
    const char *class_pv;
    ClassMeta *class_meta;
    IV i;
    
    if (items < 2) croak("Usage: Object::Proto::with($class_name, @role_names)");
    
    class_pv = SvPV(ST(0), class_len);
    class_meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!class_meta) {
        croak("Class '%s' not defined with Object::Proto::define", class_pv);
    }
    
    for (i = 1; i < items; i++) {
        STRLEN role_len;
        const char *role_pv = SvPV(ST(i), role_len);
        RoleMeta *role_meta = get_role_meta(aTHX_ role_pv, role_len);
        
        if (!role_meta) {
            croak("Role '%s' not defined", role_pv);
        }
        
        apply_role_to_class(aTHX_ class_meta, role_meta);
    }
    
    XSRETURN_EMPTY;
}

/* Object::Proto::does("ClassName" or $obj, "RoleName") - check if class/object does role */
static XS(xs_does) {
    dXSARGS;
    ClassMeta *meta;
    STRLEN role_len;
    const char *role_pv;
    IV i;
    
    if (items < 2) croak("Usage: Object::Proto::does($class_or_obj, $role_name)");
    
    /* Get class meta from class name or object */
    if (SvROK(ST(0))) {
        /* Object - get stash name */
        HV *stash = SvSTASH(SvRV(ST(0)));
        meta = get_class_meta(aTHX_ HvNAME(stash), HvNAMELEN(stash));
    } else {
        STRLEN class_len;
        const char *class_pv = SvPV(ST(0), class_len);
        meta = get_class_meta(aTHX_ class_pv, class_len);
    }
    
    if (!meta) {
        XSRETURN_NO;
    }
    
    role_pv = SvPV(ST(1), role_len);
    
    /* Check if role is in consumed_roles */
    for (i = 0; i < meta->role_count; i++) {
        if (strEQ(meta->consumed_roles[i]->role_name, role_pv)) {
            XSRETURN_YES;
        }
    }
    
    XSRETURN_NO;
}

/* ============================================
   Method Modifier API
   ============================================ */

/* Object::Proto::before("Class::method", \&callback) */
static XS(xs_before) {
    dXSARGS;
    STRLEN full_name_len;
    const char *full_name;
    char *class_name, *method_name, *sep;
    ClassMeta *meta;
    
    if (items != 2) croak("Usage: Object::Proto::before('Class::method', \\&callback)");
    
    full_name = SvPV(ST(0), full_name_len);
    if (!SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
        croak("Second argument must be a code reference");
    }
    
    /* Parse "Class::method" */
    sep = strstr(full_name, "::");
    if (!sep) {
        croak("Method name must be fully qualified (Class::method)");
    }
    
    {
        STRLEN class_len = sep - full_name;
        Newx(class_name, class_len + 1, char);
        Copy(full_name, class_name, class_len, char);
        class_name[class_len] = '\0';
        method_name = sep + 2;
    }
    
    meta = get_class_meta(aTHX_ class_name, strlen(class_name));
    if (!meta) {
        Safefree(class_name);
        croak("Class '%s' not defined with Object::Proto::define", class_name);
    }
    
    add_modifier(aTHX_ meta, method_name, ST(1), 0);  /* 0 = before */
    
    Safefree(class_name);
    XSRETURN_EMPTY;
}

/* Object::Proto::after("Class::method", \&callback) */
static XS(xs_after) {
    dXSARGS;
    STRLEN full_name_len;
    const char *full_name;
    char *class_name, *method_name, *sep;
    ClassMeta *meta;
    
    if (items != 2) croak("Usage: Object::Proto::after('Class::method', \\&callback)");
    
    full_name = SvPV(ST(0), full_name_len);
    if (!SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
        croak("Second argument must be a code reference");
    }
    
    sep = strstr(full_name, "::");
    if (!sep) {
        croak("Method name must be fully qualified (Class::method)");
    }
    
    {
        STRLEN class_len = sep - full_name;
        Newx(class_name, class_len + 1, char);
        Copy(full_name, class_name, class_len, char);
        class_name[class_len] = '\0';
        method_name = sep + 2;
    }
    
    meta = get_class_meta(aTHX_ class_name, strlen(class_name));
    if (!meta) {
        Safefree(class_name);
        croak("Class '%s' not defined with Object::Proto::define", class_name);
    }
    
    add_modifier(aTHX_ meta, method_name, ST(1), 1);  /* 1 = after */
    
    Safefree(class_name);
    XSRETURN_EMPTY;
}

/* Object::Proto::around("Class::method", \&callback) */
static XS(xs_around) {
    dXSARGS;
    STRLEN full_name_len;
    const char *full_name;
    char *class_name, *method_name, *sep;
    ClassMeta *meta;
    
    if (items != 2) croak("Usage: Object::Proto::around('Class::method', \\&callback)");
    
    full_name = SvPV(ST(0), full_name_len);
    if (!SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
        croak("Second argument must be a code reference");
    }
    
    sep = strstr(full_name, "::");
    if (!sep) {
        croak("Method name must be fully qualified (Class::method)");
    }
    
    {
        STRLEN class_len = sep - full_name;
        Newx(class_name, class_len + 1, char);
        Copy(full_name, class_name, class_len, char);
        class_name[class_len] = '\0';
        method_name = sep + 2;
    }
    
    meta = get_class_meta(aTHX_ class_name, strlen(class_name));
    if (!meta) {
        Safefree(class_name);
        croak("Class '%s' not defined with Object::Proto::define", class_name);
    }
    
    add_modifier(aTHX_ meta, method_name, ST(1), 2);  /* 2 = around */
    
    Safefree(class_name);
    XSRETURN_EMPTY;
}

/* Object::Proto::singleton("Class") - marks class as singleton and installs instance() method */
static XS(xs_singleton) {
    dXSARGS;
    STRLEN class_len;
    const char *class_pv;
    ClassMeta *meta;
    char full_name[256];
    CV *instance_cv;

    if (items < 1) croak("Usage: Object::Proto::singleton($class)");

    class_pv = SvPV(ST(0), class_len);

    meta = get_class_meta(aTHX_ class_pv, class_len);
    if (!meta) {
        croak("Class '%s' not defined with Object::Proto::define", class_pv);
    }

    /* Mark as singleton */
    meta->is_singleton = 1;
    meta->singleton_instance = NULL;

    /* Install instance() class method */
    snprintf(full_name, sizeof(full_name), "%s::instance", class_pv);
    instance_cv = newXS(full_name, xs_singleton_instance, __FILE__);
    CvXSUBANY(instance_cv).any_iv = PTR2IV(meta);

    XSRETURN_EMPTY;
}

/* ============================================
   Boot
   ============================================ */

XS_EXTERNAL(boot_Object__Proto) {
    dXSBOOTARGSXSAPIVERCHK;
    PERL_UNUSED_VAR(items);

    /* Register custom ops */
    XopENTRY_set(&object_new_xop, xop_name, "object_new");
    XopENTRY_set(&object_new_xop, xop_desc, "object constructor");
    Perl_custom_op_register(aTHX_ pp_object_new, &object_new_xop);
    
    XopENTRY_set(&object_get_xop, xop_name, "object_get");
    XopENTRY_set(&object_get_xop, xop_desc, "object property get");
    Perl_custom_op_register(aTHX_ pp_object_get, &object_get_xop);
    
    XopENTRY_set(&object_set_xop, xop_name, "object_set");
    XopENTRY_set(&object_set_xop, xop_desc, "object property set");
    Perl_custom_op_register(aTHX_ pp_object_set, &object_set_xop);

    XopENTRY_set(&object_set_typed_xop, xop_name, "object_set_typed");
    XopENTRY_set(&object_set_typed_xop, xop_desc, "object property set with type check");
    Perl_custom_op_register(aTHX_ pp_object_set_typed, &object_set_typed_xop);

    XopENTRY_set(&object_func_get_xop, xop_name, "object_func_get");
    XopENTRY_set(&object_func_get_xop, xop_desc, "object function-style get");
    Perl_custom_op_register(aTHX_ pp_object_func_get, &object_func_get_xop);
    
    XopENTRY_set(&object_func_set_xop, xop_name, "object_func_set");
    XopENTRY_set(&object_func_set_xop, xop_desc, "object function-style set");
    Perl_custom_op_register(aTHX_ pp_object_func_set, &object_func_set_xop);

    /* Initialize registries */
    g_class_registry = newHV();
    g_type_registry = newHV();

    /* Install XS functions */
    newXS("Object::Proto::define", xs_define, __FILE__);
    newXS("Object::Proto::import_accessors", xs_import_accessors, __FILE__);
    newXS("Object::Proto::import_accessor", xs_import_accessor, __FILE__);
    newXS("Object::Proto::prototype", xs_prototype, __FILE__);
    newXS("Object::Proto::set_prototype", xs_set_prototype, __FILE__);
    newXS("Object::Proto::prototype_chain", xs_prototype_chain, __FILE__);
    newXS("Object::Proto::has_own_property", xs_has_own_property, __FILE__);
    newXS("Object::Proto::prototype_depth", xs_prototype_depth, __FILE__);
    newXS("Object::Proto::lock", xs_lock, __FILE__);
    newXS("Object::Proto::unlock", xs_unlock, __FILE__);
    newXS("Object::Proto::freeze", xs_freeze, __FILE__);
    newXS("Object::Proto::is_frozen", xs_is_frozen, __FILE__);
    newXS("Object::Proto::is_locked", xs_is_locked, __FILE__);

    /* Introspection API */
    newXS("Object::Proto::clone", xs_clone, __FILE__);
    newXS("Object::Proto::properties", xs_properties, __FILE__);
    newXS("Object::Proto::slot_info", xs_slot_info, __FILE__);

    /* Type registry API */
    newXS("Object::Proto::register_type", xs_register_type, __FILE__);
    newXS("Object::Proto::has_type", xs_has_type, __FILE__);
    newXS("Object::Proto::list_types", xs_list_types, __FILE__);

    /* Singleton support */
    newXS("Object::Proto::singleton", xs_singleton, __FILE__);
    
    /* Role API */
    newXS("Object::Proto::role", xs_role, __FILE__);
    newXS("Object::Proto::requires", xs_requires, __FILE__);
    newXS("Object::Proto::with", xs_with, __FILE__);
    newXS("Object::Proto::does", xs_does, __FILE__);
    
    /* Method modifier API */
    newXS("Object::Proto::before", xs_before, __FILE__);
    newXS("Object::Proto::after", xs_after, __FILE__);
    newXS("Object::Proto::around", xs_around, __FILE__);

    /* Register cleanup for global destruction */
    Perl_call_atexit(aTHX_ object_cleanup_globals, NULL);

    Perl_xs_boot_epilog(aTHX_ ax);
}
