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

src/builtins/guts.pir

@@ -203,8 +203,10 @@ Helper function to dereference any chains
 
 .sub '!DEREF'
     .param pmc x
+    $P0 = get_root_namespace ['parrot';'ObjectRef']
+    $P0 = get_class $P0
   loop:
-    $I0 = isa x, ['ObjectRef']
+    $I0 = isa x, $P0
     unless $I0 goto done
     x = deref x
     goto loop
@@ -1350,8 +1352,7 @@ Constructs a Mapping, based upon the values list.
     # For now, we assume integer type, unless we have a first pair that says
     # otherwise.
     .local pmc cur_val
-    cur_val = new ['Int']
-    cur_val = 0
+    cur_val = box 0
 
     # Iterate over values and make mapping.
     .local pmc result, values_it, cur_item

src/builtins/op.pir

@@ -28,56 +28,67 @@ src/builtins/op.pir - Perl 6 builtin operators
 
 
 ## autoincrement
-.sub 'postfix:++' :multi(_)
+.sub 'prefix:++' :multi(_) :subid('!prefix:++')
     .param pmc a
-    $P0 = a.'clone'()
     $I0 = defined a
-    if $I0 goto have_a
-    'infix:='(a, 0)
-  have_a:
-    $P1 = a.'clone'()
-    inc $P1
-    'infix:='(a, $P1)
-    .return ($P0)
+    unless $I0 goto inc_undef
+    $P1 = a.'succ'()
+    .tailcall 'infix:='(a, $P1)
+  inc_undef:
+    .tailcall 'infix:='(a, 1)
 .end
 
-.sub 'postfix:--' :multi(_)
+.sub 'postfix:++' :multi(_) :subid('!postfix:++')
     .param pmc a
     $P0 = a.'clone'()
-    $I0 = defined a
-    if $I0 goto have_a
-    'infix:='(a, 0)
-  have_a:
-    $P1 = a.'clone'()
-    dec $P1
-    'infix:='(a, $P1)
+    .const 'Sub' $P1 = '!prefix:++'
+    $P1(a)
     .return ($P0)
 .end
 
-
-.sub 'prefix:++' :multi(_)
+.sub 'prefix:--' :multi(_) :subid('!prefix:--')
     .param pmc a
     $I0 = defined a
-    if $I0 goto have_a
-    'infix:='(a, 0)
-  have_a:
-    $P0 = a.'clone'()
-    inc $P0
-    'infix:='(a, $P0)
-    .return (a)
+    unless $I0 goto dec_undef
+    $P1 = a.'pred'()
+    .tailcall 'infix:='(a, $P1)
+  dec_undef:
+    .tailcall 'infix:='(a, -1)
 .end
 
-
-.sub 'prefix:--' :multi(_)
+.sub 'postfix:--' :multi(_)
     .param pmc a
-    $I0 = defined a
-    if $I0 goto have_a
-    'infix:='(a, 0)
-  have_a:
     $P0 = a.'clone'()
-    dec $P0
-    'infix:='(a, $P0)
+    .const 'Sub' $P1 = '!prefix:--'
+    $P1(a)
+    .return ($P0)
+.end
+
+.sub 'prefix:++' :multi(Integer) :subid('!prefix:++Int')
+    .param pmc a
+    unless a < 2147483647 goto fallback
+    $P0 = getprop 'readonly', a
+    unless null $P0 goto fallback
+    $P0 = getprop 'type', a
+    if null $P0 goto fast_inc
+    $P1 = get_hll_global 'Int'
+    $I0 = issame $P0, $P1
+    unless $I0 goto fallback
+  fast_inc:
+    inc a
     .return (a)
+  fallback:
+    .const 'Sub' fb = '!prefix:++'
+    .tailcall fb(a)
+.end
+
+.sub 'postfix:++' :multi(Integer)
+    .param pmc a
+    $P0 = '!DEREF'(a)
+    $P0 = clone $P0
+    .const 'Sub' $P1 = '!prefix:++Int'
+    $P1(a)
+    .return ($P0)
 .end
 
 
@@ -402,6 +413,7 @@ src/builtins/op.pir - Perl 6 builtin operators
 
     # Get the class of the variable we're adding roles to.
     .local pmc p6meta, parrot_class
+    var.'!rebox'()
     parrot_class = class var
 
     # Derive a new class that does the role(s) specified.

src/classes/Bool.pir

@@ -41,13 +41,15 @@ symbols for C<Bool::True> and C<Bool::False>.
 .end
 
 
-.sub 'succ' :method :vtable('increment')
-    self = 1
+.sub 'succ' :method
+    $P0 = get_global 'True'
+    .return ($P0)
 .end
 
 
-.sub 'pred' :method :vtable('decrement')
-    self = 0
+.sub 'pred' :method
+    $P0 = get_global 'False'
+    .return ($P0)
 .end
 
 =back

src/classes/Int.pir

@@ -28,7 +28,7 @@ Int - Perl 6 integers
 
 =item Scalar
 
-This is a value type, so just returns itself.
+This is a value type, so just returns its dereferenced self.
 
 =cut
 
@@ -73,15 +73,15 @@ Increment and Decrement Methods
 =cut
 
 .sub 'pred' :method
-    $P0 = clone self
-    dec $P0
-    .return ($P0)
+    $N0 = self
+    dec $N0
+    .tailcall '!upgrade_to_num_if_needed'($N0)
 .end
 
 .sub 'succ' :method
-    $P0 = clone self
-    inc $P0
-    .return ($P0)
+    $N0 = self
+    inc $N0
+    .tailcall '!upgrade_to_num_if_needed'($N0)
 .end
 
 

src/classes/Object.pir

@@ -597,6 +597,30 @@ Create a clone of self, also cloning the attributes given by attrlist.
     .return (result)
 .end
 
+
+=item !rebox
+
+If we end up with an object that isn't a subclass of Perl6Object
+(e.g., a parrot Integer, Float, or Str), the C<!rebox> method will
+adjust it.
+
+=cut
+
+.namespace ['Perl6Object']
+.sub '!rebox' :method
+    $I0 = isa self, ['Perl6Object']
+    if $I0 goto done
+    .local pmc p6meta
+    p6meta = get_hll_global ['Perl6Object'], '$!P6META'
+    $P0 = self.'WHAT'()
+    $P0 = p6meta.'get_parrotclass'($P0)
+    $P0 = new $P0
+    assign $P0, self
+    copy self, $P0
+  done:
+.end
+
+
 =item !.?
 
 Helper method for implementing the .? operator. Calls at most one matching

src/classes/Str.pir

@@ -94,16 +94,116 @@ Increment and Decrement Methods
 
 =cut
 
+.namespace ['Str']
+.const string RANGES = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza"
+
+.sub '!range_pos' :anon
+    .param string str
+
+    .local int len, pos, r0, r1
+    len = length str
+
+    # Scan from the end of a string for a character that is in RANGES.
+    # This is the potential end of the substring to be incremented.
+    pos = len
+  scan_loop:
+    # Reset range positions to indicate that we haven't found a valid substr
+    r0 = 0
+    r1 = -1
+  scan_end_loop:
+    unless pos > 0 goto done
+    dec pos
+    $S0 = substr str, pos, 1
+    $I0 = index RANGES, $S0
+    if $I0 < 0 goto scan_end_loop
+
+    # we found a candidate end of the range, now scan for start
+    r1 = pos
+  scan_start_loop:
+    # if we reach the beginning of the string, the range starts at pos 0
+    unless pos > 0 goto done
+    dec pos
+    $S0 = substr str, pos, 1
+    # if we find a dot: this isn't a valid range, scan again
+    if $S0 == '.' goto scan_loop
+    # if we find a valid character, keep scanning
+    $I0 = index RANGES, $S0
+    if $I0 >= 0 goto scan_start_loop
+    # pos + 1 is the start of the range, we're done
+    r0 = pos + 1
+
+  done:
+    .return (r0, r1)
+.end
+
+
 .sub 'pred' :method
-    $P0 = clone self
-    dec $P0
-    .return ($P0)
+    .local string str
+    str = self
+    str = clone str
+
+    .local int r0, r1, ipos
+    (r0, r1) = '!range_pos'(str)
+    if r1 < 0 goto done
+
+  dec_1:
+    .local string orig, repl
+    orig = substr str, r1, 1
+    ipos = index RANGES, orig 
+    $I0 = ipos + 1
+    $I0 = index RANGES, orig, $I0
+    if $I0 < 0 goto dec_2
+    ipos = $I0
+  dec_2:
+    dec ipos
+    repl = substr RANGES, ipos, 1
+    substr str, r1, 1, repl
+    # if the replacement wasn't a carry, we're done
+    if orig > repl goto done
+  carry:
+    # if there are more characters in the range, decrement those first
+    dec r1
+    if r1 >= r0 goto dec_1
+  extend:
+    .tailcall '!FAIL'('Decrement out of range')
+
+  done:
+    .return (str)
 .end
 
+
 .sub 'succ' :method
-    $P0 = clone self
-    inc $P0
-    .return ($P0)
+    .local string str
+    str = self
+    str = clone str
+
+    .local int r0, r1, ipos
+    (r0, r1) = '!range_pos'(str)
+    if r1 < 0 goto done
+
+  inc_1:
+    .local string orig, repl
+    orig = substr str, r1, 1
+    ipos = index RANGES, orig 
+    inc ipos
+    .local string repl
+    repl = substr RANGES, ipos, 1
+    substr str, r1, 1, repl
+    # if the replacement wasn't a carry, we're done
+    if orig < repl goto done
+  carry:
+    # if there are more characters in the range, increment those first
+    dec r1
+    if r1 >= r0 goto inc_1
+  extend:
+    # insert a new character based on the previous one
+    unless repl == '0' goto extend_1
+    repl = '1'
+  extend_1:
+    substr str, r0, 0, repl
+
+  done:
+    .return (str)
 .end