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) ?? Nil !! 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::if(
  588. nqp::getattr(self,Map,'$!storage').DEFINITE,
  589. nqp::p6bool(nqp::existskey(
  590. nqp::getattr(self,Map,'$!storage'),nqp::unbox_s(key.WHICH)))
  591. )
  592. }
  593. method DELETE-KEY(TKey \key) {
  594. nqp::if(
  595. (nqp::getattr(self,Map,'$!storage').DEFINITE
  596. && nqp::existskey(nqp::getattr(self,Map,'$!storage'),
  597. (my str $which = key.WHICH))),
  598. nqp::stmts(
  599. (my TValue $value =
  600. nqp::getattr(
  601. nqp::atkey(nqp::getattr(self,Map,'$!storage'),$which),
  602. Pair,'$!value')),
  603. nqp::deletekey(nqp::getattr(self,Map,'$!storage'),$which),
  604. $value
  605. ),
  606. TValue
  607. )
  608. }
  609. method IterationBuffer() {
  610. nqp::stmts(
  611. (my $buffer := nqp::create(IterationBuffer)),
  612. nqp::if(
  613. nqp::defined(
  614. nqp::getattr(self,Map,'$!storage')
  615. ) && nqp::elems(
  616. nqp::getattr(self,Map,'$!storage')
  617. ),
  618. nqp::stmts(
  619. (my $iterator := nqp::iterator(
  620. nqp::getattr(self,Map,'$!storage')
  621. )),
  622. nqp::setelems($buffer,nqp::elems(
  623. nqp::getattr(self,Map,'$!storage')
  624. )),
  625. (my int $i = -1),
  626. nqp::while(
  627. $iterator,
  628. nqp::bindpos($buffer,($i = nqp::add_i($i,1)),
  629. nqp::iterval(nqp::shift($iterator)))
  630. )
  631. )
  632. ),
  633. $buffer
  634. )
  635. }
  636. method keys() {
  637. Seq.new(class :: does Rakudo::Iterator::Mappy {
  638. method pull-one() {
  639. nqp::if(
  640. $!iter,
  641. nqp::getattr(nqp::iterval(nqp::shift($!iter)),
  642. Pair,'$!key'),
  643. IterationEnd
  644. )
  645. }
  646. }.new(self))
  647. }
  648. method values() {
  649. Seq.new(class :: does Rakudo::Iterator::Mappy {
  650. method pull-one() {
  651. nqp::if(
  652. $!iter,
  653. nqp::getattr(nqp::iterval(nqp::shift($!iter)),
  654. Pair,'$!value'),
  655. IterationEnd
  656. )
  657. }
  658. }.new(self))
  659. }
  660. method kv() {
  661. Seq.new(Rakudo::Iterator.Mappy-kv-from-pairs(self))
  662. }
  663. method iterator() { Rakudo::Iterator.Mappy-values(self) }
  664. method antipairs() {
  665. Seq.new(class :: does Rakudo::Iterator::Mappy {
  666. method pull-one() {
  667. nqp::if(
  668. $!iter,
  669. nqp::iterval(nqp::shift($!iter)).antipair,
  670. IterationEnd
  671. )
  672. }
  673. }.new(self))
  674. }
  675. multi method perl(::?CLASS:D \SELF:) {
  676. SELF.perlseen('Hash', {
  677. my $TKey-perl := TKey.perl;
  678. my $TValue-perl := TValue.perl;
  679. $TKey-perl eq 'Any' && $TValue-perl eq 'Mu'
  680. ?? ':{' ~ SELF.pairs.sort.map({.perl}).join(', ') ~ '}'
  681. !! self.elems
  682. ?? "(my $TValue-perl %\{$TKey-perl\} = {
  683. self.pairs.sort.map({.perl}).join(', ')
  684. })"
  685. !! "(my $TValue-perl %\{$TKey-perl\})"
  686. })
  687. }
  688. # gotta force capture keys to strings or binder fails
  689. method Capture() {
  690. nqp::defined(nqp::getattr(self,Map,'$!storage'))
  691. ?? do {
  692. my $cap := nqp::create(Capture);
  693. my $h := nqp::hash();
  694. for self.kv -> \k, \v {
  695. nqp::bindkey($h,
  696. nqp::unbox_s(nqp::istype(k,Str) ?? k !! k.Str),
  697. v)
  698. }
  699. nqp::bindattr($cap,Capture,'%!hash',$h);
  700. $cap
  701. }
  702. !! nqp::create(Capture)
  703. }
  704. method Map() { self.pairs.Map }
  705. }
  706. method ^parameterize(Mu:U \hash, Mu:U \t, |c) {
  707. if c.elems == 0 {
  708. my $what := hash.^mixin(TypedHash[t]);
  709. # needs to be done in COMPOSE phaser when that works
  710. $what.^set_name("{hash.^name}[{t.^name}]");
  711. $what;
  712. }
  713. elsif c.elems == 1 {
  714. my $what := hash.^mixin(TypedHash[t, c[0].WHAT]);
  715. # needs to be done in COMPOSE phaser when that works
  716. $what.^set_name("{hash.^name}[{t.^name},{c[0].^name}]");
  717. $what;
  718. }
  719. else {
  720. die "Can only type-constrain Hash with [ValueType] or [ValueType,KeyType]";
  721. }
  722. }
  723. }
  724. sub circumfix:<{ }>(*@elems) { my % = @elems }
  725. sub hash(*@a, *%h) { my % = flat @a, %h }
  726. # XXX parse hangs with ordinary sub declaration
  727. BEGIN my &circumfix:<:{ }> = sub (*@elems) { Hash.^parameterize(Mu,Any).new(@elems) }