commit 47606f1d55237675588da08f772f0e0c797d8502
Author: Vasily Chekalkin <bacek@bacek.com>
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: