#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define NEED_ptr_table_new
#define NEED_ptr_table_fetch
#define NEED_ptr_table_store
#define NEED_ptr_table_free
#include "ppport.h"
#ifndef ptr_table_new
#include "ptable.h"
#define ptr_table_new PTABLE_new
#define ptr_table_fetch PTABLE_fetch
#define ptr_table_store PTABLE_store
#define ptr_table_free PTABLE_free
#endif
#include "hook_op_check.h"
#define MY_CXT_KEY "Lexical::SingleAssignment::_guts" XS_VERSION
typedef struct {
        PTR_TBL_t *padop_table;
        int padop_table_refcount;
} my_cxt_t;
START_MY_CXT
/* post hook for sassign that marks SVs as readonly */
STATIC OP *
pp_sassign_readonly (pTHX) {
        dSP;
        OP *ret = PL_ppaddr[OP_SASSIGN](aTHXR);
        SPAGAIN;
        assert(SvPADMY(TOPs));
        SvREADONLY_on(TOPs);
        return ret;
}
/* post hook for aassign that marks SVs as readonly */
STATIC OP *
pp_aassign_readonly (pTHX) {
        dSP;
        SV **lvalues;
        SV **first = &PL_stack_base[TOPMARK + 1];
        int items = 1 + ( SP - first );
        /* save pointers to all the SVs being assigned to*/
        Newx(lvalues, items, SV *);
        save_freepv(lvalues);
        Copy(first, lvalues, items, SV *);
        /* perform the assignment */
        OP *ret = PL_ppaddr[OP_AASSIGN](aTHXR);
        /* make all the values readonly, including all child elements for container
         * types */
        while ( items ) {
                SV *sv = lvalues[--items];
                assert(SvPADMY(sv));
                if ( SvTYPE(sv) == SVt_PVAV ) {
                        AV *av = (AV *)sv;
                        SV **array = AvARRAY(av);
                        int i;
                        for ( i = 0; i < AvMAX(av); i++ ) {
                                SvREADONLY_on(array[i]);
                        }
                } else if ( SvTYPE(sv) == SVt_PVHV ) {
                        /* this is like Hash::Util::lock_hash */
                        HV *hv = (HV *)sv;
                        HE *he;
                        SV *val;
                        hv_iterinit(hv);
                        while ( he = hv_iternext(hv) ) {
                                SvREADONLY_on(hv_iterval(hv, he));
                        }
                }
                SvREADONLY_on(sv);
        }
        return ret;
}
STATIC OP *
lsa_ck_sassign(pTHX_ OP *o, void *ud) {
        OP *rvalue = cBINOPo->op_first;
        if ( rvalue ) {
                OP *lvalue = rvalue->op_sibling;
                if ( lvalue ) {
                        switch ( lvalue->op_type ) {
                                case OP_PADSV:
                                case OP_PADHV:
                                case OP_PADAV:
                                        /* the op for the lvalue SV is a pad op */
                                        if ( lvalue->op_private & OPpLVAL_INTRO ) {
                                                /* this is the first instance of the variable, where it's declared */
                                                if ( o->op_ppaddr == PL_ppaddr[OP_SASSIGN] ) {
                                                        o->op_ppaddr = pp_sassign_readonly;
                                                } else {
                                                        warn("Not overriding assignment op (already augmented)");
                                                }
                                                /* mark this op as accounted for, see delayed_ck_padany */
                                                assert(MY_CXT.padop_table != NULL);
                                                ptr_table_store(MY_CXT.padop_table, lvalue, NULL);
                                        } else if ( ptr_table_fetch(MY_CXT.padop_table, lvalue) ) {
                                                croak("Assignment to lexical allowed only in declaration");
                                        }
                        }
                }
        }
        return o;
}
STATIC OP *
lsa_ck_aassign(pTHX_ OP *o, void *ud) {
        LISTOP *lvalues = (LISTOP *)cBINOPo->op_first->op_sibling;
        OP *lvalue;
        bool augment_readonly = FALSE;
        for ( lvalue = lvalues->op_first->op_sibling; lvalue; lvalue = lvalue->op_sibling ) {
                switch ( lvalue->op_type ) {
                        case OP_PADSV:
                        case OP_PADHV:
                        case OP_PADAV:
                                if ( lvalue->op_private & OPpLVAL_INTRO ) {
                                        augment_readonly = TRUE;
                                        assert(MY_CXT.padop_table != NULL);
                                        ptr_table_store(MY_CXT.padop_table, lvalue, NULL);
                                } else if ( ptr_table_fetch(MY_CXT.padop_table, lvalue) ) {
                                        croak("Assignment to lexical allowed only in declaration");
                                }
                }
        }
        if ( augment_readonly ) {
                if ( o->op_ppaddr == PL_ppaddr[OP_AASSIGN] ) {
                        o->op_ppaddr = pp_aassign_readonly;
                } else {
                        warn("Not overriding assignment op (already augmented)");
                }
        }
        return o;
}
/* since the pad op is not yet ready at padany check time, SAVEDESTRUCTOR_X is
 * used to defer a check until later
 *
 * if by the time delayed_ck_padany is invoked on the pad op no sassign or
 * aassign opcheck has marked this op as accounted for in an assignment, this
 * means the op is declaring a variable but there is no initialization. */
STATIC void
delayed_ck_padany(pTHX_ OP *o) {
        assert(MY_CXT.padop_table != NULL);
        switch ( o->op_type ) {
                case OP_PADSV:
                case OP_PADHV:
                case OP_PADAV:
                        if ( o->op_private & OPpLVAL_INTRO ) {
                                if ( ptr_table_fetch(MY_CXT.padop_table, o) ) {
                                        /* FIXME the table contains PL_curcup at check time, use it
                                         * for a better error message */
                                        if ( PL_in_eval && !(PL_in_eval & EVAL_KEEPERR) ) {
                                                /* only die if we're not already dying due to some
                                                 * other error */
                                                croak("Declaration of lexical without assignment");
                                        }
                                }
                                break;
                        }
                        /* fall through */
                default:
                        ptr_table_store(MY_CXT.padop_table, o, NULL);
        }
}
STATIC OP *
lsa_ck_padany(pTHX_ OP *o, void *ud) {
        assert(MY_CXT.padop_table != NULL);
        ptr_table_store(MY_CXT.padop_table, (void *)o, (void *)&PL_curcop);
        SAVEDESTRUCTOR_X(delayed_ck_padany, (void *)o);
        return o;
}
MODULE = Lexical::SingleAssignment      PACKAGE = Lexical::SingleAssignment
PROTOTYPES: ENABLE
BOOT:
{
        MY_CXT.padop_table = NULL;
        MY_CXT.padop_table_refcount = 0;
}
hook_op_check_id
setup_sassign (class)
        SV *class;
    CODE:
        RETVAL = hook_op_check (OP_SASSIGN, lsa_ck_sassign, NULL);
    OUTPUT:
        RETVAL
void
teardown_sassign (class, hook)
        hook_op_check_id hook
    CODE:
        (void)hook_op_check_remove (OP_SASSIGN, hook);
hook_op_check_id
setup_aassign (class)
        SV *class;
    CODE:
        RETVAL = hook_op_check (OP_AASSIGN, lsa_ck_aassign, NULL);
    OUTPUT:
        RETVAL
void
teardown_aassign (class, hook)
        hook_op_check_id hook
    CODE:
        (void)hook_op_check_remove (OP_AASSIGN, hook);
hook_op_check_id
setup_padany (class)
        SV *class;
    CODE:
        RETVAL = hook_op_check (OP_PADANY, lsa_ck_padany, NULL);
    OUTPUT:
        RETVAL
void
teardown_padany (class, hook)
        hook_op_check_id hook
    CODE:
        (void)hook_op_check_remove (OP_PADANY, hook);
void ptable_refcount_inc (class)
                SV *class;
        CODE:
                if ( !MY_CXT.padop_table ) {
                        assert( MY_CXT.ptable_refcount == 0 );
                        MY_CXT.padop_table = ptr_table_new();
                }
                MY_CXT.padop_table_refcount++;
                assert( MY_CXT.padop_table_refcount > 0 );
void ptable_refcount_dec (class)
                SV *class;
        CODE:
                assert( MY_CXT.padop_table != NULL );
                assert( MY_CXT.padop_table_refcount > 0 );
                if ( MY_CXT.padop_table_refcount-- == 0 ) {
                        ptr_table_free(MY_CXT.padop_table);
                        MY_CXT.padop_table = NULL;
                }