# New Ticket Created by Vasily Chekalkin
# Please include the string: [perl #54514]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=54514 >
Hello.
There is initial implementation of sort for Lists. Only
src/classes/List.pir affected.
Example output:
[EMAIL PROTECTED]:~/src/parrot/languages/perl6$ cat s2.t
my @l = ('a', 'b', 'c', 'd', 1, 2, 3, 4);
my @l1 = sort @l;
say [EMAIL PROTECTED];
[EMAIL PROTECTED]:~/src/parrot/languages/perl6$ ../../parrot perl6.pbc s2.t
1 2 3 4 a b c d
[EMAIL PROTECTED]:~/src/parrot/languages/perl6$ cat s3.t
my @l = ('a', 'b', 'c', 'd', 1, 2, 3, 4);
my @l1 = sort { $^b <=> $^a } , @l;
say [EMAIL PROTECTED];
[EMAIL PROTECTED]:~/src/parrot/languages/perl6$ ../../parrot perl6.pbc s3.t
4 3 2 1 d c b a
--
Bacek
Index: src/classes/List.pir
===================================================================
--- src/classes/List.pir (revision 27652)
+++ src/classes/List.pir (working copy)
@@ -1018,6 +1036,148 @@
.return list.'uniq'()
.end
+=item $!merge
+
+Subsubroutine for merge-sort
+
+=cut
+
+.sub '$!merge'
+ .param pmc comparer
+ .param pmc left
+ .param pmc right
+ .local pmc result, l, r
+ .local int have_left, have_right
+ .local pmc closure
+
+ result = new 'List'
+ $I0 = elements left
+ $I1 = elements right
+
+ have_left = 0
+ have_right = 0
+
+ loop_start:
+
+ shift_left:
+ if have_left goto shift_right
+ unless left goto finish_right
+ l = shift left
+ have_left = 1
+
+ shift_right:
+ if have_right goto loop_body
+ unless right goto finish_left
+
+ r = shift right
+ have_right = 1
+
+ loop_body:
+ closure = newclosure comparer
+ $I0 = closure(l, r)
+ if $I0 < 0 goto push_left
+
+ push_right:
+ push result, r
+ have_right = 0
+ goto loop_start
+
+ push_left:
+ push result, l
+ have_left = 0
+ goto loop_start
+
+
+ finish_left:
+ unless have_left goto finish_left_tail
+ push result, l
+ finish_left_tail:
+ unless left goto finish_right
+ l = shift left
+ push result, l
+ goto finish_left_tail
+
+ finish_right:
+ unless have_right goto finish_right_tail
+ push result, r
+ finish_right_tail:
+ unless right goto finish
+ r = shift right
+ push result, r
+ goto finish_right_tail
+
+ finish:
+ .return (result)
+
+.end
+
+=item $!merge_sort
+
+Implementation of merge-sort algorithm
+
+=cut
+
+.sub '$!merge_sort'
+ .param pmc comparer
+ .param pmc list
+ .local pmc left, right, result, elem
+ .local int len, half
+
+ len = elements list
+
+ unless len <= 1 goto lets_sort
+ .return (list)
+
+ lets_sort:
+ left = new 'List'
+ right = new 'List'
+ half = len / 2
+
+ create_left:
+ if half < 1 goto create_right
+ elem = shift list
+ push left, elem
+ dec half
+ goto create_left
+
+ create_right:
+ len = elements list
+ if len < 1 goto do_it
+
+ elem = shift list
+ push right, elem
+ goto create_right
+
+ do_it:
+ left = '$!merge_sort'(comparer, left)
+ right = '$!merge_sort'(comparer, right)
+ result = '$!merge'(left, right)
+ .return (result)
+.end
+
+
+.sub sort :multi(_, 'List')
+ .param pmc sorter
+ .param pmc list :slurpy
+ .local pmc sorted
+
+ sorted = '$!merge_sort'(sorter, list :flat)
+
+ .return (sorted)
+.end
+
+.sub sort :multi('List')
+ .param pmc list :slurpy
+ .local pmc sorted
+
+ get_global $P0, "infix:cmp"
+ sorted = '$!merge_sort'($P0, list :flat)
+
+ $P0 = 'list'(sorted)
+ .return ($P0)
+.end
+
+
## TODO: join map reduce sort zip
=back
