Add a way to introspect if a lexical is native.

Author: jnthn

src/QAST/Operations.nqp

@@ -1024,6 +1024,15 @@ QAST::Operations.add_core_op('callercode', -> $qastcomp, $op {
     $ops.result($reg);
     $ops
 });
+QAST::Operations.add_core_op('lexprimspec', -> $qastcomp, $op {
+    unless +@($op) == 2 {
+        nqp::die("Operation 'lexprimspec' expects two operands");
+    }
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'), :name('get_lex_type'), :returns(int),
+        $op[0], $op[1]
+    ))
+});
 
 # Exception handling/munging.
 my $exc_exclude := 0;

src/pmc/nqplexpad.pmc

@@ -1,5 +1,11 @@
 #include "pmc_nqplexinfo.h"
 
+/* Possible options for boxed primitives. */
+#define STORAGE_SPEC_BP_NONE    0
+#define STORAGE_SPEC_BP_INT     1
+#define STORAGE_SPEC_BP_NUM     2
+#define STORAGE_SPEC_BP_STR     3
+
 /* Locates the register number for getting the specified name
  * and type of lexical. */
 static INTVAL register_number_for_get(PARROT_INTERP, Hash *hash,
@@ -316,6 +322,24 @@ Return the LexInfo PMC, if any or a Null PMC.
         GET_ATTR_lexinfo(INTERP, SELF, lexinfo);
         RETURN(PMC *lexinfo);
     }
+    
+    METHOD get_lex_type(STRING *name) {
+        Hash *hash;
+        HashBucket *b;
+        INTVAL spec;
+        GET_ATTR_lexinfo_hash(INTERP, SELF, hash);
+        b = Parrot_hash_get_bucket(interp, hash, name);
+        if (!b)
+            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LEX_NOT_FOUND,
+                "Lexical '%Ss' not found", name);
+        switch ((INTVAL)b->value & 3) {
+            case REGNO_INT: spec = STORAGE_SPEC_BP_INT; break;
+            case REGNO_NUM: spec = STORAGE_SPEC_BP_NUM; break;
+            case REGNO_STR: spec = STORAGE_SPEC_BP_STR; break;
+            default: spec = STORAGE_SPEC_BP_NONE; break;
+        }
+        RETURN(INTVAL spec);
+    }
 
 /*