def gnomeSort(array) {
    var size := array.size()
    var i := 1
    var j := 2
    while (i < size) {
        if (array[i-1] <= array[i]) {
            i := j
            j += 1
        } else {
            def t := array[i-1]
            array[i-1] := array[i]
            array[i] := t
            i -= 1
            if (i <=> 0) {
                i := j
                j += 1
            }
        }
    }
}


class
	GNOME_SORT [G -> COMPARABLE]

feature

	sort (ar: ARRAY [G]): ARRAY [G]
			-- Sorted array in ascending order.
		require
			array_not_void: ar /= Void
		local
			i, j: INTEGER
			ith: G
		do
			create Result.make_empty
			Result.deep_copy (ar)
			from
				i := 2
				j := 3
			until
				i > Result.count
			loop
				if Result [i - 1] <= Result [i] then
					i := j
					j := j + 1
				else
					ith := Result [i - 1]
					Result [i - 1] := Result [i]
					Result [i] := ith
					i := i - 1
					if i = 1 then
						i := j
						j := j + 1
					end
				end
			end
		ensure
			Same_length: ar.count = Result.count
			Result_is_sorted: is_sorted (Result)
		end

feature {NONE}

	is_sorted (ar: ARRAY [G]): BOOLEAN
			--- Is 'ar' sorted in ascending order?
		require
			ar_not_empty: ar.is_empty = False
		local
			i: INTEGER
		do
			Result := True
			from
				i := ar.lower
			until
				i = ar.upper
			loop
				if ar [i] > ar [i + 1] then
					Result := False
				end
				i := i + 1
			end
		end

end


def insertion_sort(L)
	for i in range(1, len(L) - 1)
		j = i - 1
		key = L[i]
		while (L[j] > key) and (j >= 0)
			L[j + 1] = L[j]
			j -= 1
		end
		L[j+1] = key
	end

	return L
end


using System.Console;
using Nemerle.English;

module InsertSort
{
    public static Sort(this a : array[int]) : void
    {
        mutable value = 0; mutable j = 0;
        foreach (i in [1 .. (a.Length - 1)])
        {
            value = a[i]; j = i - 1;
            while (j >= 0 and a[j] > value)
            {
                a[j + 1] = a[j];
                j = j - 1;
            }
            a[j + 1] = value;
        }
    }

    Main() : void
    {
        def arr = array[1, 4, 8, 3, 8, 3, 5, 2, 6];
        arr.Sort();
        foreach (i in arr) Write($"$i  ");
    }
}


%%%-------------------------------------------------------------------

:- module quicksort_task_for_lists.

:- interface.
:- import_module io.
:- pred main(io, io).
:- mode main(di, uo) is det.

:- implementation.
:- import_module int.
:- import_module list.

%%%-------------------------------------------------------------------
%%%
%%% Partitioning a list into three:
%%%
%%%    Left         elements less than the pivot
%%%    Middle       elements equal to the pivot
%%%    Right        elements greater than the pivot
%%%
%%% The implementation is tail-recursive.
%%%

:- pred partition(comparison_func(T), T, list(T),
                  list(T), list(T), list(T)).
:- mode partition(in, in, in, out, out, out) is det.
partition(Compare, Pivot, Lst, Left, Middle, Right) :-
  partition(Compare, Pivot, Lst, [], Left, [], Middle, [], Right).

:- pred partition(comparison_func(T), T, list(T),
                  list(T), list(T),
                  list(T), list(T),
                  list(T), list(T)).
:- mode partition(in, in, in,
                  in, out,
                  in, out,
                  in, out) is det.
partition(_, _, [], Left0, Left, Middle0, Middle, Right0, Right) :-
  Left = Left0,
  Middle = Middle0,
  Right = Right0.
partition(Compare, Pivot, [Head | Tail], Left0, Left,
          Middle0, Middle, Right0, Right) :-
  Compare(Head, Pivot) = Cmp,
  (if (Cmp = (<))
   then partition(Compare, Pivot, Tail,
                  [Head | Left0], Left,
                  Middle0, Middle,
                  Right0, Right)
   else if (Cmp = (=))
   then partition(Compare, Pivot, Tail,
                  Left0, Left,
                  [Head | Middle0], Middle,
                  Right0, Right)
   else partition(Compare, Pivot, Tail,
                  Left0, Left,
                  Middle0, Middle,
                  [Head | Right0], Right)).

%%%-------------------------------------------------------------------
%%%
%%% Quicksort using the first element as pivot.
%%%
%%% This is not the world's best choice of pivot, but it is the
%%% easiest one to get from a linked list.
%%%
%%% This implementation is *not* tail-recursive--as most quicksort
%%% implementations also are not. (However, do an online search on
%%% "quicksort fortran 77" and you will find some "tail-recursive"
%%% implementations, with the tail recursions expressed as gotos.)
%%%

:- func quicksort(comparison_func(T), list(T)) = list(T).
quicksort(_, []) = [].
quicksort(Compare, [Pivot | Tail]) = Sorted_Lst :-
  partition(Compare, Pivot, Tail, Left, Middle, Right),
  quicksort(Compare, Left) = Sorted_Left,
  quicksort(Compare, Right) = Sorted_Right,
  Sorted_Left ++ [Pivot | Middle] ++ Sorted_Right = Sorted_Lst.

%%%-------------------------------------------------------------------

:- func example_numbers = list(int).
example_numbers = [1, 3, 9, 5, 8, 6, 5, 1, 7, 9, 8, 6, 4, 2].

:- func int_compare(int, int) = comparison_result.
int_compare(I, J) = Cmp :-
  if (I < J) then (Cmp = (<))
  else if (I = J) then (Cmp = (=))
  else (Cmp = (>)).

main(!IO) :-
  quicksort(int_compare, example_numbers) = Sorted_Numbers,
  print("unsorted: ", !IO),
  print_line(example_numbers, !IO),
  print("sorted:   ", !IO),
  print_line(Sorted_Numbers, !IO).

%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:


import extensions;
import system'routines;

extension op
{
    gnomeSort()
    {
        var list := self.clone();
        int i := 1;
        int j := 2;

        while (i < list.Length)
        {
            if (list[i-1]<=list[i])
            {
                i := j;
                j += 1
            }
            else
            {
                list.exchange(i-1,i);
                i -= 1;
                if (i==0)
                {
                    i := 1;
                    j := 2
                }
            }
        };

        ^ list
    }
}

public program()
{
    var list := new int[]{3, 9, 4, 6, 8, 1, 7, 2, 5};

    console.printLine("before:", list.asEnumerable());
    console.printLine("after :", list.gnomeSort().asEnumerable())
}


defmodule Sort do
  def gnome_sort([]), do: []
  def gnome_sort([h|t]), do: gnome_sort([h], t)

  defp gnome_sort(list, []), do: list
  defp gnome_sort([prev|p], [next|n]) when next > prev, do: gnome_sort(p, [next,prev|n])
  defp gnome_sort(p, [next|n]), do: gnome_sort([next|p], n)
end

IO.inspect Sort.gnome_sort([8,3,9,1,3,2,6])


-module(gnome_sort).
-export([gnome/1]).

gnome(L, []) -> L;
gnome([Prev|P], [Next|N]) when Next > Prev ->
	gnome(P, [Next|[Prev|N]]);
gnome(P, [Next|N]) ->
	gnome([Next|P], N).
gnome([H|T]) -> gnome([H], T).


/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.util.List

placesList = [String -
    "UK  London",     "US  New York",   "US  Boston",     "US  Washington" -
  , "UK  Washington", "US  Birmingham", "UK  Birmingham", "UK  Boston"     -
]

lists = [ -
    placesList -
  , insertionSort(String[] Arrays.copyOf(placesList, placesList.length)) -
]

loop ln = 0 to lists.length - 1
  cl = lists[ln]
  loop ct = 0 to cl.length - 1
    say cl[ct]
    end ct
    say
  end ln

return

method insertionSort(A = String[]) public constant binary returns String[]

  rl = String[A.length]
  al = List insertionSort(Arrays.asList(A))
  al.toArray(rl)

  return rl

method insertionSort(A = List) public constant binary returns ArrayList

  loop i_ = 1 to A.size - 1
    value = A.get(i_)
    j_ = i_ - 1
    loop label j_ while j_ >= 0
      if (Comparable A.get(j_)).compareTo(Comparable value) <= 0 then leave j_
      A.set(j_ + 1, A.get(j_))
      j_ = j_ - 1
      end j_
      A.set(j_ + 1, value)
    end i_

  return ArrayList(A)


proc insertSort[T](a: var openarray[T]) =
  for i in 1 .. a.high:
    let value = a[i]
    var j = i
    while j > 0 and value < a[j-1]:
      a[j] = a[j-1]
      dec j
    a[j] = value

var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
insertSort a
echo a


(*#####################*)
 DEFINITION MODULE QSORT;
(*#####################*)

FROM SYSTEM IMPORT ADDRESS;

TYPE CmpFuncPtrs = PROCEDURE(ADDRESS, ADDRESS):INTEGER;

 PROCEDURE QuickSortPtrs(VAR Array:ARRAY OF ADDRESS; N:CARDINAL;
                         Compare:CmpFuncPtrs);
END QSORT.


function gnomeSort(sequence s)
    integer i,j
    object temp
    i = 1
    j = 2
    while i < length(s) do
        if compare(s[i], s[i+1]) <= 0 then
            i = j
            j += 1
        else
            temp = s[i]
            s[i] = s[i+1]
            s[i+1] = temp
            i -= 1
            if i = 0 then
                i = j
                j += 1
            end if
        end if
    end while
    return s
end function


let inline gnomeSort (a: _ []) =
  let rec loop i j =
    if i < a.Length then
      if a.[i-1] <= a.[i] then loop j (j+1) else
        let t = a.[i-1]
        a.[i-1] <- a.[i]
        a.[i] <- t
        if i=1 then loop j (j+1) else loop (i-1) j
  loop 1 2


bundle Default {
  class Insert {
    function : Main(args : String[]) ~ Nil {
      values := [9, 7, 10, 2, 9, 7, 4, 3, 10, 2, 7, 10];
      InsertionSort(values);
      each(i : values) {
        values[i]->PrintLine();
      };
    }

    function : InsertionSort (a : Int[]) ~ Nil {
      each(i : a) {
        value := a[i];
        j := i - 1;
        while(j >= 0 & a[j] > value) {
          a[j + 1] := a[j];
          j -= 1;
        };
        a[j + 1] := value;
      };
    }
  }
}


let rec insert lst x =
  match lst with
    [] -> [x]
  | y :: ys  when x <= y -> x :: y :: ys
  | y :: ys -> y :: insert ys x

;;
let insertion_sort = List.fold_left insert [];;

insertion_sort [6;8;5;9;3;2;1;4;7];;


GENERIC INTERFACE ArraySort(Elem);

PROCEDURE Sort(VAR a: ARRAY OF Elem.T; cmp := Elem.Compare);

END ArraySort.


USING: kernel math sequences ;
IN: rosetta-code.gnome-sort

: inc-pos ( pos seq -- pos' seq )
    [ 1 + ] dip ; inline

: dec-pos ( pos seq -- pos' seq )
    [ 1 - ] dip ; inline

: take-two ( pos seq -- elt-at-pos-1 elt-at-pos )
    [ dec-pos nth ] [ nth ] 2bi ; inline

: need-swap? ( pos seq -- pos seq ? )
    over 1 < [ f ] [ 2dup take-two > ] if ;

: swap-back ( pos seq -- pos seq' )
    [ take-two ] 2keep
    [ dec-pos set-nth ] 2keep
    [ set-nth ] 2keep ;

: gnome-sort ( seq -- sorted-seq )
    1 swap [ 2dup length < ] [
        2dup [ need-swap? ] [ swap-back dec-pos ] while
        2drop inc-pos
    ] while nip ;


class Main
{
  Int[] gnomesort (Int[] list)
  {
    i := 1
    j := 2
    while (i < list.size)
    {
      if (list[i-1] <= list[i])
      {
        i = j
        j += 1
      }
      else
      {
        list.swap(i-1, i)
        i -= 1
        if (i == 0)
        {
          i = j
          j += 1
        }
      }
    }

    return list
  }

  Void main ()
  {
    list := [4,1,5,8,2,1,5,7]
    echo ("" + list + " sorted is " + gnomesort (list))
  }
}


defer precedes
defer exchange

: gnomesort                   ( a n)
  swap >r 1                   ( n c)
  begin                       ( n c)
    over over >               ( n c f)
  while                       ( n c)
    dup if                    ( n c)
      dup dup 1- over over [email protected] precedes
      if [email protected] exchange 1- else drop drop 1+ then
    else 1+ then              ( n c)
  repeat drop drop r> drop    ( --)
;

create example
  8 93 69 52 50 79 33 52 19 77 , , , , , , , , , ,

:noname >r cells [email protected] + @ swap cells r> + @ swap < ; is precedes
:noname >r cells [email protected] + swap cells r> + over @ over @ swap rot ! swap ! ; is exchange

: .array 10 0 do example i cells + ? loop cr ;

.array example 10 gnomesort .array


program example

  implicit none

  integer :: array(8) = (/ 2, 8, 6, 1, 3, 5, 4, 7 /)

  call Gnomesort(array)
  write(*,*) array

contains

subroutine Gnomesort(a)

  integer, intent(in out) :: a(:)
  integer :: i, j, temp

  i = 2
  j = 3
  do while (i <= size(a))
    if (a(i-1) <= a(i)) then
      i = j
      j = j + 1
    else
      temp = a(i-1)
      a(i-1) = a(i)
      a(i) = temp
      i = i -  1
      if (i == 1) then
        i = j
        j = j + 1
      end if
    end if
  end do

end subroutine Gnomesort

Optimized Version

      SUBROUTINE OPTIMIZEDGNOMESORT(A)     ! Nice
      IMPLICIT NONE
!
! Dummy arguments
!
      REAL , DIMENSION(0:)  ::  A
      INTENT (INOUT) A
!
! Local variables
!
      INTEGER  ::  posy
!
      DO posy = 1 , UBOUND(A , 1)       !size(a)-1
         CALL GNOMESORT(A , posy)
      END DO
      RETURN
      CONTAINS

      SUBROUTINE GNOMESORT(A , Upperbound)
      IMPLICIT NONE
!
! Dummy arguments
!
      INTEGER  ::  Upperbound
      REAL , DIMENSION(0:)  ::  A
      INTENT (IN) Upperbound
      INTENT (INOUT) A
!
! Local variables
!
      LOGICAL  ::  eval
      INTEGER  ::  posy
      REAL  ::  t
!
      eval = .FALSE.
      posy = Upperbound
      eval = (posy>0) .AND. (A(posy - 1)>A(posy))
!     do while ((posy > 0) .and. (a(posy-1) > a(posy)))
      DO WHILE ( eval )
         t = A(posy)
         A(posy) = A(posy - 1)
         A(posy - 1) = t
!
         posy = posy - 1
         eval = (posy>0)
         IF( eval )THEN     ! Have to use as a guard condition
            eval = (A(posy - 1)>A(posy))
         ELSE
            eval = .FALSE.
         END IF
      END DO
      RETURN
      END SUBROUTINE GNOMESORT

      END SUBROUTINE OPTIMIZEDGNOMESORT
!

end program example


: insertionSort(a)
| l i j v |
   a asListBuffer ->l
   2 l size for: i [
      l at(i) ->v
      i 1- ->j
      while(j) [
         l at(j) dup v <= ifTrue: [ drop break ]
         j 1+ swap l put
         j 1- ->j
         ]
      l put(j 1 +, v)
      ]
   l ;


/* REXX program sorts a stemmed array (has characters)                */
/* using the insertion sort algorithm                                 */
  Call gen                          /* fill the array with test data  */
  Call show 'before sort'           /* display the elements           */
  Say copies('-',79)                /* display a separator line       */
  Call insertionSort x.0            /* invoke the insertion sort.     */
  Call show ' after sort'           /* display the elements after sort*/
  Exit
/*--------------------------------------------------------------------*/
gen: Procedure Expose x.
  x.1="---Monday's Child Is Fair of Face  (by Mother Goose)---"
  x.2="======================================================="
  x.3="Monday's child is fair of face;"
  x.4="Tuesday's child is full of grace;"
  x.5="Wednesday's child is full of woe;"
  x.6="Thursday's child has far to go;"
  x.7="Friday's child is loving and giving;"
  x.8="Saturday's child works hard for a living;"
  x.9="But the child that is born on the Sabbath day"
  x.10="Is blithe and bonny, good and gay."
  x.0=10                            /* number of elements             */
  Return
/*--------------------------------------------------------------------*/
insertionsort: Procedure Expose x.
  Parse Arg n
  Do i=2 To n
    y=x.i
    Do j=i-1 By -1 To 1 While x.j>y
      z=j+1
      x.z=x.j
      /* Say 'set x.'z 'to x.'j '('||x.j||')' */
      End
    z=j+1
    x.z=y
    /* Say 'set x.'z 'to' y                   */
    End
  Return
/*--------------------------------------------------------------------*/
show:
  Do j=1 To x.0
    Say 'Element' right(j,length(x.0)) arg(1)":" x.j
    End
  Return


fun quicksort( arr, cmp )
{
    if( arr.length() < 2 )
        return arr;

    if( !cmp )
        cmp = ( a, b ) -> a - b;

    var a = [ ], b = [ ];
    var pivot = arr[0];
    var len = arr.length();

    for( var i = 1; i < len; ++i )
    {
        var item = arr[i];

        if( cmp( item, pivot ) < cmp( pivot, item ) )
            a.add( item );
        else
            b.add( item );
    }

    a = quicksort( a, cmp );
    b = quicksort( b, cmp );

    a.add( pivot );

    foreach( var item in b )
        a.add( item );

    return a;
}


' version 21-10-2016
' compile with: fbc -s console
' for boundry checks on array's compile with: fbc -s console -exx

Sub gnomesort(gnome() As Long)
    ' sort from lower bound to the highter bound
    ' array's can have subscript range from -2147483648 to +2147483647
    Dim As Long lb = LBound(gnome)
    Dim As Long ub = UBound(gnome)
    Dim As Long i = lb +1, j = lb +2

    While i < (ub +1)
        ' replace "<=" with ">=" for downwards sort
        If gnome(i -1) <= gnome(i) Then
            i = j
            j += 1
        Else
            Swap gnome(i -1), gnome(i)
            i -= 1
            If i = lb Then
                i = j
                j += 1
            End If
        End If
    Wend

End Sub

' ------=< MAIN >=------

Dim As Long i, array(-7 To 7)

Dim As Long a = LBound(array), b = UBound(array)

Randomize Timer
For i = a To b : array(i) = i  : Next
For i = a To b ' little shuffle
    Swap array(i), array(Int(Rnd * (b - a +1)) + a)
Next

Print "unsort ";
For i = a To b : Print Using "####"; array(i); : Next : Print
gnomesort(array())  ' sort the array
Print "  sort ";
For i = a To b : Print Using "####"; array(i); : Next : Print

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


Public Sub Main()
Dim siCount As Short
Dim siCounti As Short = 1
Dim siCountj As Short = 2
Dim siToSort As Short[] = [249, 28, 111, 36, 171, 98, 29, 448, 44, 147, 154, 46, 102, 183, 24]

Print "To sort: - ";
GoSub Display

While siCounti < siToSort.Count
  If siToSort[siCounti - 1] <= siToSort[siCounti] Then
    siCounti = siCountj
    Inc siCountj
  Else
    Swap siToSort[siCounti - 1], siToSort[siCounti]
    Dec siCounti
    If siCounti = 0 Then
      siCounti = siCountj
      Inc siCountj
    Endif
  Endif
Wend

Print "Sorted: -  ";
GoSub Display

Return
'--------------------------------------------
Display:

For siCount = 0 To siToSort.Max
  Print Format(Str(siToSort[siCount]), "####");
  If siCount <> siToSort.max Then Print ",";
Next

Print
Return

End


declare
  proc {InsertionSort A}
     Low = {Array.low A}
     High = {Array.high A}
  in
     for I in Low+1..High do
        Value = A.I
        J = {NewCell I-1}
     in
        for while:@J >= Low andthen A[email protected]J > Value do
           A.(@J+1) := A[email protected]J
           J := @J - 1
        end
        A.(@J+1) := Value
     end
  end

  Arr = {Tuple.toArray unit(3 1 4 1 5 9 2 6 5)}
in
  {InsertionSort Arr}
  {Show {Array.toRecord unit Arr}}


main
 new collection,size
 set size=16
 set collection=size for i=0:1:size-1 set collection(i)=$random(size)
 write "Collection to sort:",!!
 zwrite collection ; This will only work on Intersystem's flavor of MUMPS
 do quicksort(.collection,0,collection-1)
 write:$$isSorted(.collection) !,"Collection is sorted:",!!
 zwrite collection  ; This will only work on Intersystem's flavor of MUMPS
 q
quicksort(array,low,high)
 if low<high do
 . set pivot=$$partition(.array,low,high)
 . do quicksort(.array,low,pivot-1)
 . do quicksort(.array,pivot+1,high)
 q
partition(A,p,r)
 set pivot=A(r)
 set i=p-1
 for j=p:1:r-1 do
 . i A(j)<=pivot do
 . . set i=i+1
 . . set helper=A(j)
 . . set A(j)=A(i)
 . . set A(i)=helper
 set helper=A(r)
 set A(r)=A(i+1)
 set A(i+1)=helper
 quit i+1
isSorted(array)
 set sorted=1
 for i=0:1:array-2 do  quit:sorted=0
 . for j=i+1:1:array-1 do  quit:sorted=0
 . . set:array(i)>array(j) sorted=0
 quit sorted


package main

import "fmt"

func main() {
    a := []int{170, 45, 75, -90, -802, 24, 2, 66}
    fmt.Println("before:", a)
    gnomeSort(a)
    fmt.Println("after: ", a)
}

func gnomeSort(a []int) {
    for i, j := 1, 2; i < len(a); {
        if a[i-1] > a[i] {
            a[i-1], a[i] = a[i], a[i-1]
            i--
            if i > 0 {
                continue
            }
        }
        i = j
        j++
    }
}


def makeSwap = { a, i, j = i+1 -> print "."; a[[j,i]] = a[[i,j]] }

def checkSwap = { list, i, j = i+1 -> [(list[i] > list[j])].find{ it }.each { makeSwap(list, i, j) } }

def gnomeSort = { input ->
    def swap = checkSwap.curry(input)
    def index = 1
    while (index < input.size()) {
        index += (swap(index-1) && index > 1) ? -1 : 1
    }
    input
}


sub insertion_sort {
    my (@list) = @_;
    foreach my $i (1 .. $#list) {
        my $j = $i;
        my $k = $list[$i];
        while ( $j > 0 && $k < $list[$j - 1]) {
            $list[$j] = $list[$j - 1];
            $j--;
        }
        $list[$j] = $k;
    }
    return @list;
}

my @a = insertion_sort(4, 65, 2, -31, 0, 99, 83, 782, 1);
print "@a\n";


def quickSort(arr)
	less = {}
	pivotList = {}
	more = {}
	if len(arr) <= 1
		return arr
	else
		pivot = arr[0]
		for i in arr
			if i < pivot
				less.append(i)
			else if i > pivot
				more.append(i)
			else
				pivotList.append(i)
			end
		end

		less = quickSort(less)
		more = quickSort(more)

		return less + pivotList + more
	end
end


using System;
using System.Console;
using Nemerle.Collections.NList;

module Quicksort
{
    Qsort[T] (x : list[T]) : list[T]
      where T : IComparable
    {
        |[]    => []
        |x::xs => Qsort($[y|y in xs, (y.CompareTo(x) < 0)]) + [x] + Qsort($[y|y in xs, (y.CompareTo(x) > 0)])
    }

    Main() : void
    {
        def empty = [];
        def single = [2];
        def several = [2, 6, 1, 7, 3, 9, 4];
        WriteLine(Qsort(empty));
        WriteLine(Qsort(single));
        WriteLine(Qsort(several));
    }
}


gnomeSort [] = []
gnomeSort (x:xs) = gs [x] xs
    where
	gs vv@(v:vs) (w:ws)
		| v<=w = gs (w:vv) ws
		| otherwise = gs vs (w:v:ws)
	gs [] (y:ys) = gs [y] ys
	gs xs [] = reverse xs
-- keeping the first argument of gs in reverse order avoids the deterioration into cubic behaviour


class GnomeSort {
  @:generic
  public static function sort<T>(arr:Array<T>) {
    var i = 1;
    var j = 2;
    while (i < arr.length) {
      if (Reflect.compare(arr[i - 1], arr[i]) <= 0) {
        i = j++;
      } else {
        var temp = arr[i];
        arr[i] = arr[i - 1];
        arr[i - 1] = temp;
        if (--i == 0) {
          i = j++;
        }
      }
    }
  }
}

class Main {
  static function main() {
    var integerArray = [1, 10, 2, 5, -1, 5, -19, 4, 23, 0];
    var floatArray = [1.0, -3.2, 5.2, 10.8, -5.7, 7.3,
                      3.5, 0.0, -4.1, -9.5];
    var stringArray = ['We', 'hold', 'these', 'truths', 'to',
                       'be', 'self-evident', 'that', 'all',
                       'men', 'are', 'created', 'equal'];
    Sys.println('Unsorted Integers: ' + integerArray);
    GnomeSort.sort(integerArray);
    Sys.println('Sorted Integers:   ' + integerArray);
    Sys.println('Unsorted Floats:   ' + floatArray);
    GnomeSort.sort(floatArray);
    Sys.println('Sorted Floats:     ' + floatArray);
    Sys.println('Unsorted Strings:  ' + stringArray);
    GnomeSort.sort(stringArray);
    Sys.println('Sorted Strings:    ' + stringArray);
  }
}


procedure main()                     #: demonstrate various ways to sort a list and string
   demosort(gnomesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end

procedure gnomesort(X,op)            #: return sorted list
local i,j

   op := sortop(op,X)                # select how and what we sort

   j := (i := 2) + 1                 # translation of pseudo code
   while i <= *X do {
      if op(X[i],X[i-1]) then {
         X[i] :=: X[i -:= 1]
         if i > 1 then next
      }
      j := (i := j) + 1
   }
   return X
end


F merge(left, right)
   [Int] result
   V left_idx = 0
   V right_idx = 0
   L left_idx < left.len & right_idx < right.len
      I left[left_idx] <= right[right_idx]
         result.append(left[left_idx])
         left_idx++
      E
         result.append(right[right_idx])
         right_idx++

   I left_idx < left.len
      result.extend(left[left_idx ..])
   I right_idx < right.len
      result.extend(right[right_idx ..])
   R result

F merge_sort(m)
   I m.len <= 1
      R m

   V middle = m.len I/ 2
   V left = m[0.<middle]
   V right = m[middle..]

   left = merge_sort(left)
   right = merge_sort(right)
   R Array(merge(left, right))

V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print(merge_sort(arr))


function insertion_sort(sequence s)
object temp
integer j
    for i=2 to length(s) do
        temp = s[i]
        j = i-1
        while j>=1 and s[j]>temp do
            s[j+1] = s[j]
            j -= 1
        end while
        s[j+1] = temp
    end for
    return s
end function

constant s = {4, 15, "delta", 2, -31, 0, "alpha", 19, "gamma", 2, 13, "beta", 782, 1}

puts(1,"Before: ")    ?s
puts(1,"After: ")     ?insertion_sort(s)


function insertionSort(&$arr){
	for($i=0;$i<count($arr);$i++){
		$val = $arr[$i];
		$j = $i-1;
		while($j>=0 && $arr[$j] > $val){
			$arr[$j+1] = $arr[$j];
			$j--;
		}
		$arr[$j+1] = $val;
	}
}

$arr = array(4,2,1,6,9,3,8,7);
insertionSort($arr);
echo implode(',',$arr);


/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.util.List

placesList = [String -
    "UK  London",     "US  New York",   "US  Boston",     "US  Washington" -
  , "UK  Washington", "US  Birmingham", "UK  Birmingham", "UK  Boston"     -
]
lists = [ -
    placesList -
  , quickSortSimple(String[] Arrays.copyOf(placesList, placesList.length)) -
  , quickSortInplace(String[] Arrays.copyOf(placesList, placesList.length)) -
]

loop ln = 0 to lists.length - 1
  cl = lists[ln]
  loop ct = 0 to cl.length - 1
    say cl[ct]
    end ct
    say
  end ln

return

method quickSortSimple(array = String[]) public constant binary returns String[]

  rl = String[array.length]
  al = List quickSortSimple(Arrays.asList(array))
  al.toArray(rl)

  return rl

method quickSortSimple(array = List) public constant binary returns ArrayList

  if array.size > 1 then do
    less    = ArrayList()
    equal   = ArrayList()
    greater = ArrayList()

    pivot = array.get(Random().nextInt(array.size - 1))
    loop x_ = 0 to array.size - 1
      if (Comparable array.get(x_)).compareTo(Comparable pivot) < 0 then less.add(array.get(x_))
      if (Comparable array.get(x_)).compareTo(Comparable pivot) = 0 then equal.add(array.get(x_))
      if (Comparable array.get(x_)).compareTo(Comparable pivot) > 0 then greater.add(array.get(x_))
      end x_
    less    = quickSortSimple(less)
    greater = quickSortSimple(greater)
    out = ArrayList(array.size)
    out.addAll(less)
    out.addAll(equal)
    out.addAll(greater)

    array = out
    end

  return ArrayList array

method quickSortInplace(array = String[]) public constant binary returns String[]

  rl = String[array.length]
  al = List quickSortInplace(Arrays.asList(array))
  al.toArray(rl)

  return rl

method quickSortInplace(array = List, ixL = int 0, ixR = int array.size - 1) public constant binary returns ArrayList

  if ixL < ixR then do
    ixP = int ixL + (ixR - ixL) % 2
    ixP = quickSortInplacePartition(array, ixL, ixR, ixP)
    quickSortInplace(array, ixL, ixP - 1)
    quickSortInplace(array, ixP + 1, ixR)
    end

  array = ArrayList(array)
  return ArrayList array

method quickSortInplacePartition(array = List, ixL = int, ixR = int, ixP = int) public constant binary returns int

  pivotValue = array.get(ixP)
  rValue     = array.get(ixR)
  array.set(ixP, rValue)
  array.set(ixR, pivotValue)
  ixStore = ixL
  loop i_ = ixL to ixR - 1
    iValue = array.get(i_)
    if (Comparable iValue).compareTo(Comparable pivotValue) < 0 then do
      storeValue = array.get(ixStore)
      array.set(i_, storeValue)
      array.set(ixStore, iValue)
      ixStore = ixStore + 1
      end
    end i_
  storeValue = array.get(ixStore)
  rValue     = array.get(ixR)
  array.set(ixStore, rValue)
  array.set(ixR, storeValue)

  return ixStore


List do(
    gnomeSortInPlace := method(
        idx := 1
        while(idx <= size,
            if(idx == 0 or at(idx) > at(idx - 1)) then(
                idx = idx + 1
            ) else(
                swapIndices(idx, idx - 1)
                idx = idx - 1
            )
        )
    self)
)

lst := list(5, -1, -4, 2, 9)
lst gnomeSortInPlace println # ==> list(-4, -1, 2, 5, 9)


100 PROGRAM "GnomeSrt.bas"
110 RANDOMIZE
120 NUMERIC ARRAY(-5 TO 12)
130 CALL INIT(ARRAY)
140 CALL WRITE(ARRAY)
150 CALL GNOMESORT(ARRAY)
160 CALL WRITE(ARRAY)
170 DEF INIT(REF A)
180   FOR I=LBOUND(A) TO UBOUND(A)
190     LET A(I)=RND(98)+1
200   NEXT
210 END DEF
220 DEF WRITE(REF A)
230   FOR I=LBOUND(A) TO UBOUND(A)
240     PRINT A(I);
250   NEXT
260   PRINT
270 END DEF
280 DEF GNOMESORT(REF A)
290   LET I=LBOUND(A)+1:LET J=I+1
300   DO WHILE I<=UBOUND(A)
310     IF A(I-1)<=A(I) THEN
320       LET I=J:LET J=J+1
330     ELSE
340       LET T=A(I-1):LET A(I-1)=A(I):LET A(I)=T
350       LET I=I-1
360       IF I=LBOUND(A) THEN LET I=J:LET J=J+1
370     END IF
380   LOOP
390 END DEF


position=: 0 {[email protected]@, [
swap=: ] A.~ *@position * #@[ [email protected] <:@position
gnome=: swap~ 2 >/\ ]
gnomes=: gnome^:_


*      Merge sort                  19/06/2016
MAIN   CSECT
       STM     R14,R12,12(R13)     save caller's registers
       LR      R12,R15             set R12 as base register
       USING   MAIN,R12            notify assembler
       LA      R11,SAVEXA          get the address of my savearea
       ST      R13,4(R11)          save caller's save area pointer
       ST      R11,8(R13)          save my save area pointer
       LR      R13,R11             set R13 to point to my save area
       LA      R1,1                1
       LA      R2,NN               hbound(a)
       BAL     R14,SPLIT           call split(1,hbound(a))
       LA      RPGI,PG             pgi=0
       LA      RI,1                i=1
       DO WHILE=(C,RI,LE,=A(NN))   do i=1 to hbound(a)
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R2,A-4(R1)            a(i)
         XDECO R2,XDEC               edit a(i)
         MVC   0(4,RPGI),XDEC+8      output a(i)
         LA    RPGI,4(RPGI)          pgi=pgi+4
         LA    RI,1(RI)              i=i+1
       ENDDO   ,                   end do
       XPRNT   PG,80               print buffer
       L       R13,SAVEXA+4        restore caller's savearea address
       LM      R14,R12,12(R13)     restore caller's registers
       XR      R15,R15             set return code to 0
       BR      R14                 return to caller
*      split(istart,iend)          ------recursive---------------------
SPLIT  STM     R14,R12,12(R13)     save all registers
       LR      R9,R1               save R1
       LA      R1,72               amount of storage required
       GETMAIN RU,LV=(R1)          allocate storage for stack
       USING   STACK,R10           make storage addressable
       LR      R10,R1              establish stack addressability
       LA      R11,SAVEXB          get the address of my savearea
       ST      R13,4(R11)          save caller's save area pointer
       ST      R11,8(R13)          save my save area pointer
       LR      R13,R11             set R13 to point to my save area
       LR      R1,R9               restore R1
       LR      RSTART,R1           istart=R1
       LR      REND,R2             iend=R2
       IF CR,REND,EQ,RSTART THEN   if iend=istart
         B     RETURN                return
       ENDIF   ,                   end if
       BCTR    R2,0                iend-1
       IF C,R2,EQ,RSTART THEN      if iend-istart=1
         LR    R1,REND               iend
         SLA   R1,2                  .
         L     R2,A-4(R1)            a(iend)
         LR    R1,RSTART             istart
         SLA   R1,2                  .
         L     R3,A-4(R1)            a(istart)
         IF CR,R2,LT,R3 THEN         if a(iend)<a(istart)
           LR  R1,RSTART               istart
           SLA R1,2                    .
           LA  R2,A-4(R1)              @a(istart)
           LR  R1,REND                 iend
           SLA R1,2                    .
           LA  R3,A-4(R1)              @a(iend)
           MVC TEMP,0(R2)              temp=a(istart)
           MVC 0(4,R2),0(R3)           a(istart)=a(iend)
           MVC 0(4,R3),TEMP            a(iend)=temp
         ENDIF ,                     end if
         B     RETURN                return
       ENDIF   ,                   end if
       LR      RMIDDL,REND         iend
       SR      RMIDDL,RSTART       iend-istart
       SRA     RMIDDL,1            (iend-istart)/2
       AR      RMIDDL,RSTART       imiddl=istart+(iend-istart)/2
       LR      R1,RSTART           istart
       LR      R2,RMIDDL           imiddl
       BAL     R14,SPLIT           call split(istart,imiddl)
       LA      R1,1(RMIDDL)        imiddl+1
       LR      R2,REND             iend
       BAL     R14,SPLIT           call split(imiddl+1,iend)
       LR      R1,RSTART           istart
       LR      R2,RMIDDL           imiddl
       LR      R3,REND             iend
       BAL     R14,MERGE           call merge(istart,imiddl,iend)
RETURN L       R13,SAVEXB+4        restore caller's savearea address
       XR      R15,R15             set return code to 0
       LA      R0,72               amount of storage to free
       FREEMAIN A=(R10),LV=(R0)    free allocated storage
       L       R14,12(R13)         restore caller's return address
       LM      R2,R12,28(R13)      restore registers R2 to R12
       BR      R14                 return to caller
       DROP    R10                 base no longer needed
*      merge(jstart,jmiddl,jend)   ------------------------------------
MERGE  STM     R1,R3,JSTART        jstart=r1,jmiddl=r2,jend=r3
       SR      R2,R1               jmiddl-jstart
       LA      RBS,2(R2)           bs=jmiddl-jstart+2
       LA      RI,1                i=1
       LR      R3,RBS              bs
       BCTR    R3,0                bs-1
       DO WHILE=(CR,RI,LE,R3)      do i=0 to bs-1
         L     R2,JSTART             jstart
         AR    R2,RI                 jstart+i
         SLA   R2,2                  .
         L     R2,A-8(R2)            a(jstart+i-1)
         LR    R1,RI                 i
         SLA   R1,2                  .
         ST    R2,B-4(R1)            b(i)=a(jstart+i-1)
         LA    RI,1(RI)              i=i+1
       ENDDO   ,                   end do
       LA      RI,1                i=1
       L       RJ,JMIDDL           j=jmiddl
       LA      RJ,1(RJ)            j=jmiddl+1
       L       RK,JSTART           k=jstart
       DO UNTIL=(CR,RI,EQ,RBS,OR,  do until i=bs or                    X
               C,RJ,GT,JEND)                j>jend
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R4,B-4(R1)            r4=b(i)
         LR    R1,RJ                 j
         SLA   R1,2                  .
         L     R3,A-4(R1)            r3=a(j)
         LR    R9,RK                 k
         SLA   R9,2                  r9 for a(k)
         IF CR,R4,LE,R3 THEN         if b(i)<=a(j)
           ST  R4,A-4(R9)              a(k)=b(i)
           LA  RI,1(RI)                i=i+1
         ELSE  ,                     else
           ST  R3,A-4(R9)              a(k)=a(j)
           LA  RJ,1(RJ)                j=j+1
         ENDIF ,                     end if
         LA    RK,1(RK)              k=k+1
       ENDDO   ,                   end do
       DO WHILE=(CR,RI,LT,RBS)     do while i<bs
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R2,B-4(R1)            b(i)
         LR    R1,RK                 k
         SLA   R1,2                  .
         ST    R2,A-4(R1)            a(k)=b(i)
         LA    RI,1(RI)              i=i+1
         LA    RK,1(RK)              k=k+1
       ENDDO   ,                   end do
       BR      R14                 return to caller
*      ------- ------------------  ------------------------------------
       LTORG
SAVEXA DS      18F                 savearea of main
NN     EQU     ((B-A)/L'A)         number of items
A      DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
       DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
B      DS      (NN/2+1)F           merge sort static storage
TEMP   DS      F                   for swap
JSTART DS      F                   jstart
JMIDDL DS      F                   jmiddl
JEND   DS      F                   jend
PG     DC      CL80' '             buffer
XDEC   DS      CL12                for edit
STACK  DSECT                       dynamic area
SAVEXB DS      18F                 " savearea of mergsort (72 bytes)
       YREGS
RI     EQU     6                   i
RJ     EQU     7                   j
RK     EQU     8                   k
RSTART EQU     6                   istart
REND   EQU     7                   i
RMIDDL EQU     8                   i
RPGI   EQU     3                   pgi
RBS    EQU     0                   bs
       END     MAIN


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program mergeSort64.s  */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"

.align 4
TableNumber:      .quad   1,3,11,6,2,5,9,10,8,4,7
#TableNumber:     .quad   10,9,8,7,6,-5,4,3,2,1
                 .equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:       .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                              // entry of program
    ldr x0,qAdrTableNumber                         // address number table
    mov x1,0                                       // first element
    mov x2,NBELEMENTS                              // number of élements
    bl mergeSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable

    ldr x0,qAdrTableNumber                         // address number table
    mov x1,NBELEMENTS                              // number of élements
    bl isSorted                                    // control sort
    cmp x0,1                                       // sorted ?
    beq 1f
    ldr x0,qAdrszMessSortNok                       // no !! error sort
    bl affichageMess
    b 100f
1:                                                 // yes
    ldr x0,qAdrszMessSortOk
    bl affichageMess
100:                                               // standard end of the program
    mov x0,0                                       // return code
    mov x8,EXIT                                    // request to exit program
    svc 0                                          // perform the system call

qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return 0  if not sorted   1  if sorted */
isSorted:
    stp x2,lr,[sp,-16]!             // save  registers
    stp x3,x4,[sp,-16]!             // save  registers
    mov x2,0
    ldr x4,[x0,x2,lsl 3]
1:
    add x2,x2,1
    cmp x2,x1
    bge 99f
    ldr x3,[x0,x2, lsl 3]
    cmp x3,x4
    blt 98f
    mov x4,x3
    b 1b
98:
    mov x0,0                       // not sorted
    b 100f
99:
    mov x0,1                       // sorted
100:
    ldp x3,x4,[sp],16              // restaur  2 registers
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*         merge                                              */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index   */
merge:
    stp x1,lr,[sp,-16]!        // save  registers
    stp x2,x3,[sp,-16]!        // save  registers
    stp x4,x5,[sp,-16]!        // save  registers
    stp x6,x7,[sp,-16]!        // save  registers
    str x8,[sp,-16]!
    mov x5,x2                  // init index x2->x5
1:                             // begin loop first section
    ldr x6,[x0,x1,lsl 3]       // load value first section index r1
    ldr x7,[x0,x5,lsl 3]       // load value second section index r5
    cmp x6,x7
    ble 4f                     // <=  -> location first section OK
    str x7,[x0,x1,lsl 3]       // store value second section in first section
    add x8,x5,1
    cmp x8,x3                  // end second section ?
    ble 2f
    str x6,[x0,x5,lsl 3]
    b 4f                       // loop
2:                             // loop insert element part 1 into part 2
    sub x4,x8,1
    ldr x7,[x0,x8,lsl 3]       // load value 2
    cmp x6,x7                  // value <
    bge 3f
    str x6,[x0,x4,lsl 3]       // store value
    b 4f                       // loop
3:
    str x7,[x0,x4,lsl 3]       // store value 2
    add x8,x8,1
    cmp x8,x3                  // end second section ?
    ble 2b                     // no loop
    sub x8,x8,1
    str x6,[x0,x8,lsl 3]       // store value 1
4:
    add x1,x1,1
    cmp x1,x2                  // end first section ?
    blt 1b

100:
    ldr x8,[sp],16             // restaur 1 register
    ldp x6,x7,[sp],16          // restaur  2 registers
    ldp x4,x5,[sp],16          // restaur  2 registers
    ldp x2,x3,[sp],16          // restaur  2 registers
    ldp x1,lr,[sp],16          // restaur  2 registers
    ret                        // return to address lr x30
/******************************************************************/
/*      merge sort                                                */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the index of first element */
/* x2 contains the number of element */
mergeSort:
    stp x3,lr,[sp,-16]!    // save  registers
    stp x4,x5,[sp,-16]!    // save  registers
    stp x6,x7,[sp,-16]!    // save  registers
    cmp x2,2               // end ?
    blt 100f
    lsr x4,x2,1            // number of element of each subset
    add x5,x4,1
    tst x2,#1              // odd ?
    csel x4,x5,x4,ne
    mov x5,x1              // save first element
    mov x6,x2              // save number of element
    mov x7,x4              // save number of element of each subset
    mov x2,x4
    bl mergeSort
    mov x1,x7              // restaur number of element of each subset
    mov x2,x6              // restaur  number of element
    sub x2,x2,x1
    mov x3,x5              // restaur first element
    add x1,x1,x3              // + 1
    bl mergeSort           // sort first subset
    mov x1,x5              // restaur first element
    mov x2,x7              // restaur number of element of each subset
    add x2,x2,x1
    mov x3,x6              // restaur  number of element
    add x3,x3,x1
    sub x3,x3,1              // last index
    bl merge
100:
    ldp x6,x7,[sp],16          // restaur  2 registers
    ldp x4,x5,[sp],16          // restaur  2 registers
    ldp x3,lr,[sp],16          // restaur  2 registers
    ret                        // return to address lr x30

/******************************************************************/
/*      Display table elements                                */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
    stp x1,lr,[sp,-16]!              // save  registers
    stp x2,x3,[sp,-16]!              // save  registers
    mov x2,x0                        // table address
    mov x3,0
1:                                   // loop display table
    ldr x0,[x2,x3,lsl 3]
    ldr x1,qAdrsZoneConv
    bl conversion10S                  // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc            // insert result at // character
    bl affichageMess                 // display message
    add x3,x3,1
    cmp x3,NBELEMENTS - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    mov x0,x2
100:
    ldp x2,x3,[sp],16               // restaur  2 registers
    ldp x1,lr,[sp],16               // restaur  2 registers
    ret                             // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


(de insertionSort (Lst)
   (for (I (cdr Lst)  I  (cdr I))
      (for (J Lst  (n== J I)  (cdr J))
         (T (> (car J) (car I))
            (rot J (offset I J)) ) ) )
   Lst )


insert_sort: proc(array);
  dcl array(*)      fixed bin(31);
  dcl (i,j,tmp,h,l) fixed bin(31);

  l = lbound(array, 1);
  h = hbound(array, 1);

  do i = l + 1 to h;
    tmp = array(i);

    do j = i - 1 by -1 while(j > l - 1 & array(j) > tmp);
      array(j + 1) = array(j);
    end;

    array(j + 1) = tmp;
  end;
end insert_sort;


quicksort is fork [ >= [1 first,tally],
  pass,
  link [
      quicksort sublist [ < [pass, first], pass ],
      sublist [ match [pass,first],pass ],
      quicksort sublist [ > [pass,first], pass ]
  ]
]


public static void gnomeSort(int[] a)
{
  int i=1;
  int j=2;

  while(i < a.length) {
    if ( a[i-1] <= a[i] ) {
      i = j; j++;
    } else {
      int tmp = a[i-1];
      a[i-1] = a[i];
      a[i--] = tmp;
      i = (i==0) ? j++ : i;
    }
  }
}


function gnomeSort(a) {
    function moveBack(i) {
        for( ; i > 0 && a[i-1] > a[i]; i--) {
            var t = a[i];
            a[i] = a[i-1];
            a[i-1] = t;
        }
    }
    for (var i = 1; i < a.length; i++) {
        if (a[i-1] > a[i]) moveBack(i);
    }
    return a;
}


(defun split (xys)
   (if (endp (rest xys))
       (mv xys nil)
       (mv-let (xs ys)
               (split (rest (rest xys)))
          (mv (cons (first xys) xs)
              (cons (second xys) ys)))))

(defun mrg (xs ys)
   (declare (xargs :measure (+ (len xs) (len ys))))
   (cond ((endp xs) ys)
         ((endp ys) xs)
         ((< (first xs) (first ys))
          (cons (first xs) (mrg (rest xs) ys)))
         (t (cons (first ys) (mrg xs (rest ys))))))

(defthm split-shortens
   (implies (consp (rest xs))
            (mv-let (ys zs)
                    (split xs)
               (and (< (len ys) (len xs))
                    (< (len zs) (len xs))))))

(defun msort (xs)
     (declare (xargs
            :measure (len xs)
            :hints (("Goal"
                     :use ((:instance split-shortens))))))
   (if (endp (rest xs))
       xs
       (mv-let (ys zs)
               (split xs)
          (mrg (msort ys)
               (msort zs)))))


100H:

/* INSERTION SORT ON 16-BIT INTEGERS */
INSERTION$SORT: PROCEDURE (AP, LEN);
    DECLARE (AP, LEN, I, J, V, A BASED AP) ADDRESS;
    DO I = 1 TO LEN-1;
        V = A(I);
        J = I;
        DO WHILE J > 0 AND A(J-1) > V;
            A(J) = A(J-1);
            J = J-1;
        END;
        A(J) = V;
    END;
END INSERTION$SORT;

/* CP/M CALLS AND FUNCTION TO PRINT INTEGERS */
BDOS: PROCEDURE (FN, ARG);
    DECLARE FN BYTE, ARG ADDRESS;
    GO TO 5;
END BDOS;

PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (7) BYTE INITIAL ('..... $');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P-1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL BDOS(9, P);
END PRINT$NUMBER;

/* SORT AN ARRAY */
DECLARE NUMBERS (11) ADDRESS INITIAL (4, 65, 2, 31, 0, 99, 2, 8, 3, 782, 1);
CALL INSERTION$SORT(.NUMBERS, LENGTH(NUMBERS));

/* PRINT THE SORTED ARRAY */
DECLARE N BYTE;
DO N = 0 TO LAST(NUMBERS);
    CALL PRINT$NUMBER(NUMBERS(N));
END;

CALL BDOS(0,0);
EOF


function insertionSort($arr){
	for($i=0;$i -lt $arr.length;$i++){
		$val = $arr[$i]
		$j = $i-1
		while($j -ge 0 -and $arr[$j] -gt $val){
			$arr[$j+1] = $arr[$j]
			$j--
		}
		$arr[$j+1] = $val
	}
}

$arr = @(4,2,1,6,9,3,8,7)
insertionSort($arr)
$arr -join ","


proc quickSortImpl[T](a: var openarray[T], start, stop: int) =
  if stop - start > 0:
    let pivot = a[start]
    var left = start
    var right = stop
    while left <= right:
      while cmp(a[left], pivot) < 0:
        inc(left)
      while cmp(a[right], pivot) > 0:
        dec(right)
      if left <= right:
        swap(a[left], a[right])
        inc(left)
        dec(right)
    quickSortImpl(a, start, right)
    quickSortImpl(a, left, stop)

proc quickSort[T](a: var openarray[T]) =
  quickSortImpl(a, 0, a.len - 1)

var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
a.quickSort()
echo a


# As soon as "condition" is true, then emit . and stop:
def do_until(condition; next):
  def u: if condition then . else (next|u) end;
  u;

# input: an array
def gnomeSort:
  def swap(i;j): .[i] as $x | .[i]=.[j] | .[j]=$x;

  length as $length
  # state: [i, j, ary]
  | [1, 2, .]
  | do_until( .[0] >= $length;
              .[0] as $i | .[1] as $j
              | .[2]
              # for descending sort, use >= for comparison
              | if .[$i-1] <= .[$i] then [$j, $j + 1, .]
                else swap( $i-1; $i)
                | ($i - 1) as $i
                | if $i == 0 then [$j, $j + 1, .]
                  else [$i, $j, .]
                  end
                end )
  | .[2];


function gnomesort!(arr::Vector)
    i, j = 1, 2
    while i < length(arr)
        if arr[i] ≤ arr[i+1]
            i = j
            j += 1
        else
            arr[i], arr[i+1] = arr[i+1], arr[i]
            i -= 1
            if i == 0
                i = j
                j += 1
            end
        end
    end
    return arr
end

v = rand(-10:10, 10)
println("# unordered: $v\n -> ordered: ", gnomesort!(v))


// version 1.1.0

fun <T: Comparable<T>> gnomeSort(a: Array<T>, ascending: Boolean = true) {
    var i = 1
    var j = 2
    while (i < a.size)
        if (ascending && (a[i - 1] <= a[i]) ||
           !ascending && (a[i - 1] >= a[i]))
            i = j++
        else {
            val temp = a[i - 1]
            a[i - 1] = a[i]
            a[i--] = temp
            if (i == 0) i = j++
        }
}

fun main(args: Array<String>) {
    val array = arrayOf(100, 2, 56, 200, -52, 3, 99, 33, 177, -199)
    println("Original      : ${array.asList()}")
    gnomeSort(array)
    println("Sorted (asc)  : ${array.asList()}")
    gnomeSort(array, false)
    println("Sorted (desc) : ${array.asList()}")
}


DEFINE MAX_COUNT="100"

PROC PrintArray(INT ARRAY a INT size)
  INT i

  Put('[)
  FOR i=0 TO size-1
  DO
    IF i>0 THEN Put(' ) FI
    PrintI(a(i))
  OD
  Put(']) PutE()
RETURN

PROC Merge(INT ARRAY a INT first,mid,last)
  INT ARRAY left(MAX_COUNT),right(MAX_COUNT)
  INT leftSize,rightSize,i,j,k

  leftSize=mid-first+1
  rightSize=last-mid

  FOR i=0 TO leftSize-1
  DO
    left(i)=a(first+i)
  OD
  FOR i=0 TO rightSize-1
  DO
    right(i)=a(mid+1+i)
  OD
  i=0 j=0
  k=first
  WHILE i<leftSize AND j<rightSize
  DO
    IF left(i)<=right(j) THEN
      a(k)=left(i)
      i==+1
    ELSE
      a(k)=right(j)
      j==+1
    FI
    k==+1
  OD

  WHILE i<leftSize
  DO
    a(k)=left(i)
    i==+1 k==+1
  OD

  WHILE j<rightSize
  DO
    a(k)=right(j)
    j==+1 k==+1
  OD
RETURN

PROC MergeSort(INT ARRAY a INT size)
  INT currSize,first,mid,last

  currSize=1
  WHILE currSize<size
  DO
    first=0
    WHILE first<size-1
    DO
      mid=first+currSize-1
      IF mid>size-1 THEN
        mid=size-1
      FI
      last=first+2*currSize-1
      IF last>size-1 THEN
        last=size-1
      FI
      Merge(a,first,mid,last);

      first==+2*currSize
    OD
    currSize==*2
  OD
RETURN

PROC Test(INT ARRAY a INT size)
  PrintE("Array before sort:")
  PrintArray(a,size)
  MergeSort(a,size)
  PrintE("Array after sort:")
  PrintArray(a,size)
  PutE()
RETURN

PROC Main()
  INT ARRAY
    a(10)=[1 4 65535 0 3 7 4 8 20 65530],
    b(21)=[10 9 8 7 6 5 4 3 2 1 0
      65535 65534 65533 65532 65531
      65530 65529 65528 65527 65526],
    c(8)=[101 102 103 104 105 106 107 108],
    d(12)=[1 65535 1 65535 1 65535 1
      65535 1 65535 1 65535]

  Test(a,10)
  Test(b,21)
  Test(c,8)
  Test(d,12)
RETURN


function mergesort(a:Array)
{
	//Arrays of length 1 and 0 are always sorted
	if(a.length <= 1) return a;
	else
	{
		var middle:uint = a.length/2;
		//split the array into two
		var left:Array = new Array(middle);
		var right:Array = new Array(a.length-middle);
		var j:uint = 0, k:uint = 0;
		//fill the left array
		for(var i:uint = 0; i < middle; i++)
			left[j++]=a[i];
		//fill the right array
		for(i = middle; i< a.length; i++)
			right[k++]=a[i];
		//sort the arrays
		left = mergesort(left);
		right = mergesort(right);
		//If the last element of the left array is less than or equal to the first
		//element of the right array, they are in order and don't need to be merged
		if(left[left.length-1] <= right[0])
			return left.concat(right);
		a = merge(left, right);
		return a;
	}
}

function merge(left:Array, right:Array)
{
	var result:Array = new Array(left.length + right.length);
	var j:uint = 0, k:uint = 0, m:uint = 0;
	//merge the arrays in order
	while(j < left.length && k < right.length)
	{
		if(left[j] <= right[k])
			result[m++] = left[j++];
		else
			result[m++] = right[k++];
	}
	//If one of the arrays has remaining entries that haven't been merged, they
	//will be greater than the rest of the numbers merged so far, so put them on the
	//end of the array.
	for(; j < left.length; j++)
		result[m++] = left[j];
	for(; k < right.length; k++)
		result[m++] = right[k];
	return result;
}


insert_sort(L1,L2) :-
  insert_sort_intern(L1,[],L2).

insert_sort_intern([],L,L).
insert_sort_intern([H|T],L1,L) :-
  insert(L1,H,L2),
  insert_sort_intern(T,L2,L).

insert([],X,[X]).
insert([H|T],X,[X,H|T]) :-
  X =< H,
  !.
insert([H|T],X,[H|T2]) :-
  insert(T,X,T2).


Procedure insertionSort(Array a(1))
  Protected low, high
  Protected firstIndex, lastIndex = ArraySize(a())

  If lastIndex > firstIndex + 1
    low = firstIndex + 1
    While low <= lastIndex
      high = low
      While high > firstIndex
        If a(high) < a(high - 1)
          Swap a(high), a(high - 1)
        Else
          Break
        EndIf
        high - 1
      Wend
      low + 1
    Wend
  EndIf
EndProcedure


let
  qs = l:
    if l == [] then []
    else
      with builtins;
      let x  = head l;
          xs = tail l;
          low  = filter (a: a < x)  xs;
          high = filter (a: a >= x) xs;
      in qs low ++ [x] ++ qs high;
in
  qs [4 65 2 (-31) 0 99 83 782]


function gnomeSort(a)
    local i, j = 2, 3

    while i <= #a do
        if a[i-1] <= a[i] then
            i = j
            j = j + 1
        else
            a[i-1], a[i] = a[i], a[i-1] -- swap
            i = i - 1
            if i == 1 then -- 1 instead of 0
                i = j
                j = j + 1
            end
        end
    end
end


arr := Array([17,3,72,0,36,2,3,8,40,0]):
len := numelems(arr):
i := 2:
while (i <= len) do
	if (i=1 or arr[i] >= arr[i-1]) then
		i++:
	else
		temp:= arr[i]:
		arr[i] := arr[i-1]:
		arr[i-1] := temp:
		i--:
	end if:
end do:
arr;


generic
   type Element_Type is private;
   type Index_Type is (<>);
   type Collection_Type is array(Index_Type range <>) of Element_Type;
   with function "<"(Left, Right : Element_Type) return Boolean is <>;

package Mergesort is
   function Sort(Item : Collection_Type) return Collection_Type;
end MergeSort;


MODE DATA = CHAR;

PROC merge sort = ([]DATA m)[]DATA: (
    IF LWB m >= UPB m THEN
        m
    ELSE
        INT middle = ( UPB m + LWB m ) OVER 2;
        []DATA left = merge sort(m[:middle]);
        []DATA right = merge sort(m[middle+1:]);
        flex merge(left, right)[AT LWB m]
    FI
);

# FLEX version: A demonstration of FLEX for manipulating arrays #
PROC flex merge = ([]DATA in left, in right)[]DATA:(
    [UPB in left + UPB in right]DATA result;
    FLEX[0]DATA left := in left;
    FLEX[0]DATA right := in right;

    FOR index TO UPB result DO
        # change the direction of this comparison to change the direction of the sort #
        IF LWB right > UPB right THEN
            result[index:] := left;
            stop iteration
        ELIF LWB left > UPB left THEN
            result[index:] := right;
            stop iteration
        ELIF left[1] <= right[1] THEN
            result[index] := left[1];
            left := left[2:]
        ELSE
            result[index] := right[1];
            right := right[2:]
        FI
    OD;
stop iteration:
    result
);

[32]CHAR char array data := "big fjords vex quick waltz nymph";
print((merge sort(char array data), new line));


def insertion_sort(L):
    for i in xrange(1, len(L)):
        j = i-1
        key = L[i]
        while j >= 0 and L[j] > key:
           L[j+1] = L[j]
           j -= 1
        L[j+1] = key


(define insert
  X []     -> [X]
  X [Y|Ys] -> [X Y|Ys] where (<= X Y)
  X [Y|Ys] -> [Y|(insert X Ys)])

(define insertion-sort
  []     -> []
  [X|Xs] -> (insert X (insertion-sort Xs)))

(insertion-sort [6 8 5 9 3 2 1 4 7])


class QuickSort {
  function : Main(args : String[]) ~ Nil {
    array := [1, 3, 5, 7, 9, 8, 6, 4, 2];
    Sort(array);
    each(i : array) {
      array[i]->PrintLine();
    };
  }

  function : Sort(array : Int[]) ~ Nil {
    size := array->Size();
    if(size <= 1) {
      return;
    };
    Sort(array, 0, size - 1);
  }

  function : native : Sort(array : Int[], low : Int, high : Int) ~ Nil {
    i := low; j := high;
    pivot := array[low + (high-low)/2];

    while(i <= j) {
      while(array[i] < pivot) {
        i+=1;
      };

      while(array[j] > pivot) {
        j-=1;
      };

      if (i <= j) {
        temp := array[i];
        array[i] := array[j];
        array[j] := temp;
        i+=1; j-=1;
      };
    };

    if(low < j) {
      Sort(array, low, j);
    };

    if(i < high) {
      Sort(array, i, high);
    };
  }
}


function list = gnomeSort(list)

    i = 2;
    j = 3;

    while i <= numel(list)

        if list(i-1) <= list(i)
            i = j;
            j = j+1;
        else
            list([i-1 i]) = list([i i-1]); %Swap
            i = i-1;
            if i == 1
                i = j;
                j = j+1;
            end
        end %if

    end %while
end %gnomeSort


fn gnomeSort arr =
(
	local i = 2
	local j = 3
	while i <= arr.count do
	(
		if arr[i-1] <= arr[i] then
		(
			i = j
			j += 1
		)
		else
		(
			swap arr[i-1] arr[i]
			i -= 1
			if i == 1 then
			(
				i = j
				j += 1
			)
		)
	)
	return arr
)


def gnomesort(suffix v)(expr n) =
begingroup save i, j, t;
  i := 1; j := 2;
  forever: exitif not (i < n);
    if v[i-1] <= v[i]:
      i := j; j := j + 1;
    else:
      t := v[i-1];
      v[i-1] := v[i];
      v[i] := t;
      i := i - 1;
      i := if i=0: j; j := j + 1 else: i fi;
    fi
  endfor
endgroup enddef;


(*
    In-place, iterative binary merge sort
    Merge sort algorithm: John von Neumann, 1945.

    Convenience terminology used here:
        run: one of two adjacent source-list ranges containing ordered items for merging.
        block: range in the destination list to which two runs are merged.
*)
on mergeSort(theList, l, r) -- Sort items l thru r of theList.
    set listLength to (count theList)
    if (listLength < 2) then return
    -- Convert negative and/or transposed range indices.
    if (l < 0) then set l to listLength + l + 1
    if (r < 0) then set r to listLength + r + 1
    if (l > r) then set {l, r} to {r, l}

    -- Script object containing the input list and the sort range indices.
    script main
        property lst : theList
        property l : missing value
        property r : missing value
    end script
    set {main's l, main's r} to {l, r}

    -- Just swap adjacent items as necessary on the first pass.
    -- (Short insertion sorts would be better, to create larger initial runs.)
    repeat with j from (l + 1) to r by 2
        set i to j - 1
        set lv to main's lst's item i
        set rv to main's lst's item j
        if (lv > rv) then
            set main's lst's item i to rv
            set main's lst's item j to lv
        end if
    end repeat
    set rangeLength to r - l + 1
    if (rangeLength < 3) then return -- That's all if fewer than three items to sort.

    -- Script object to alternate with the one above as the source and destination for the
    -- merges. Its list need only contain the items from the sort range as ordered so far.
    script aux
        property lst : main's lst's items l thru r
        property l : 1
        property r : rangeLength
    end script

    -- Work out how many merging passes will be needed and set the script objects' initial
    -- source and destination roles so that the final pass will merge back to the original list.
    set passesToDo to 0
    set blockSize to 2
    repeat while (blockSize < rangeLength)
        set passesToDo to passesToDo + 1
        set blockSize to blockSize + blockSize
    end repeat
    set {srce, dest} to {{main, aux}, {aux, main}}'s item (passesToDo mod 2 + 1)

    -- Do the remaining passes, doubling the run and block sizes on each pass.
    -- (The end set in each pass will usually be truncated.)
    set blockSize to 2
    repeat passesToDo times -- Per pass.
        set runSize to blockSize
        set blockSize to blockSize + blockSize
        set k to (dest's l) - 1 -- Destination traversal index.

        repeat with leftStart from srce's l to srce's r by blockSize -- Per merge.
            set blockEnd to k + blockSize
            if (blockEnd comes after dest's r) then set blockEnd to dest's r
            set i to leftStart -- Left run traversal index.
            set leftEnd to leftStart + runSize - 1
            if (leftEnd comes before srce's r) then
                set j to leftEnd + 1 -- Right run traversal index.
                set rightEnd to leftEnd + runSize
                if (rightEnd comes after srce's r) then set rightEnd to srce's r
                -- Merge process:
                set lv to srce's lst's item i
                set rv to srce's lst's item j
                repeat with k from (k + 1) to blockEnd
                    if (lv > rv) then
                        set dest's lst's item k to rv
                        if (j = rightEnd) then exit repeat -- Right run used up.
                        set j to j + 1
                        set rv to srce's lst's item j
                    else
                        set dest's lst's item k to lv
                        if (i = leftEnd) then -- Left run used up.
                            set i to j
                            exit repeat
                        end if
                        set i to i + 1
                        set lv to srce's lst's item i
                    end if
                end repeat
            end if
            -- Use up the remaining items from the not-yet-exhausted run.
            repeat with k from (k + 1) to blockEnd
                set dest's lst's item k to srce's lst's item i
                set i to i + 1
            end repeat
        end repeat -- Per merge.

        -- Switch source and destination scripts for the next pass.
        tell srce
            set srce to dest
            set dest to it
        end tell
    end repeat -- Per pass.

    return -- nothing
end mergeSort
property sort : mergeSort

-- Demo:
local aList
set aList to {22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList


[ [] swap witheach
    [ swap 2dup findwith
        [ over > ] [ ]
      nip stuff ] ]        is insertionsort ( [ --> [ )


void quicksortInPlace(NSMutableArray *array, NSInteger first, NSInteger last, NSComparator comparator) {
    if (first >= last) return;
    id pivot = array[(first + last) / 2];
    NSInteger left = first;
    NSInteger right = last;
    while (left <= right) {
        while (comparator(array[left], pivot) == NSOrderedAscending)
            left++;
        while (comparator(array[right], pivot) == NSOrderedDescending)
            right--;
        if (left <= right)
            [array exchangeObjectAtIndex:left++ withObjectAtIndex:right--];
    }
    quicksortInPlace(array, first, right, comparator);
    quicksortInPlace(array, left, last, comparator);
}

NSArray* quicksort(NSArray *unsorted, NSComparator comparator) {
    NSMutableArray *a = [NSMutableArray arrayWithArray:unsorted];
    quicksortInPlace(a, 0, a.count - 1, comparator);
    return a;
}

int main(int argc, const char * argv[]) {
    @autoreleasepool {
        NSArray *a = @[ @1, @3, @5, @7, @9, @8, @6, @4, @2 ];
        NSLog(@"Unsorted: %@", a);
        NSLog(@"Sorted: %@", quicksort(a, ^(id x, id y) { return [x compare:y]; }));
        NSArray *b = @[ @"Emil", @"Peg", @"Helen", @"Juergen", @"David", @"Rick", @"Barb", @"Mike", @"Tom" ];
        NSLog(@"Unsorted: %@", b);
        NSLog(@"Sorted: %@", quicksort(b, ^(id x, id y) { return [x compare:y]; }));
    }
    return 0;
}


/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.util.List

i1 = ArrayList(Arrays.asList([Integer(3), Integer(3), Integer(1), Integer(2), Integer(4), Integer(3), Integer(5), Integer(6)]))
say i1.toString
say gnomeSort(i1).toString

return

method isTrue public constant binary returns boolean
  return 1 == 1

method isFalse public constant binary returns boolean
  return \isTrue

method gnomeSort(a = String[], sAsc = isTrue) public constant binary returns String[]

  rl = String[a.length]
  al = List gnomeSort(Arrays.asList(a), sAsc)
  al.toArray(rl)

  return rl

method gnomeSort(a = List, sAsc = isTrue) public constant binary returns ArrayList

  sDsc = \sAsc -- Ascending/descending switches
  ra = ArrayList(a)
  i_ = 1
  j_ = 2
  loop label i_ while i_ < ra.size
    ctx = (Comparable ra.get(i_ - 1)).compareTo(Comparable ra.get(i_))
    if (sAsc & ctx <= 0) | (sDsc & ctx >= 0) then do
      i_ = j_
      j_ = j_ + 1
      end
    else do
      swap = ra.get(i_)
      ra.set(i_, ra.get(i_ - 1))
      ra.set(i_ - 1, swap)
      i_ = i_ - 1
      if i_ = 0 then do
        i_ = j_
        j_ = j_ + 1
        end
      end
    end i_

  return ra


proc gnomeSort[T](a: var openarray[T]) =
  var
    n = a.len
    i = 1
    j = 2
  while i < n:
    if a[i-1] > a[i]:
      swap a[i-1], a[i]
      dec i
      if i > 0: continue
    i = j
    inc j

var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
gnomeSort a
echo a


/* ARM assembly Raspberry PI  */
/*  program mergeSort.s  */

 /* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"

.align 4
#TableNumber:      .int   1,11,3,6,2,5,9,10,8,4,7
TableNumber:       .int   10,9,8,7,6,5,4,3,2,1
                   .equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:            .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                              @ entry of program

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#0                                      @ first element
    mov r2,#NBELEMENTS                             @ number of élements
    bl mergeSort
    ldr r0,iAdrTableNumber                         @ address number table
    bl displayTable

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#NBELEMENTS                             @ number of élements
    bl isSorted                                    @ control sort
    cmp r0,#1                                      @ sorted ?
    beq 1f
    ldr r0,iAdrszMessSortNok                       @ no !! error sort
    bl affichageMess
    b 100f
1:                                                 @ yes
    ldr r0,iAdrszMessSortOk
    bl affichageMess
100:                                               @ standard end of the program
    mov r0, #0                                     @ return code
    mov r7, #EXIT                                  @ request to exit program
    svc #0                                         @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrTableNumber:          .int TableNumber
iAdrszMessSortOk:         .int szMessSortOk
iAdrszMessSortNok:        .int szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements  > 0  */
/* r0 return 0  if not sorted   1  if sorted */
isSorted:
    push {r2-r4,lr}                                    @ save registers
    mov r2,#0
    ldr r4,[r0,r2,lsl #2]
1:
    add r2,#1
    cmp r2,r1
    movge r0,#1
    bge 100f
    ldr r3,[r0,r2, lsl #2]
    cmp r3,r4
    movlt r0,#0
    blt 100f
    mov r4,r3
    b 1b
100:
    pop {r2-r4,lr}
    bx lr                                              @ return

/******************************************************************/
/*         merge                                              */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index   */
merge:
    push {r1-r8,lr}               @ save registers
    mov r5,r2                     @ init index r2->r5
1:                                @ begin loop first section
    ldr r6,[r0,r1,lsl #2]         @ load value first section index r1
    ldr r7,[r0,r5,lsl #2]         @ load value second section index r5
    cmp r6,r7
    ble 3f                        @ <=  -> location first section OK
    str r7,[r0,r1,lsl #2]         @ store value second section in first section
    add r8,r5,#1
    cmp r8,r3                     @ end second section ?
    strgt r6,[r0,r5,lsl #2]
    bgt 3f                        @ loop
2:                                @ loop insert element part 1 into part 2
    sub r4,r8,#1
    ldr r7,[r0,r8,lsl #2]         @ load value 2
    cmp r6,r7                     @ value <
    strlt r6,[r0,r4,lsl #2]       @ store value
    blt 3f
    str r7,[r0,r4,lsl #2]         @ store value 2
    add r8,#1
    cmp r8,r3                     @ end second section ?
    ble 2b                        @ no loop
    sub r8,#1
    str r6,[r0,r8,lsl #2]         @ store value 1
3:
    add r1,#1
    cmp r1,r2                     @ end first section ?
    blt 1b

100:
    pop {r1-r8,lr}
    bx lr                          @ return
/******************************************************************/
/*      merge sort                                                */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the index of first element */
/* r2 contains the number of element */
mergeSort:
    push {r3-r7,lr}           @ save registers
    cmp r2,#2
    blt 100f
    lsr r4,r2,#1             @ number of element of each subset
    tst r2,#1
    addne r4,#1
    mov r5,r1              @ save first element
    mov r6,r2              @ save number of element
    mov r7,r4              @ save number of element of each subset
    mov r2,r4
    bl mergeSort
    mov r1,r7              @ restaur number of element of each subset
    mov r2,r6              @ restaur  number of element
    sub r2,r1
    mov r3,r5              @ restaur first element
    add r1,r3              @ + 1
    bl mergeSort           @ sort first subset
    mov r1,r5              @ restaur first element
    mov r2,r7              @ restaur number of element of each subset
    add r2,r1
    mov r3,r6              @ restaur  number of element
    add r3,r1
    sub r3,#1              @ last index
    bl merge
100:
    pop {r3-r7,lr}
    bx lr                  @ return

/******************************************************************/
/*      Display table elements                                */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
    push {r0-r3,lr}                                    @ save registers
    mov r2,r0                                          @ table address
    mov r3,#0
1:                                                     @ loop display table
    ldr r0,[r2,r3,lsl #2]
    ldr r1,iAdrsZoneConv                               @
    bl conversion10S                                    @ décimal conversion
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv                               @ insert conversion
    bl strInsertAtCharInc
    bl affichageMess                                   @ display message
    add r3,#1
    cmp r3,#NBELEMENTS - 1
    ble 1b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    mov r0,r2
100:
    pop {r0-r3,lr}
    bx lr
iAdrsZoneConv:           .int sZoneConv
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


#lang racket

(define (sort < l)
  (define (insert x ys)
    (match ys
      [(list) (list x)]
      [(cons y rst) (cond [(< x y) (cons x ys)]
                          [else (cons y (insert x rst))])]))
  (foldl insert '() l))


sub insertion_sort ( @a is copy ) {
    for 1 .. @a.end -> $i {
        my $value = @a[$i];
        my $j;
        loop ( $j = $i-1; $j >= 0 and @a[$j] > $value; $j-- ) {
            @a[$j+1] = @a[$j];
        }
        @a[$j+1] = $value;
    }
    return @a;
}

my @data = 22, 7, 2, -5, 8, 4;
say 'input  = ' ~ @data;
say 'output = ' ~ @data.&insertion_sort;


let rec quicksort gt = function
  | [] -> []
  | x::xs ->
      let ys, zs = List.partition (gt x) xs in
      (quicksort gt ys) @ (x :: (quicksort gt zs))

let _ =
  quicksort (>) [4; 65; 2; -31; 0; 99; 83; 782; 1]


# let gnome_sort a =
    let i = ref 1
    and j = ref 2 in
    while !i < Array.length a do
      if a.(!i-1) <= a.(!i) then
      begin
        i := !j;
        j := !j + 1;
      end else begin
        swap a (!i-1) (!i);
        i := !i - 1;
        if !i = 0 then begin
          i := !j;
          j := !j + 1;
        end;
      end;
    done;
  ;;
val gnome_sort : 'a array -> unit = <fun>

# let a = [| 7; 9; 4; 2; 1; 3; 6; 5; 0; 8; |] ;;
val a : int array = [|7; 9; 4; 2; 1; 3; 6; 5; 0; 8|]

# gnome_sort a ;;
- : unit = ()

# a ;;
- : int array = [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|]


fun mergesort(m):
    if m.lenght <= 1: return m
    let middle = floor m.lenght / 2
    let left = merge(m[:middle])
    let right = merge(m[middle-1:]);

fun merge(left, right):
    let result = []
    while not (left.isempty or right.isempty):
        if left[1] <= right[1]:
            result.push! left.shift!()
        else:
            result.push! right.shift!()
    result.push! left.push! right

let arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print mergesort arr


(*------------------------------------------------------------------*)
(* Mergesort in ATS2, for linear lists.                             *)
(*------------------------------------------------------------------*)

#include "share/atspre_staload.hats"

staload UN = "prelude/SATS/unsafe.sats"

#define NIL list_vt_nil ()
#define ::  list_vt_cons

(*------------------------------------------------------------------*)

(* Destructive stable merge. *)
extern fun {a : [email protected]}
list_vt_merge {m, n : int}
              (lst1 : list_vt (a, m),
               lst2 : list_vt (a, n))
    :<!wrt> list_vt (a, m + n)

(* Order predicate for list_vt_merge. You have to implement this to
   suit your needs. *)
extern fun {a : [email protected]}
list_vt_merge$lt : (&a, &a) -<> bool

(* Destructive stable mergesort. *)
extern fun {a : [email protected]}
list_vt_mergesort {n   : int}
                  (lst : list_vt (a, n))
    :<!wrt> list_vt (a, n)

(* Order predicate for list_vt_mergesort. You have to implement this
   to suit your needs. *)
extern fun {a : [email protected]}
list_vt_mergesort$lt : (&a, &a) -<> bool

(*------------------------------------------------------------------*)

implement {a}
list_vt_merge {m, n} (lst1, lst2) =
  let
    macdef lt = list_vt_merge$lt<a>

    fun
    loop {m, n       : nat} .<m + n>.
         (lst1       : list_vt (a, m),
          lst2       : list_vt (a, n),
          lst_merged : &List_vt a? >> list_vt (a, m + n))
        :<!wrt> void =
      case+ lst1 of
      | ~ NIL => lst_merged := lst2
      | @ elem1 :: tail1 =>
        begin
          case+ lst2 of
          | ~ NIL =>
            let
              prval () = [email protected] lst1
            in
              lst_merged := lst1
            end
          | @ elem2 :: tail2 =>
            if ~(elem2 \lt elem1) then
              let
                val () = lst_merged := lst1
                prval () = [email protected] lst2
                val () = loop (tail1, lst2, tail1)
                prval () = [email protected] lst_merged
              in
              end
            else
              let
                val () = lst_merged := lst2
                prval () = [email protected] lst1
                val () = loop (lst1, tail2, tail2)
                prval () = [email protected] lst_merged
              in
              end
        end

    prval () = lemma_list_vt_param lst1 (* Proves 0 <= m. *)
    prval () = lemma_list_vt_param lst2 (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= m} ()
    prval () = prop_verify {0 <= n} ()

    var lst_merged : List_vt a?
    val () = loop {m, n} (lst1, lst2, lst_merged)
  in
    lst_merged
  end

(*------------------------------------------------------------------*)

implement {a}
list_vt_mergesort {n} lst =
  let
    implement
    list_vt_merge$lt<a> (x, y) =
      list_vt_mergesort$lt<a> (x, y)

    (* You can make SMALL larger than 1 and write small_sort as a fast
       stable sort for small lists. *)
    #define SMALL 1
    fn
    small_sort {m   : pos | m <= SMALL}
               (lst : list_vt (a, m),
                m   : int m)
        :<!wrt> list_vt (a, m) =
      lst

    fun
    recurs {m   : pos} .<m>.
           (lst : list_vt (a, m),
            m   : int m)
        :<!wrt> list_vt (a, m) =
      if m <= SMALL then
        small_sort (lst, m)
      else
        let
          prval () = prop_verify {2 <= m} ()
          val i = m / 2
          val @(lst1, lst2) = list_vt_split_at<a> (lst, i)
          val lst1 = recurs (lst1, i)
          val lst2 = recurs (lst2, m - i)
        in
          list_vt_merge<a> (lst1, lst2)
        end

    prval () = lemma_list_vt_param lst (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= n} ()
  in
    case+ lst of
    | NIL => lst
    | _ :: _ => recurs (lst, length lst)
  end

(*------------------------------------------------------------------*)

extern fun
list_vt_mergesort_int {n   : int}
                      (lst : list_vt (int, n))
    :<!wrt> list_vt (int, n)

implement
list_vt_mergesort_int {n} lst =
  let
    implement
    list_vt_mergesort$lt<int> (x, y) =
      x < y
  in
    list_vt_mergesort<int> {n} lst
  end

implement
main0 () =
  let
    val lst = $list_vt (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49,
                        48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76,
                        53, 37, 90)
    val () = println! ("before : ", $UN.castvwtp1{List int} lst)
    val lst = list_vt_mergesort_int lst
    val () = println! ("after  : ", $UN.castvwtp1{List int} lst)
  in
    list_vt_free<int> lst
  end

(*------------------------------------------------------------------*)


import List;

public list[int] insertionSort(a){
	for(i <- [0..size(a)-1]){
		v = a[i];
		j = i-1;
		while(j >= 0 && a[j] > v){
			a[j+1] = a[j];
			j -= 1;
                }
		a[j+1] = v;
        }
	return a;
}


Sub InsertionSort(theList() as Integer)
  for insertionElementIndex as Integer = 1 to UBound(theList)
    dim insertionElement as Integer = theList(insertionElementIndex)
    dim j as Integer = insertionElementIndex - 1
    while (j >= 0) and (insertionElement < theList(j))
      theList(j + 1) = theList(j)
      j = j - 1
    wend
    theList(j + 1) = insertionElement
  next
End Sub


; This program works with REBOL version R2 and R3, to make it work with Red
; change the word func to function
insertion-sort: func [
	a [block!]
	/local i [integer!] j [integer!] n [integer!]
	value [integer! string! date!]
][
	i: 2
	n: length? a

	while [i <= n][
        	value: a/:i
		j: i
		while [ all [ 	1 < j
				value < a/(j - 1) ]][

	       		a/:j: a/(j - 1)
			j: j - 1
        	]
        	a/:j: value
		i: i + 1
	]
	a
]

probe insertion-sort [4 2 1 6 9 3 8 7]

probe insertion-sort [ "---Monday's Child Is Fair of Face (by Mother Goose)---"
  "Monday's child is fair of face;"
  "Tuesday's child is full of grace;"
  "Wednesday's child is full of woe;"
 "Thursday's child has far to go;"
  "Friday's child is loving and giving;"
  "Saturday's child works hard for a living;"
  "But the child that is born on the Sabbath day"
  "Is blithe and bonny, good and gay."]

; just by adding the date! type to the local variable value the same function can sort dates.
probe insertion-sort [12-Jan-2015 11-Jan-2015 11-Jan-2016 12-Jan-2014]


function f=quicksort(v)                       % v must be a column vector
  f = v; n=length(v);
  if(n > 1)
     vl = min(f); vh = max(f);                  % min, max
     p  = (vl+vh)*0.5;                          % pivot
     ia = find(f < p); ib = find(f == p); ic=find(f > p);
     f  = [quicksort(f(ia)); f(ib); quicksort(f(ic))];
  end
endfunction

N=30; v=rand(N,1); tic,u=quicksort(v); toc
u


function s = gnomesort(v)
  i = 2; j = 3;
  while ( i <= length(v) )
    if ( v(i-1) <= v(i) )
      i = j;
      j++;
    else
      t = v(i-1);
      v(i-1) = v(i);
      v(i) = t;
      i--;
      if ( i == 1 )
	i = j;
	j++;
      endif
    endif
  endwhile
  s = v;
endfunction


#NoEnv

Test := []
Loop 100 {
    Random n, 0, 999
    Test.Insert(n)
}
Result := MergeSort(Test)
Loop % Result.MaxIndex() {
    MsgBox, 1, , % Result[A_Index]
    IfMsgBox Cancel
        Break
}
Return

/*
    Function MergeSort
        Sorts an array by first recursively splitting it down to its
        individual elements and then merging those elements in their
        correct order.

    Parameters
        Array   The array to be sorted

    Returns
        The sorted array
*/
MergeSort(Array)
    {
        ; Return single element arrays
        If (! Array.HasKey(2))
            Return Array

        ; Split array into Left and Right halfs
        Left := [], Right := [], Middle := Array.MaxIndex() // 2
        Loop % Middle
            Right.Insert(Array.Remove(Middle-- + 1)), Left.Insert(Array.Remove(1))
        If (Array.MaxIndex())
            Right.Insert(Array.Remove(1))

        Left := MergeSort(Left), Right := MergeSort(Right)

        ; If all the Right values are greater than all the
        ; Left values, just append Right at the end of Left.
        If (Left[Left.MaxIndex()] <= Right[1]) {
            Loop % Right.MaxIndex()
                Left.Insert(Right.Remove(1))
            Return Left
        }
        ; Loop until one of the arrays is empty
        While(Left.MaxIndex() and Right.MaxIndex())
            Left[1] <= Right[1] ? Array.Insert(Left.Remove(1))
                                : Array.Insert(Right.Remove(1))

        Loop % Left.MaxIndex()
            Array.Insert(Left.Remove(1))

        Loop % Right.MaxIndex()
            Array.Insert(Right.Remove(1))

        Return Array
    }


/*REXX program sorts a stemmed array (has characters) using the insertion sort algorithm*/
call gen                                         /*generate the array's (data) elements.*/
call show           'before sort'                /*display the  before  array elements. */
     say copies('▒', 85)                         /*display a separator line  (a fence). */
call insertionSort  #                            /*invoke the  insertion  sort.         */
call show           ' after sort'                /*display the   after  array elements. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen: @.=;                 @.1  = "---Monday's Child Is Fair of Face  (by Mother Goose)---"
                          @.2  = "======================================================="
                          @.3  = "Monday's child is fair of face;"
                          @.4  = "Tuesday's child is full of grace;"
                          @.5  = "Wednesday's child is full of woe;"
                          @.6  = "Thursday's child has far to go;"
                          @.7  = "Friday's child is loving and giving;"
                          @.8  = "Saturday's child works hard for a living;"
                          @.9  = "But the child that is born on the Sabbath day"
                          @.10 = "Is blithe and bonny, good and gay."
            do #=1  while @.#\==''; end;  #= #-1 /*determine how many entries in @ array*/
     return                                      /* [↑]  adjust # for the DO loop index.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
insertionSort:  procedure expose @.;      parse arg #
                          do i=2  to #;   $= @.i;       do j=i-1  by -1  to 1  while @.j>$
                                                        _= j + 1;        @._= @.j
                                                        end   /*j*/
                          _= j + 1;       @._= $
                          end   /*i*/
                return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:  do j=1  for #;  say '   element'  right(j,length(#))  arg(1)": "  @.j; end;  return


alist = [7,6,5,9,8,4,3,1,2,0]
see insertionsort(alist)

func insertionsort blist
     for i = 1 to len(blist)
         value = blist[i]
         j = i - 1
         while j >= 1 and blist[j] > value
               blist[j+1] = blist[j]
               j = j - 1
         end
         blist[j+1] = value
      next
      return blist


declare
  fun {GnomeSort Xs}
     case Xs of nil then nil
     [] X|Xr then {Loop [X] Xr}
     end
  end

  fun {Loop Vs Ws}
     case [Vs Ws]
     of [V|_  W|Wr] andthen V =< W then {Loop W|Vs Wr}
     [] [V|Vr W|Wr] then {Loop Vr W|V|Wr}
     [] [nil  W|Wr] then {Loop [W] Wr}
     [] [Vs   nil ] then {Reverse Vs}
     end
  end
in
  {Show {GnomeSort [3 1 4 1 5 9 2 6 5]}}


MsgBox % MSort("")
MsgBox % MSort("xxx")
MsgBox % MSort("3,2,1")
MsgBox % MSort("dog,000000,cat,pile,abcde,1,zz,xx,z")

MSort(x) {                                                  ; Merge-sort of a comma separated list
   If (2 > L:=Len(x))
       Return x                                             ; empty or single item lists are sorted
   StringGetPos p, x, `,, % "L" L//2                        ; Find middle comma
   Return Merge(MSort(SubStr(x,1,p)), MSort(SubStr(x,p+2))) ; Split, Sort, Merge
}

Len(list) {
   StringReplace t, list,`,,,UseErrorLevel                  ; #commas -> ErrorLevel
   Return list="" ? 0 : ErrorLevel+1
}

Item(list,ByRef p) {                                        ; item at position p, p <- next position
   Return (p := InStr(list,",",0,i:=p+1)) ? SubStr(list,i,p-i) : SubStr(list,i)
}

Merge(list0,list1) {                                        ; Merge 2 sorted lists
   IfEqual list0,, Return list1
   IfEqual list1,, Return list0
   i0 := Item(list0,p0:=0)
   i1 := Item(list1,p1:=0)
   Loop  {
      i := i0>i1
      list .= "," i%i%                                      ; output smaller
      If (p%i%)
         i%i% := Item(list%i%,p%i%)                         ; get next item from processed list
      Else {
         i ^= 1                                             ; list is exhausted: attach rest of other
         Return SubStr(list "," i%i% (p%i% ? "," SubStr(list%i%,p%i%+1) : ""), 2)
      }
   }
}


class Array
  def insertionsort!
    1.upto(length - 1) do |i|
      value = self[i]
      j = i - 1
      while j >= 0 and self[j] > value
        self[j+1] = self[j]
        j -= 1
      end
      self[j+1] = value
    end
    self
  end
end
ary = [7,6,5,9,8,4,3,1,2,0]
p ary.insertionsort!
# => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]


dim insSort(100)
sortEnd = 0
global inSort
global sortEnd

' -- insert some random numbers --

for i = 1 to 20
  a = int(1000 * rnd(1))
  x = insertSort(a)
next i

' --- Print the Sorted Data -----

print "End Sort:";sortEnd                ' number sorted
for i = 1 to sortEnd
 print i;" ";insSort(i)                  ' location and sorted data
next i
wait

function insertSort(x)                   ' Insert Sort Function
i = 1
while x > insSort(i) and i <= sortEnd
  i = i + 1
wend
for j = sortEnd to i step -1
   insSort(j + 1) = insSort(j)
next j
insSort(i) = x
sortEnd    = sortEnd + 1
end function


(define (quicksort l ??)
  (if (null? l)
      '()
      (append (quicksort (filter (lambda (x) (?? (car l) x)) (cdr l)) ??)
              (list (car l))
              (quicksort (filter (lambda (x) (not (?? (car l) x))) (cdr l)) ??))))

(print
   (quicksort (list 1 3 5 9 8 6 4 3 2) >))
(print
   (quicksort (iota 100) >))
(print
   (quicksort (iota 100) <))


procedure gnomesort(var arr : Array of Integer; size : Integer);
var
   i, j, t	: Integer;
begin
   i := 1;
   j := 2;
   while i < size do begin
      if arr[i-1] <= arr[i] then
      begin
	 i := j;
	 j := j + 1
      end
      else begin
	 t := arr[i-1];
	 arr[i-1] := arr[i];
	 arr[i] := t;
	 i := i - 1;
	 if i = 0 then begin
	    i := j;
	    j := j + 1
	 end
      end
   end;
end;


DEFPROC_MergeSort(Start%,End%)
REM *****************************************************************
REM This procedure Merge Sorts the chunk of data% bounded by
REM Start% & End%.
REM *****************************************************************

LOCAL Middle%
IF End%=Start% ENDPROC

IF End%-Start%=1 THEN
   IF data%(End%)<data%(Start%) THEN
      SWAP data%(Start%),data%(End%)
   ENDIF
   ENDPROC
ENDIF

Middle%=Start%+(End%-Start%)/2

PROC_MergeSort(Start%,Middle%)
PROC_MergeSort(Middle%+1,End%)
PROC_Merge(Start%,Middle%,End%)

ENDPROC
:
DEF PROC_Merge(Start%,Middle%,End%)

LOCAL fh_size%
fh_size% = Middle%-Start%+1

FOR I%=0 TO fh_size%-1
  fh%(I%)=data%(Start%+I%)
NEXT I%

I%=0
J%=Middle%+1
K%=Start%

REPEAT
  IF fh%(I%) <= data%(J%) THEN
    data%(K%)=fh%(I%)
    I%+=1
    K%+=1
  ELSE
    data%(K%)=data%(J%)
    J%+=1
    K%+=1
  ENDIF
UNTIL I%=fh_size% OR J%>End%

WHILE I% < fh_size%
  data%(K%)=fh%(I%)
  I%+=1
  K%+=1
ENDWHILE

ENDPROC


get "libhdr"

let mergesort(A, n) be if n >= 2
$(  let m = n / 2
    mergesort(A, m)
    mergesort(A+m, n-m)
    merge(A, n, m)
$)
and merge(A, n, m) be
$(  let i, j = 0, m
    let x = getvec(n)
    for k=0 to n-1
        x!k := A!valof
            test j~=n & (i=m | A!j < A!i)
            $(  j := j + 1
                resultis j - 1
            $)
            else
            $(  i := i + 1
                resultis i - 1
            $)
    for i=0 to n-1 do a!i := x!i
    freevec(x)
$)

let write(s, A, len) be
$(  writes(s)
    for i=0 to len-1 do writed(A!i, 4)
    wrch('*N')
$)

let start() be
$(  let array = table 4,65,2,-31,0,99,2,83,782,1
    let length = 10
    write("Before: ", array, length)
    mergesort(array, length)
    write("After:  ", array, length)
$)


fn insertion_sort<T: std::cmp::Ord>(arr: &mut [T]) {
    for i in 1..arr.len() {
        let mut j = i;
        while j > 0 && arr[j] < arr[j-1] {
            arr.swap(j, j-1);
            j = j-1;
        }
    }
}


DEF
sort () = ()
sort (a : x) = insert a (sort x)
insert a () = a,
insert a (b : x) = a < b -> a : b : x
          b : insert a x
?


def insertSort[X](list: List[X])(implicit ord: Ordering[X]) = {
  def insert(list: List[X], value: X) = list.span(x => ord.lt(x, value)) match {
    case (lower, upper) => lower ::: value :: upper
  }
  list.foldLeft(List.empty[X])(insert)
}


    a = .array~Of(4, 65, 2, -31, 0, 99, 83, 782, 1)
    say 'before:' a~toString( ,', ')
    a = quickSort(a)
    say ' after:' a~toString( ,', ')
    exit

::routine quickSort
    use arg arr -- the array to be sorted
    less = .array~new
    pivotList = .array~new
    more = .array~new
    if arr~items <= 1 then
        return arr
    else do
        pivot = arr[1]
        do i over arr
            if i < pivot then
                less~append(i)
            else if i > pivot then
                more~append(i)
            else
                pivotList~append(i)
        end
        less = quickSort(less)
        more = quickSort(more)
        return less~~appendAll(pivotList)~~appendAll(more)
    end


with javascript_semantics

function gnomeSort(sequence s)
integer i = 1, j = 2
    while i<length(s) do
        object si = s[i],
               sn = s[i+1]
        if si<=sn then
            i = j
            j += 1
        else
            s[i] = sn
            s[i+1] = si
            i -= 1
            if i = 0 then
                i = j
                j += 1
            end if
        end if
    end while
    return s
end function

?gnomeSort(shuffle(tagset(10)))


#include <stdio.h>
#include <stdlib.h>

void merge (int *a, int n, int m) {
    int i, j, k;
    int *x = malloc(n * sizeof (int));
    for (i = 0, j = m, k = 0; k < n; k++) {
        x[k] = j == n      ? a[i++]
             : i == m      ? a[j++]
             : a[j] < a[i] ? a[j++]
             :               a[i++];
    }
    for (i = 0; i < n; i++) {
        a[i] = x[i];
    }
    free(x);
}

void merge_sort (int *a, int n) {
    if (n < 2)
        return;
    int m = n / 2;
    merge_sort(a, m);
    merge_sort(a + m, n - m);
    merge(a, n, m);
}

int main () {
    int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
    int n = sizeof a / sizeof a[0];
    int i;
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    merge_sort(a, n);
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    return 0;
}


(define (insert x lst)
  (if (null? lst)
      (list x)
      (let ((y (car lst))
            (ys (cdr lst)))
        (if (<= x y)
            (cons x lst)
            (cons y (insert x ys))))))

(define (insertion-sort lst)
  (if (null? lst)
      '()
      (insert (car lst)
              (insertion-sort (cdr lst)))))

(insertion-sort '(6 8 5 9 3 2 1 4 7))


const proc: insertionSort (inout array elemType: arr) is func
  local
    var integer: i is 0;
    var integer: j is 0;
    var elemType: help is elemType.value;
  begin
    for i range 2 to length(arr) do
      j := i;
      help := arr[i];
      while j > 1 and arr[pred(j)] > help do
        arr[j] := arr[pred(j)];
        decr(j);
      end while;
      arr[j] := help;
    end for;
  end func;


declare
  fun {QuickSort Xs}
     case Xs of nil then nil
     [] Pivot|Xr then
	fun {IsSmaller X} X < Pivot end
        Smaller Larger
     in
	{List.partition Xr IsSmaller ?Smaller ?Larger}
        {Append {QuickSort Smaller} Pivot|{QuickSort Larger}}
     end
  end
in
  {Show {QuickSort [3 1 4 1 5 9 2 6 5]}}


(de gnomeSort (Lst)
   (let J (cdr Lst)
      (for (I Lst (cdr I))
         (if (>= (cadr I) (car I))
            (setq I J  J (cdr J))
            (xchg I (cdr I))
            (if (== I Lst)
               (setq I J  J (cdr J))
               (setq I (prior I Lst)) ) ) ) )
   Lst )


SORT: PROCEDURE OPTIONS (MAIN);
   DECLARE A(0:9) FIXED STATIC INITIAL (5, 2, 7, 1, 9, 8, 6, 3, 4, 0);

   CALL GNOME_SORT (A);
   put skip edit (A) (f(7));

GNOME_SORT: PROCEDURE (A) OPTIONS (REORDER); /* 9 September 2015 */
   declare A(*) fixed;
   declare t fixed;
   declare (i, j) fixed;

   i = 1; j = 2;
   do while (i <= hbound(A));
      if a(i-1) <= a(i) then
         do;
            i = j; j = j + 1;
         end;
      else
         do;
            t = a(i-1); a(i-1) = a(i); a(i) = t;
            i = i - 1;
            if i = 0 then do; i = j; j = j + 1; end;
         end;
   end;

END GNOME_SORT;

END SORT;


SUB gnomeSort (a() AS LONG)
    DIM i AS LONG, j AS LONG
    i = 1
    j = 2
    WHILE (i < UBOUND(a) + 1)
        IF (a(i - 1) <= a(i)) THEN
            i = j
            INCR j
        ELSE
            SWAP a(i - 1), a(i)
            DECR i
            IF 0 = i THEN
                i = j
                INCR j
            END IF
        END IF
    WEND
END SUB

FUNCTION PBMAIN () AS LONG
    DIM n(9) AS LONG, x AS LONG
    RANDOMIZE TIMER
    OPEN "output.txt" FOR OUTPUT AS 1
    FOR x = 0 TO 9
        n(x) = INT(RND * 9999)
        PRINT #1, n(x); ",";
    NEXT
    PRINT #1,
    gnomeSort n()
    FOR x = 0 TO 9
        PRINT #1, n(x); ",";
    NEXT
    CLOSE 1
END FUNCTION