Move RAWCREATE to CgOp for a considerable improvement in lazy list speed

sorear · Jul 21, 2010 · 5e3712d · 5e3712d
1 parent 4aabaad
commit 5e3712d
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 22 deletions.
diff --git a/CgOp.pm b/CgOp.pm
@@ -408,7 +408,8 @@ use warnings;
     }
 
     sub pos {
-        CgOp::Primitive->new(op => [ 'pos', $_[0] ]);
+        CgOp::Primitive->new(op => [ 'pos', blessed($_[0]) ? () : $_[0] ],
+            zyg => [blessed($_[0]) ? ($_[0]) : ()]);
     }
 
     sub ternary {

diff --git a/CodeGen.pm b/CodeGen.pm
@@ -30,6 +30,8 @@ use 5.010;
               Insert       => [m => 'Void'],
               RemoveAt     => [m => 'Void'],
               Count        => [f => 'Int32'] },
+        'LValue[]' =>
+            { Length       => [f => 'Int32'] },
         'Double' =>
             { ToString     => [m => 'String'] },
         'Variable' =>
@@ -41,6 +43,8 @@ use 5.010;
         'String' =>
             { Length       => [f => 'Int32'],
               Substring    => [m => 'String'] },
+        'Frame' =>
+            { pos          => [f => 'LValue[]'] },
 
         'Kernel.SlurpyHelper'  => [c => 'List<Variable>'],
         'Kernel.Bind'          => [c => 'Void'],
@@ -314,6 +318,9 @@ use 5.010;
     # at the Perl 6 level.
     sub pos {
         my ($self, $num) = @_;
+        if (! defined($num)) {
+            $num = $self->_pop;
+        }
         $self->_push('Variable',
             "new Variable(false, Variable.Context.Scalar, th.pos[$num])");
     }
@@ -363,7 +370,7 @@ use 5.010;
 
     sub clr_int {
         my ($self, $val) = @_;
-        $self->_push('System.Int32', $val);
+        $self->_push('Int32', $val);
     }
 
     sub clr_double {
@@ -490,7 +497,8 @@ use 5.010;
 
     sub push_null {
         my ($self, $ty) = @_;
-        $self->_push($ty, "null");
+        # (Int32)null isn't liked much
+        $self->_push($ty, $ty eq 'Int32' ? "0" : "null");
     }
 
     sub close_sub {

diff --git a/setting b/setting
@@ -348,25 +348,20 @@ PRE-INIT {
     Mu.HOW.add-method(Q:CgOp { (w (clr_string "not")) },
         anon method notdef() { ! self.Bool });
     Mu.HOW.add-method(Q:CgOp { (w (clr_string "RAWCREATE")) },
-        anon method RAWCREATE(*@fields) {
-            my $obj = Q:CgOp {
-                (ns (rawnew DynObject (getfield klass
-                    (cast DynObject (@ (l self))))))
-            };
-            while @fields {
-                my $name  = @fields.shift;
-                my $value = @fields.shift;
-
-                Q:CgOp {
-                    (prog
-                      [setindex (unbox String (@ (l $name)))
-                        (getfield slots (cast DynObject (@ (l $obj))))
-                        (l $value)]
-                      [null Variable])
-                };
-            }
-            $obj;
-        });
+        anon method RAWCREATE { Q:CgOp {
+            (withtypes i Int32 max Int32 obj DynObject
+              [l max (getfield Length (getfield pos (callframe)))]
+              [l i (int 1)]
+              [l obj (rawnew DynObject (getfield klass (cast DynObject
+                      (@ (pos 0)))))]
+              [whileloop 0 0 (< (l i) (l max)) (prog
+                  [setindex
+                    (unbox String (@ (pos (l i))))
+                    (getfield slots (l obj))
+                    (nsw (@ (pos (+ (l i) (int 1)))))]
+                  [l i (+ (l i) (int 2))])]
+              [ns (l obj)])
+        } });
     Mu.HOW.add-method(Q:CgOp { (w (clr_string "bless")) },
         anon method bless($obj) { Q:CgOp {
             (prog