1. # Method that we have on enumeration types.
  2. my role Enumeration {
  3. has $.key;
  4. has $.value;
  5. has int $!index;
  6. method enums() { self.^enum_values.Map }
  7. multi method kv(::?CLASS:D:) { ($!key, $!value) }
  8. method pair(::?CLASS:D:) { $!key => $!value }
  9. multi method gist(::?CLASS:D:) { $!key }
  10. multi method perl(::?CLASS:D:) { self.^name ~ '::' ~ $!key }
  11. multi method pick(::?CLASS:U:) { self.^enum_value_list.pick }
  12. multi method pick(::?CLASS:U: \n) { self.^enum_value_list.pick(n) }
  13. multi method pick(::?CLASS:D: *@pos) { self xx +?( @pos[0] // 1 ) }
  14. multi method roll(::?CLASS:U:) { self.^enum_value_list.roll }
  15. multi method roll(::?CLASS:U: \n) { self.^enum_value_list.roll(n) }
  16. multi method roll(::?CLASS:D: *@pos) { self xx +?( @pos[0] // 1 ) }
  17. multi method Numeric(::?CLASS:D:) { $!value.Numeric }
  18. multi method Int(::?CLASS:D:) { $!value.Int }
  19. multi method Real(::?CLASS:D:) { $!value.Real }
  20. multi method WHICH(::?CLASS:D:) {
  21. nqp::box_s(
  22. nqp::concat(self.^name,nqp::concat("|",$!index)),
  23. ValueObjAt
  24. )
  25. }
  26. # Make sure we always accept any element of the enumeration
  27. multi method ACCEPTS(::?CLASS:D: ::?CLASS:U $ --> True) { }
  28. multi method ACCEPTS(::?CLASS:D: ::?CLASS:D \v) { self === v }
  29. method CALL-ME(|) {
  30. my $x := nqp::atpos(nqp::p6argvmarray(), 1).AT-POS(0);
  31. nqp::istype($x, ::?CLASS)
  32. ?? $x
  33. !! self.^enum_from_value($x)
  34. }
  35. method pred(::?CLASS:D:) {
  36. nqp::if(
  37. nqp::getattr_i(self,::?CLASS,'$!index'),
  38. nqp::atpos(
  39. nqp::getattr(self.^enum_value_list,List,'$!reified'),
  40. nqp::sub_i(nqp::getattr_i(self,::?CLASS,'$!index'),1)
  41. ),
  42. self
  43. )
  44. }
  45. method succ(::?CLASS:D:) {
  46. nqp::stmts(
  47. (my $values := nqp::getattr(self.^enum_value_list,List,'$!reified')),
  48. nqp::if(
  49. nqp::islt_i(
  50. nqp::getattr_i(self,::?CLASS,'$!index'),
  51. nqp::sub_i(nqp::elems($values),1),
  52. ),
  53. nqp::atpos(
  54. $values,
  55. nqp::add_i(nqp::getattr_i(self,::?CLASS,'$!index'),1)
  56. ),
  57. self
  58. )
  59. )
  60. }
  61. }
  62. # Methods that we also have if the base type of an enumeration is
  63. # Numeric.
  64. my role NumericEnumeration {
  65. multi method Str(::?CLASS:D:) {
  66. self.key
  67. }
  68. }
  69. my role StringyEnumeration {
  70. multi method Str(::?CLASS:D:) {
  71. self.value
  72. }
  73. }
  74. my role NumericStringyEnumeration {
  75. multi method Str(::?CLASS:D:) {
  76. self.key
  77. }
  78. }
  79. sub ENUM_VALUES(*@args) {
  80. my Mu $prev = -1;
  81. my %res;
  82. for @args {
  83. if .^isa(Pair) {
  84. %res{.key} = $prev = .value;
  85. }
  86. else {
  87. %res{$_} = $prev.=succ;
  88. }
  89. }
  90. nqp::p6bindattrinvres(
  91. nqp::create(Map),Map,'$!storage',nqp::getattr(%res,Map,'$!storage')
  92. )
  93. }
  94. Metamodel::EnumHOW.set_composalizer(-> $type, $name, %enum_values {
  95. my Mu $r := Metamodel::ParametricRoleHOW.new_type(:name($name));
  96. $r.^add_attribute(Attribute.new(
  97. :name('$!' ~ $name), :type(nqp::decont($type)),
  98. :has_accessor(1), :package($r)));
  99. for %enum_values.kv -> $key, $value {
  100. my $meth = method () { self."$name"() == $value }
  101. $meth.set_name($key);
  102. $r.^add_method($key, $meth);
  103. }
  104. $r.^set_body_block( -> |c {nqp::list($r,nqp::hash('$?CLASS',c<$?CLASS>))});
  105. $r.^compose;
  106. $r
  107. });
  108. # We use this one because, for example, Int:D === Int:D, has an optimization
  109. # that simply unboxes the values. That's no good for us, since two different
  110. # Enumertaion:Ds could have the same Int:D value.
  111. multi infix:<===> (Enumeration:D \a, Enumeration:D \b) {
  112. nqp::p6bool(nqp::eqaddr(nqp::decont(a), nqp::decont(b)))
  113. }