1. # This file implements the following set operators:
  2. # (<) is a proper subset of (ASCII)
  3. # ⊂ is a proper subset of
  4. # ⊄ is NOT a proper subset of
  5. # (>) is a proper superset of (ASCII)
  6. # ⊃ is a proper superset of
  7. # ⊅ is NOT a proper superset of
  8. proto sub infix:<<(<)>>($, $ --> Bool:D) is pure {*}
  9. multi sub infix:<<(<)>>(Setty:D $a, Setty:D $b --> Bool:D) {
  10. nqp::if(
  11. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  12. False, # X is never a true subset of itself
  13. nqp::if(
  14. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  15. nqp::if(
  16. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  17. nqp::if(
  18. nqp::islt_i(nqp::elems($araw),nqp::elems($braw))
  19. && (my $iter := nqp::iterator($araw)),
  20. nqp::stmts( # A has fewer elems than B
  21. nqp::while(
  22. $iter,
  23. nqp::unless(
  24. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  25. return False # elem in A doesn't exist in B
  26. )
  27. ),
  28. True # all elems in A exist in B
  29. ),
  30. False # number of elems in B smaller or equal to A
  31. ),
  32. True # no elems in A, and elems in B
  33. ),
  34. False # can never have fewer elems in A than in B
  35. )
  36. )
  37. }
  38. multi sub infix:<<(<)>>(Setty:D $a, Mixy:D $b --> Bool:D) { $a.Mix (<) $b }
  39. multi sub infix:<<(<)>>(Setty:D $a, Baggy:D $b --> Bool:D) { $a.Bag (<) $b }
  40. multi sub infix:<<(<)>>(Setty:D $a, Any $b --> Bool:D) { $a (<) $b.Set }
  41. multi sub infix:<<(<)>>(Mixy:D $a, Mixy:D $b --> Bool:D) {
  42. Rakudo::QuantHash.MIX-IS-PROPER-SUBSET($a,$b)
  43. }
  44. multi sub infix:<<(<)>>(Mixy:D $a, Baggy:D $b --> Bool:D) {
  45. Rakudo::QuantHash.MIX-IS-PROPER-SUBSET($a,$b)
  46. }
  47. multi sub infix:<<(<)>>(Mixy:D $a, Any $b --> Bool:D) { $a (<) $b.Mix }
  48. multi sub infix:<<(<)>>(Baggy:D $a, Mixy:D $b --> Bool:D) {
  49. Rakudo::QuantHash.MIX-IS-PROPER-SUBSET($a,$b)
  50. }
  51. multi sub infix:<<(<)>>(Baggy:D $a, Baggy:D $b --> Bool:D) {
  52. nqp::if(
  53. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  54. False, # never proper subset of self
  55. nqp::if( # different objects
  56. (my $araw := $a.RAW-HASH) && (my $iter := nqp::iterator($araw)),
  57. nqp::if( # elements on left
  58. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  59. nqp::if( # elements on both sides
  60. nqp::isle_i(nqp::elems($araw),nqp::elems($braw)),
  61. nqp::stmts( # equal number of elements on either side
  62. (my int $less = 0),
  63. nqp::while(
  64. $iter,
  65. nqp::if(
  66. (my $left := nqp::getattr(
  67. nqp::iterval(nqp::shift($iter)),
  68. Pair,
  69. '$!value'
  70. ))
  71. >
  72. (my $right := nqp::getattr(
  73. nqp::ifnull(
  74. nqp::atkey($braw,nqp::iterkey_s($iter)),
  75. BEGIN nqp::p6bindattrinvres( # virtual 0
  76. nqp::create(Pair),Pair,'$!value',0)
  77. ),
  78. Pair,
  79. '$!value'
  80. )),
  81. (return False), # too many on left, we're done
  82. nqp::unless($less,$less = $left < $right)
  83. )
  84. ),
  85. nqp::p6bool( # ok so far, must have lower total or fewer keys
  86. $less || nqp::islt_i(nqp::elems($araw),nqp::elems($braw))
  87. )
  88. ),
  89. False # more keys on left
  90. ),
  91. False # keys on left, no keys on right
  92. ),
  93. nqp::p6bool( # no keys on left
  94. ($braw := $b.RAW-HASH) && nqp::elems($braw)
  95. )
  96. )
  97. )
  98. }
  99. multi sub infix:<<(<)>>(Baggy:D $a, Any $b --> Bool:D) { $a (<) $b.Bag }
  100. multi sub infix:<<(<)>>(Any $a, Mixy:D $b --> Bool:D) { $a.Mix (<) $b }
  101. multi sub infix:<<(<)>>(Any $a, Baggy:D $b --> Bool:D) { $a.Bag (<) $b }
  102. multi sub infix:<<(<)>>(Failure:D $a, Any $b) { $a.throw }
  103. multi sub infix:<<(<)>>(Any $a, Failure:D $b) { $b.throw }
  104. multi sub infix:<<(<)>>(Any $a, Any $b --> Bool:D) {
  105. infix:<<(<)>>($a.Set, $b.Set)
  106. }
  107. # U+2282 SUBSET OF
  108. my constant &infix:<⊂> := &infix:<<(<)>>;
  109. # U+2284 NOT A SUBSET OF
  110. proto sub infix:<⊄>(|) is pure {*}
  111. multi sub infix:<⊄>($a, $b --> Bool:D) { not $a (<) $b }
  112. proto sub infix:<<(>)>>(|) is pure {*}
  113. multi sub infix:<<(>)>>(Any $a, Any $b --> Bool:D) { $b (<) $a }
  114. # U+2283 SUPERSET OF
  115. proto sub infix:<⊃>(|) is pure {*}
  116. multi sub infix:<⊃>($a, $b --> Bool:D) { $b (<) $a }
  117. # U+2285 NOT A SUPERSET OF
  118. proto sub infix:<⊅>(|) is pure {*}
  119. multi sub infix:<⊅>($a, $b --> Bool:D) { not $b (<) $a }