# New Ticket Created by Vasily Chekalkin
# Please include the string: [perl #59398]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=59398 >
Hello.
For consistency sake (and removing many dummy proxy methods)
--
Bacek.
commit be069166b765ed48e5e21df11498d32ece41b13d
Author: Vasily Chekalkin <[EMAIL PROTECTED]>
Date: Sat Sep 27 22:37:34 2008 +1000
Move many methods from Str.pir to any-str.pir
diff --git a/languages/perl6/src/builtins/any-str.pir b/languages/perl6/src/builtins/any-str.pir
index 5e20b48..2772cc4 100644
--- a/languages/perl6/src/builtins/any-str.pir
+++ b/languages/perl6/src/builtins/any-str.pir
@@ -21,7 +21,7 @@ the size of that file down and to emphasize their generic,
.namespace []
.sub 'onload' :anon :init :load
$P0 = get_hll_namespace ['Any']
- '!EXPORT'('chars ord index rindex substr', 'from'=>$P0)
+ '!EXPORT'('capitalize chop chars index lc lcfirst rindex ord substr uc ucfirst', 'from'=>$P0)
.end
@@ -30,12 +30,89 @@ the size of that file down and to emphasize their generic,
=cut
.namespace ['Any']
+
+=item capitalize
+
+ our Str multi Str::capitalize ( Str $string )
+
+Has the effect of first doing an C<lc> on the entire string, then performing a
+C<s:g/(\w+)/{ucfirst $1}/> on it.
+
+=cut
+
+.sub 'capitalize' :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'Perl6Str'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ downcase tmps
+
+ .local int pos, is_ws, is_lc
+ pos = 0
+ goto first_char
+ next_grapheme:
+ if pos == len goto done
+ is_ws = is_cclass .CCLASS_WHITESPACE, tmps, pos
+ if is_ws goto ws
+ advance:
+ pos += 1
+ goto next_grapheme
+ ws:
+ pos += 1
+ first_char:
+ is_lc = is_cclass .CCLASS_LOWERCASE, tmps, pos
+ unless is_lc goto advance
+ $S1 = substr tmps, pos, 1
+ upcase $S1
+ substr tmps, pos, 1, $S1
+ ## the length may have changed after replacement, so measure it again
+ len = length tmps
+ goto advance
+ done:
+ retv = tmps
+ .return (retv)
+.end
+
.sub 'chars' :method :multi(_)
$S0 = self
$I0 = length $S0
.return ($I0)
.end
+
+=item chop
+
+ our Str method Str::chop ( Str $string: )
+
+Returns string with one Char removed from the end.
+
+=cut
+
+.sub 'chop' :method
+ .local string tmps
+ .local pmc retv
+ .local int len
+
+ retv = new 'Perl6Str'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+ dec len
+ substr tmps,tmps, 0, len
+ done:
+ retv = tmps
+ .return(retv)
+.end
+
+
=item comb()
Partial implementation for now, returns a list of strings
@@ -110,6 +187,62 @@ Partial implementation for now, returns a list of strings
.return ($P0)
.end
+
+=item lc
+
+ our Str multi Str::lc ( Str $string )
+
+Returns the input string after converting each character to its lowercase
+form, if uppercase.
+
+=cut
+
+.sub 'lc' :method
+ .local string tmps
+ .local pmc retv
+
+ tmps = self
+ downcase tmps
+
+ retv = new 'Perl6Str'
+ retv = tmps
+
+ .return(retv)
+.end
+
+=item lcfirst
+
+ our Str multi Str::lcfirst ( Str $string )
+
+Like C<lc>, but only affects the first character.
+
+=cut
+
+.sub 'lcfirst' :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'Perl6Str'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ substr fchr, tmps, 0, 1
+ downcase fchr
+
+ concat retv, fchr
+ substr tmps, tmps, 1
+ concat retv, tmps
+
+ done:
+ .return(retv)
+.end
+
+
+
=item match()
=cut
@@ -643,6 +776,62 @@ Partial implementation. The :g modifier on regexps doesn't work, for example.
.return ($I0)
.end
+
+=item uc
+
+ our Str multi Str::uc ( Str $string )
+
+Returns the input string after converting each character to its uppercase
+form, if lowercase. This is not a Unicode "titlecase" operation, but a
+full "uppercase".
+
+=cut
+
+.sub 'uc' :method :multi(_)
+ .local string tmps
+ .local pmc retv
+
+ tmps = self
+ upcase tmps
+
+ retv = new 'Perl6Str'
+ retv = tmps
+
+ .return(retv)
+.end
+
+=item ucfirst
+
+ our Str multi Str::ucfirst ( Str $string )
+
+Performs a Unicode "titlecase" operation on the first character of the string.
+
+=cut
+
+.sub 'ucfirst' :method
+ .local string tmps
+ .local string fchr
+ .local pmc retv
+ .local int len
+
+ retv = new 'Perl6Str'
+ tmps = self
+
+ len = length tmps
+ if len == 0 goto done
+
+ substr fchr, tmps, 0, 1
+ upcase fchr
+
+ concat retv, fchr
+ substr tmps, tmps, 1
+ concat retv, tmps
+
+ done:
+ .return(retv)
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
diff --git a/languages/perl6/src/classes/Str.pir b/languages/perl6/src/classes/Str.pir
index 65d8d98..3d4a8aa 100644
--- a/languages/perl6/src/classes/Str.pir
+++ b/languages/perl6/src/classes/Str.pir
@@ -46,134 +46,6 @@ as the Perl 6 C<Str> class.
.return(retv)
.end
-.sub lc :method
- .local string tmps
- .local pmc retv
-
- tmps = self
- downcase tmps
-
- retv = new 'Perl6Str'
- retv = tmps
-
- .return(retv)
-.end
-
-.sub uc :method
- .local string tmps
- .local pmc retv
-
- tmps = self
- upcase tmps
-
- retv = new 'Perl6Str'
- retv = tmps
-
- .return(retv)
-.end
-
-.sub lcfirst :method
- .local string tmps
- .local string fchr
- .local pmc retv
- .local int len
-
- retv = new 'Perl6Str'
- tmps = self
-
- len = length tmps
- if len == 0 goto done
-
- substr fchr, tmps, 0, 1
- downcase fchr
-
- concat retv, fchr
- substr tmps, tmps, 1
- concat retv, tmps
-
- done:
- .return(retv)
-.end
-
-.sub ucfirst :method
- .local string tmps
- .local string fchr
- .local pmc retv
- .local int len
-
- retv = new 'Perl6Str'
- tmps = self
-
- len = length tmps
- if len == 0 goto done
-
- substr fchr, tmps, 0, 1
- upcase fchr
-
- concat retv, fchr
- substr tmps, tmps, 1
- concat retv, tmps
-
- done:
- .return(retv)
-.end
-
-.sub capitalize :method
- .local string tmps
- .local string fchr
- .local pmc retv
- .local int len
-
- retv = new 'Perl6Str'
- tmps = self
-
- len = length tmps
- if len == 0 goto done
-
- downcase tmps
-
- .local int pos, is_ws, is_lc
- pos = 0
- goto first_char
- next_grapheme:
- if pos == len goto done
- is_ws = is_cclass .CCLASS_WHITESPACE, tmps, pos
- if is_ws goto ws
- advance:
- pos += 1
- goto next_grapheme
- ws:
- pos += 1
- first_char:
- is_lc = is_cclass .CCLASS_LOWERCASE, tmps, pos
- unless is_lc goto advance
- $S1 = substr tmps, pos, 1
- upcase $S1
- substr tmps, pos, 1, $S1
- ## the length may have changed after replacement, so measure it again
- len = length tmps
- goto advance
- done:
- retv = tmps
- .return (retv)
-.end
-
-.sub 'chop' :method
- .local string tmps
- .local pmc retv
- .local int len
-
- retv = new 'Perl6Str'
- tmps = self
-
- len = length tmps
- if len == 0 goto done
- dec len
- substr tmps,tmps, 0, len
- done:
- retv = tmps
- .return(retv)
-.end
=item perl()
@@ -254,111 +126,6 @@ Returns the identify value.
.include 'cclass.pasm'
-=item lc
-
- our Str multi Str::lc ( Str $string )
-
-Returns the input string after converting each character to its lowercase
-form, if uppercase.
-
-=cut
-
-.sub 'lc'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'lc'()
-.end
-
-
-=item lcfirst
-
- our Str multi Str::lcfirst ( Str $string )
-
-Like C<lc>, but only affects the first character.
-
-=cut
-
-.sub 'lcfirst'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'lcfirst'()
-.end
-
-
-=item uc
-
- our Str multi Str::uc ( Str $string )
-
-Returns the input string after converting each character to its uppercase
-form, if lowercase. This is not a Unicode "titlecase" operation, but a
-full "uppercase".
-
-=cut
-
-.sub 'uc'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'uc'()
-.end
-
-
-=item ucfirst
-
- our Str multi Str::ucfirst ( Str $string )
-
-Performs a Unicode "titlecase" operation on the first character of the string.
-
-=cut
-
-.sub 'ucfirst'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'ucfirst'()
-.end
-
-
-=item capitalize
-
- our Str multi Str::capitalize ( Str $string )
-
-Has the effect of first doing an C<lc> on the entire string, then performing a
-C<s:g/(\w+)/{ucfirst $1}/> on it.
-
-=cut
-
-.sub 'capitalize'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'capitalize'()
-.end
-
-=item chop
-
- our Str method Str::chop ( Str $string: )
-
-Returns string with one Char removed from the end.
-
-=cut
-
-.sub 'chop'
- .param string a
- .local pmc s
- s = new 'Perl6Str'
- s = a
- .return s.'chop'()
-.end
-
-
=item infix:===
Overridden for Str.
