Refactor autoviv methods to better handle type objects, use multidisp…

…atch.
rakudo · Apr 20, 2012 · 45ef4e2 · 45ef4e2
1 parent c40f488
commit 45ef4e2
Show file tree

Hide file tree

Showing 4 changed files with 36 additions and 24 deletions.
diff --git a/src/core/Any.pm b/src/core/Any.pm
@@ -111,6 +111,18 @@ my class Any {
                   :excludes_max($excludes_max));
     }
 
+    proto method push(|$) { * }
+    multi method push(Any:U \$self: *@values) {
+        &infix:<=>($self, Array.new);
+        $self.push(@values);
+    }
+
+    proto method unshift(|$) { * }
+    multi method unshift(Any:U \$self: *@values) {
+        &infix:<=>($self, Array.new);
+        $self.unshift(@values);
+    }
+
     proto method postcircumfix:<[ ]>(|$) { * }
     multi method postcircumfix:<[ ]>() { self.list }
     multi method postcircumfix:<[ ]>(:$BIND!) { die(X::Bind::ZenSlice.new()) }
@@ -157,18 +169,18 @@ my class Any {
         die "Cannot bind to a whatever array slice"
     }
 
-    method at_pos(\$self: $pos) is rw {
-        if $self.defined {
-            fail X::OutOfRange.new(
-                what => 'Index',
-                got  => $pos,
-                range => (0..0)
-            ) if $pos != 0;
-            return $self;
-        }
+    proto method at_pos(|$) {*}
+    multi method at_pos(Any:D: $pos) {
+        fail X::OutOfRange.new(
+            what => 'Index',
+            got  => $pos,
+            range => (0..0)
+        ) if $pos != 0;
+        self;
+    }
+    multi method at_pos(Any:U \$self: $pos) is rw {
         pir::setattribute__0PPsP(my $v, Scalar, '$!whence',
-            -> { $self.defined 
-                     || pir::perl6_container_store__0PP($self, Array.new);
+            -> { $self.defined || &infix:<=>($self, Array.new);
                  $self.bind_pos($pos, $v) });
     }
 
@@ -204,12 +216,13 @@ my class Any {
         die "Cannot bind to a whatever hash slice"
     }
 
-    method at_key(\$self: $key) is rw {
-        fail "postcircumfix:<\{ \}> not defined for type {$self.WHAT.perl}"
-            if $self.defined;
+    proto method at_key(|$) { * }
+    multi method at_key(Any:D: $key) {
+        fail "postcircumfix:<\{ \}> not defined for type {self.WHAT.perl}";
+    }
+    multi method at_key(Any:U \$self: $key) is rw {
         pir::setattribute__0PPsP(my $v, Scalar, '$!whence',
-            -> { $self.defined 
-                     || pir::perl6_container_store__0PP($self, Hash.new);
+            -> { $self.defined || &infix:<=>($self, Hash.new);
                  $self.bind_key($key, $v) });
     }
 

diff --git a/src/core/Array.pm b/src/core/Array.pm
@@ -7,7 +7,7 @@ class Array {
         nqp::p6list($args, self.WHAT, Bool::True);
     }
 
-    multi method at_pos($pos) is rw {
+    multi method at_pos(Array:D: $pos) is rw {
         my int $p = nqp::unbox_i($pos.Int);
         my Mu $items := nqp::getattr(self, List, '$!items');
         nqp::islist($items) or 
@@ -20,7 +20,7 @@ class Array {
           !! pir::setattribute__0PPsP(my $v, Scalar, '$!whence',
                  -> { nqp::bindpos($items, $p, $v) } )
     }
-    multi method at_pos(int $pos) is rw {
+    multi method at_pos(Array:D: int $pos) is rw {
         my Mu $items := nqp::getattr(self, List, '$!items');
         nqp::islist($items) or 
             $items := nqp::bindattr(self, List, '$!items', nqp::list());

diff --git a/src/core/Hash.pm b/src/core/Hash.pm
@@ -5,7 +5,7 @@ my class Hash {
 
     method new(*@args) { @args.hash }
 
-    method at_key($key is copy) is rw {
+    multi method at_key(Hash:D: $key is copy) is rw {
         my Mu $storage := pir::defined(nqp::getattr(self, EnumMap, '$!storage')) ??
             nqp::getattr(self, EnumMap, '$!storage') !!
             nqp::bindattr(self, EnumMap, '$!storage', pir::new__Ps('Hash'));

diff --git a/src/core/List.pm b/src/core/List.pm
@@ -65,14 +65,13 @@ my class List does Positional {
         nqp::p6parcel($rpa, Any);
     }
 
-    proto method at_pos($) { * }
-    multi method at_pos($pos is copy) is rw {
+    multi method at_pos(List:D: $pos is copy) is rw {
         $pos = $pos.Int;
         self.exists($pos)
           ?? nqp::atpos($!items, nqp::unbox_i($pos))
           !! Nil
     }
-    multi method at_pos(int $pos) is rw {
+    multi method at_pos(List:D: int $pos) is rw {
         self.exists($pos)
             ?? nqp::atpos($!items, $pos)
             !! Nil;
@@ -167,7 +166,7 @@ my class List does Positional {
           !! fail 'Element popped from empty list';
     }
 
-    method push(*@values) {
+    multi method push(List:D: *@values) {
         my $pos = self.elems;
         fail '.push on infinite lists NYI' if $!nextiter.defined;
         self.STORE_AT_POS($pos++, @values.shift) while @values.gimme(1);
@@ -220,7 +219,7 @@ my class List does Positional {
           !! fail 'Element shifted from empty list';
     }
 
-    method unshift(*@elems) {
+    multi method unshift(List:D: *@elems) {
         nqp::bindattr(self, List, '$!items', nqp::list())
             unless nqp::islist($!items);
         while @elems {