1. my class Rakudo::Sorting {
  2. # Return new IterationBuffer with the two given values
  3. sub IB2(Mu \one,Mu \two --> IterationBuffer) {
  4. nqp::stmts(
  5. (my $buf := nqp::create(IterationBuffer)),
  6. nqp::bindpos($buf,0,one),
  7. nqp::bindpos($buf,1,two),
  8. $buf
  9. )
  10. }
  11. # https://en.wikipedia.org/wiki/Merge_sort#Bottom-up_implementation
  12. # The parameter is the HLL List to be sorted *in place* using simple cmp.
  13. method MERGESORT-REIFIED-LIST(\list) {
  14. nqp::if(
  15. nqp::isgt_i((my int $n = nqp::elems(
  16. # $A has the items to sort; $B is a work array
  17. my $A := nqp::getattr(list,List,'$!reified')
  18. )),2),
  19. nqp::stmts( # we actually need to sort
  20. (my $B := nqp::setelems(nqp::create(IterationBuffer),$n)),
  21. # Each 1-element run in $A is already "sorted"
  22. # Make successively longer sorted runs of length 2, 4, 8, 16...
  23. # until $A is wholly sorted
  24. (my int $width = 1),
  25. nqp::while(
  26. nqp::islt_i($width,$n),
  27. nqp::stmts(
  28. (my int $l = 0),
  29. # $A is full of runs of length $width
  30. nqp::while(
  31. nqp::islt_i($l,$n),
  32. nqp::stmts(
  33. (my int $left = $l),
  34. (my int $right = nqp::add_i($l,$width)),
  35. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  36. (my int $end = nqp::add_i($l,nqp::add_i($width,$width))),
  37. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  38. (my int $i = $left),
  39. (my int $j = $right),
  40. (my int $k = nqp::sub_i($left,1)),
  41. # Merge two runs: $A[i .. i+width-1] and
  42. # $A[i+width .. i+2*width-1]
  43. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  44. nqp::while(
  45. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  46. nqp::if(
  47. nqp::islt_i($i,$right) && (
  48. nqp::isge_i($j,$end)
  49. || nqp::iseq_i(
  50. nqp::decont( # for some reason we need this
  51. nqp::atpos($A,$i) cmp nqp::atpos($A,$j)
  52. || nqp::cmp_i($i,$j)
  53. ), # apparently code gen with || isn't right
  54. -1
  55. )
  56. ),
  57. nqp::stmts(
  58. (nqp::bindpos($B,$k,nqp::atpos($A,$i))),
  59. ($i = nqp::add_i($i,1))
  60. ),
  61. nqp::stmts(
  62. (nqp::bindpos($B,$k,nqp::atpos($A,$j))),
  63. ($j = nqp::add_i($j,1))
  64. )
  65. )
  66. ),
  67. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  68. )
  69. ),
  70. # Now work array $B is full of runs of length 2*width.
  71. # Copy array B to array A for next iteration. A more
  72. # efficient implementation would swap the roles of A and B.
  73. (my $temp := $B),($B := $A),($A := $temp), # swap
  74. # Now array $A is full of runs of length 2*width.
  75. ($width = nqp::add_i($width,$width))
  76. )
  77. ),
  78. nqp::p6bindattrinvres(list,List,'$!reified',$A)
  79. ),
  80. nqp::if(
  81. nqp::islt_i($n,2)
  82. || nqp::isle_i(nqp::atpos($A,0) cmp nqp::atpos($A,1),0),
  83. list, # nothing to be done, we already have the result
  84. nqp::p6bindattrinvres(list,List,'$!reified', # need to swap
  85. IB2(nqp::atpos($A,1),nqp::atpos($A,0)))
  86. )
  87. )
  88. }
  89. # Takes the HLL List to be sorted *in place* using the comparator
  90. method MERGESORT-REIFIED-LIST-WITH(\list, &comparator) {
  91. nqp::if(
  92. nqp::isgt_i((my int $n = nqp::elems(
  93. # $A has the items to sort; $B is a work array
  94. my $A := nqp::getattr(list,List,'$!reified')
  95. )),2),
  96. nqp::stmts( # we actually need to sort
  97. (my $B := nqp::setelems(nqp::create(IterationBuffer),$n)),
  98. # Each 1-element run in $A is already "sorted"
  99. # Make successively longer sorted runs of length 2, 4, 8, 16...
  100. # until $A is wholly sorted
  101. (my int $width = 1),
  102. nqp::while(
  103. nqp::islt_i($width,$n),
  104. nqp::stmts(
  105. (my int $l = 0),
  106. # $A is full of runs of length $width
  107. nqp::while(
  108. nqp::islt_i($l,$n),
  109. nqp::stmts(
  110. (my int $left = $l),
  111. (my int $right = nqp::add_i($l,$width)),
  112. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  113. (my int $end = nqp::add_i($l,nqp::add_i($width,$width))),
  114. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  115. (my int $i = $left),
  116. (my int $j = $right),
  117. (my int $k = nqp::sub_i($left,1)),
  118. # Merge two runs: $A[i .. i+width-1] and
  119. # $A[i+width .. i+2*width-1]
  120. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  121. nqp::while(
  122. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  123. nqp::if(
  124. nqp::islt_i($i,$right) && (
  125. nqp::isge_i($j,$end)
  126. || nqp::iseq_i(
  127. nqp::decont( # for some reason we need this
  128. comparator(
  129. nqp::atpos($A,$i),nqp::atpos($A,$j))
  130. || nqp::cmp_i($i,$j)
  131. ), # apparently code gen with || isn't right
  132. -1
  133. )
  134. ),
  135. nqp::stmts(
  136. (nqp::bindpos($B,$k,nqp::atpos($A,$i))),
  137. ($i = nqp::add_i($i,1))
  138. ),
  139. nqp::stmts(
  140. (nqp::bindpos($B,$k,nqp::atpos($A,$j))),
  141. ($j = nqp::add_i($j,1))
  142. )
  143. )
  144. ),
  145. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  146. )
  147. ),
  148. # Now work array $B is full of runs of length 2*width.
  149. # Copy array B to array A for next iteration. A more
  150. # efficient implementation would swap the roles of A and B.
  151. (my $temp := $B),($B := $A),($A := $temp), # swap
  152. # Now array $A is full of runs of length 2*width.
  153. ($width = nqp::add_i($width,$width))
  154. )
  155. ),
  156. nqp::p6bindattrinvres(list,List,'$!reified',$A)
  157. ),
  158. nqp::if(
  159. nqp::islt_i($n,2)
  160. || nqp::iseq_i(
  161. comparator(nqp::atpos($A,0),nqp::atpos($A,1)),-1),
  162. list, # nothing to be done, we already have the result
  163. nqp::p6bindattrinvres(list,List,'$!reified', # need to swap
  164. IB2(nqp::atpos($A,1),nqp::atpos($A,0)))
  165. )
  166. )
  167. }
  168. # Takes the HLL List to be sorted *in place* using the mapper
  169. method MERGESORT-REIFIED-LIST-AS(\list,&mapper) {
  170. nqp::if(
  171. nqp::isgt_i((my int $n = nqp::elems(
  172. my $O := nqp::getattr(list,List,'$!reified') # Original
  173. )),2),
  174. nqp::stmts( # we actually need to sort
  175. (my $S := # the Schwartz
  176. nqp::setelems(nqp::create(IterationBuffer),$n)),
  177. (my $A := nqp::setelems(nqp::list_i,$n)), # indexes to sort
  178. (my $B := nqp::setelems(nqp::list_i,$n)), # work array
  179. (my int $s = -1),
  180. nqp::while( # set up the Schwartz and the initial indexes
  181. nqp::islt_i(($s = nqp::add_i($s,1)),$n),
  182. nqp::bindpos($S,nqp::bindpos_i($A,$s,$s),
  183. mapper(nqp::atpos($O,$s)))
  184. ),
  185. # Each 1-element run in $A is already "sorted"
  186. # Make successively longer sorted runs of length 2, 4, 8, 16...
  187. # until $A is wholly sorted
  188. (my int $width = 1),
  189. nqp::while(
  190. nqp::islt_i($width,$n),
  191. nqp::stmts(
  192. (my int $l = 0),
  193. # $A is full of runs of length $width
  194. nqp::while(
  195. nqp::islt_i($l,$n),
  196. nqp::stmts(
  197. (my int $left = $l),
  198. (my int $right = nqp::add_i($l,$width)),
  199. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  200. (my int $end = nqp::add_i($l,nqp::add_i($width,$width))),
  201. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  202. (my int $i = $left),
  203. (my int $j = $right),
  204. (my int $k = nqp::sub_i($left,1)),
  205. # Merge two runs: $A[i .. i+width-1] and
  206. # $A[i+width .. i+2*width-1]
  207. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  208. nqp::while(
  209. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  210. nqp::if(
  211. nqp::islt_i($i,$right) && (
  212. nqp::isge_i($j,$end)
  213. || (nqp::iseq_i(
  214. nqp::decont(
  215. nqp::atpos($S,nqp::atpos_i($A,$i))
  216. cmp nqp::atpos($S,nqp::atpos_i($A,$j))
  217. || nqp::cmp_i($i,$j)
  218. ),
  219. -1
  220. ))
  221. ),
  222. nqp::stmts(
  223. (nqp::bindpos_i($B,$k,nqp::atpos_i($A,$i))),
  224. ($i = nqp::add_i($i,1))
  225. ),
  226. nqp::stmts(
  227. (nqp::bindpos_i($B,$k,nqp::atpos_i($A,$j))),
  228. ($j = nqp::add_i($j,1))
  229. )
  230. )
  231. ),
  232. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  233. )
  234. ),
  235. # Now work array $B is full of runs of length 2*width.
  236. # Copy array B to array A for next iteration. A more
  237. # efficient implementation would swap the roles of A and B.
  238. (my $temp := $B),($B := $A),($A := $temp), # swap
  239. # Now array $A is full of runs of length 2*width.
  240. ($width = nqp::add_i($width,$width))
  241. )
  242. ),
  243. ($s = -1),
  244. nqp::while( # repurpose the Schwartz for the result
  245. nqp::islt_i(($s = nqp::add_i($s,1)),$n),
  246. nqp::bindpos($S,$s,nqp::atpos($O,nqp::atpos_i($A,$s)))
  247. ),
  248. nqp::p6bindattrinvres(list,List,'$!reified',$S)
  249. ),
  250. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',
  251. nqp::if(
  252. nqp::islt_i($n,2)
  253. || nqp::iseq_i(
  254. mapper(nqp::atpos($O,0)) cmp mapper(nqp::atpos($O,1)),-1),
  255. $O, # nothing to be done, we already have the result
  256. IB2(nqp::atpos($O,1),nqp::atpos($O,0)) # need to swap
  257. )
  258. )
  259. )
  260. }
  261. # https://en.wikipedia.org/wiki/Merge_sort#Bottom-up_implementation
  262. # Sort a native str array (or nqp::list_s) and return the result.
  263. # Uses the given str array as one of the buffers for performance reasons.
  264. # Please nqp::clone first if you want to keep the original intact.
  265. method MERGESORT-str(Mu \sortable) {
  266. nqp::if(
  267. nqp::isgt_i((my int $n = nqp::elems(sortable)),2),
  268. # $A has the items to sort; $B is a work array
  269. nqp::stmts(
  270. (my Mu $A := sortable),
  271. (my Mu $B := nqp::setelems(nqp::list_s,$n)),
  272. # Each 1-element run in $A is already "sorted"
  273. # Make successively longer sorted runs of length 2, 4, 8, 16...
  274. # until $A is wholly sorted
  275. (my int $width = 1),
  276. nqp::while(
  277. nqp::islt_i($width,$n),
  278. nqp::stmts(
  279. (my int $l = 0),
  280. # $A is full of runs of length $width
  281. nqp::while(
  282. nqp::islt_i($l,$n),
  283. nqp::stmts(
  284. (my int $left = $l),
  285. (my int $right = nqp::add_i($l,$width)),
  286. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  287. (my int $end =
  288. nqp::add_i($l,nqp::add_i($width,$width))),
  289. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  290. (my int $i = $left),
  291. (my int $j = $right),
  292. (my int $k = nqp::sub_i($left,1)),
  293. # Merge two runs: $A[i .. i+width-1] and
  294. # $A[i+width .. i+2*width-1]
  295. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  296. nqp::while(
  297. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  298. nqp::if(
  299. nqp::islt_i($i,$right) && (
  300. nqp::isge_i($j,$end)
  301. || nqp::islt_s(
  302. nqp::atpos_s($A,$i),
  303. nqp::atpos_s($A,$j)
  304. )
  305. ),
  306. nqp::stmts(
  307. (nqp::bindpos_s($B,$k,nqp::atpos_s($A,$i))),
  308. ($i = nqp::add_i($i,1))
  309. ),
  310. nqp::stmts(
  311. (nqp::bindpos_s($B,$k,nqp::atpos_s($A,$j))),
  312. ($j = nqp::add_i($j,1))
  313. )
  314. )
  315. ),
  316. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  317. )
  318. ),
  319. # Now work array $B is full of runs of length 2*width.
  320. # Copy array B to array A for next iteration. A more
  321. # efficient implementation would swap the roles of A and B.
  322. (my Mu $temp := $B),($B := $A),($A := $temp), # swap
  323. # Now array $A is full of runs of length 2*width.
  324. ($width = nqp::add_i($width,$width))
  325. )
  326. ),
  327. $A
  328. ),
  329. nqp::if(
  330. nqp::islt_i($n,2)
  331. || nqp::isle_s(nqp::atpos_s(sortable,0),nqp::atpos_s(sortable,1)),
  332. nqp::clone(sortable), # we already have the result
  333. nqp::stmts(
  334. (my $R := nqp::setelems(nqp::list_s,2)),
  335. nqp::bindpos_s($R,0,nqp::atpos_s(sortable,1)),
  336. nqp::bindpos_s($R,1,nqp::atpos_s(sortable,0)),
  337. $R
  338. )
  339. )
  340. )
  341. }
  342. # https://en.wikipedia.org/wiki/Merge_sort#Bottom-up_implementation
  343. # Sort a native int array (or nqp::list_i) and return the result.
  344. # Uses the given int array as one of the buffers for performance reasons.
  345. # Please nqp::clone first if you want to keep the original intact.
  346. method MERGESORT-int(Mu \sortable) {
  347. nqp::if(
  348. nqp::isgt_i((my int $n = nqp::elems(sortable)),2),
  349. # $A has the items to sort; $B is a work array
  350. nqp::stmts(
  351. (my Mu $A := sortable),
  352. (my Mu $B := nqp::setelems(nqp::list_i,$n)),
  353. # Each 1-element run in $A is already "sorted"
  354. # Make successively longer sorted runs of length 2, 4, 8, 16...
  355. # until $A is wholly sorted
  356. (my int $width = 1),
  357. nqp::while(
  358. nqp::islt_i($width,$n),
  359. nqp::stmts(
  360. (my int $l = 0),
  361. # $A is full of runs of length $width
  362. nqp::while(
  363. nqp::islt_i($l,$n),
  364. nqp::stmts(
  365. (my int $left = $l),
  366. (my int $right = nqp::add_i($l,$width)),
  367. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  368. (my int $end =
  369. nqp::add_i($l,nqp::add_i($width,$width))),
  370. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  371. (my int $i = $left),
  372. (my int $j = $right),
  373. (my int $k = nqp::sub_i($left,1)),
  374. # Merge two runs: $A[i .. i+width-1] and
  375. # $A[i+width .. i+2*width-1]
  376. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  377. nqp::while(
  378. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  379. nqp::if(
  380. nqp::islt_i($i,$right) && (
  381. nqp::isge_i($j,$end)
  382. || nqp::islt_i(
  383. nqp::atpos_i($A,$i),
  384. nqp::atpos_i($A,$j)
  385. )
  386. ),
  387. nqp::stmts(
  388. (nqp::bindpos_i($B,$k,nqp::atpos_i($A,$i))),
  389. ($i = nqp::add_i($i,1))
  390. ),
  391. nqp::stmts(
  392. (nqp::bindpos_i($B,$k,nqp::atpos_i($A,$j))),
  393. ($j = nqp::add_i($j,1))
  394. )
  395. )
  396. ),
  397. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  398. )
  399. ),
  400. # Now work array $B is full of runs of length 2*width.
  401. # Copy array B to array A for next iteration. A more
  402. # efficient implementation would swap the roles of A and B.
  403. (my Mu $temp := $B),($B := $A),($A := $temp), # swap
  404. # Now array $A is full of runs of length 2*width.
  405. ($width = nqp::add_i($width,$width))
  406. )
  407. ),
  408. $A
  409. ),
  410. nqp::if(
  411. nqp::islt_i($n,2)
  412. || nqp::isle_i(nqp::atpos_i(sortable,0),nqp::atpos_i(sortable,1)),
  413. nqp::clone(sortable), # we already have the result
  414. nqp::stmts(
  415. (my $R := nqp::setelems(nqp::list_i,2)),
  416. nqp::bindpos_i($R,0,nqp::atpos_i(self,1)),
  417. nqp::bindpos_i($R,1,nqp::atpos_i(self,0)),
  418. $R
  419. )
  420. )
  421. )
  422. }
  423. # https://en.wikipedia.org/wiki/Merge_sort#Bottom-up_implementation
  424. # Sort a native num array (or nqp::list_n) and return the result.
  425. # Uses the given num array as one of the buffers for performance reasons.
  426. # Please nqp::clone first if you want to keep the original intact.
  427. method MERGESORT-num(Mu \sortable) {
  428. nqp::if(
  429. nqp::isgt_i((my int $n = nqp::elems(sortable)),2),
  430. # $A has the items to sort; $B is a work array
  431. nqp::stmts(
  432. (my Mu $A := sortable),
  433. (my Mu $B := nqp::setelems(nqp::list_n,$n)),
  434. # Each 1-element run in $A is already "sorted"
  435. # Make successively longer sorted runs of length 2, 4, 8, 16...
  436. # until $A is wholly sorted
  437. (my int $width = 1),
  438. nqp::while(
  439. nqp::islt_i($width,$n),
  440. nqp::stmts(
  441. (my int $l = 0),
  442. # $A is full of runs of length $width
  443. nqp::while(
  444. nqp::islt_i($l,$n),
  445. nqp::stmts(
  446. (my int $left = $l),
  447. (my int $right = nqp::add_i($l,$width)),
  448. nqp::if(nqp::isge_i($right,$n),($right = $n)),
  449. (my int $end =
  450. nqp::add_i($l,nqp::add_i($width,$width))),
  451. nqp::if(nqp::isge_i($end,$n),($end = $n)),
  452. (my int $i = $left),
  453. (my int $j = $right),
  454. (my int $k = nqp::sub_i($left,1)),
  455. # Merge two runs: $A[i .. i+width-1] and
  456. # $A[i+width .. i+2*width-1]
  457. # to $B or copy $A[i..n-1] to $B[] ( if(i+width >= n) )
  458. nqp::while(
  459. nqp::islt_i(($k = nqp::add_i($k,1)),$end),
  460. nqp::if(
  461. nqp::islt_i($i,$right) && (
  462. nqp::isge_i($j,$end)
  463. || nqp::islt_n(
  464. nqp::atpos_n($A,$i),
  465. nqp::atpos_n($A,$j)
  466. )
  467. ),
  468. nqp::stmts(
  469. (nqp::bindpos_n($B,$k,nqp::atpos_n($A,$i))),
  470. ($i = nqp::add_i($i,1))
  471. ),
  472. nqp::stmts(
  473. (nqp::bindpos_n($B,$k,nqp::atpos_n($A,$j))),
  474. ($j = nqp::add_i($j,1))
  475. )
  476. )
  477. ),
  478. ($l = nqp::add_i($l,nqp::add_i($width,$width)))
  479. )
  480. ),
  481. # Now work array $B is full of runs of length 2*width.
  482. # Copy array B to array A for next iteration. A more
  483. # efficient implementation would swap the roles of A and B.
  484. (my Mu $temp := $B),($B := $A),($A := $temp), # swap
  485. # Now array $A is full of runs of length 2*width.
  486. ($width = nqp::add_i($width,$width))
  487. )
  488. ),
  489. $A
  490. ),
  491. nqp::if(
  492. nqp::islt_i($n,2)
  493. || nqp::isle_n(nqp::atpos_n(sortable,0),nqp::atpos_n(sortable,1)),
  494. nqp::clone(self), # we already have the result
  495. nqp::stmts(
  496. (my $R := nqp::setelems(nqp::list_n,2)),
  497. nqp::bindpos_n($R,0,nqp::atpos_n(sortable,1)),
  498. nqp::bindpos_n($R,1,nqp::atpos_n(sortable,0)),
  499. $R
  500. )
  501. )
  502. )
  503. }
  504. }