BinarySearchInsertionSort

Binary search on an array of cell-sized items. "find" and "insert" could be the basis of an insertion sort or an array of unique items kept sorted incrementally. Examples of the search routine are given with and without using locals.

create ar20 20 cells allot

ar20 value ar
   0 value sz

defer [compare]  ( item1 item2 --  <=> )
' - is [compare]    \ default to numbers, but could be pointers

\ with locals
: binary-search  0 { item upper lower -- index found? }
  begin  upper lower >
  while  upper lower + 2/  ( mid )
         dup cells ar + @ item [compare]
         dup 0= if drop true exit then
         0< if 1+ to lower else to upper then
  repeat upper lower max false ;

\ without locals
: new-bounds ( upper lower mid item<mid? -- upper' lower' )
  0< if  1+ swap drop ( upper mid+1 )
  else   rot drop swap  ( mid lower )
  then ;
: binary-search ( item size -- index found? )
  swap >r 0 ( upper lower r: item )
  begin
    2dup >
  while
    2dup + 2/ ( upper lower mid )
    dup cells ar + @ r@ [compare]
    dup 0= if r> 2drop >r 2drop r> true exit then
    new-bounds
  repeat r> drop max false ;

: insert ( item -- )
  dup sz binary-search if 2drop exit then   \ already there
  ( item insert-index )
  sz over - cells >r
  cells ar +
    dup dup cell+ r> move
  !  sz 1+ to sz ;