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