aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

23
Task/Sorting-algorithms-Merge-sort/Forth/sorting-algorithms-merge-sort.fth Normal file
View file

@ -0,0 +1,23 @@
: merge-step ( right mid left -- right mid+ left+ )
over @ over @ < if
over @ >r
2dup - over dup cell+ rot move
r> over !
>r cell+ 2dup = if rdrop dup else r> then
then cell+ ;
: merge ( right mid left -- right left )
dup >r begin 2dup > while merge-step repeat 2drop r> ;
: mid ( l r -- mid ) over - 2/ cell negate and + ;
: mergesort ( right left -- right left )
2dup cell+ <= if exit then
swap 2dup mid recurse rot recurse merge ;
: sort ( addr len -- ) cells over + swap mergesort 2drop ;
create test 8 , 1 , 5 , 3 , 9 , 0 , 2 , 7 , 6 , 4 ,
: .array ( addr len -- ) 0 do dup i cells + @ . loop drop ;
test 10 2dup sort .array \ 0 1 2 3 4 5 6 7 8 9