my $qr=qr/^normal$/;
my $bqr=bless qr/^blessed$/,"Foo";
print "Normal : $qr\n";
print "Blessed: $bqr\n";

##</code><code>##

Normal : (?-xism:^normal$)
Blessed: Foo=SCALAR(0x1acf020)

##</code><code>##

SV *
regexp(sv)
    SV * sv
PROTOTYPE: $
PREINIT:
    STRLEN patlen;
    char *pattern;
    char reflags[6];
    int left;
PPCODE:
{
    /* 
       Checks if a reference is a regex or not. If the parameter is 
       not a ref, or is not the result of a qr// then returns undef. 
       Otherwise in list context it returns the pattern and the 
       modifiers, in scalar context it returns the pattern just as it 
       would if the qr// was blessed into the package Regexp and 
       stringified normally.
    */
       
    if (SvMAGICAL(sv)) { /* is this if needed??? Why?*/
        mg_get(sv);
    }
    if(!SvROK(sv)) {     /* bail if we dont have a ref. */ 
        XSRETURN_UNDEF;
    }
    patlen=0;
    left=0;
    if (SvTHINKFIRST(sv))
    {
        sv = (SV*)SvRV(sv);
        if (sv)
        {
            MAGIC *mg;
            if (SvTYPE(sv)==SVt_PVMG)
            {
                if ( ((SvFLAGS(sv) &
                       (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
                      == (SVs_OBJECT|SVs_RMG))
                     && (mg = mg_find(sv, 'r')))
                {
                    /* Housten, we have a regex! */
                    regexp *re = (regexp *)mg->mg_obj;
                    I32 gimme = GIMME_V;

                    if ( gimme == G_ARRAY ) {
                        /* 
                           we are in list/array context so stringify 
                           the modifiers that apply. We ignore "negative 
                           modifiers" in this scenario. Also we dont cache 
                           the modifiers. AFAICT there isnt anywhere for
                           them to go.  :-(
                        */ 

                        char *fptr = "msix";
                        char ch;
                        U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);

                        while((ch = *fptr++)) {
                            if(reganch & 1) {
                                reflags[left++] = ch;
                            }
                            reganch >>= 1;
                        }
                        /* return the pattern and the modifiers */                        
                        XPUSHs(sv_2mortal(newSVpvn(re->precomp,re->prelen)));
                        XPUSHs(sv_2mortal(newSVpvn(reflags,left)));
                        XSRETURN(2);
                    } else {
                            /* 
                               Non array/list context. So we build up the 
                               stringified form just as PL_sv_2pv does, 
                               and like it we also cache the result. The 
                               entire content of the if() is directly taken
                               from PL_sv_2pv
                            */
          
                            if (!mg->mg_ptr )
                            {
                                char *fptr = "msix";
                                char ch;
                                int right = 4;
                                U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);

                                while((ch = *fptr++)) {
                                    if(reganch & 1) {
                                        reflags[left++] = ch;
                                    }
                                    else {
                                        reflags[right--] = ch;
                                    }
                                    reganch >>= 1;
                                }
                                if(left != 4) {
                                    reflags[left] = '-';
                                    left = 5;
                                }
                                mg->mg_len = re->prelen + 4 + left;
                                New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
                                Copy("(?", mg->mg_ptr, 2, char);
                                Copy(reflags, mg->mg_ptr+2, left, char);
                                Copy(":", mg->mg_ptr+left+2, 1, char);
                                Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
                                mg->mg_ptr[mg->mg_len - 1] = ')';
                                mg->mg_ptr[mg->mg_len] = 0;

                            }
                            /* return the pattern in (?msix:..) format */                        
                            XPUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len)));
                            XSRETURN(1);
                    }
                }
            }
        }
    }
    /* 'twould appear it aint a regex, so return undef/empty list */
    XSRETURN_UNDEF;
}

##</code><code>##

my $qr=qr/^foo$/;
while (length $qr < 1000) {
	print "$qr\n";
	$qr=eval "qr/$qr/" or die $@;
}

##</code><code>##

(?-xism:^foo$)
(?-xism:(?-xism:^foo$))
(?-xism:(?-xism:(?-xism:^foo$)))
(?-xism:(?-xism:(?-xism:(?-xism:^foo$))))
(?-xism:(?-xism:(?-xism:(?-xism:(?-xism:^foo$)))))
(?-xism:(?-xism:(?-xism:(?-xism:(?-xism:(?-xism:^foo$))))))
...