Some simple, uncommentable Cursor tracking.

Author: jnthn

src/NQP/Compiler.nqp

@@ -1,3 +1,5 @@
+use QRegex;
+
 class NQP::Compiler is HLL::Compiler {
     method optimize($past, *%adverbs) {
         %adverbs<optimize> eq 'off'
@@ -43,6 +45,10 @@ sub MAIN(*@ARGS) {
     # Enter the compiler.
     $nqpcomp.command_line(@ARGS, :encoding('utf8'), :transcode('ascii iso-8859-1'));
 
+    # Uncomment below to dump cursor usage logging (also need to uncomment two lines
+    # in src/QRegex/Cursor.nqp, in !cursor_start_cur and !cursor_start_all).
+    #ParseShared.log_dump();
+
     # Close event logging
     $nqpcomp.nqpevent();
 }

src/QRegex/Cursor.nqp

@@ -5,6 +5,21 @@ my class ParseShared is export {
     has int $!highwater;
     has @!highexpect;
     has %!marks;
+    
+    # Follow is a little simple usage tracing infrastructure, used by the
+    # !cursor_start_* methods when uncommented.
+    my %cursors_created;
+    my $cursors_total;
+    method log_cc($name) {
+        %cursors_created{$name}++;
+        $cursors_total++;
+    }
+    method log_dump() {
+        for %cursors_created {
+            say($_.value ~ "\t" ~ $_.key);
+        }
+        say("TOTAL: " ~ $cursors_total);
+    }
 }
 
 role NQPCursorRole is export {
@@ -109,6 +124,8 @@ role NQPCursorRole is export {
         my @start_result;
         my $new := nqp::create(self);
         my $sub := nqp::callercode();
+        # Uncomment following to log cursor creation.
+        #$!shared.log_cc(nqp::getcodename($sub));
         nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
         nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
         if nqp::defined($!restart) {
@@ -138,6 +155,8 @@ role NQPCursorRole is export {
     method !cursor_start_cur() {
         my $new := nqp::create(self);
         my $sub := nqp::callercode();
+        # Uncomment following to log cursor creation.
+        #$!shared.log_cc(nqp::getcodename($sub));
         nqp::bindattr($new, $?CLASS, '$!shared', $!shared);
         nqp::bindattr($new, $?CLASS, '$!regexsub', nqp::ifnull(nqp::getcodeobj($sub), $sub));
         if nqp::defined($!restart) {