WIP on bind/set/getattr with hints

Raku · Sep 18, 2013 · 1af1098 · 1af1098
1 parent f9578fe
commit 1af1098
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 10 deletions.
diff --git a/src/vm/parrot/QAST/Compiler.nqp b/src/vm/parrot/QAST/Compiler.nqp
@@ -983,20 +983,36 @@ class QAST::Compiler is HLL::Compiler {
             $ops.push($obj);
             $ops.push($han);
 
+            # Get lookup hint if possible.
+            my $hint := -1;
+            if @args[1].has_compile_time_value {
+                $hint := pir::repr_hint_for__IPs(@args[1].compile_time_value, $name);
+            }
+
             # Go by whether it's a bind or lookup.
             my $type    := type_to_register_type($node.returns);
             my $op_type := type_to_lookup_name($node.returns);
             if $*BINDVAL {
                 my $valpost := self.as_post_clear_bindval($*BINDVAL, :want(nqp::lc($type)));
                 $ops.push($valpost);
-                $ops.push_pirop("repr_bind_attr_$op_type", $obj.result, $han.result,
-                    self.escape($name), $valpost.result);
+                if $hint == -1 {
+                    $ops.push_pirop("repr_bind_attr_$op_type", $obj.result, $han.result,
+                        self.escape($name), $valpost.result);
+                } else {
+                    $ops.push_pirop("repr_bind_attr_$op_type", $obj.result, $han.result,
+                        self.escape($name), $hint, $valpost.result);
+                }
                 $ops.result($valpost.result);
             }
             else {
                 my $res_reg := $*REGALLOC."fresh_{nqp::lc($type)}"();
-                $ops.push_pirop("repr_get_attr_$op_type", $res_reg, $obj.result, $han.result,
-                    self.escape($name));
+                if $hint == -1 {
+                    $ops.push_pirop("repr_get_attr_$op_type", $res_reg, $obj.result, $han.result,
+                        self.escape($name));
+                } else {
+                    $ops.push_pirop("repr_get_attr_$op_type", $res_reg, $obj.result, $han.result,
+                        self.escape($name), $hint);
+                }
                 $ops.result($res_reg);
             }
         }

diff --git a/src/vm/parrot/QAST/Operations.nqp b/src/vm/parrot/QAST/Operations.nqp
@@ -2130,7 +2130,38 @@ QAST::Operations.add_core_pirop_mapping('r_elems', 'repr_elems', 'IP', :inlinabl
 
 # object opcodes
 QAST::Operations.add_core_pirop_mapping('bindattr', 'setattribute', '3PPsP', :inlinable(1));
-QAST::Operations.add_core_pirop_mapping('bindattr_i', 'repr_bind_attr_int', '3PPsi', :inlinable(1));
+QAST::Operations.add_core_op('bindattr_i', -> $qastcomp, $op {
+    if +@($op) != 4 {
+        nqp::die('bindattr_i requires four operands');
+    }
+    if $op[1].has_compile_time_value && $op[2].has_compile_time_value {
+        my $hint := -1;
+        my $ops := PIRT::Ops.new();
+        $hint := pir::repr_hint_for__IPs($op[1].compile_time_value, $op[2].compile_time_value);
+        my $hint_reg := $*REGALLOC.fresh_i();
+        $hint := $qastcomp.coerce($qastcomp.as_post($hint), 'I');
+        $ops.push("# this bind_attr is improved");
+        $ops.push($hint);
+        $ops.push_pirop('set', $hint_reg, $hint);
+        $ops.push($qastcomp.as_post(QAST::VM.new(
+            :pirop<repr_bind_attr_int__0PPSII>,
+            $op[0],
+            $op[1],
+            $op[2],
+            $op[3],
+            $hint_reg
+        )));
+        $ops;
+    } else {
+        $qastcomp.as_post(QAST::VM.new(
+            :pirop<repr_bind_attr_int__0PPSI>,
+            $op[0],
+            $op[1],
+            $op[2],
+            $op[3]
+        ))
+    }
+});
 QAST::Operations.add_core_pirop_mapping('bindattr_n', 'repr_bind_attr_num', '3PPsn', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('bindattr_s', 'repr_bind_attr_str', '3PPss', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('getattr', 'getattribute', 'PPPs', :inlinable(1));

diff --git a/src/vm/parrot/ops/nqp.ops b/src/vm/parrot/ops/nqp.ops
@@ -1031,7 +1031,7 @@ inline op repr_get_attr_int(out INT, invar PMC, invar PMC, in STR, in INT) :base
         if (IS_CONCRETE(obj)) {
             NativeValue value;
             value.type = NATIVE_VALUE_INT;
-            REPR(obj)->attr_funcs->get_attribute_native(interp, STABLE(obj), OBJECT_BODY(obj), ch, name, NO_HINT, &value);
+            REPR(obj)->attr_funcs->get_attribute_native(interp, STABLE(obj), OBJECT_BODY(obj), ch, name, $5, &value);
             $1 = value.value.intval;
         }
         else
@@ -1062,7 +1062,7 @@ inline op repr_get_attr_num(out NUM, invar PMC, invar PMC, in STR, in INT) :base
         if (IS_CONCRETE(obj)) {
             NativeValue value;
             value.type = NATIVE_VALUE_FLOAT;
-            REPR(obj)->attr_funcs->get_attribute_native(interp, STABLE(obj), OBJECT_BODY(obj), ch, name, NO_HINT, &value);
+            REPR(obj)->attr_funcs->get_attribute_native(interp, STABLE(obj), OBJECT_BODY(obj), ch, name, $5, &value);
             $1 = value.value.floatval;
         }
         else
@@ -2355,10 +2355,10 @@ Gets lookup hint for an attribute.
 =cut
 
 */
-inline op repr_hint_for(out INT, invar PMC, invar PMC, in STR) :base_core {
-    PMC *ch = decontainerize(interp, $3);
+inline op repr_hint_for(out INT, invar PMC, in STR) :base_core {
+    PMC *ch = decontainerize(interp, $2);
     if ($2->vtable->base_type == smo_id)
-        $1 = REPR($2)->attr_funcs->hint_for(interp, STABLE($2), $3, $4);
+        $1 = REPR($2)->attr_funcs->hint_for(interp, STABLE($2), ch, $3);
     else
         $1 = NO_HINT;
 }