1. # This file implements the following set operators:
  2. # (<=) is a subset of (ASCII)
  3. # ⊆ is a subset of
  4. # ⊈ is NOT a subset of
  5. # (>=) is a superset of (ASCII)
  6. # ⊇ is a superset of
  7. # ⊉ is NOT a superset of
  8. proto sub infix:<<(<=)>>($, $ --> Bool:D) is pure {*}
  9. multi sub infix:<<(<=)>>(Setty:D $a, Setty:D $b --> Bool:D) {
  10. nqp::stmts(
  11. nqp::unless(
  12. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  13. nqp::if(
  14. (my $araw := $a.RAW-HASH)
  15. && nqp::elems($araw),
  16. nqp::if( # number of elems in B *always* >= A
  17. (my $braw := $b.RAW-HASH)
  18. && nqp::isle_i(nqp::elems($araw),nqp::elems($braw))
  19. && (my $iter := nqp::iterator($araw)),
  20. nqp::while( # number of elems in B >= A
  21. $iter,
  22. nqp::unless(
  23. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  24. return False # elem in A doesn't exist in B
  25. )
  26. ),
  27. return False # number of elems in B smaller than A
  28. )
  29. )
  30. ),
  31. True
  32. )
  33. }
  34. multi sub infix:<<(<=)>>(Setty:D $a, Mixy:D $b --> Bool:D) { $a.Mix (<=) $b }
  35. multi sub infix:<<(<=)>>(Setty:D $a, Baggy:D $b --> Bool:D) { $a.Bag (<=) $b }
  36. multi sub infix:<<(<=)>>(Setty:D $a, Any $b --> Bool:D) { $a (<=) $b.Set }
  37. multi sub infix:<<(<=)>>(Mixy:D $a, Mixy:D $b --> Bool:D) {
  38. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  39. }
  40. multi sub infix:<<(<=)>>(Mixy:D $a, Baggy:D $b --> Bool:D) {
  41. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  42. }
  43. multi sub infix:<<(<=)>>(Mixy:D $a, Setty:D $b --> Bool:D) { $a (<=) $b.Mix }
  44. multi sub infix:<<(<=)>>(Mixy:D $a, Any $b --> Bool:D) { $a (<=) $b.Mix }
  45. multi sub infix:<<(<=)>>(Baggy:D $a, Mixy:D $b --> Bool:D) {
  46. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  47. }
  48. multi sub infix:<<(<=)>>(Baggy:D $a, Baggy:D $b --> Bool:D) {
  49. nqp::stmts(
  50. nqp::unless(
  51. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  52. nqp::if(
  53. (my $araw := $a.RAW-HASH)
  54. && nqp::elems($araw),
  55. nqp::if( # number of elems in B *always* >= A
  56. (my $braw := $b.RAW-HASH)
  57. && nqp::isle_i(nqp::elems($araw),nqp::elems($braw))
  58. && (my $iter := nqp::iterator($araw)),
  59. nqp::while( # number of elems in B >= A
  60. $iter,
  61. nqp::unless(
  62. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  63. <= # value in A should be less or equal than B
  64. nqp::getattr(
  65. nqp::ifnull(
  66. nqp::atkey($braw,nqp::iterkey_s($iter)),
  67. BEGIN # provide virtual value 0
  68. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0)
  69. ),
  70. Pair,
  71. '$!value'
  72. ),
  73. return False
  74. )
  75. ),
  76. return False # number of elems in B smaller than A
  77. )
  78. )
  79. ),
  80. True
  81. )
  82. }
  83. multi sub infix:<<(<=)>>(Baggy:D $a, Setty:D $b --> Bool:D) { $a (<=) $b.Bag }
  84. multi sub infix:<<(<=)>>(Baggy:D $a, Any $b --> Bool:D) { $a (<=) $b.Bag }
  85. multi sub infix:<<(<=)>>(Map:D $a, Map:D $b --> Bool:D) {
  86. nqp::if(
  87. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  88. True, # B is alias of A
  89. nqp::if( # A and B are different
  90. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  91. && nqp::elems($araw),
  92. nqp::if( # something in A
  93. nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)),
  94. nqp::if( # both are normal Maps
  95. (my $iter := nqp::iterator($araw))
  96. && (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  97. && nqp::elems($braw),
  98. nqp::stmts( # something to check for in B
  99. nqp::while(
  100. $iter,
  101. nqp::if(
  102. nqp::iterval(nqp::shift($iter)),
  103. nqp::unless( # valid in A
  104. nqp::atkey($braw,nqp::iterkey_s($iter)),
  105. return False # valid elem in A isn't valid elem in B
  106. )
  107. )
  108. ),
  109. True # all valids in A occur as valids in B
  110. ),
  111. nqp::stmts( # nothing to check for in B
  112. nqp::while(
  113. $iter,
  114. nqp::if(
  115. nqp::iterval(nqp::shift($iter)),
  116. return False # valid in elem in A (and none in B)
  117. )
  118. ),
  119. True # no valid elems in A
  120. )
  121. ),
  122. $a.Set (<=) $b.Set # either is objectHash, so coerce
  123. ),
  124. True # nothing in A
  125. )
  126. )
  127. }
  128. multi sub infix:<<(<=)>>(Any $a, Mixy:D $b --> Bool:D) { $a.Mix (<=) $b }
  129. multi sub infix:<<(<=)>>(Any $a, Baggy:D $b --> Bool:D) { $a.Bag (<=) $b }
  130. multi sub infix:<<(<=)>>(Any $a, Setty:D $b --> Bool:D) { $a.Set (<=) $b }
  131. multi sub infix:<<(<=)>>(Failure:D $a, Any $b) { $a.throw }
  132. multi sub infix:<<(<=)>>(Any $a, Failure:D $b) { $b.throw }
  133. multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) {
  134. infix:<<(<=)>>($a.Set, $b.Set)
  135. }
  136. # U+2286 SUBSET OF OR EQUAL TO
  137. my constant &infix:<⊆> := &infix:<<(<=)>>;
  138. # U+2288 NEITHER A SUBSET OF NOR EQUAL TO
  139. proto sub infix:<⊈>(|) is pure {*}
  140. multi sub infix:<⊈>($a, $b --> Bool:D) { not $a (<=) $b }
  141. proto sub infix:<<(>=)>>(|) is pure {*}
  142. multi sub infix:<<(>=)>>(Any $a, Any $b --> Bool:D) { $b (<=) $a }
  143. # U+2287 SUPERSET OF OR EQUAL TO
  144. proto sub infix:<⊇>(|) is pure {*}
  145. multi sub infix:<⊇>($a, $b --> Bool:D) { $b (<=) $a }
  146. # U+2289 NEITHER A SUPERSET OF NOR EQUAL TO
  147. proto sub infix:<⊉>(|) is pure {*}
  148. multi sub infix:<⊉>($a, $b --> Bool:D) { not $b (<=) $a }