# New Ticket Created by Vasily Chekalkin
# Please include the string: [perl #59400]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=59400 >
Hello.
Small proxy class to support lvalue semantic of Str.substr. Holds
original string, start, len. In get_string method returns substring. In
infix:= construct new string and assign it to original.
--
Bacek
commit 47606f1d55237675588da08f772f0e0c797d8502
Author: Vasily Chekalkin <[EMAIL PROTECTED]>
Date: Sat Sep 27 22:39:50 2008 +1000
Implement SubStr class to support lvalue assignemnt for Str.substr.
diff --git a/languages/perl6/config/makefiles/root.in b/languages/perl6/config/makefiles/root.in
index 69b0175..21960cd 100644
--- a/languages/perl6/config/makefiles/root.in
+++ b/languages/perl6/config/makefiles/root.in
@@ -78,6 +78,7 @@ BUILTINS_PIR = \
src/classes/Subset.pir \
src/classes/Grammar.pir \
src/classes/Module.pir \
+ src/classes/SubStr.pir \
src/builtins/globals.pir \
src/builtins/any-list.pir \
src/builtins/any-num.pir \
diff --git a/languages/perl6/src/builtins/any-str.pir b/languages/perl6/src/builtins/any-str.pir
index 2772cc4..962d9ea 100644
--- a/languages/perl6/src/builtins/any-str.pir
+++ b/languages/perl6/src/builtins/any-str.pir
@@ -440,9 +440,16 @@ B<Note:> partial implementation only
len += $I0
len -= start
len_done:
- $S0 = self
- $S1 = substr $S0, start, len
- .return ($S1)
+ $I0 = self.'chars'()
+ if start > $I0 goto return_fail
+ if start > 0 goto do_substr
+ $I0 = -$I0
+ if start < $I0 goto return_fail
+ do_substr:
+ $P0 = get_hll_global 'SubStr'
+ .return $P0.'new'('string'=>self,'start'=>start,'len'=>len)
+ return_fail:
+ .return '!FAIL'('Substr outside the string')
.end
=item trans()
diff --git a/languages/perl6/src/classes/SubStr.pir b/languages/perl6/src/classes/SubStr.pir
new file mode 100644
index 0000000..46d73a5
--- /dev/null
+++ b/languages/perl6/src/classes/SubStr.pir
@@ -0,0 +1,88 @@
+## $Id$
+
+=head1 TITLE
+
+SubStr - Proxy class to support assignment to Str.substr result
+
+=head1 DESCRIPTION
+
+Holds original Str, start and len.
+
+=head1 Methods
+
+=over 4
+
+=cut
+
+.namespace ['SubStr']
+
+.include 'cclass.pasm'
+
+.sub 'onload' :anon :init :load
+ .local pmc p6meta, strsubstrproto
+ p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+ strsubstrproto = p6meta.'new_class'('SubStr', 'parent'=>'Any', 'attr'=>'$!string $!start $!len')
+.end
+
+=item get_string() (vtable)
+
+=cut
+
+.sub 'VTABLE_get_string' :method :vtable('get_string')
+ .local string str
+ .local int start, len
+ $P0 = getattribute self, '$!string'
+ str = $P0
+ $P0 = getattribute self, '$!start'
+ start = $P0
+ $P0 = getattribute self, '$!len'
+ len = $P0
+ $S1 = substr str, start, len
+ .return ($S1)
+.end
+
+=item infix:=
+
+Assign operator. Construct new string replacing substring with provided one.
+
+=cut
+
+.sub 'infix:=' :method
+ .param string replacement
+
+ .local pmc origin
+ .local string str, result
+ .local int start, len
+ origin = getattribute self, '$!string'
+ str = origin
+ $P0 = getattribute self, '$!start'
+ start = $P0
+ $P0 = getattribute self, '$!len'
+ len = $P0
+
+ if start == 0 goto replace_substr
+ # Get head.
+ result = substr str, 0, start
+ replace_substr:
+ result = concat result, replacement
+
+ # Concat tail
+ $I0 = origin.'chars'()
+ $I1 = $I0 - len
+ $S0 = substr str, len, $I1
+ result = concat result, $S0
+
+ origin = result
+ .return ()
+.end
+
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
