1. # this is actually part of the Array class
  2. my role TypedArray[::TValue] does Positional[TValue] {
  3. proto method new(|) { * }
  4. multi method new(:$shape!) {
  5. set-descriptor(nqp::if(
  6. nqp::defined($shape),
  7. set-shape(self,$shape),
  8. nqp::if(
  9. Metamodel::EnumHOW.ACCEPTS($shape.HOW),
  10. set-shape(self,$shape.^elems),
  11. nqp::create(self)
  12. )
  13. ))
  14. }
  15. multi method new() {
  16. set-descriptor(nqp::create(self))
  17. }
  18. multi method new(\values, :$shape!) {
  19. set-descriptor(nqp::if(
  20. nqp::defined($shape),
  21. set-shape(self,$shape),
  22. nqp::if(
  23. Metamodel::EnumHOW.ACCEPTS($shape.HOW),
  24. set-shape(self,$shape.^elems),
  25. nqp::create(self)
  26. )
  27. )).STORE(values)
  28. }
  29. multi method new(\values) {
  30. set-descriptor(nqp::create(self)).STORE(values)
  31. }
  32. multi method new(**@values is raw, :$shape!) {
  33. set-descriptor(nqp::if(
  34. nqp::defined($shape),
  35. set-shape(self,$shape),
  36. nqp::if(
  37. Metamodel::EnumHOW.ACCEPTS($shape.HOW),
  38. set-shape(self,$shape.^elems),
  39. nqp::create(self)
  40. )
  41. )).STORE(@values)
  42. }
  43. multi method new(**@values is raw) {
  44. set-descriptor(nqp::create(self)).STORE(@values)
  45. }
  46. sub set-descriptor(\list) is raw {
  47. nqp::stmts(
  48. nqp::bindattr(list,Array,'$!descriptor',
  49. Perl6::Metamodel::ContainerDescriptor.new(
  50. :of(TValue), :rw(1), :default(TValue))
  51. ),
  52. list
  53. )
  54. }
  55. # must have a proto here to hide the candidates in Array
  56. # otherwise we could bind any value to the Array
  57. proto method BIND-POS(|) { * }
  58. # these BIND-POSses are identical to Array's, except for bindval
  59. multi method BIND-POS(Array:D: int $pos, TValue \bindval) is raw {
  60. nqp::if(
  61. nqp::islt_i($pos,0),
  62. Failure.new(X::OutOfRange.new(
  63. :what($*INDEX // 'Index'),:got($pos),:range<0..^Inf>)),
  64. nqp::stmts(
  65. nqp::if(
  66. nqp::getattr(self,List,'$!reified').DEFINITE,
  67. nqp::if(
  68. (nqp::isge_i(
  69. $pos,nqp::elems(nqp::getattr(self,List,'$!reified')))
  70. && nqp::getattr(self,List,'$!todo').DEFINITE),
  71. nqp::getattr(self,List,'$!todo').reify-at-least(
  72. nqp::add_i($pos,1)),
  73. ),
  74. nqp::bindattr(self,List,'$!reified',nqp::create(IterationBuffer))
  75. ),
  76. nqp::bindpos(nqp::getattr(self,List,'$!reified'),$pos,bindval)
  77. )
  78. )
  79. }
  80. # because this is a very hot path, we copied the code from the int candidate
  81. multi method BIND-POS(Array:D: Int:D $pos, TValue \bindval) is raw {
  82. nqp::if(
  83. nqp::islt_i($pos,0),
  84. Failure.new(X::OutOfRange.new(
  85. :what($*INDEX // 'Index'),:got($pos),:range<0..^Inf>)),
  86. nqp::stmts(
  87. nqp::if(
  88. nqp::getattr(self,List,'$!reified').DEFINITE,
  89. nqp::if(
  90. (nqp::isge_i(
  91. $pos,nqp::elems(nqp::getattr(self,List,'$!reified')))
  92. && nqp::getattr(self,List,'$!todo').DEFINITE),
  93. nqp::getattr(self,List,'$!todo').reify-at-least(
  94. nqp::add_i($pos,1)),
  95. ),
  96. nqp::bindattr(self,List,'$!reified',nqp::create(IterationBuffer))
  97. ),
  98. nqp::bindpos(nqp::getattr(self,List,'$!reified'),$pos,bindval)
  99. )
  100. )
  101. }
  102. multi method perl(::?CLASS:D \SELF:) {
  103. my $args = self.map({ ($_ // TValue).perl(:arglist) }).join(', ');
  104. 'Array[' ~ TValue.perl ~ '].new(' ~ $args ~ ')';
  105. }
  106. }
  107. method ^parameterize(Mu:U \arr, Mu:U \t, |c) {
  108. if c.elems == 0 {
  109. my $what := arr.^mixin(TypedArray[t]);
  110. # needs to be done in COMPOSE phaser when that works
  111. $what.^set_name("{arr.^name}[{t.^name}]");
  112. $what;
  113. }
  114. else {
  115. die "Can only type-constrain Array with [ValueType]"
  116. }
  117. }
  118. }
  119. #========== closed down the Array class started in src/core/Array.pm ==========