Merge remote-tracking branch 'upstream/nom' into deleteadverbkvpkv

Conflicts: src/core/Any.pm
rakudo · May 22, 2013 · d0ac9a7 · d0ac9a7
2 parents 21a9579 + 267c54c
commit d0ac9a7
Show file tree

Hide file tree

Showing 16 changed files with 74 additions and 26 deletions.
diff --git a/docs/ChangeLog b/docs/ChangeLog
@@ -6,6 +6,7 @@ New in 2013.05
 + implemented Cool.lines
 + renamed IO to IO::Handle; IO is now a tag role, as per spec
 + simplify timezone handling
++ .Set and .Bag methods for List and Parcel
 
 New in 2013.04
 + add Capture.Bool()

diff --git a/docs/release_guide.pod b/docs/release_guide.pod
@@ -73,7 +73,7 @@ Dates are based on Parrot's expected release schedule.
 
   2013-05-23   Rakudo #64 "Austin"             FROGGS
   2013-06-20   Rakudo #65                      masak
-  2013-07-18   Rakudo #66
+  2013-07-18   Rakudo #66                      tadzik
   2013-08-22   Rakudo #67
   2013-09-19   Rakudo #68
   2013-10-17   Rakudo #69

diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -153,7 +153,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
             %info<container_base>  := $*W.find_symbol(['Hash']);
             %info<bind_constraint> := $*W.find_symbol(['Associative']);
             if $shape {
-                @value_type[0] := $*W.find_symbol(['Mu']) unless +@value_type;
+                @value_type[0] := $*W.find_symbol(['Any']) unless +@value_type;
                 my $shape_ast := $shape[0].ast;
                 if $shape_ast.isa(QAST::Stmts) && +@($shape_ast) == 1 && $shape_ast[0].has_compile_time_value {
                     @value_type[1] := $shape_ast[0].compile_time_value;

diff --git a/src/RESTRICTED.setting b/src/RESTRICTED.setting
@@ -11,6 +11,10 @@ sub mkdir(|)  { restricted('mkdir')   }
 sub rmdir(|)  { restricted('rmdir') }
 sub rename(|) { restricted('rename')  }
 sub copy(|)   { restricted('copy')    }
+sub spurt(|)  { restricted('spurt')   }
+sub link(|)   { restricted('link')   }
+sub symlink(|){ restricted('symlink') }
+sub chmod(|)  { restricted('chmod')   }
 
 my class RESTRICTED is Mu { 
     method FALLBACK(|) { restricted(self.^name) }  # NYI, but see S12

diff --git a/src/core/Any.pm b/src/core/Any.pm
@@ -2,6 +2,7 @@ my class MapIter { ... }
 my class Range { ... }
 my class X::Bind::Slice { ... }
 my class X::Bind::ZenSlice { ... }
+my $default= [];  # so that we can check passing of parameters to ".hash"
 
 my class Any {
     multi method ACCEPTS(Any:D: Mu \a) { self === a }
@@ -17,7 +18,21 @@ my class Any {
     method uniq() { self.list.uniq }
     method infinite() { Mu }
     method flat() { nqp::p6list(nqp::list(self), List, Bool::True) }
-    method hash() { my %h = self }
+    method hash( :$type = $default, :$of = $default ) {
+
+        # your basic hash
+        if ( $type === $default and $of === $default ) {
+            my %h = self;
+        }
+
+        # need to add type / of info
+        else {
+            my $code= $of === $default ?? "my %h" !! "my {$of.perl} %h";
+            $code ~= "\{{$type.perl}}" unless $type === $default;
+            $code ~= " = self";
+            eval $code;
+        }
+    }
     method list() { nqp::p6list(nqp::list(self), List, Mu) }
     method lol()  { MapIter.new(self.list, { .item }, Mu).list }
     method pick($n = 1) { self.list.pick($n) }
@@ -402,7 +417,8 @@ my class Any {
                  SELF.delete($_)
              } ).eager.Parcel;
     }
-    multi method postcircumfix:<{ }>(\SELF: Positional \key, :$exists!) is rw {
+    multi method postcircumfix:<{ }>(
+      \SELF: Positional \key, :$exists!) is rw {
         nqp::iscont(key) 
           ?? !( SELF.exists(key) ?^ $exists )
           !! key.map({ !( SELF.exists($_) ?^ $exists ) }).eager.Parcel;

diff --git a/src/core/Bag.pm b/src/core/Bag.pm
@@ -3,6 +3,7 @@ my role Baggy { Any }
 my class Bag is Iterable does Associative does Baggy {
     has %!elems; # should be UInt
 
+    method default { 0 }
     method keys { %!elems.keys }
     method values { %!elems.values }
     method elems returns Int { [+] self.values }
@@ -70,6 +71,7 @@ multi sub infix:<(+)>(Bag $a, Bag $b --> Bag) { bag((set($a) (|) set($b)).map({
 my class KeyBag does Associative does Baggy {
     has %!elems; # should be UInt
 
+    method default { 0 }
     method keys { %!elems.keys }
     method values { %!elems.values }
     method elems returns Int { [+] self.values }

diff --git a/src/core/Hash.pm b/src/core/Hash.pm
@@ -114,7 +114,7 @@ my class Hash {
     }
 
     my role TypedHash[::TValue] does Associative[TValue] {
-        method at_key($key is copy, TValue $v? is copy) is rw {
+        method at_key(::?CLASS:D: $key is copy, TValue $v? is copy) is rw {
             $key = $key.Str;
             self.exists($key)
               ?? nqp::findmethod(EnumMap, 'at_key')(self, $key)
@@ -135,7 +135,7 @@ my class Hash {
     }
     my role TypedHash[::TValue, ::TKey] does Associative[TValue] {
         has $!keys;
-        method at_key(TKey \key, TValue $v? is copy) is rw {
+        method at_key(::?CLASS:D: TKey \key, TValue $v? is copy) is rw {
             my $key_which = key.WHICH;
             self.exists($key_which)
               ?? nqp::findmethod(EnumMap, 'at_key')(self, $key_which)

diff --git a/src/core/IO.pm b/src/core/IO.pm
@@ -347,7 +347,7 @@ sub dir(Cool $path = '.', Mu :$test = none('.', '..')) {
     my Mu $RSA := pir::new__PS('OS').readdir(nqp::unbox_s($path.Str));
     my int $elems = nqp::elems($RSA);
     my @res;
-    my ($directory, $volume) = IO::Spec.splitpath(~$path, :nofile);
+    my ($volume, $directory) = IO::Spec.splitpath(~$path, :nofile);
     loop (my int $i = 0; $i < $elems; $i = $i + 1) {
         my Str $file := nqp::p6box_s(pir::trans_encoding__Ssi(
 			nqp::atpos_s($RSA, $i),

diff --git a/src/core/List.pm b/src/core/List.pm
@@ -71,6 +71,16 @@ my class List does Positional {
         nqp::p6parcel($rpa, Any);
     }
 
+    proto method Set(|) {*}
+    multi method Set() {
+        set self;
+    }
+
+    proto method Bag(|) {*}
+    multi method Bag() {
+        bag self;
+    }
+
     multi method at_pos(List:D: $pos is copy) is rw {
         $pos = $pos.Int;
         self.exists($pos)

diff --git a/src/core/Mu.pm b/src/core/Mu.pm
@@ -489,7 +489,7 @@ my class Mu {
 }
 
 
-proto sub defined(Mu) { * }
+proto sub defined(Mu) is pure { * }
 multi sub defined(Mu \x) { x.defined }
 
 proto sub infix:<~~>(|) { * }

diff --git a/src/core/Parcel.pm b/src/core/Parcel.pm
@@ -116,6 +116,16 @@ my class Parcel does Positional {
     method fmt($format = '%s', $separator = ' ') {
         self.list.fmt($format, $separator);
     }
+
+    proto method Set(|) {*}
+    multi method Set() {
+        set self;
+    }
+
+    proto method Bag(|) {*}
+    multi method Bag() {
+        bag self;
+    }
 }
 
 

diff --git a/src/core/Pod.pm b/src/core/Pod.pm
@@ -54,7 +54,7 @@ my class Pod::Block::Declarator is Pod::Block {
     method Str {
         ~@.content
     }
-    multi method gist(Pod::Block:D:) {
+    multi method gist(Pod::Block::Declarator:D:) {
         self.Str
     }
 }

diff --git a/src/core/Set.pm b/src/core/Set.pm
@@ -1,6 +1,7 @@
 my class Set is Iterable does Associative {
     has %!elems;
 
+    method default { False }
     method keys { %!elems.keys }
     method values { %!elems.values }
     method elems returns Int { %!elems.elems }
@@ -103,6 +104,7 @@ multi sub infix:«(>)»(Set $a, Set $b --> Bool) { $a > $b and so $b.keys.all (e
 my class KeySet is Iterable does Associative {
     has %!elems;
 
+    method default { False }
     method keys { %!elems.keys }
     method values { %!elems.values }
     method elems returns Int { %!elems.elems }

diff --git a/src/core/Stringy.pm b/src/core/Stringy.pm
@@ -4,10 +4,10 @@ multi sub infix:<eqv>(Stringy:D $a, Stringy:D $b) {
     $a.WHAT === $b.WHAT && ($a cmp $b) == 0
 }
 
-proto prefix:<~>($) { * }
+proto prefix:<~>($) is pure { * }
 multi prefix:<~>(\a)          { a.Stringy }
 
-proto infix:<~>($?, $?)            { * }
+proto infix:<~>($?, $?) is pure { * }
 multi infix:<~>($x = '')       { $x.Stringy }
 multi infix:<~>(\a, \b)      { a.Stringy ~ b.Stringy }
 
@@ -16,46 +16,46 @@ multi infix:<x>()              { fail "No zero-arg meaning for infix:<x>" }
 multi infix:<x>($x)            { $x.Stringy }
 multi infix:<x>($s, $n)        { $s.Stringy x ($n.Int // 0) }
 
-proto infix:<leg>($?, $?) { * }
+proto infix:<leg>($?, $?) is pure { * }
 multi infix:<leg>(\a, \b)      { a.Stringy cmp b.Stringy }
 
-proto infix:<eq>($?, $?)            { * }
+proto infix:<eq>($?, $?)  is pure { * }
 multi infix:<eq>($x?)          { Bool::True }
 multi infix:<eq>(\a, \b)       { a.Stringy eq b.Stringy }
 
-proto infix:<ne>(Mu $?, Mu $?)   { * }
+proto infix:<ne>(Mu $?, Mu $?) is pure { * }
 multi infix:<ne>($x?)            { Bool::True }
 multi infix:<ne>(Mu \a, Mu \b)   { a !eq b }
 
-proto infix:<lt>($?, $?)            { * }
+proto infix:<lt>($?, $?) is pure { * }
 multi infix:<lt>($x?)          { Bool::True }
 multi infix:<lt>(\a, \b)       { a.Stringy lt b.Stringy }
 
-proto infix:<le>($?, $?)            { * }
+proto infix:<le>($?, $?) is pure { * }
 multi infix:<le>($x?)          { Bool::True }
 multi infix:<le>(\a, \b)       { a.Stringy le b.Stringy }
 
-proto infix:<gt>($?, $?)            { * }
+proto infix:<gt>($?, $?) is pure { * }
 multi infix:<gt>($x?)          { Bool::True }
 multi infix:<gt>(\a, \b)       { a.Stringy gt b.Stringy }
 
-proto infix:<ge>($?, $?)            { * }
+proto infix:<ge>($?, $?) is pure { * }
 multi infix:<ge>($x?)          { Bool::True }
 multi infix:<ge>(\a, \b)       { a.Stringy ge b.Stringy }
 
-proto infix:<~|>($?, $?)            { * }
+proto infix:<~|>($?, $?) is pure { * }
 multi infix:<~|>($x = '')      { $x.Stringy }
 multi infix:<~|>(\a, \b)       { a.Stringy ~| b.Stringy }
 
-proto infix:<~^>($?, $?)            { * }
+proto infix:<~^>($?, $?)  is pure { * }
 multi infix:<~^>($x = '')      { $x.Stringy }
 multi infix:<~^>(\a, \b)       { a.Stringy ~^ b.Stringy }
 
-proto infix:<~&>($?, $?)            { * }
+proto infix:<~&>($?, $?) is pure { * }
 multi infix:<~&>()             { fail "No zero-arg meaning for infix:<~&>" }
 multi infix:<~&>($x)           { $x.Stringy }
 multi infix:<~&>(\a, \b)       { a.Stringy ~& b.Stringy }
 
-proto prefix:<~^>($?, $?)          { * }
+proto prefix:<~^>($?, $?) is pure { * }
 multi prefix:<~^>(\a)         { ~^ a.Stringy }
 
diff --git a/t/spectest.data b/t/spectest.data
@@ -56,6 +56,7 @@ S02-magicals/pid.t
 S02-magicals/progname.t
 S02-magicals/sub.t
 S02-magicals/vm.t
+S02-names/bare-sigil.t
 S02-names/caller.t
 S02-names/identifier.t
 S02-names/indirect.t
@@ -307,6 +308,7 @@ S05-metasyntax/angle-brackets.t
 S05-metasyntax/assertions.t
 S05-metasyntax/changed.t
 S05-metasyntax/charset.t
+S05-metasyntax/delimiters.t
 S05-metasyntax/interpolating-closure.t
 S05-metasyntax/litvar.t
 S05-metasyntax/longest-alternative.t
@@ -548,7 +550,6 @@ S16-io/getc.t
 S16-io/say-and-ref.t
 S16-io/say.t
 S16-unfiled/rebindstdhandles.t
-S16-unfiled/slurp.t
 S19-command-line/dash-e.t # icu
 S19-command-line/help.t
 S24-testing/0-compile.t
@@ -595,8 +596,9 @@ S32-container/roundrobin.t
 S32-container/zip.t
 S32-exceptions/misc.t
 S32-hash/delete.t
-S32-hash/delete_adverb.t
+S32-hash/delete-adverb.t
 S32-hash/exists.t
+S32-hash/exists-adverb.t
 S32-hash/invert.t
 S32-hash/keys_values.t
 S32-hash/kv.t
@@ -616,6 +618,7 @@ S32-io/io-path-cygwin.t
 S32-io/io-path.t
 S32-io/IO-Socket-INET.t
 S32-io/note.t
+S32-io/slurp.t
 S32-list/categorize.t
 S32-list/classify.t
 S32-list/create.t
@@ -677,7 +680,7 @@ S32-str/samecase.t                                         # icu
 S32-str/split-simple.t
 S32-str/split.t
 S32-str/sprintf.t
-S32-str/substr.t
+S32-str/substr.t                                           # icu
 S32-str/substr-rw.t
 S32-str/tclc.t                                             # icu
 S32-str/trim.t

diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION
@@ -1 +1 @@
-2013.04-134-gb4ad9fc
+2013.04-138-ga0808a0