first attempt at charrange on JVM

Raku · Nov 11, 2013 · 8f0d8f4 · 8f0d8f4
1 parent f8a27c0
commit 8f0d8f4
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 15 deletions.
diff --git a/src/QRegex/P6Regex/Actions.nqp b/src/QRegex/P6Regex/Actions.nqp
@@ -641,26 +641,22 @@ class QRegex::P6Regex::Actions is HLL::Actions {
                     $str := $str ~ (%*RX<i> ?? nqp::lc($c) ~ nqp::uc($c) !! $c);
                 }
             }
-            #?if parrot
             if nqp::elems(@alts) == 0 && $use-range == 1 && nqp::chars($str) && $<sign> ne '-' {
                 $qast := QAST::Regex.new(
                                   $str,
                                   QAST::IVal.new( :value($lower) ),
                                   QAST::IVal.new( :value($upper) )
                                   , :rxtype<charrange>, :node($/) );
             } else {
-            #?endif
-            @alts.push(QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/), :negate( $<sign> eq '-' ) ))
-                if nqp::chars($str);
-            $qast := +@alts == 1 ?? @alts[0] !!
-                $<sign> eq '-' ??
-                    QAST::Regex.new( :rxtype<concat>, :node($/), :negate(1),
-                        QAST::Regex.new( :rxtype<conj>, :subtype<zerowidth>, |@alts ),
-                        QAST::Regex.new( :rxtype<cclass>, :name<.> ) ) !!
-                    QAST::Regex.new( :rxtype<altseq>, |@alts );
-            #?if parrot
+                @alts.push(QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/), :negate( $<sign> eq '-' ) ))
+                    if nqp::chars($str);
+                $qast := +@alts == 1 ?? @alts[0] !!
+                    $<sign> eq '-' ??
+                        QAST::Regex.new( :rxtype<concat>, :node($/), :negate(1),
+                            QAST::Regex.new( :rxtype<conj>, :subtype<zerowidth>, |@alts ),
+                            QAST::Regex.new( :rxtype<cclass>, :name<.> ) ) !!
+                        QAST::Regex.new( :rxtype<altseq>, |@alts );
             }
-            #?endif
         }
         make $qast;
     }

diff --git a/src/vm/jvm/QAST/Compiler.nqp b/src/vm/jvm/QAST/Compiler.nqp
@@ -4873,10 +4873,48 @@ class QAST::CompilerJAST {
 
         $il;
     }
-    
+
     method charrange($node) {
-        # TODO
-        self.enumcharlist($node);
+        my $il := JAST::InstructionList.new();
+
+        if $node.negate {
+            die("negated charrange NYI");
+        }
+
+        my $succeed := JAST::Label.new(:name(self.unique('charrange_succeed_')));
+
+        $il.append(JAST::Instruction.new( :op('lload'), %*REG<pos> ));
+        $il.append(JAST::Instruction.new( :op('lload'), %*REG<eos> ));
+        $il.append($LCMP);
+        $il.append(JAST::Instruction.new( :op('ifge'), %*REG<fail> ));
+
+        $il.append(JAST::Instruction.new( :op('aload'), %*REG<tgt> ));
+        $il.append(JAST::Instruction.new( :op('lload'), %*REG<pos> ));
+        $il.append($L2I);
+        $il.append(JAST::Instruction.new( :op('invokevirtual'),
+            $TYPE_STR, 'codePointAt', 'Integer', 'Integer' ));
+        $il.append($I2L);
+        $il.append($DUP);
+        $il.append(JAST::PushIVal.new( :value($node[1].value) ));
+        $il.append($LCMP);
+        $il.append(JAST::Instruction.new( :op('ifge'), $succeed ));
+        $il.append($POP);
+        $il.append(JAST::Instruction.new( :op('goto'), %*REG<fail>));
+
+        $il.append($succeed);
+        $il.append(JAST::PushIVal.new( :value($node[2].value) ));
+        $il.append($LCMP);
+        $il.append(JAST::Instruction.new( :op('ifgt'), %*REG<fail> ));
+
+        unless $node.subtype eq 'zerowidth' {
+            $il.append(JAST::Instruction.new( :op('lload'), %*REG<pos> ));
+            $il.append($IVAL_ONE);
+            $il.append($LADD);
+            $il.append(JAST::Instruction.new( :op('lstore'), %*REG<pos> ));
+        }
+
+        $il;
+        #self.enumcharlist($node);
     }
 
     method literal($node) {