1. # this is actually part of the Array class
  2. my role ShapedArray does Rakudo::Internals::ShapedArrayCommon {
  3. has $.shape;
  4. # Handle dimensions > 3 or more indices than dimensions.
  5. # If dimensions <= 3, then custom AT-POS should have caught
  6. # correct number of indices already.
  7. multi method AT-POS(::?CLASS:D: **@indices) is raw {
  8. nqp::stmts(
  9. (my $reified := nqp::getattr(self,List,'$!reified')),
  10. nqp::if(
  11. nqp::islt_i(
  12. @indices.elems, # reifies
  13. (my int $numdims = nqp::numdimensions($reified))
  14. ),
  15. X::NYI.new(
  16. feature => "Partially dimensioned views of shaped arrays").throw,
  17. nqp::stmts(
  18. (my $indices := nqp::getattr(@indices,List,'$!reified')),
  19. (my $idxs := nqp::list_i),
  20. nqp::while( # native index list
  21. nqp::isge_i(($numdims = nqp::sub_i($numdims,1)),0),
  22. nqp::push_i($idxs,nqp::shift($indices))
  23. ),
  24. (my $element := nqp::ifnull(
  25. nqp::atposnd($reified,$idxs), # found it
  26. nqp::p6bindattrinvres( # create container
  27. (my $scalar := nqp::p6scalarfromdesc(
  28. nqp::getattr(self,Array,'$!descriptor'))),
  29. Scalar,
  30. '$!whence',
  31. -> { nqp::bindposnd($reified,$idxs,$scalar) }
  32. )
  33. )),
  34. nqp::if(
  35. nqp::elems($indices),
  36. $element.AT-POS(|@indices), # index further
  37. $element # we're done!
  38. )
  39. )
  40. )
  41. )
  42. }
  43. multi method ASSIGN-POS(::?CLASS:D: **@indices) {
  44. nqp::stmts(
  45. (my $value := @indices.pop), # reifies
  46. (my $indices := nqp::getattr(@indices,List,'$!reified')),
  47. (my $reified := nqp::getattr(self,List,'$!reified')),
  48. nqp::if(
  49. nqp::isge_i(
  50. (my int $numind = nqp::elems($indices)),
  51. (my int $numdims = nqp::numdimensions($reified))
  52. ),
  53. nqp::stmts( # more than enough indices
  54. (my $idxs := nqp::list_i),
  55. nqp::while( # native index list
  56. nqp::isge_i(($numdims = nqp::sub_i($numdims,1)),0),
  57. nqp::push_i($idxs,nqp::shift($indices))
  58. ),
  59. (my $element := nqp::ifnull(
  60. nqp::atposnd($reified,$idxs), # found it!
  61. nqp::bindposnd($reified,$idxs, # create new scalar
  62. nqp::p6scalarfromdesc(
  63. nqp::getattr(self,Array,'$!descriptor')))
  64. )),
  65. nqp::if(
  66. nqp::elems($indices),
  67. $element.AT-POS(|@indices), # go deeper
  68. $element # this is it
  69. ) = $value # and assign
  70. ),
  71. X::NotEnoughDimensions.new( # too few indices
  72. operation => 'assign to',
  73. got-dimensions => $numind,
  74. needed-dimensions => $numdims
  75. ).throw
  76. )
  77. )
  78. }
  79. multi method EXISTS-POS(::?CLASS:D: **@indices) {
  80. nqp::p6bool(
  81. nqp::stmts(
  82. (my int $numind = @indices.elems), # reifies
  83. (my $indices := nqp::getattr(@indices,List,'$!reified')),
  84. (my $reified := nqp::getattr(self,List,'$!reified')),
  85. (my $dims := nqp::dimensions($reified)),
  86. (my int $i = -1),
  87. nqp::if(
  88. nqp::isge_i(
  89. $numind,
  90. (my int $numdims = nqp::numdimensions($reified)),
  91. ),
  92. nqp::stmts( # same or more indices
  93. (my $idxs := nqp::list_i),
  94. nqp::while(
  95. nqp::islt_i( # still indices left
  96. ($i = nqp::add_i($i,1)),
  97. $numind)
  98. && nqp::islt_i( # within range?
  99. (my $idx = nqp::shift($indices)),
  100. nqp::atpos_i($dims,$i)),
  101. nqp::push_i($idxs,$idx)
  102. ),
  103. nqp::if(
  104. nqp::iseq_i($i,$numind)
  105. && nqp::not_i(
  106. nqp::isnull(nqp::atposnd($reified,$idxs))),
  107. nqp::unless( # base pos exists
  108. nqp::not_i(nqp::elems($indices)),
  109. nqp::atposnd($reified,$idxs).EXISTS-POS(|@indices)
  110. )
  111. )
  112. ),
  113. nqp::stmts( # fewer inds than dims
  114. nqp::while(
  115. nqp::islt_i(($i = nqp::add_i($i,1)),$numind)
  116. && nqp::islt_i(
  117. nqp::atpos($indices,$i),
  118. nqp::atpos_i($dims,$i)),
  119. nqp::null
  120. ),
  121. nqp::iseq_i($i,$numind) # all clear or oor
  122. )
  123. )
  124. )
  125. )
  126. }
  127. proto method DELETE-POS(|) {*}
  128. multi method DELETE-POS(::?CLASS:U: |c) {
  129. self.Any::DELETE-POS(|c)
  130. }
  131. multi method DELETE-POS(::?CLASS:D:) is raw {
  132. die "Must specify at least one index with DELETE-POS"
  133. }
  134. multi method DELETE-POS(::?CLASS:D: **@indices) {
  135. nqp::stmts(
  136. (my int $numind = @indices.elems), # reifies
  137. (my $indices := nqp::getattr(@indices,List,'$!reified')),
  138. (my $reified := nqp::getattr(self,List,'$!reified')),
  139. (my int $i = -1),
  140. nqp::if(
  141. nqp::isge_i(
  142. $numind,
  143. (my int $numdims = nqp::numdimensions($reified)),
  144. ),
  145. nqp::stmts( # same or more indices
  146. (my $idxs := nqp::list_i),
  147. nqp::while(
  148. nqp::islt_i( # still indices left
  149. ($i = nqp::add_i($i,1)),$numind),
  150. nqp::push_i($idxs,nqp::shift($indices)),
  151. ),
  152. nqp::if(
  153. nqp::isnull(my $value := nqp::atposnd($reified,$idxs)),
  154. Nil, # nothing here
  155. nqp::if(
  156. nqp::elems($indices),
  157. $value.DELETE-POS(|@indices), # delete at deeper level
  158. nqp::stmts( # found it, nullify here
  159. nqp::bindposnd($reified,$idxs,nqp::null),
  160. $value
  161. )
  162. )
  163. )
  164. ),
  165. X::NotEnoughDimensions.new( # fewer inds than dims
  166. operation => 'delete from',
  167. got-dimensions => $numind,
  168. needed-dimensions => $numdims
  169. ).throw
  170. )
  171. )
  172. }
  173. proto method BIND-POS(|) is raw {*}
  174. multi method BIND-POS(::?CLASS:U: |c) is raw {
  175. self.Any::BIND-POS(|c)
  176. }
  177. multi method BIND-POS(::?CLASS:D:) {
  178. die "Must specify at least one index and a value with BIND-POS"
  179. }
  180. multi method BIND-POS(::?CLASS:D: $) {
  181. die "Must specify at least one index and a value with BIND-POS"
  182. }
  183. multi method BIND-POS(::?CLASS:D: **@indices) is raw {
  184. nqp::stmts(
  185. (my $value := nqp::decont(@indices.pop)), # reifies
  186. (my $indices := nqp::getattr(@indices,List,'$!reified')),
  187. (my $reified := nqp::getattr(self,List,'$!reified')),
  188. (my int $i = -1),
  189. nqp::if(
  190. nqp::isge_i(
  191. (my int $numind = nqp::elems($indices)),
  192. (my int $numdims = nqp::numdimensions($reified)),
  193. ),
  194. nqp::stmts( # same or more indices
  195. (my $idxs := nqp::list_i),
  196. nqp::while(
  197. nqp::islt_i( # still indices left
  198. ($i = nqp::add_i($i,1)),$numind),
  199. nqp::push_i($idxs,nqp::shift($indices))
  200. ),
  201. nqp::if(
  202. nqp::elems($indices),
  203. nqp::atposnd($reified,$idxs) # bind at deeper level
  204. .BIND-POS(|@indices,$value),
  205. nqp::bindposnd($reified,$idxs, # found it, bind here
  206. $value)
  207. )
  208. ),
  209. X::NotEnoughDimensions.new( # fewer inds than dims
  210. operation => 'bind to',
  211. got-dimensions => $numind,
  212. needed-dimensions => $numdims
  213. ).throw
  214. )
  215. )
  216. }
  217. sub MEMCPY(Mu \to, Mu \from) {
  218. class :: does Rakudo::Iterator::ShapeLeaf {
  219. has $!from;
  220. has $!desc;
  221. method INIT(Mu \to, Mu \from) {
  222. nqp::stmts(
  223. ($!from := nqp::getattr(from,List,'$!reified')),
  224. ($!desc := nqp::getattr(from,Array,'$!descriptor')),
  225. self.SET-SELF(to)
  226. )
  227. }
  228. method new(Mu \to, Mu \from) { nqp::create(self).INIT(to,from) }
  229. method result(--> Nil) {
  230. nqp::ifnull(
  231. nqp::atposnd($!list,$!indices),
  232. nqp::bindposnd($!list,$!indices,
  233. nqp::p6scalarfromdesc($!desc))
  234. ) = nqp::atposnd($!from,$!indices)
  235. }
  236. }.new(to,from).sink-all
  237. }
  238. sub INTCPY(Mu \to, Mu \from) {
  239. class :: does Rakudo::Iterator::ShapeLeaf {
  240. has $!from;
  241. method INIT(Mu \to, Mu \from) {
  242. nqp::stmts(
  243. ($!from := from),
  244. self.SET-SELF(to)
  245. )
  246. }
  247. method new(Mu \to, Mu \from) { nqp::create(self).INIT(to,from) }
  248. method result(--> Nil) {
  249. nqp::ifnull(
  250. nqp::atposnd($!list,$!indices),
  251. nqp::bindposnd($!list,$!indices,nqp::p6scalarfromdesc(Mu))
  252. ) = nqp::multidimref_i($!from,$!indices)
  253. }
  254. }.new(to,from).sink-all
  255. }
  256. sub NUMCPY(Mu \to, Mu \from) {
  257. class :: does Rakudo::Iterator::ShapeLeaf {
  258. has $!from;
  259. method INIT(Mu \to, Mu \from) {
  260. nqp::stmts(
  261. ($!from := from),
  262. self.SET-SELF(to)
  263. )
  264. }
  265. method new(Mu \to, Mu \from) { nqp::create(self).INIT(to,from) }
  266. method result(--> Nil) {
  267. nqp::ifnull(
  268. nqp::atposnd($!list,$!indices),
  269. nqp::bindposnd($!list,$!indices,nqp::p6scalarfromdesc(Mu))
  270. ) = nqp::multidimref_n($!from,$!indices)
  271. }
  272. }.new(to,from).sink-all
  273. }
  274. proto method STORE(|) { * }
  275. multi method STORE(::?CLASS:D: ::?CLASS:D \in) {
  276. nqp::if(
  277. in.shape eqv self.shape,
  278. nqp::stmts(
  279. MEMCPY(self,in), # VM-supported memcpy-like thing?
  280. self
  281. ),
  282. X::Assignment::ArrayShapeMismatch.new(
  283. source-shape => in.shape,
  284. target-shape => self.shape
  285. ).throw
  286. )
  287. }
  288. multi method STORE(::?CLASS:D: array:D \in) {
  289. nqp::if(
  290. in.shape eqv self.shape,
  291. nqp::stmts(
  292. nqp::if(
  293. nqp::istype(in.of,Int),
  294. INTCPY(self,in), # copy from native int
  295. NUMCPY(self,in) # copy from native num
  296. ),
  297. self
  298. ),
  299. X::Assignment::ArrayShapeMismatch.new(
  300. source-shape => in.shape,
  301. target-shape => self.shape
  302. ).throw
  303. )
  304. }
  305. multi method STORE(::?CLASS:D: Iterable:D \in) {
  306. class :: does Rakudo::Iterator::ShapeBranch {
  307. has $!iterators;
  308. has $!desc;
  309. method INIT(\to,\from) {
  310. nqp::stmts(
  311. self.SET-SELF(to),
  312. ($!desc := nqp::getattr(to,Array,'$!descriptor')),
  313. ($!iterators := nqp::setelems(
  314. nqp::list(from.iterator),
  315. nqp::add_i($!maxdim,1)
  316. )),
  317. self
  318. )
  319. }
  320. method new(\to,\from) { nqp::create(self).INIT(to,from) }
  321. method done(--> Nil) {
  322. nqp::unless( # verify lowest
  323. nqp::atpos($!iterators,0).is-lazy # finite iterator
  324. || nqp::eqaddr( # and something there
  325. nqp::atpos($!iterators,0).pull-one,IterationEnd),
  326. nqp::atposnd($!list,$!indices) # boom!
  327. )
  328. }
  329. method process(--> Nil) {
  330. nqp::stmts(
  331. (my int $i = $!level),
  332. nqp::while(
  333. nqp::isle_i(($i = nqp::add_i($i,1)),$!maxdim),
  334. nqp::if(
  335. nqp::eqaddr((my $item := # exhausted ?
  336. nqp::atpos($!iterators,nqp::sub_i($i,1)).pull-one),
  337. IterationEnd
  338. ),
  339. nqp::bindpos($!iterators,$i, # add an empty one
  340. Rakudo::Iterator.Empty),
  341. nqp::if( # is it an iterator?
  342. nqp::istype($item,Iterable) && nqp::isconcrete($item),
  343. nqp::bindpos($!iterators,$i,$item.iterator),
  344. X::Assignment::ToShaped.new(shape => self.dims).throw
  345. )
  346. )
  347. ),
  348. (my $iter := nqp::atpos($!iterators,$!maxdim)),
  349. nqp::until( # loop over highest dim
  350. nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd)
  351. || nqp::isgt_i(nqp::atpos_i($!indices,$!maxdim),$!maxind),
  352. nqp::stmts(
  353. (nqp::ifnull( # containerize if needed
  354. nqp::atposnd($!list,$!indices),
  355. nqp::bindposnd($!list,$!indices,
  356. nqp::p6scalarfromdesc($!desc))
  357. ) = $pulled),
  358. nqp::bindpos_i($!indices,$!maxdim, # increment index
  359. nqp::add_i(nqp::atpos_i($!indices,$!maxdim),1))
  360. )
  361. ),
  362. nqp::unless(
  363. nqp::eqaddr($pulled,IterationEnd) # if not exhausted
  364. || nqp::isle_i( # and index too high
  365. nqp::atpos_i($!indices,$!maxdim),$!maxind)
  366. || $iter.is-lazy, # and not lazy
  367. nqp::atposnd($!list,$!indices) # error
  368. )
  369. )
  370. }
  371. }.new(self,in).sink-all;
  372. self
  373. }
  374. multi method STORE(::?CLASS:D: Iterator:D \iterator) {
  375. class :: does Rakudo::Iterator::ShapeLeaf {
  376. has Mu $!iterator;
  377. has Mu $!desc;
  378. method INIT(\list,\iterator) {
  379. nqp::stmts(
  380. ($!iterator := iterator),
  381. ($!desc := nqp::getattr(list,Array,'$!descriptor')),
  382. self.SET-SELF(list)
  383. )
  384. }
  385. method new(\list,\iter) { nqp::create(self).INIT(list,iter) }
  386. method result(--> Nil) {
  387. nqp::unless(
  388. nqp::eqaddr(
  389. (my $pulled := $!iterator.pull-one),IterationEnd),
  390. nqp::ifnull(
  391. nqp::atposnd($!list,$!indices),
  392. nqp::bindposnd($!list,$!indices,
  393. nqp::p6scalarfromdesc($!desc))
  394. ) = $pulled
  395. )
  396. }
  397. }.new(self,iterator).sink-all;
  398. self
  399. }
  400. multi method STORE(::?CLASS:D: Mu \item) {
  401. X::Assignment::ToShaped.new(shape => self.shape).throw
  402. }
  403. multi method kv(::?CLASS:D:) {
  404. Seq.new(class :: does Rakudo::Iterator::ShapeLeaf {
  405. has int $!on-key;
  406. method result() is raw {
  407. nqp::if(
  408. ($!on-key = nqp::not_i($!on-key)),
  409. nqp::stmts(
  410. (my $result := self.indices),
  411. (nqp::bindpos_i($!indices,$!maxdim, # back 1 for next
  412. nqp::sub_i(nqp::atpos_i($!indices,$!maxdim),1))),
  413. $result
  414. ),
  415. nqp::atposnd($!list,$!indices)
  416. )
  417. }
  418. # needs its own push-all since it fiddles with $!indices
  419. method push-all($target --> IterationEnd) {
  420. nqp::until(
  421. nqp::eqaddr((my $pulled := self.pull-one),IterationEnd),
  422. $target.push($pulled)
  423. )
  424. }
  425. }.new(self))
  426. }
  427. multi method pairs(::?CLASS:D:) {
  428. Seq.new(class :: does Rakudo::Iterator::ShapeLeaf {
  429. has Mu $!desc;
  430. method !INIT(\list) {
  431. nqp::stmts(
  432. ($!desc := nqp::getattr(list,Array,'$!descriptor')),
  433. self.SET-SELF(list)
  434. )
  435. }
  436. method new(Mu \list) { nqp::create(self)!INIT(list) }
  437. method result() {
  438. Pair.new(
  439. self.indices,
  440. nqp::ifnull(
  441. nqp::atposnd($!list,$!indices),
  442. nqp::stmts(
  443. # By the time the block gets executed, the $!indices
  444. # may be at the next iteration already or even reset
  445. # because we reached the end. So we need to make
  446. # a copy of the indices now.
  447. (my $indices := nqp::clone($!indices)),
  448. nqp::p6bindattrinvres(
  449. (my $scalar := nqp::p6scalarfromdesc($!desc)),
  450. Scalar,
  451. '$!whence',
  452. -> { nqp::bindposnd($!list,$indices,$scalar) }
  453. )
  454. )
  455. )
  456. )
  457. }
  458. }.new(self))
  459. }
  460. multi method antipairs(::?CLASS:D:) {
  461. Seq.new(class :: does Rakudo::Iterator::ShapeLeaf {
  462. method result() {
  463. Pair.new(nqp::atposnd($!list,$!indices),self.indices)
  464. }
  465. }.new(self))
  466. }
  467. multi method List(::?CLASS:D:) {
  468. nqp::stmts(
  469. self.iterator.push-all(
  470. (my $list := nqp::create(IterationBuffer))),
  471. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$list)
  472. )
  473. }
  474. method iterator(::?CLASS:D:) {
  475. class :: does Rakudo::Iterator::ShapeLeaf {
  476. has Mu $!desc;
  477. method !INIT(\list) {
  478. nqp::stmts(
  479. ($!desc := nqp::getattr(list,Array,'$!descriptor')),
  480. self.SET-SELF(list)
  481. )
  482. }
  483. method new(Mu \list) { nqp::create(self)!INIT(list) }
  484. method result() is raw {
  485. nqp::ifnull(
  486. nqp::atposnd($!list,$!indices),
  487. nqp::stmts(
  488. # By the time the block gets executed, the $!indices
  489. # may be at the next iteration already or even reset
  490. # because we reached the end. So we need to make
  491. # a copy of the indices now.
  492. (my $indices := nqp::clone($!indices)),
  493. nqp::p6bindattrinvres(
  494. (my $scalar := nqp::p6scalarfromdesc($!desc)),
  495. Scalar,
  496. '$!whence',
  497. -> { nqp::bindposnd($!list,$indices,$scalar) }
  498. )
  499. )
  500. )
  501. }
  502. }.new(self)
  503. }
  504. # A shaped array isn't lazy, these methods don't need to go looking
  505. # into the "todo".
  506. method eager() { self }
  507. method sum() is nodal { self.Any::sum }
  508. multi method elems(::?CLASS:D:) {
  509. nqp::elems(nqp::getattr(self,List,'$!reified'))
  510. }
  511. method clone() {
  512. my \obj := nqp::create(self);
  513. nqp::bindattr(obj,Array,'$!descriptor',
  514. nqp::getattr(self,Array,'$!descriptor'));
  515. nqp::bindattr(obj,::?CLASS,'$!shape',
  516. nqp::getattr(self,::?CLASS,'$!shape'));
  517. nqp::p6bindattrinvres(obj,List,'$!reified',
  518. nqp::clone(nqp::getattr(self,List,'$!reified')))
  519. }
  520. }