1. # This file implements the following set operators:
  2. # (elem) is an element of (ASCII)
  3. # ∈ is an element of
  4. # ∉ is NOT an element of
  5. # (cont) contains (ASCII)
  6. # ∋ contains
  7. # ∌ does NOT contain
  8. proto sub infix:<(elem)>($, $ --> Bool:D) is pure {*}
  9. multi sub infix:<(elem)>(Str:D $a, Map:D $b --> Bool:D) {
  10. nqp::p6bool(
  11. (my $storage := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  12. && nqp::elems($storage)
  13. && nqp::if(
  14. nqp::eqaddr($b.keyof,Str(Any)),
  15. nqp::atkey($storage,$a), # normal hash
  16. nqp::getattr( # object hash
  17. nqp::ifnull(
  18. nqp::atkey($storage,$a.WHICH),
  19. BEGIN # provide virtual value False # did not exist
  20. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',False)
  21. ),
  22. Pair,
  23. '$!value'
  24. )
  25. )
  26. )
  27. }
  28. multi sub infix:<(elem)>(Any $a, Map:D $b --> Bool:D) {
  29. nqp::p6bool(
  30. (my $storage := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  31. && nqp::elems($storage) # haz a haystack
  32. && nqp::not_i(nqp::eqaddr($b.keyof,Str(Any))) # is object hash
  33. && nqp::getattr(
  34. nqp::ifnull(
  35. nqp::atkey($storage,$a.WHICH), # exists
  36. BEGIN # provide virtual value False # did not exist
  37. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',False)
  38. ),
  39. Pair,
  40. '$!value'
  41. )
  42. )
  43. }
  44. multi sub infix:<(elem)>(Int:D $a, Range:D $b --> Bool:D) {
  45. $b.is-int ?? $b.ACCEPTS($a) !! infix:<(elem)>($a,$b.iterator)
  46. }
  47. multi sub infix:<(elem)>(Any $a, Iterable:D $b --> Bool:D) {
  48. infix:<(elem)>($a,$b.iterator)
  49. }
  50. multi sub infix:<(elem)>(Any $a, Iterator:D $b --> Bool:D) {
  51. nqp::if(
  52. $b.is-lazy,
  53. Failure.new(X::Cannot::Lazy.new(:action<(elem)>)),
  54. nqp::stmts(
  55. (my str $needle = $a.WHICH),
  56. nqp::until(
  57. nqp::eqaddr((my $pulled := $b.pull-one),IterationEnd),
  58. nqp::if(
  59. nqp::iseq_s($needle,$pulled.WHICH),
  60. return True
  61. )
  62. ),
  63. False
  64. )
  65. )
  66. }
  67. multi sub infix:<(elem)>(Any $a, QuantHash:D $b --> Bool:D) {
  68. nqp::p6bool(
  69. (my $elems := $b.RAW-HASH) && nqp::existskey($elems,$a.WHICH)
  70. )
  71. }
  72. multi sub infix:<(elem)>(Any $, Failure:D $b) { $b.throw }
  73. multi sub infix:<(elem)>(Failure:D $a, Any $) { $a.throw }
  74. multi sub infix:<(elem)>(Any $a, Any $b) { infix:<(elem)>($a,$b.Set) }
  75. # U+2208 ELEMENT OF
  76. my constant &infix:<∈> := &infix:<(elem)>;
  77. # U+2209 NOT AN ELEMENT OF
  78. proto sub infix:<∉>(|) is pure {*}
  79. multi sub infix:<∉>($a, $b --> Bool:D) { not $a (elem) $b }
  80. proto sub infix:<(cont)>(|) is pure {*}
  81. multi sub infix:<(cont)>($a, $b --> Bool:D) { $b (elem) $a }
  82. # U+220B CONTAINS AS MEMBER
  83. proto sub infix:<∋>(|) is pure {*}
  84. multi sub infix:<∋>($a, $b --> Bool:D) { $b (elem) $a }
  85. # U+220C DOES NOT CONTAIN AS MEMBER
  86. proto sub infix:<∌>(|) is pure {*}
  87. multi sub infix:<∌>($a, $b --> Bool:D) { not $b (elem) $a }