Define a PL_infix_plugin hook, of a similar style to PL_keyword_plugin

Runs for identifier-named custom infix operators and sequences of
non-identifier symbol characters.

Defines multiple precedence levels for custom infix operators that fit
alongside exponentiation, multiplication, addition, or relational
comparision operators, as well as a "high" and "low" at either end.

Author: leonerd

embed.fnc

@@ -1572,6 +1572,7 @@ Apd	|void	|cv_set_call_checker_flags|NN CV *cv \
 					  |NN Perl_call_checker ckfun \
 					  |NN SV *ckobj|U32 ckflags
 Apd	|void	|wrap_op_checker|Optype opcode|NN Perl_check_t new_checker|NN Perl_check_t *old_checker_p
+Axpd	|void	|wrap_infix_plugin|NN Perl_infix_plugin_t new_plugin|NN Perl_infix_plugin_t *old_plugin_p
 Axpd	|void	|wrap_keyword_plugin|NN Perl_keyword_plugin_t new_plugin|NN Perl_keyword_plugin_t *old_plugin_p
 CpR	|PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems
 Apd	|char*	|scan_vstring	|NN const char *s|NN const char *const e \
@@ -1600,6 +1601,7 @@ p	|void	|opslab_force_free|NN OPSLAB *slab
 #endif
 : Used in perly.y
 p	|void	|package	|NN OP* o
+p	|OP *	|build_infix_plugin|NN OP *lhs|NN OP *rhs|NN void *tokendata
 : Used in perly.y
 p	|void	|package_version|NN OP* v
 : Used in toke.c and perly.y
@@ -3821,6 +3823,8 @@ Apxd	|void|cop_store_label \
 
 epo	|int	|keyword_plugin_standard|NN char* keyword_ptr|STRLEN keyword_len|NN OP** op_ptr
 
+epo	|STRLEN	|infix_plugin_standard|NN char* operator_ptr|STRLEN operator_len|NN struct Perl_custom_infix** def
+
 #if defined(USE_ITHREADS)
 #  if defined(PERL_IN_SV_C)
 S	|void	|unreferenced_to_tmp_stack|NN AV *const unreferenced

embed.h

@@ -761,6 +761,7 @@
 #define whichsig_pv(a)		Perl_whichsig_pv(aTHX_ a)
 #define whichsig_pvn(a,b)	Perl_whichsig_pvn(aTHX_ a,b)
 #define whichsig_sv(a)		Perl_whichsig_sv(aTHX_ a)
+#define wrap_infix_plugin(a,b)	Perl_wrap_infix_plugin(aTHX_ a,b)
 #define wrap_keyword_plugin(a,b)	Perl_wrap_keyword_plugin(aTHX_ a,b)
 #define wrap_op_checker(a,b,c)	Perl_wrap_op_checker(aTHX_ a,b,c)
 #if !(defined(PERL_USE_3ARG_SIGHANDLER))
@@ -1226,6 +1227,7 @@
 #define boot_core_UNIVERSAL()	Perl_boot_core_UNIVERSAL(aTHX)
 #define boot_core_builtin()	Perl_boot_core_builtin(aTHX)
 #define boot_core_mro()		Perl_boot_core_mro(aTHX)
+#define build_infix_plugin(a,b,c)	Perl_build_infix_plugin(aTHX_ a,b,c)
 #define cando(a,b,c)		Perl_cando(aTHX_ a,b,c)
 #define check_utf8_print(a,b)	Perl_check_utf8_print(aTHX_ a,b)
 #define ck_anoncode(a)		Perl_ck_anoncode(aTHX_ a)

perl.h

@@ -6003,10 +6003,27 @@ typedef void (*XSINIT_t) (pTHX);
 typedef void (*ATEXIT_t) (pTHX_ void*);
 typedef void (*XSUBADDR_t) (pTHX_ CV *);
 
+/* TODO: find somewhere to store this */
+enum Perl_custom_infix_precedence {
+    INFIX_PREC_LOW  =  10, /* non-associative */
+    INFIX_PREC_REL  =  30, /* non-associative, just below `==` */
+    INFIX_PREC_ADD  =  50, /* left-associative, same precedence as `+` */
+    INFIX_PREC_MUL  =  70, /* left-associative, same precedence as `*` */
+    INFIX_PREC_POW  =  90, /* right-associative, same precedence as `**` */
+    INFIX_PREC_HIGH = 110, /* non-associative */
+};
+struct Perl_custom_infix;
+struct Perl_custom_infix {
+    enum Perl_custom_infix_precedence prec;
+    void (*parse)(pTHX_ SV **opdata, struct Perl_custom_infix *);  /* optional */
+    OP *(*build_op)(pTHX_ SV **opdata, OP *lhs, OP *rhs, struct Perl_custom_infix *);
+};
+
 typedef OP* (*Perl_ppaddr_t)(pTHX);
 typedef OP* (*Perl_check_t) (pTHX_ OP*);
 typedef void(*Perl_ophook_t)(pTHX_ OP*);
 typedef int (*Perl_keyword_plugin_t)(pTHX_ char*, STRLEN, OP**);
+typedef STRLEN (*Perl_infix_plugin_t)(pTHX_ char*, STRLEN, struct Perl_custom_infix **);
 typedef void(*Perl_cpeep_t)(pTHX_ OP *, OP *);
 
 typedef void(*globhook_t)(pTHX);

perlvars.h

@@ -235,10 +235,12 @@ Instead, use the function L</wrap_keyword_plugin>.
 */
 
 #if defined(USE_ITHREADS)
-PERLVAR(G, keyword_plugin_mutex, perl_mutex)   /* Mutex for PL_keyword_plugin */
+PERLVAR(G, keyword_plugin_mutex, perl_mutex)   /* Mutex for PL_keyword_plugin and PL_infix_plugin */
 #endif
 PERLVARI(G, keyword_plugin, Perl_keyword_plugin_t, Perl_keyword_plugin_standard)
 
+PERLVARI(G, infix_plugin, Perl_infix_plugin_t, Perl_infix_plugin_standard)
+
 PERLVARI(G, op_sequence, HV *, NULL)	/* dump.c */
 PERLVARI(G, op_seq,	UV,	0)	/* dump.c */