Merge branch 'master' of git@github.com:/rakudo/rakudo

rakudo · Apr 18, 2009 · e453f45 · e453f45
2 parents 9fdea82 + bbd14b2
commit e453f45
Show file tree

Hide file tree

Showing 6 changed files with 43 additions and 39 deletions.
diff --git a/src/builtins/any-list.pir b/src/builtins/any-list.pir
@@ -55,30 +55,6 @@ the size of that file down and to emphasize their generic,
     .return ($I0)
 .end
 
-=item join
-
-=cut
-
-.namespace []
-.sub 'join' :multi('String')
-    .param string sep
-    .param pmc values          :slurpy
-    .tailcall values.'join'(sep)
-.end
-
-.namespace ['Any']
-.sub 'join' :method :multi(_)
-    .param string sep          :optional
-    .param int has_sep         :opt_flag
-    if has_sep goto have_sep
-    sep = ''
-  have_sep:
-    $P0 = self.'list'()
-    $P0.'!flatten'()
-    $S0 = join sep, $P0
-    .return ($S0)
-.end
-
 =item keys()
 
 Return a List with the keys of the invocant.

diff --git a/src/builtins/control.pir b/src/builtins/control.pir
@@ -46,13 +46,16 @@ the moment -- we'll do more complex handling a bit later.)
 =cut
 
 .sub '!FAIL'
-    .param string value        :optional
-    .param int has_value       :opt_flag
-    if has_value goto have_value
-    value = 'Use of uninitialized value'
-  have_value:
+    .param pmc args            :slurpy
+    if args goto message_args
+    .local string message
+    message = 'Use of uninitialized value'
+    goto have_message
+  message_args:
+    message = join '', args
+  have_message:
     $P0 = new 'Exception'
-    $P0['message'] = value
+    $P0['message'] = message
     $P1 = new 'Failure'
     setattribute $P1, '$!exception', $P0
     .return ($P1)

diff --git a/src/classes/Associative.pir b/src/classes/Associative.pir
@@ -127,7 +127,7 @@ Returns the type constraining what may be stored.
     $I0 = isa invocant, 'Perl6Object'
     if $I0 goto object_method
   foreign:
-    $P0 = get_hll_global ['Associative'], 'postcircumfix:{ }'
+    $P0 = get_hll_global ['Associative[::T]'], 'postcircumfix:{ }'
     .tailcall $P0(invocant, args :flat, options :flat :named)
   object_method:
     .tailcall invocant.'postcircumfix:{ }'(args :flat, options :flat :named)

diff --git a/src/setting/Any-list.pm b/src/setting/Any-list.pm
@@ -11,6 +11,10 @@ class Any is also {
         }
     }
 
+    our Str multi method join(Str $separator = '') {
+        @.list.reduce({ $^a ~ $separator ~ $^b })
+    }
+
     our List multi method map(*&expr) {
         return gather {
             my $arity = &expr.arity || 1;
@@ -97,6 +101,11 @@ our List multi grep(Code $test, *@values) {
     @values.grep($test)
 }
 
+our Str multi join(Str $separator = '', *@values) {
+    die("Not enough arguments for join") if ! @values;
+    @values.join($separator)
+}
+
 our List multi map(Code $expr, *@values) {
     @values.map($expr)
 }

diff --git a/src/setting/Any-str.pm b/src/setting/Any-str.pm
@@ -3,23 +3,23 @@ class Any is also {
         self.lc.subst(/\w+/, { .ucfirst }, :global)
     }
 
-    our Str multi method chop is export {
+    our Str multi method chop() is export {
         self.substr(0, -1)
     }
 
     our Str multi method fmt(Str $format) {
         sprintf($format, self)
     }
 
-    our Str multi method lc is export {
+    our Str multi method lc() is export {
         Q:PIR {
             $S0 = self
             downcase $S0
             %r = box $S0
         }
     }
 
-    our Str multi method lcfirst is export {
+    our Str multi method lcfirst() is export {
         self gt '' ?? self.substr(0,1).lc ~ self.substr(1) !! ""
     }
 
@@ -31,7 +31,7 @@ class Any is also {
         }
     }
 
-    our Int multi method p5chomp is export(:P5) {
+    our Int multi method p5chomp() is export(:P5) {
         my $num = 0;
 
         for @.list -> $str is rw {
@@ -45,7 +45,7 @@ class Any is also {
     }
 
     # TODO: Return type should be a Char once that is supported.
-    our Str multi method p5chop is export(:P5) {
+    our Str multi method p5chop() is export(:P5) {
         my $char = '';
 
         for @.list -> $str is rw {
@@ -58,6 +58,21 @@ class Any is also {
         $char
     }
 
+    our Str multi method samecase(Str $pattern) is export {
+        my @pattern = $pattern.split('');
+        [~] gather {
+            my $p = "";
+            for (~self).split('') -> $s {
+                $p = @pattern.shift if @pattern;
+                given $p {
+                    when /<upper>/ { take $s.uc }
+                    when /<lower>/ { take $s.lc }
+                    default { take $s }
+                }
+            }
+        }
+    }
+
     our List multi method split(Code $delimiter, $limit = *) {
         my $s = ~self;
         my $l = $limit ~~ Whatever ?? Inf !! $limit;
@@ -126,19 +141,19 @@ class Any is also {
     }
 
     # TODO: signature not fully specced in S32 yet
-    our Str multi method trim is export {
+    our Str multi method trim() is export {
         (~self).subst(/(^\s+)|(\s+$)/, "", :g)
     }
 
-    our Str multi method uc is export {
+    our Str multi method uc() is export {
         Q:PIR {
             $S0 = self
             upcase $S0
             %r = box $S0
         }
     }
 
-    our Str multi method ucfirst is export {
+    our Str multi method ucfirst() is export {
         self gt '' ?? self.substr(0,1).uc ~ self.substr(1) !! ""
     }
 }

diff --git a/t/spectest.data b/t/spectest.data
@@ -375,6 +375,7 @@ S32-str/p5chomp.t
 S32-str/p5chop.t
 S32-str/pos.t
 S32-str/rindex.t
+S32-str/samecase.t
 S32-str/split-simple.t
 S32-str/sprintf.t
 S32-str/substr.t