Combsort — Forth version

Here's another combsort that the amazing Nick Estes helped with. We did this on the plane to RubyConf.

Forth is pretty strange to program in. I have to say that it's a lot of fun, but probably too much fun. It's easy to get more wrapped up in stack manipulation than in solving the actual problem. I also think that this program doesn't seem very self-documenting. I'm sure that someone who actually knows Forth could do better.

That being said, I like Forth's culture of refactoring and of understanding your code. Those are great ideas.

This is written in gforth 0.4.9-19990617, but I didn't knowingly use any non-ANS keywords. I availed myself of some locals, which could probably be factored out by someone with more expertise and time.

Anyhow, here's the combsort function from combsort.fs:

: newgap ( gap -- gap )
    10 * 13 /
    dup 9 = over 10 = or if
        drop 11
    then
    dup 1 < if
        drop 1
    then
;

: swap_values ( a b --  a b swapped )
    2dup > dup >r ( a b swapped )
    if ( a b )
        swap ( b a true )
    then ( a' b' )
    r> ( a' b' swapped )
;

: swap_by_pointer ( p1 p2 -- swapped )
    over @ over @ ( p1 p2 a b )
    swap_values ( p1 p2 a b swapped )
    >r ( p1 p2 a b )
    rot ! ( p1 a )
    swap !
    r> ( swapped )
;

: inner_loop ( gap array length -- swapped )
    { gap array length }
    false ( swapped )
    length gap - 0 ?do
        array i cells + ( swapped p1 )
        array i gap + cells + ( swapped p1 p2 )
        swap_by_pointer ( swapped p1 p2 -- swapped swapped' )
        or ( swapped )
    loop
;

: combsort ( array length -- ) { array length }
    length
    begin
        newgap
        dup array length inner_loop
        over 1 > or while
    repeat
    drop
;