1. my class X::Invalid::ComputedValue { ... };
  2. my class Hash { # declared in BOOTSTRAP
  3. # my class Hash is Map
  4. # has Mu $!descriptor;
  5. multi method WHICH(Hash:D:) { self.Mu::WHICH }
  6. multi method Hash(Hash:) {
  7. self
  8. }
  9. multi method Map(Hash:U:) { Map }
  10. multi method Map(Hash:D: :$view) {
  11. my $hash := nqp::getattr(self,Map,'$!storage');
  12. # empty
  13. if nqp::not_i(nqp::defined($hash)) {
  14. nqp::create(Map)
  15. }
  16. # view, assuming no change in hash
  17. elsif $view {
  18. nqp::p6bindattrinvres(nqp::create(Map),Map,'$!storage',$hash)
  19. }
  20. # make cow copy
  21. else {
  22. my $map := nqp::hash;
  23. my \iter := nqp::iterator($hash);
  24. my str $key;
  25. nqp::while(
  26. iter,
  27. nqp::bindkey(
  28. $map,
  29. ($key = nqp::iterkey_s(nqp::shift(iter))),
  30. nqp::decont(nqp::atkey($hash,$key))
  31. )
  32. );
  33. nqp::p6bindattrinvres(nqp::create(Map),Map,'$!storage',$map)
  34. }
  35. }
  36. method clone(Hash:D:) is raw {
  37. nqp::p6bindattrinvres(
  38. nqp::p6bindattrinvres(
  39. nqp::create(self),Map,'$!storage',
  40. nqp::clone(nqp::getattr(self,Map,'$!storage'))),
  41. Hash, '$!descriptor', nqp::isnull($!descriptor) ?? (nqp::null) !! nqp::clone($!descriptor))
  42. }
  43. method !AT-KEY-CONTAINER(Str:D \key) is raw {
  44. nqp::p6bindattrinvres(
  45. (my \v := nqp::p6scalarfromdesc($!descriptor)),
  46. Scalar,
  47. '$!whence',
  48. -> { nqp::bindkey(
  49. nqp::if(
  50. nqp::isconcrete(nqp::getattr(self,Map,'$!storage')),
  51. nqp::getattr(self,Map,'$!storage'),
  52. nqp::bindattr(self,Map,'$!storage',nqp::hash)
  53. ),key,v)
  54. }
  55. )
  56. }
  57. multi method AT-KEY(Hash:D: Str:D \key) is raw {
  58. nqp::if(
  59. nqp::isconcrete(nqp::getattr(self,Map,'$!storage')),
  60. nqp::ifnull(
  61. nqp::atkey(nqp::getattr(self,Map,'$!storage'),key),
  62. self!AT-KEY-CONTAINER(key)
  63. ),
  64. self!AT-KEY-CONTAINER(key)
  65. )
  66. }
  67. multi method AT-KEY(Hash:D: \key) is raw {
  68. nqp::if(
  69. nqp::isconcrete(nqp::getattr(self,Map,'$!storage')),
  70. nqp::ifnull(
  71. nqp::atkey(nqp::getattr(self,Map,'$!storage'),key.Str),
  72. self!AT-KEY-CONTAINER(key.Str)
  73. ),
  74. self!AT-KEY-CONTAINER(key.Str)
  75. )
  76. }
  77. multi method STORE_AT_KEY(Str:D \key, Mu \x --> Nil) {
  78. nqp::bindkey(
  79. nqp::getattr(self,Map,'$!storage'),
  80. nqp::unbox_s(key),
  81. (nqp::p6scalarfromdesc($!descriptor) = x),
  82. )
  83. }
  84. multi method STORE_AT_KEY(\key, Mu \x --> Nil) {
  85. nqp::bindkey(
  86. nqp::getattr(self,Map,'$!storage'),
  87. nqp::unbox_s(key.Str),
  88. (nqp::p6scalarfromdesc($!descriptor) = x),
  89. )
  90. }
  91. multi method ASSIGN-KEY(Hash:D: Str:D \key, Mu \assignval) is raw {
  92. nqp::if(
  93. nqp::getattr(self,Map,'$!storage').DEFINITE,
  94. (nqp::ifnull(
  95. nqp::atkey(
  96. nqp::getattr(self,Map,'$!storage'),
  97. nqp::unbox_s(key)
  98. ),
  99. nqp::bindkey(
  100. nqp::getattr(self,Map,'$!storage'),
  101. nqp::unbox_s(key),
  102. nqp::p6scalarfromdesc($!descriptor)
  103. )
  104. ) = assignval),
  105. nqp::bindkey(
  106. nqp::bindattr(self,Map,'$!storage',nqp::hash),
  107. nqp::unbox_s(key),
  108. nqp::p6scalarfromdesc($!descriptor) = assignval
  109. )
  110. )
  111. }
  112. multi method ASSIGN-KEY(Hash:D: \key, Mu \assignval) is raw {
  113. nqp::if(
  114. nqp::getattr(self,Map,'$!storage').DEFINITE,
  115. (nqp::ifnull(
  116. nqp::atkey(
  117. nqp::getattr(self,Map,'$!storage'),
  118. nqp::unbox_s(key.Str)
  119. ),
  120. nqp::bindkey(
  121. nqp::getattr(self,Map,'$!storage'),
  122. nqp::unbox_s(key.Str),
  123. nqp::p6scalarfromdesc($!descriptor)
  124. )
  125. ) = assignval),
  126. nqp::bindkey(
  127. nqp::bindattr(self,Map,'$!storage',nqp::hash),
  128. nqp::unbox_s(key.Str),
  129. nqp::p6scalarfromdesc($!descriptor) = assignval
  130. )
  131. )
  132. }
  133. # for some reason, this can't be turned into a multi without
  134. # making setting compilation get very confused indeed
  135. method BIND-KEY(Hash:D: \key, Mu \bindval) is raw {
  136. nqp::bindattr(self,Map,'$!storage',nqp::hash)
  137. unless nqp::defined(nqp::getattr(self,Map,'$!storage'));
  138. nqp::bindkey(nqp::getattr(self,Map,'$!storage'),
  139. nqp::unbox_s(nqp::istype(key,Str) ?? key !! key.Str), bindval)
  140. }
  141. multi method DELETE-KEY(Hash:U: --> Nil) { }
  142. multi method DELETE-KEY(Hash:D: Str:D \key) {
  143. nqp::if(
  144. (nqp::getattr(self,Map,'$!storage').DEFINITE
  145. && nqp::existskey(nqp::getattr(self,Map,'$!storage'),
  146. nqp::unbox_s(key))),
  147. nqp::stmts(
  148. (my $value = nqp::atkey(nqp::getattr(self,Map,'$!storage'),
  149. nqp::unbox_s(key))),
  150. nqp::deletekey(nqp::getattr(self,Map,'$!storage'),
  151. nqp::unbox_s(key)),
  152. $value
  153. ),
  154. nqp::p6scalarfromdesc($!descriptor)
  155. )
  156. }
  157. multi method DELETE-KEY(Hash:D: \key) {
  158. nqp::stmts(
  159. (my str $key = nqp::unbox_s(key.Str)),
  160. nqp::if(
  161. (nqp::getattr(self,Map,'$!storage').DEFINITE
  162. && nqp::existskey(nqp::getattr(self,Map,'$!storage'),$key)),
  163. nqp::stmts(
  164. (my $value = nqp::atkey(nqp::getattr(self,Map,'$!storage'),$key)),
  165. nqp::deletekey(nqp::getattr(self,Map,'$!storage'),$key),
  166. $value
  167. ),
  168. nqp::p6scalarfromdesc($!descriptor)
  169. )
  170. )
  171. }
  172. multi method perl(Hash:D \SELF:) {
  173. SELF.perlseen(self.^name, {
  174. '$' x nqp::iscont(SELF) # self is always deconted
  175. ~ '{' ~ self.sort.map({.perl}).join(', ') ~ '}'
  176. })
  177. }
  178. multi method gist(Hash:D:) {
  179. self.gistseen(self.^name, {
  180. '{' ~
  181. self.sort.map({
  182. state $i = 0;
  183. ++$i == 101 ?? '...'
  184. !! $i == 102 ?? last()
  185. !! .gist
  186. }).join(', ')
  187. ~ '}'
  188. })
  189. }
  190. multi method DUMP(Hash:D: :$indent-step = 4, :%ctx) {
  191. nqp::if(
  192. %ctx,
  193. self.DUMP-OBJECT-ATTRS(
  194. nqp::list(
  195. '$!descriptor',
  196. $!descriptor,
  197. '$!storage',
  198. nqp::getattr(nqp::decont(self),Map,'$!storage')
  199. ),
  200. :$indent-step,
  201. :%ctx
  202. ),
  203. DUMP(self, :$indent-step)
  204. )
  205. }
  206. # introspection
  207. method name() {
  208. nqp::isnull($!descriptor) ?? Nil !! $!descriptor.name
  209. }
  210. method keyof() {
  211. Str(Any)
  212. }
  213. method of() {
  214. nqp::isnull($!descriptor) ?? Mu !! $!descriptor.of
  215. }
  216. method default() {
  217. nqp::isnull($!descriptor) ?? Any !! $!descriptor.default
  218. }
  219. method dynamic() {
  220. nqp::isnull($!descriptor) ?? False !! nqp::p6bool($!descriptor.dynamic)
  221. }
  222. method push(+values) {
  223. fail X::Cannot::Lazy.new(:action<push>, :what(self.^name))
  224. if values.is-lazy;
  225. my $previous;
  226. my int $has_previous = 0;
  227. nqp::if(
  228. $has_previous,
  229. nqp::stmts(
  230. self!_push_construct($previous,$_),
  231. ($has_previous = 0)
  232. ),
  233. nqp::if(
  234. nqp::istype($_,Pair),
  235. self!_push_construct(.key,.value),
  236. nqp::stmts(
  237. ($previous := $_),
  238. ($has_previous = 1)
  239. )
  240. )
  241. ) for values;
  242. warn "Trailing item in {self.^name}.push" if $has_previous;
  243. self
  244. }
  245. method append(+values) {
  246. fail X::Cannot::Lazy.new(:action<append>, :what(self.^name))
  247. if values.is-lazy;
  248. my $previous;
  249. my int $has_previous = 0;
  250. nqp::if(
  251. $has_previous,
  252. nqp::stmts(
  253. self!_append_construct($previous,$_),
  254. ($has_previous = 0)
  255. ),
  256. nqp::if(
  257. nqp::istype($_,Pair),
  258. self!_append_construct(.key,.value),
  259. nqp::stmts(
  260. ($previous := $_),
  261. ($has_previous = 1)
  262. )
  263. )
  264. ) for values;
  265. warn "Trailing item in {self.^name}.append" if $has_previous;
  266. self
  267. }
  268. proto method classify-list(|) {*}
  269. multi method classify-list( &test, \list, :&as ) {
  270. fail X::Cannot::Lazy.new(:action<classify>) if list.is-lazy;
  271. my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator;
  272. my $value := iter.pull-one;
  273. unless $value =:= IterationEnd {
  274. my $tested := test($value);
  275. # multi-level classify
  276. if nqp::istype($tested, Iterable) {
  277. my $els = $tested.elems;
  278. loop {
  279. my @keys = @$tested;
  280. @keys == $els or X::Invalid::ComputedValue.new(
  281. :name<mapper>,
  282. :method<classify-list>,
  283. :value('an item with different number of elements '
  284. ~ 'in it than previous items'),
  285. :reason('all values need to have the same number '
  286. ~ 'of elements. Mixed-level classification is '
  287. ~ 'not supported.'),
  288. ).throw;
  289. my $last := @keys.pop;
  290. my $hash = self;
  291. $hash = $hash{$_} //= self.new for @keys;
  292. $hash{$last}.push(&as ?? as($value) !! $value);
  293. last if ($value := iter.pull-one) =:= IterationEnd;
  294. $tested := test($value);
  295. };
  296. }
  297. # just a simple classify
  298. else {
  299. loop {
  300. self{$tested}.push(&as ?? as($value) !! $value);
  301. last if ($value := iter.pull-one) =:= IterationEnd;
  302. nqp::istype(($tested := test($value)), Iterable)
  303. and X::Invalid::ComputedValue.new(
  304. :name<mapper>,
  305. :method<classify-list>,
  306. :value('an item with different number of elements '
  307. ~ 'in it than previous items'),
  308. :reason('all values need to have the same number '
  309. ~ 'of elements. Mixed-level classification is '
  310. ~ 'not supported.'),
  311. ).throw;
  312. };
  313. }
  314. }
  315. self;
  316. }
  317. multi method classify-list( %test, |c ) {
  318. self.classify-list( { %test{$^a} }, |c );
  319. }
  320. multi method classify-list( @test, |c ) {
  321. self.classify-list( { @test[$^a] }, |c );
  322. }
  323. multi method classify-list(&test, **@list, |c) {
  324. self.classify-list(&test, @list, |c);
  325. }
  326. proto method categorize-list(|) {*}
  327. multi method categorize-list( &test, \list, :&as ) {
  328. fail X::Cannot::Lazy.new(:action<categorize>) if list.is-lazy;
  329. my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator;
  330. my $value := iter.pull-one;
  331. unless $value =:= IterationEnd {
  332. my $tested := test($value);
  333. # multi-level categorize
  334. if nqp::istype($tested[0],Iterable) {
  335. my $els = $tested[0].elems;
  336. loop {
  337. for $tested.cache -> $cat {
  338. my @keys = @$cat or next;
  339. my $last := @keys.pop;
  340. my $hash = self;
  341. $hash = $hash{$_} //= self.new for @keys;
  342. $hash{$last}.push(&as ?? as($value) !! $value);
  343. }
  344. last if ($value := iter.pull-one) =:= IterationEnd;
  345. $tested := test($value);
  346. nqp::istype($tested[0],Iterable)
  347. and $els == $tested[0]
  348. or X::Invalid::ComputedValue.new(
  349. :name<mapper>,
  350. :method<categorize-list>,
  351. :value('an item with different number of elements '
  352. ~ 'in it than previous items'),
  353. :reason('all values need to have the same number '
  354. ~ 'of elements. Mixed-level classification is '
  355. ~ 'not supported.'),
  356. ).throw;
  357. }
  358. }
  359. # simple categorize
  360. else {
  361. loop {
  362. self{$_}.push(&as ?? as($value) !! $value)
  363. for @$tested;
  364. last if ($value := iter.pull-one) =:= IterationEnd;
  365. nqp::istype(($tested := test($value))[0], Iterable)
  366. and X::Invalid::ComputedValue.new(
  367. :name<mapper>,
  368. :method<categorize-list>,
  369. :value('an item with different number of elements '
  370. ~ 'in it than previous items'),
  371. :reason('all values need to have the same number '
  372. ~ 'of elements. Mixed-level classification is '
  373. ~ 'not supported.'),
  374. ).throw;
  375. };
  376. }
  377. }
  378. self;
  379. }
  380. multi method categorize-list( %test, |c ) {
  381. self.categorize-list( { %test{$^a} }, |c );
  382. }
  383. multi method categorize-list( @test, |c ) {
  384. self.categorize-list( { @test[$^a] }, |c );
  385. }
  386. multi method categorize-list( &test, **@list, |c ) {
  387. self.categorize-list( &test, @list, |c );
  388. }
  389. # push a value onto a hash slot, constructing an array if necessary
  390. method !_push_construct(Mu $key, Mu \value --> Nil) {
  391. self.EXISTS-KEY($key)
  392. ?? self.AT-KEY($key).^isa(Array)
  393. ?? self.AT-KEY($key).push(value)
  394. !! self.ASSIGN-KEY($key,[self.AT-KEY($key),value])
  395. !! self.ASSIGN-KEY($key,value)
  396. }
  397. # append values into a hash slot, constructing an array if necessary
  398. method !_append_construct(Mu $key, Mu \value --> Nil) {
  399. self.EXISTS-KEY($key)
  400. ?? self.AT-KEY($key).^isa(Array)
  401. ?? self.AT-KEY($key).append(|value)
  402. !! self.ASSIGN-KEY($key,[|self.AT-KEY($key),|value])
  403. !! self.ASSIGN-KEY($key,value)
  404. }
  405. my role TypedHash[::TValue] does Associative[TValue] {
  406. # These ASSIGN-KEY candidates are only needed because of:
  407. # my Int %h; try %h<a> = "foo"; dd %h
  408. # leaving an uninitialized Int for key <a> in the hash. If
  409. # we could live with that, then these candidates can be
  410. # removed. However, there are spectest covering this
  411. # eventuality, so to appease roast, we need these.
  412. multi method ASSIGN-KEY(::?CLASS:D: Str:D \key, Mu \assignval) is raw {
  413. nqp::if(
  414. nqp::getattr(self,Map,'$!storage').DEFINITE,
  415. nqp::if(
  416. nqp::existskey(
  417. nqp::getattr(self,Map,'$!storage'),
  418. nqp::unbox_s(key)
  419. ),
  420. (nqp::atkey(
  421. nqp::getattr(self,Map,'$!storage'),
  422. nqp::unbox_s(key)
  423. ) = assignval),
  424. nqp::bindkey(
  425. nqp::getattr(self,Map,'$!storage'),
  426. nqp::unbox_s(key),
  427. nqp::p6scalarfromdesc(
  428. nqp::getattr(self,Hash,'$!descriptor')) = assignval
  429. )
  430. ),
  431. nqp::bindkey(
  432. nqp::bindattr(self,Map,'$!storage',nqp::hash),
  433. nqp::unbox_s(key),
  434. nqp::p6scalarfromdesc(
  435. nqp::getattr(self,Hash,'$!descriptor')) = assignval
  436. )
  437. )
  438. }
  439. multi method ASSIGN-KEY(::?CLASS:D: \key, Mu \assignval) is raw {
  440. nqp::stmts(
  441. (my str $key = nqp::unbox_s(key.Str)),
  442. nqp::if(
  443. nqp::getattr(self,Map,'$!storage').DEFINITE,
  444. nqp::if(
  445. nqp::existskey(
  446. nqp::getattr(self,Map,'$!storage'),
  447. $key
  448. ),
  449. (nqp::atkey(
  450. nqp::getattr(self,Map,'$!storage'),
  451. $key
  452. ) = assignval),
  453. nqp::bindkey(
  454. nqp::getattr(self,Map,'$!storage'),
  455. nqp::unbox_s(key.Str),
  456. nqp::p6scalarfromdesc(
  457. nqp::getattr(self,Hash,'$!descriptor')) = assignval
  458. )
  459. ),
  460. nqp::bindkey(
  461. nqp::bindattr(self,Map,'$!storage',nqp::hash),
  462. $key,
  463. nqp::p6scalarfromdesc(
  464. nqp::getattr(self,Hash,'$!descriptor')) = assignval
  465. )
  466. )
  467. )
  468. }
  469. multi method perl(::?CLASS:D \SELF:) {
  470. SELF.perlseen('Hash', {
  471. '$' x nqp::iscont(SELF) # self is always deconted
  472. ~ (self.elems
  473. ?? "(my {TValue.perl} % = {
  474. self.sort.map({.perl}).join(', ')
  475. })"
  476. !! "(my {TValue.perl} %)"
  477. )
  478. })
  479. }
  480. }
  481. my role TypedHash[::TValue, ::TKey] does Associative[TValue] {
  482. method keyof () { TKey }
  483. method AT-KEY(::?CLASS:D: TKey \key) is raw {
  484. nqp::if(
  485. nqp::getattr(self,Map,'$!storage').DEFINITE,
  486. nqp::if(
  487. nqp::existskey(nqp::getattr(self,Map,'$!storage'),
  488. (my str $which = nqp::unbox_s(key.WHICH))),
  489. nqp::getattr(
  490. nqp::atkey(nqp::getattr(self,Map,'$!storage'),$which),
  491. Pair,'$!value'),
  492. nqp::p6bindattrinvres(
  493. (my \v := nqp::p6scalarfromdesc(
  494. nqp::getattr(self,Hash,'$!descriptor'))),
  495. Scalar,
  496. '$!whence',
  497. -> { nqp::bindkey(nqp::getattr(self,Map,'$!storage'),
  498. $which,Pair.new(key,v)); v }
  499. )
  500. ),
  501. nqp::p6bindattrinvres(
  502. (my \vv := nqp::p6scalarfromdesc(
  503. nqp::getattr(self,Hash,'$!descriptor'))),
  504. Scalar,
  505. '$!whence',
  506. -> { nqp::bindkey(
  507. nqp::if(
  508. nqp::getattr(self,Map,'$!storage').DEFINITE,
  509. nqp::getattr(self,Map,'$!storage'),
  510. nqp::bindattr(self,Map,'$!storage',nqp::hash)
  511. ),
  512. nqp::unbox_s(key.WHICH), Pair.new(key,vv)); vv }
  513. )
  514. )
  515. }
  516. method STORE_AT_KEY(TKey \key, TValue \x --> Nil) {
  517. nqp::bindkey(
  518. nqp::getattr(self,Map,'$!storage'),
  519. nqp::unbox_s(key.WHICH),
  520. Pair.new(
  521. key,
  522. nqp::p6scalarfromdesc(nqp::getattr(self,Hash,'$!descriptor'))
  523. = x
  524. )
  525. )
  526. }
  527. method ASSIGN-KEY(::?CLASS:D: TKey \key, TValue \assignval) is raw {
  528. nqp::if(
  529. nqp::getattr(self,Map,'$!storage').DEFINITE,
  530. nqp::if(
  531. nqp::existskey(nqp::getattr(self,Map,'$!storage'),
  532. my str $which = nqp::unbox_s(key.WHICH)),
  533. (nqp::getattr(
  534. nqp::atkey(nqp::getattr(self,Map,'$!storage'),$which),
  535. Pair,'$!value') = assignval),
  536. nqp::getattr(
  537. (nqp::bindkey(nqp::getattr(self,Map,'$!storage'),$which,
  538. Pair.new(key,nqp::p6scalarfromdesc(
  539. nqp::getattr(self,Hash,'$!descriptor')) = assignval))),
  540. Pair,'$!value')
  541. ),
  542. nqp::getattr(
  543. (nqp::bindkey(nqp::bindattr(self,Map,'$!storage',nqp::hash),
  544. nqp::unbox_s(key.WHICH),
  545. Pair.new(key,nqp::p6scalarfromdesc(
  546. nqp::getattr(self,Hash,'$!descriptor')) = assignval))),
  547. Pair,'$!value')
  548. )
  549. }
  550. method BIND-KEY(TKey \key, TValue \bindval) is raw {
  551. nqp::getattr(
  552. nqp::if(
  553. nqp::getattr(self,Map,'$!storage').DEFINITE,
  554. nqp::bindkey(nqp::getattr(self,Map,'$!storage'),
  555. nqp::unbox_s(key.WHICH),
  556. Pair.new(key,bindval)),
  557. nqp::bindkey(nqp::bindattr(self,Map,'$!storage',nqp::hash),
  558. nqp::unbox_s(key.WHICH),
  559. Pair.new(key,bindval))
  560. ),
  561. Pair,'$!value'
  562. )
  563. }
  564. method EXISTS-KEY(TKey \key) {
  565. nqp::p6bool(
  566. nqp::defined(nqp::getattr(self,Map,'$!storage'))
  567. && nqp::existskey(nqp::getattr(self,Map,'$!storage'),key.WHICH)
  568. )
  569. }
  570. method DELETE-KEY(TKey \key) {
  571. nqp::if(
  572. (nqp::getattr(self,Map,'$!storage').DEFINITE
  573. && nqp::existskey(nqp::getattr(self,Map,'$!storage'),
  574. (my str $which = key.WHICH))),
  575. nqp::stmts(
  576. (my TValue $value =
  577. nqp::getattr(
  578. nqp::atkey(nqp::getattr(self,Map,'$!storage'),$which),
  579. Pair,'$!value')),
  580. nqp::deletekey(nqp::getattr(self,Map,'$!storage'),$which),
  581. $value
  582. ),
  583. TValue
  584. )
  585. }
  586. method FLATTENABLE_HASH() {
  587. nqp::stmts(
  588. (my $flattened := nqp::hash),
  589. nqp::if(
  590. (my $raw := nqp::getattr(self,Map,'$!storage'))
  591. && (my $iter := nqp::iterator($raw)),
  592. nqp::while(
  593. $iter,
  594. nqp::bindkey(
  595. $flattened,
  596. nqp::if(
  597. nqp::istype(
  598. (my $key := nqp::getattr(
  599. nqp::iterval(nqp::shift($iter)),
  600. Pair,
  601. '$!key'
  602. )),
  603. Str,
  604. ),
  605. $key,
  606. $key.Str
  607. ),
  608. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  609. )
  610. )
  611. ),
  612. $flattened
  613. )
  614. }
  615. method IterationBuffer() {
  616. nqp::stmts(
  617. (my $buffer := nqp::create(IterationBuffer)),
  618. nqp::if(
  619. nqp::defined(
  620. nqp::getattr(self,Map,'$!storage')
  621. ) && nqp::elems(
  622. nqp::getattr(self,Map,'$!storage')
  623. ),
  624. nqp::stmts(
  625. (my $iterator := nqp::iterator(
  626. nqp::getattr(self,Map,'$!storage')
  627. )),
  628. nqp::setelems($buffer,nqp::elems(
  629. nqp::getattr(self,Map,'$!storage')
  630. )),
  631. (my int $i = -1),
  632. nqp::while(
  633. $iterator,
  634. nqp::bindpos($buffer,($i = nqp::add_i($i,1)),
  635. nqp::iterval(nqp::shift($iterator)))
  636. )
  637. )
  638. ),
  639. $buffer
  640. )
  641. }
  642. method keys() {
  643. Seq.new(class :: does Rakudo::Iterator::Mappy {
  644. method pull-one() {
  645. nqp::if(
  646. $!iter,
  647. nqp::getattr(nqp::iterval(nqp::shift($!iter)),
  648. Pair,'$!key'),
  649. IterationEnd
  650. )
  651. }
  652. }.new(self))
  653. }
  654. method values() {
  655. Seq.new(class :: does Rakudo::Iterator::Mappy {
  656. method pull-one() {
  657. nqp::if(
  658. $!iter,
  659. nqp::getattr(nqp::iterval(nqp::shift($!iter)),
  660. Pair,'$!value'),
  661. IterationEnd
  662. )
  663. }
  664. }.new(self))
  665. }
  666. method kv() {
  667. Seq.new(Rakudo::Iterator.Mappy-kv-from-pairs(self))
  668. }
  669. method iterator() { Rakudo::Iterator.Mappy-values(self) }
  670. method antipairs() {
  671. Seq.new(class :: does Rakudo::Iterator::Mappy {
  672. method pull-one() {
  673. nqp::if(
  674. $!iter,
  675. nqp::iterval(nqp::shift($!iter)).antipair,
  676. IterationEnd
  677. )
  678. }
  679. }.new(self))
  680. }
  681. multi method roll(::?CLASS:D:) {
  682. nqp::if(
  683. (my $raw := nqp::getattr(self,Map,'$!storage')) && nqp::elems($raw),
  684. nqp::stmts(
  685. (my int $i = nqp::add_i(nqp::elems($raw).rand.floor,1)),
  686. (my $iter := nqp::iterator($raw)),
  687. nqp::while(
  688. nqp::shift($iter) && ($i = nqp::sub_i($i,1)),
  689. nqp::null
  690. ),
  691. nqp::iterval($iter)
  692. ),
  693. Nil
  694. )
  695. }
  696. multi method roll(::?CLASS:D: Callable:D $calculate) {
  697. self.roll( $calculate(self.elems) )
  698. }
  699. multi method roll(::?CLASS:D: Whatever $) { self.roll(Inf) }
  700. multi method roll(::?CLASS:D: $count) {
  701. Seq.new(nqp::if(
  702. (my $raw := nqp::getattr(self,Map,'$!storage'))
  703. && nqp::elems($raw) && $count > 0,
  704. class :: does Iterator {
  705. has $!storage;
  706. has $!keys;
  707. has $!count;
  708. method !SET-SELF(\hash,\count) {
  709. nqp::stmts(
  710. ($!storage := nqp::getattr(hash,Map,'$!storage')),
  711. ($!count = $count),
  712. (my $iter := nqp::iterator($!storage)),
  713. ($!keys := nqp::list_s),
  714. nqp::while(
  715. $iter,
  716. nqp::push_s($!keys,nqp::iterkey_s(nqp::shift($iter)))
  717. ),
  718. self
  719. )
  720. }
  721. method new(\h,\c) { nqp::create(self)!SET-SELF(h,c) }
  722. method pull-one() {
  723. nqp::if(
  724. $!count,
  725. nqp::stmts(
  726. --$!count, # must be HLL to handle Inf
  727. nqp::atkey(
  728. $!storage,
  729. nqp::atpos_s($!keys,nqp::elems($!keys).rand.floor)
  730. )
  731. ),
  732. IterationEnd
  733. )
  734. }
  735. method is-lazy() { $!count == Inf }
  736. }.new(self,$count),
  737. Rakudo::Iterator.Empty
  738. ))
  739. }
  740. multi method perl(::?CLASS:D \SELF:) {
  741. SELF.perlseen('Hash', {
  742. my $TKey-perl := TKey.perl;
  743. my $TValue-perl := TValue.perl;
  744. $TKey-perl eq 'Any' && $TValue-perl eq 'Mu'
  745. ?? ( '$(' x nqp::iscont(SELF)
  746. ~ ':{' ~ SELF.sort.map({.perl}).join(', ') ~ '}'
  747. ~ ')' x nqp::iscont(SELF)
  748. )
  749. !! '$' x nqp::iscont(SELF)
  750. ~ (self.elems
  751. ?? "(my $TValue-perl %\{$TKey-perl\} = {
  752. self.sort.map({.perl}).join(', ')
  753. })"
  754. !! "(my $TValue-perl %\{$TKey-perl\})"
  755. )
  756. })
  757. }
  758. # gotta force capture keys to strings or binder fails
  759. method Capture() {
  760. nqp::defined(nqp::getattr(self,Map,'$!storage'))
  761. ?? do {
  762. my $cap := nqp::create(Capture);
  763. my $h := nqp::hash();
  764. for self.kv -> \k, \v {
  765. nqp::bindkey($h,
  766. nqp::unbox_s(nqp::istype(k,Str) ?? k !! k.Str),
  767. v)
  768. }
  769. nqp::bindattr($cap,Capture,'%!hash',$h);
  770. $cap
  771. }
  772. !! nqp::create(Capture)
  773. }
  774. method Map() { self.pairs.Map }
  775. }
  776. method ^parameterize(Mu:U \hash, Mu:U \t, |c) {
  777. if c.elems == 0 {
  778. my $what := hash.^mixin(TypedHash[t]);
  779. # needs to be done in COMPOSE phaser when that works
  780. $what.^set_name("{hash.^name}[{t.^name}]");
  781. $what;
  782. }
  783. elsif c.elems == 1 {
  784. my $what := hash.^mixin(TypedHash[t, c[0].WHAT]);
  785. # needs to be done in COMPOSE phaser when that works
  786. $what.^set_name("{hash.^name}[{t.^name},{c[0].^name}]");
  787. $what;
  788. }
  789. else {
  790. die "Can only type-constrain Hash with [ValueType] or [ValueType,KeyType]";
  791. }
  792. }
  793. }
  794. proto sub circumfix:<{ }>(|) {*}
  795. multi sub circumfix:<{ }>(*@elems) { my % = @elems }
  796. # XXX parse dies with 'don't change grammar in the setting, please!'
  797. # with ordinary sub declaration
  798. #sub circumfix:<:{ }>(*@elems) { Hash.^parameterize(Mu,Any).new(@elems) }
  799. BEGIN my &circumfix:<:{ }> = sub (*@e) { Hash.^parameterize(Mu,Any).new(@e) }
  800. proto sub hash(|) {*}
  801. multi sub hash(*%h) { %h }
  802. multi sub hash(*@a, *%h) { my % = flat @a, %h }