zpg, list sorting

needs lists.forth
needs list-utils.forth
needs part.forth

: pointer-array ( list -- array )
    here >r 0 ,
    begin dup while
	    dup , cdr repeat drop
    here r@ - cell / 1- r@ !
    r> ;

: array. ( array -- )
    ." #( "
    dup cell+ swap @ 0 do dup @ . cell+ loop drop
    ." )" ;

: array-car. ( array -- )
    ." ##( "
    dup cell+ swap @ 0 do dup @ car. cell+ loop drop
    ." )" ;

: str< car rot car 2swap compare 0< ;

variable mylist
s{ this is not exactly what we anticipated in 2006, but i guess it'll do. } mylist !

' str< is partition-compare

: array>list ( array -- list )
    dup cell+ @ nil over dup >r cdr! swap
    array-bounds cell+ swap cell+ do i @ over cdr! cdr cell +loop nil swap cdr! r> ;

: sort-list ( list1 -- list2 )
    pointer-array dup sort array>list ;

cr mylist @ list.
mylist @ sort-list mylist !
cr mylist @ list.