add Perl_op_class(o) API function

Given an op, this function determines what type of struct it has been
allocated as. Returns one of the OPclass enums, such as OPclass_LISTOP.

Originally this was a static function in B.xs, but it has wider
applicability; indeed several XS modules on CPAN have cut and pasted it.

It adds the OPclass enum to op.h. In B.xs there was a similar enum, but
with names like OPc_LISTOP. I've renamed them to OPclass_LISTOP etc. so as
not to clash with the cut+paste code already on CPAN.

2 files changed, 5 insertions, 155 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index e0f9e21f0d..9e58700ebe 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.65';
+    $B::VERSION = '1.66';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 2279f36850..5143305bab 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -39,22 +39,6 @@ static const char* const svclassnames[] = {
     "B::IO",
 };
 
-typedef enum {
-    OPc_NULL,	/* 0 */
-    OPc_BASEOP,	/* 1 */
-    OPc_UNOP,	/* 2 */
-    OPc_BINOP,	/* 3 */
-    OPc_LOGOP,	/* 4 */
-    OPc_LISTOP,	/* 5 */
-    OPc_PMOP,	/* 6 */
-    OPc_SVOP,	/* 7 */
-    OPc_PADOP,	/* 8 */
-    OPc_PVOP,	/* 9 */
-    OPc_LOOP,	/* 10 */
-    OPc_COP,	/* 11 */
-    OPc_METHOP,	/* 12 */
-    OPc_UNOP_AUX /* 13 */
-} opclass;
 
 static const char* const opclassnames[] = {
     "B::NULL",
@@ -113,146 +97,12 @@ static void B_init_my_cxt(pTHX_ my_cxt_t * cxt) {
     cxt->x_specialsv_list[6] = (SV *) pWARN_STD;
 }
 
-static opclass
-cc_opclass(pTHX_ const OP *o)
-{
-    bool custom = 0;
-
-    if (!o)
-	return OPc_NULL;
-
-    if (o->op_type == 0) {
-	if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
-	    return OPc_COP;
-	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
-    }
-
-    if (o->op_type == OP_SASSIGN)
-	return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
-
-    if (o->op_type == OP_AELEMFAST) {
-#ifdef USE_ITHREADS
-	    return OPc_PADOP;
-#else
-	    return OPc_SVOP;
-#endif
-    }
-    
-#ifdef USE_ITHREADS
-    if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
-	o->op_type == OP_RCATLINE)
-	return OPc_PADOP;
-#endif
-
-    if (o->op_type == OP_CUSTOM)
-        custom = 1;
-
-    switch (OP_CLASS(o)) {
-    case OA_BASEOP:
-	return OPc_BASEOP;
-
-    case OA_UNOP:
-	return OPc_UNOP;
-
-    case OA_BINOP:
-	return OPc_BINOP;
-
-    case OA_LOGOP:
-	return OPc_LOGOP;
-
-    case OA_LISTOP:
-	return OPc_LISTOP;
-
-    case OA_PMOP:
-	return OPc_PMOP;
-
-    case OA_SVOP:
-	return OPc_SVOP;
-
-    case OA_PADOP:
-	return OPc_PADOP;
-
-    case OA_PVOP_OR_SVOP:
-        /*
-         * Character translations (tr///) are usually a PVOP, keeping a 
-         * pointer to a table of shorts used to look up translations.
-         * Under utf8, however, a simple table isn't practical; instead,
-         * the OP is an SVOP (or, under threads, a PADOP),
-         * and the SV is a reference to a swash
-         * (i.e., an RV pointing to an HV).
-         */
-	return (!custom &&
-		   (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
-	       )
-#if  defined(USE_ITHREADS)
-		? OPc_PADOP : OPc_PVOP;
-#else
-		? OPc_SVOP : OPc_PVOP;
-#endif
-
-    case OA_LOOP:
-	return OPc_LOOP;
-
-    case OA_COP:
-	return OPc_COP;
-
-    case OA_BASEOP_OR_UNOP:
-	/*
-	 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
-	 * whether parens were seen. perly.y uses OPf_SPECIAL to
-	 * signal whether a BASEOP had empty parens or none.
-	 * Some other UNOPs are created later, though, so the best
-	 * test is OPf_KIDS, which is set in newUNOP.
-	 */
-	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
-
-    case OA_FILESTATOP:
-	/*
-	 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
-	 * the OPf_REF flag to distinguish between OP types instead of the
-	 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
-	 * return OPc_UNOP so that walkoptree can find our children. If
-	 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
-	 * (no argument to the operator) it's an OP; with OPf_REF set it's
-	 * an SVOP (and op_sv is the GV for the filehandle argument).
-	 */
-	return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
-#ifdef USE_ITHREADS
-		(o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
-#else
-		(o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
-#endif
-    case OA_LOOPEXOP:
-	/*
-	 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
-	 * label was omitted (in which case it's a BASEOP) or else a term was
-	 * seen. In this last case, all except goto are definitely PVOP but
-	 * goto is either a PVOP (with an ordinary constant label), an UNOP
-	 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
-	 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
-	 * get set.
-	 */
-	if (o->op_flags & OPf_STACKED)
-	    return OPc_UNOP;
-	else if (o->op_flags & OPf_SPECIAL)
-	    return OPc_BASEOP;
-	else
-	    return OPc_PVOP;
-    case OA_METHOP:
-	return OPc_METHOP;
-    case OA_UNOP_AUX:
-	return OPc_UNOP_AUX;
-    }
-    warn("can't determine class of operator %s, assuming BASEOP\n",
-	 OP_NAME(o));
-    return OPc_BASEOP;
-}
 
 static SV *
 make_op_object(pTHX_ const OP *o)
 {
     SV *opsv = sv_newmortal();
-    sv_setiv(newSVrv(opsv, opclassnames[cc_opclass(aTHX_ o)]), PTR2IV(o));
+    sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), PTR2IV(o));
     return opsv;
 }
 
@@ -509,7 +359,7 @@ walkoptree(pTHX_ OP *o, const char *method, SV *ref)
     dSP;
     OP *kid;
     SV *object;
-    const char *const classname = opclassnames[cc_opclass(aTHX_ o)];
+    const char *const classname = opclassnames[op_class(o)];
     dMY_CXT;
 
     /* Check that no-one has changed our reference, or is holding a reference
@@ -542,7 +392,7 @@ walkoptree(pTHX_ OP *o, const char *method, SV *ref)
 	    ref = walkoptree(aTHX_ kid, method, ref);
 	}
     }
-    if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_SPLIT
+    if (o && (op_class(o) == OPclass_PMOP) && o->op_type != OP_SPLIT
            && (kid = PMOP_pmreplroot(cPMOPo)))
     {
 	ref = walkoptree(aTHX_ kid, method, ref);
@@ -1083,7 +933,7 @@ next(o)
 		    : &PL_sv_undef);
 		break;
 	    case 26: /* B::OP::size */
-		ret = sv_2mortal(newSVuv((UV)(opsizes[cc_opclass(aTHX_ o)])));
+		ret = sv_2mortal(newSVuv((UV)(opsizes[op_class(o)])));
 		break;
 	    case 27: /* B::OP::name */
 	    case 28: /* B::OP::desc */