Object-Pad

 view release on metacpan or  search on metacpan

include/class.h  view on Meta::CPAN

    /* Things that only roles have */
    struct {
      AV *superroles;      /* each elem is a raw pointer directly to a ClassMeta whose type == METATYPE_ROLE */
      HV *applied_classes; /* keyed by class name each elem is a raw pointer directly to a RoleEmbedding */
      AV *applycvs;        /* the APPLY {} phaser blocks; each elem is a CV* directly */
    } role;
  };
};

/* Metadata about the embedding of a role into a class */
#define LINNET_VAL_ROLEEMBEDDING  0x4F505245  /* "OPRE" */
#define MUST_ROLEEMBEDDING(ptr)   LINNET_CHECK_CAST(ptr, RoleEmbedding *, LINNET_VAL_ROLEEMBEDDING)
typedef struct RoleEmbedding {
  LINNET_FIELD
  SV *embeddingsv;
  struct ClassMeta *rolemeta;
  struct ClassMeta *classmeta;
  PADOFFSET offset;
} RoleEmbedding;

#define LINNET_VAL_METHODMETA  0x4F504D4D  /* "OPMM" */
#define MUST_METHODMETA(ptr)   LINNET_CHECK_CAST(ptr, MethodMeta *, LINNET_VAL_METHODMETA)

lib/Object/Pad.xs  view on Meta::CPAN

    croak("ARGH: Expected that padix[$self] = 1");

  /* Give it a name that isn't valid as a Perl variable so it can't collide */
  padix = pad_add_name_pvs("@(Object::Pad/fields)", 0, NULL, NULL);
  if(padix != PADIX_FIELDS)
    croak("ARGH: Expected that padix[@fields] = 2");

  if(meta->type == METATYPE_ROLE) {
    /* Don't give this a padname or Future::AsyncAwait will break it (RT137649) */
    padix = pad_add_name_pvs("", 0, NULL, NULL);
    if(padix != PADIX_EMBEDDING)
      croak("ARGH: Expected that padix[(embedding)] = 3");
  }
}

static void S_freepadsv(pTHX_ PADOFFSET padix)
{
  SvREFCNT_dec(PAD_SVl(padix));
  PAD_SVl(padix) = NULL;
}
#define SAVEFREEPADSV(padix)  SAVEDESTRUCTOR_X(S_freepadsv, (void *)(padix))

lib/Object/Pad.xs  view on Meta::CPAN

    croak("Cannot invoke method on a non-instance");

  HV *classstash;
  FIELDOFFSET offset;
  RoleEmbedding *embedding = NULL;

  if(is_role) {
    /* Embedding info is stored in pad1; PAD_SVl() will look at CvDEPTH. We'll
     * have to grab it manually */
    PAD *pad1 = PadlistARRAY(CvPADLIST(find_runcv(0)))[1];
    SV *embeddingsv = PadARRAY(pad1)[PADIX_EMBEDDING];

    /* We should never see NULL */
    assert(embeddingsv);

    if(SvTYPE(embeddingsv) == SVt_PVHV) {
      HV *applied_classes = (HV *)embeddingsv;
      HV *stash = SvSTASH(SvRV(self));

      if(stash == CvSTASH(find_runcv(0)))
        croak("Cannot invoke a role method directly");

      AV *isa = mro_get_linear_isa(stash);

      for(UV idx = 0; idx < av_count(isa); idx++) {
        HE *he = hv_fetch_ent(applied_classes, AvARRAY(isa)[idx], 0, 0);
        if(!he)
          continue;

        /* HeVAL is a RoleEmbedding * directly */
        embedding = MUST_ROLEEMBEDDING(HeVAL(he));
        break;
      }

      if(!embedding)
        croak("Could not find embedding info for %" HEKf " in applied classes map",
          HEKfARG(HvNAME_HEK(stash)));
    }
    else {
      embedding = MUST_ROLEEMBEDDING(SvPVX(embeddingsv));
    }

    if(embedding == &ObjectPad__embedding_standalone) {
      classstash = NULL;
      offset     = 0;
    }
    else {
      classstash = embedding->classmeta->stash;
      offset     = embedding->offset;
    }

lib/Object/Pad.xs  view on Meta::CPAN

    while((iter = hv_iternext(parammap))) {
      ParamMeta *parammeta = MUST_PARAMMETA(HeVAL(iter));

      dump_parammeta(aTHX_ ctx, parammeta);
    }
  }

  switch(classmeta->type) {
    case METATYPE_CLASS:
      for(i = 0; i < av_count(classmeta->cls.direct_roles); i++) {
        RoleEmbedding *embedding = MUST_ROLEEMBEDDING(AvARRAY(classmeta->cls.direct_roles)[i]);

        dump_roleembedding(aTHX_ ctx, embedding);
      }
      break;

    case METATYPE_ROLE:
      /* No need to dump the values of role.applied_classes because any class
       * they're applied to will have done that already */
      break;
  }

lib/Object/Pad.xs  view on Meta::CPAN

    retcount++;

    PUTBACK;

    while(classmeta) {
      retcount += deconstruct_object_class(fieldstore, classmeta, 0);

      AV *roles = classmeta->cls.direct_roles;
      U32 nroles = av_count(roles);
      for(U32 i = 0; i < nroles; i++) {
        RoleEmbedding *embedding = MUST_ROLEEMBEDDING(AvARRAY(roles)[i]);

        retcount += deconstruct_object_class(fieldstore, embedding->rolemeta, embedding->offset);
      }

      classmeta = classmeta->cls.supermeta;
    }

    SPAGAIN;
    XSRETURN(retcount);
  }

lib/Object/Pad.xs  view on Meta::CPAN

    while(classmeta) {
      if(!want_classname || sv_eq(want_classname, classmeta->name)) {
        RETVAL = ref_field_class(want_fieldname, fieldstore, classmeta, 0);
        if(RETVAL)
          goto done;
      }

      AV *roles = classmeta->cls.direct_roles;
      U32 nroles = av_count(roles);
      for(U32 i = 0; i < nroles; i++) {
        RoleEmbedding *embedding = MUST_ROLEEMBEDDING(AvARRAY(roles)[i]);

        if(!want_classname || sv_eq(want_classname, embedding->rolemeta->name)) {
          RETVAL = ref_field_class(want_fieldname, fieldstore, embedding->rolemeta, embedding->offset);
          if(RETVAL)
            goto done;
        }
      }

      classmeta = classmeta->cls.supermeta;
    }

share/include/object_pad.h  view on Meta::CPAN

  REPR_PVOBJ,        /* instances are SVt_PVOBJ on perl 5.38+ */
};

/* Special pad indexes within `method` CVs */
enum {
  PADIX_SELF = 1,
  PADIX_FIELDS = 2,

  /* for role methods */
  PADIX_EMBEDDING = 3,

  /* during initfields */
  PADIX_PARAMS = 4,
};

/* Function prototypes */

#define get_compclassmeta()  ObjectPad_get_compclassmeta(aTHX)
ClassMeta *ObjectPad_get_compclassmeta(pTHX);

src/class.c  view on Meta::CPAN

        (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++))
#endif

#define need_PLparser()  ObjectPad__need_PLparser(aTHX)
void ObjectPad__need_PLparser(pTHX); /* in Object/Pad.xs */

/* Empty MGVTBL simply for locating instance backing AV */
static MGVTBL vtbl_backingav = {};

RoleEmbedding ObjectPad__embedding_standalone = {
  LINNET_INIT(LINNET_VAL_ROLEEMBEDDING)
};

typedef struct ClassAttributeRegistration ClassAttributeRegistration;

struct ClassAttributeRegistration {
  ClassAttributeRegistration *next;

  const char *name;
  STRLEN permit_hintkeylen;

src/class.c  view on Meta::CPAN

    }
  }

  if(classmeta->type == METATYPE_CLASS) {
    U32 nroles;
    RoleEmbedding **embeddings = mop_class_get_direct_roles(classmeta, &nroles);

    assert(classmeta->type == METATYPE_CLASS || nroles == 0);

    for(i = 0; i < nroles; i++) {
      RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
      ClassMeta *rolemeta = embedding->rolemeta;

      assert(rolemeta->sealed);

      make_instance_fields(rolemeta, fieldstore, embedding->offset);
    }
  }
}

#define alias_fieldkeys_into_av(classmeta, hv, backingav)  S_alias_fieldkeys_into_av(aTHX_ classmeta, hv, backingav)

src/class.c  view on Meta::CPAN

  /* Perl core's cv_clone() would break in some situation here; see
   *   https://rt.cpan.org/Ticket/Display.html?id=141483
   */
  CV *embedded_cv = cv_copy_flags(cv, 0);
  SV *embeddingsv = embedding->embeddingsv;

  assert(SvTYPE(embeddingsv) == SVt_PV && SvLEN(embeddingsv) >= sizeof(RoleEmbedding));

  PAD *pad1 = PadlistARRAY(CvPADLIST(embedded_cv))[1];
  PadARRAY(pad1)[PADIX_EMBEDDING] = SvREFCNT_inc(embeddingsv);

  return embedded_cv;
}

RoleEmbedding *ObjectPad__get_embedding_from_pad(pTHX)
{
  /* Embedding info is stored in pad1; PAD_SVl() will look at CvDEPTH. We'll
   * have to grab it manually */
  PAD *pad1 = PadlistARRAY(CvPADLIST(find_runcv(0)))[1];
  SV *embeddingsv = PadARRAY(pad1)[PADIX_EMBEDDING];
  if(embeddingsv && embeddingsv != &PL_sv_undef)
    return MUST_ROLEEMBEDDING(SvPVX(embeddingsv));
  else
    return NULL;
}

RoleEmbedding **ObjectPad_mop_class_get_direct_roles(pTHX_ const ClassMeta *meta, U32 *nroles)
{
  assert(meta->type == METATYPE_CLASS);
  AV *roles = meta->cls.direct_roles;
  *nroles = av_count(roles);
  return (RoleEmbedding **)AvARRAY(roles);

src/class.c  view on Meta::CPAN

    padix = pad_add_name_pvs("$class", 0, NULL, NULL);
    if(padix != PADIX_SELF)
      croak("ARGH: Expected that padix[$class] = 1");
    intro_my();
  }

  if(meta->type == METATYPE_ROLE) {
    PAD *pad1 = PadlistARRAY(CvPADLIST(PL_compcv))[1];

    if(meta->role_is_invokable) {
      SV *sv = PadARRAY(pad1)[PADIX_EMBEDDING];
      SvUPGRADE(sv, SVt_PV);
      SvPOK_on(sv);
      SvLEN(sv) = 0;
      SvPVX(sv) = (void *)&ObjectPad__embedding_standalone;
    }
    else {
      SvREFCNT_dec(PadARRAY(pad1)[PADIX_EMBEDDING]);
      /* Unembedded role CVs store the entire class map */
      PadARRAY(pad1)[PADIX_EMBEDDING] = SvREFCNT_inc(meta->role.applied_classes);
    }
  }
}

void ObjectPad__add_fields_to_pad(pTHX_ ClassMeta *meta, U32 since_field)
{
  AV *fields = meta->fields;
  U32 nfields = av_count(fields);

  U32 i;

src/class.c  view on Meta::CPAN

    CvOUTSIDE(PL_compcv)     = CvOUTSIDE(outside);
    CvOUTSIDE_SEQ(PL_compcv) = CvOUTSIDE_SEQ(outside);
  }

  return body;
}

void ObjectPad__prepare_adjust_params(pTHX_ ClassMeta *meta)
{
  /* Skip the PADIX_EMBEDDING slot if not already done so */
  if(meta->type != METATYPE_ROLE)
    pad_add_name_pvs("", 0, NULL, NULL);

  PADOFFSET params_padix = pad_add_name_pvs("%(params)", 0, NULL, NULL);
  assert(params_padix == PADIX_PARAMS);
  PERL_UNUSED_VAR(params_padix);

  intro_my();
}

src/class.c  view on Meta::CPAN

}

#define mop_class_implements_role(meta, rolemeta)  S_mop_class_implements_role(aTHX_ meta, rolemeta)
static bool S_mop_class_implements_role(pTHX_ ClassMeta *meta, ClassMeta *rolemeta)
{
  U32 i, n;
  switch(meta->type) {
    case METATYPE_CLASS: {
      RoleEmbedding **embeddings = mop_class_get_all_roles(meta, &n);
      for(i = 0; i < n; i++)
        if(MUST_ROLEEMBEDDING(embeddings[i])->rolemeta == rolemeta)
          return true;

      break;
    }

    case METATYPE_ROLE: {
      ClassMeta **roles = (ClassMeta **)AvARRAY(meta->role.superroles);
      U32 n = av_count(meta->role.superroles);
      /* TODO: this isn't super-efficient in deep cross-linked heirarchies */
      for(i = 0; i < n; i++) {

src/class.c  view on Meta::CPAN

  HV *srcstash = rolemeta->stash;
  HV *dststash = classmeta->stash;

  SV *embeddingsv = newSV(sizeof(RoleEmbedding));
  assert(SvTYPE(embeddingsv) == SVt_PV && SvLEN(embeddingsv) >= sizeof(RoleEmbedding));

  RoleEmbedding *embedding = (RoleEmbedding *)SvPVX(embeddingsv);

  *embedding = (RoleEmbedding){
    LINNET_INIT(LINNET_VAL_ROLEEMBEDDING)
    .embeddingsv = embeddingsv,
    .rolemeta    = rolemeta,
    .classmeta   = classmeta,
    .offset      = -1,
  };

  av_push(classmeta->cls.embedded_roles, (SV *)embedding);
  hv_store_ent(rolemeta->role.applied_classes, classmeta->name, (SV *)embedding, 0);

  U32 nbuilds = rolemeta->buildcvs ? av_count(rolemeta->buildcvs) : 0;

src/class.c  view on Meta::CPAN

    }
  }
}

static void S_apply_roles(pTHX_ ClassMeta *dstmeta, ClassMeta *srcmeta)
{
  U32 nroles;
  RoleEmbedding **arr = mop_class_get_direct_roles(srcmeta, &nroles);
  U32 i;
  for(i = 0; i < nroles; i++) {
    mop_class_apply_role(MUST_ROLEEMBEDDING(arr[i]));
  }
}

void ObjectPad__check_colliding_param(pTHX_ ClassMeta *classmeta, SV *paramname)
{
  HV *parammap = classmeta->parammap;
  assert(parammap);

  HE *he = hv_fetch_ent(parammap, paramname, 0, 0);
  if(!he)

src/class.c  view on Meta::CPAN

  if(meta->initfields_lines) {
    ops = op_append_list(OP_LINESEQ, ops,
      meta->initfields_lines);
  }

  if(meta->type == METATYPE_CLASS) {
    U32 nroles;
    RoleEmbedding **embeddings = mop_class_get_direct_roles(meta, &nroles);

    for(i = 0; i < nroles; i++) {
      RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
      ClassMeta *rolemeta = embedding->rolemeta;

      if(!rolemeta->sealed)
        mop_class_seal(rolemeta);

      assert(rolemeta->sealed);
      assert(rolemeta->initfields);

      DEBUG_SET_CURCOP_LINE(__LINE__);

src/class.c  view on Meta::CPAN

    if(!cv_does && meta->cls.foreign_does)
      cv_does = meta->cls.foreign_does;

    if(sv_eq(meta->name, wantrole)) {
      XSRETURN_YES;
    }

    int i;
    for(i = 0; i < nroles; i++) {
      RoleEmbedding *embedding = MUST_ROLEEMBEDDING(AvARRAY(roles)[i]);
      if(sv_eq(embedding->rolemeta->name, wantrole)) {
        XSRETURN_YES;
      }
    }

    meta = meta->type == METATYPE_CLASS ? meta->cls.supermeta : NULL;
  }

  if (cv_does) {
    /* return $self->DOES(@_); */

src/class.c  view on Meta::CPAN

      copy_requiremethods_from(meta, supermeta);

    if(supermeta->has_adjust)
      meta->has_adjust = true;

    U32 nroles;
    RoleEmbedding **embeddings = mop_class_get_all_roles(supermeta, &nroles);
    if(nroles) {
      U32 i;
      for(i = 0; i < nroles; i++) {
        RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
        ClassMeta *rolemeta = embedding->rolemeta;

        av_push(meta->cls.embedded_roles, (SV *)embedding);
        hv_store_ent(rolemeta->role.applied_classes, meta->name, (SV *)embedding, 0);
      }
    }
  }
  else {
    /* A subclass of a foreign class */
    meta->cls.foreign_new = fetch_superclass_method_pv(meta->stash, "new", 3, -1);

src/field.c  view on Meta::CPAN

    const char *key = HvNAME(objstash);
    STRLEN klen = HvNAMELEN(objstash);
    if(HvNAMEUTF8(objstash))
      klen = -klen;

    assert(key);
    SV **svp = hv_fetch(classmeta->role.applied_classes, key, klen, 0);
    if(!svp)
      croak("Cannot fetch role field value from a non-applied instance");

    RoleEmbedding *embedding = MUST_ROLEEMBEDDING(*svp);

    fieldstore = get_obj_fieldstore(self, embedding->classmeta->repr, true);
    fieldix = fieldmeta->fieldix + embedding->offset;
  }
  else {
    const char *stashname = HvNAME(classmeta->stash);

    if(!stashname || !sv_derived_from(self, stashname))
      croak("Cannot fetch field value from a non-derived instance");