1. proto sub infix:<(elem)>($, $ --> Bool:D) is pure {*}
  2. multi sub infix:<(elem)>($a, Any $b --> Bool:D) {
  3. $a (elem) $b.Set(:view);
  4. }
  5. multi sub infix:<(elem)>($a, Set $b --> Bool:D) {
  6. $b.EXISTS-KEY($a);
  7. }
  8. # U+2208 ELEMENT OF
  9. only sub infix:<∈>($a, $b --> Bool:D) is pure {
  10. $a (elem) $b;
  11. }
  12. # U+2209 NOT AN ELEMENT OF
  13. only sub infix:<∉>($a, $b --> Bool:D) is pure {
  14. $a !(elem) $b;
  15. }
  16. proto sub infix:<(cont)>($, $ --> Bool:D) is pure {*}
  17. multi sub infix:<(cont)>(Any $a, $b --> Bool:D) {
  18. $a.Set(:view) (cont) $b;
  19. }
  20. multi sub infix:<(cont)>(Set $a, $b --> Bool:D) {
  21. $a.EXISTS-KEY($b);
  22. }
  23. # U+220B CONTAINS AS MEMBER
  24. only sub infix:<∋>($a, $b --> Bool:D) is pure {
  25. $a (cont) $b;
  26. }
  27. # U+220C DOES NOT CONTAIN AS MEMBER
  28. only sub infix:<∌>($a, $b --> Bool:D) is pure {
  29. $a !(cont) $b;
  30. }
  31. only sub infix:<(|)>(**@p) is pure {
  32. with @p.first(Mixy) {
  33. my $mixhash = nqp::istype(@p[0], MixHash)
  34. ?? MixHash.new-from-pairs(@p.shift.pairs)
  35. !! @p.shift.MixHash;
  36. for @p.map(*.Mix(:view)) -> $mix {
  37. for $mix.keys {
  38. # Handle negative weights: don't take max for keys that are zero
  39. $mixhash{$_} ?? ($mixhash{$_} max= $mix{$_})
  40. !! $mixhash{$_} = $mix{$_}
  41. }
  42. }
  43. $mixhash.Mix(:view);
  44. } orwith @p.first(Baggy) {
  45. my $baghash = nqp::istype(@p[0], BagHash)
  46. ?? BagHash.new-from-pairs(@p.shift.pairs)
  47. !! @p.shift.BagHash;
  48. for @p.map(*.Bag(:view)) -> $bag {
  49. $baghash{$_} max= $bag{$_} for $bag.keys;
  50. }
  51. $baghash.Bag(:view);
  52. } else {
  53. Set.new( @p.map(*.Set(:view).keys.Slip) );
  54. }
  55. }
  56. # U+222A UNION
  57. only sub infix:<∪>(|p) is pure {
  58. infix:<(|)>(|p);
  59. }
  60. only sub infix:<(&)>(**@p) is pure {
  61. return set() unless @p;
  62. with @p.first(Mixy) {
  63. my $mixhash = nqp::istype(@p[0], MixHash)
  64. ?? MixHash.new-from-pairs(@p.shift.pairs)
  65. !! @p.shift.MixHash;
  66. for @p.map(*.Mix(:view)) -> $mix {
  67. $mix{$_}
  68. ?? ($mixhash{$_} min= $mix{$_})
  69. !! $mixhash.DELETE-KEY($_)
  70. for $mixhash.keys;
  71. }
  72. $mixhash.Mix(:view);
  73. } orwith @p.first(Baggy) {
  74. my $baghash = nqp::istype(@p[0], BagHash)
  75. ?? BagHash.new-from-pairs(@p.shift.pairs)
  76. !! @p.shift.BagHash;
  77. for @p.map(*.Bag(:view)) -> $bag {
  78. $bag{$_}
  79. ?? ($baghash{$_} min= $bag{$_})
  80. !! $baghash.DELETE-KEY($_)
  81. for $baghash.keys;
  82. }
  83. $baghash.Bag(:view);
  84. } else {
  85. my $sethash = nqp::istype(@p[0], SetHash)
  86. ?? SetHash.new(@p.shift.keys)
  87. !! @p.shift.SetHash;
  88. for @p.map(*.Set(:view)) -> $set {
  89. $set{$_} || $sethash.DELETE-KEY($_) for $sethash.keys;
  90. }
  91. $sethash.Set(:view);
  92. }
  93. }
  94. # U+2229 INTERSECTION
  95. only sub infix:<∩>(|p) is pure {
  96. infix:<(&)>(|p);
  97. }
  98. only sub infix:<(-)>(**@p) is pure {
  99. return set() unless @p;
  100. with @p.first(Mixy) {
  101. my $mixhash = nqp::istype(@p[0], MixHash)
  102. ?? MixHash.new-from-pairs(@p.shift.pairs)
  103. !! @p.shift.MixHash;
  104. for @p.map(*.Mix(:view)) -> $mix {
  105. $mix{$_} < $mixhash{$_}
  106. ?? ($mixhash{$_} -= $mix{$_})
  107. !! $mixhash.DELETE-KEY($_)
  108. for $mixhash.keys;
  109. }
  110. $mixhash.Mix(:view);
  111. } orwith @p.first(Baggy) {
  112. my $baghash = nqp::istype(@p[0], BagHash)
  113. ?? BagHash.new-from-pairs(@p.shift.pairs)
  114. !! @p.shift.BagHash;
  115. for @p.map(*.Bag(:view)) -> $bag {
  116. $bag{$_} < $baghash{$_}
  117. ?? ($baghash{$_} -= $bag{$_})
  118. !! $baghash.DELETE-KEY($_)
  119. for $baghash.keys;
  120. }
  121. $baghash.Bag(:view);
  122. } else {
  123. my $sethash = nqp::istype(@p[0],SetHash)
  124. ?? SetHash.new(@p.shift.keys)
  125. !! @p.shift.SetHash;
  126. for @p.map(*.Set(:view)) -> $set {
  127. $set{$_} && $sethash.DELETE-KEY($_) for $sethash.keys;
  128. }
  129. $sethash.Set(:view);
  130. }
  131. }
  132. # U+2216 SET MINUS
  133. only sub infix:<∖>(|p) is pure {
  134. infix:<(-)>(|p);
  135. }
  136. only sub infix:<(^)>(**@p) is pure {
  137. return set() unless my $chain = @p.elems;
  138. if $chain == 1 {
  139. return @p[0];
  140. } elsif $chain == 2 {
  141. my ($a, $b) = @p;
  142. my $mixy-or-baggy = False;
  143. if nqp::istype($a, Mixy) || nqp::istype($b, Mixy) {
  144. ($a, $b) = $a.MixHash, $b.MixHash;
  145. $mixy-or-baggy = True;
  146. } elsif nqp::istype($a, Baggy) || nqp::istype($b, Baggy) {
  147. ($a, $b) = $a.BagHash, $b.BagHash;
  148. $mixy-or-baggy = True;
  149. }
  150. return $mixy-or-baggy
  151. # the set formula is not symmetric for bag/mix. this is.
  152. ?? ($a (-) $b) (+) ($b (-) $a)
  153. # set formula for the two-arg set.
  154. !! ($a (|) $b) (-) ($b (&) $a);
  155. } else {
  156. with @p.first(Mixy) || @p.first(Baggy) {
  157. my $head;
  158. while (@p) {
  159. my ($a, $b);
  160. if $head.defined {
  161. ($a, $b) = $head, @p.shift;
  162. } else {
  163. ($a, $b) = @p.shift, @p.shift;
  164. }
  165. if nqp::istype($a, Mixy) || nqp::istype($b, Mixy) {
  166. ($a, $b) = $a.MixHash, $b.MixHash;
  167. } elsif nqp::istype($a, Baggy) || nqp::istype($b, Baggy) {
  168. ($a, $b) = $a.BagHash, $b.BagHash;
  169. }
  170. $head = ($a (-) $b) (+) ($b (-) $a);
  171. }
  172. return $head;
  173. } else {
  174. return ([(+)] @p>>.Bag).grep(*.value == 1).Set;
  175. }
  176. }
  177. }
  178. # U+2296 CIRCLED MINUS
  179. only sub infix:<⊖>($a, $b) is pure {
  180. $a (^) $b;
  181. }
  182. multi sub infix:<eqv>(Setty:D \a, Setty:D \b) {
  183. nqp::p6bool(
  184. nqp::unless(
  185. nqp::eqaddr(a,b),
  186. nqp::eqaddr(a.WHAT,b.WHAT)
  187. && nqp::getattr(nqp::decont(a),a.WHAT,'%!elems')
  188. eqv nqp::getattr(nqp::decont(b),b.WHAT,'%!elems')
  189. )
  190. )
  191. }
  192. proto sub infix:<<(<=)>>($, $ --> Bool:D) is pure {*}
  193. multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) {
  194. $a.Set(:view) (<=) $b.Set(:view);
  195. }
  196. multi sub infix:<<(<=)>>(Setty $a, Setty $b --> Bool:D) {
  197. $a <= $b and so $a.keys.all (elem) $b
  198. }
  199. # U+2286 SUBSET OF OR EQUAL TO
  200. only sub infix:<⊆>($a, $b --> Bool:D) is pure {
  201. $a (<=) $b;
  202. }
  203. # U+2288 NEITHER A SUBSET OF NOR EQUAL TO
  204. only sub infix:<⊈>($a, $b --> Bool:D) is pure {
  205. $a !(<=) $b;
  206. }
  207. proto sub infix:<<(<)>>($, $ --> Bool:D) is pure {*}
  208. multi sub infix:<<(<)>>(Any $a, Any $b --> Bool:D) {
  209. $a.Set(:view) (<) $b.Set(:view);
  210. }
  211. multi sub infix:<<(<)>>(Setty $a, Setty $b --> Bool:D) {
  212. $a < $b and so $a.keys.all (elem) $b;
  213. }
  214. # U+2282 SUBSET OF
  215. only sub infix:<⊂>($a, $b --> Bool:D) is pure {
  216. $a (<) $b;
  217. }
  218. # U+2284 NOT A SUBSET OF
  219. only sub infix:<⊄>($a, $b --> Bool:D) is pure {
  220. $a !(<) $b;
  221. }
  222. proto sub infix:<<(>=)>>($, $ --> Bool:D) is pure {*}
  223. multi sub infix:<<(>=)>>(Any $a, Any $b --> Bool:D) {
  224. $a.Set(:view) (>=) $b.Set(:view);
  225. }
  226. multi sub infix:<<(>=)>>(Setty $a, Setty $b --> Bool:D) {
  227. $a >= $b and so $b.keys.all (elem) $a;
  228. }
  229. # U+2287 SUPERSET OF OR EQUAL TO
  230. only sub infix:<⊇>($a, $b --> Bool:D) is pure {
  231. $a (>=) $b;
  232. }
  233. # U+2289 NEITHER A SUPERSET OF NOR EQUAL TO
  234. only sub infix:<⊉>($a, $b --> Bool:D) is pure {
  235. $a !(>=) $b;
  236. }
  237. proto sub infix:<<(>)>>($, $ --> Bool:D) is pure {*}
  238. multi sub infix:<<(>)>>(Any $a, Any $b --> Bool:D) {
  239. $a.Set(:view) (>) $b.Set(:view);
  240. }
  241. multi sub infix:<<(>)>>(Setty $a, Setty $b --> Bool:D) {
  242. $a > $b and so $b.keys.all (elem) $a;
  243. }
  244. # U+2283 SUPERSET OF
  245. only sub infix:<⊃>($a, $b --> Bool:D) is pure {
  246. $a (>) $b;
  247. }
  248. # U+2285 NOT A SUPERSET OF
  249. only sub infix:<⊅>($a, $b --> Bool:D) is pure {
  250. $a !(>) $b;
  251. }
  252. only sub infix:<(.)>(**@p) is pure {
  253. return bag() unless @p;
  254. with @p.first(Mixy) {
  255. my $mixhash = nqp::istype(@p[0], MixHash)
  256. ?? MixHash.new-from-pairs(@p.shift.pairs)
  257. !! @p.shift.MixHash;
  258. for @p.map(*.Mix(:view)) -> $mix {
  259. $mix{$_}
  260. ?? ($mixhash{$_} *= $mix{$_})
  261. !! $mixhash.DELETE-KEY($_)
  262. for $mixhash.keys;
  263. }
  264. $mixhash.Mix(:view);
  265. } else { # go Baggy by default
  266. my $baghash = nqp::istype(@p[0], BagHash)
  267. ?? BagHash.new-from-pairs(@p.shift.pairs)
  268. !! @p.shift.BagHash;
  269. for @p.map(*.Bag(:view)) -> $bag {
  270. $bag{$_}
  271. ?? ($baghash{$_} *= $bag{$_})
  272. !! $baghash.DELETE-KEY($_)
  273. for $baghash.keys;
  274. }
  275. $baghash.Bag(:view);
  276. }
  277. }
  278. # U+228D MULTISET MULTIPLICATION
  279. only sub infix:<⊍>(|p) is pure {
  280. infix:<(.)>(|p);
  281. }
  282. only sub infix:<(+)>(**@p) is pure {
  283. return bag() unless @p;
  284. with @p.first(Mixy) {
  285. my $mixhash = nqp::istype(@p[0], MixHash)
  286. ?? MixHash.new-from-pairs(@p.shift.pairs)
  287. !! @p.shift.MixHash;
  288. for @p.map(*.Mix(:view)) -> $mix {
  289. $mixhash{$_} += $mix{$_} for $mix.keys;
  290. }
  291. $mixhash.Mix(:view);
  292. } else { # go Baggy by default
  293. my $baghash = nqp::istype(@p[0], BagHash)
  294. ?? BagHash.new-from-pairs(@p.shift.pairs)
  295. !! @p.shift.BagHash;
  296. for @p.map(*.Bag(:view)) -> $bag {
  297. $baghash{$_} += $bag{$_} for $bag.keys;
  298. }
  299. $baghash.Bag(:view);
  300. }
  301. }
  302. # U+228E MULTISET UNION
  303. only sub infix:<⊎>(|p) is pure {
  304. infix:<(+)>(|p);
  305. }
  306. proto sub infix:<<(<+)>>($, $ --> Bool:D) is pure {*}
  307. multi sub infix:<<(<+)>>(Any $a, Any $b --> Bool:D) {
  308. if nqp::istype($a, Mixy) or nqp::istype($b, Mixy) {
  309. $a.Mix(:view) (<+) $b.Mix(:view);
  310. } else {
  311. $a.Bag(:view) (<+) $b.Bag(:view);
  312. }
  313. }
  314. multi sub infix:<<(<+)>>(QuantHash:U $a, QuantHash:U $b --> True ) {}
  315. multi sub infix:<<(<+)>>(QuantHash:U $a, QuantHash:D $b --> True ) {}
  316. multi sub infix:<<(<+)>>(QuantHash:D $a, QuantHash:U $b --> Bool:D ) {
  317. not $a.keys;
  318. }
  319. multi sub infix:<<(<+)>>(QuantHash:D $a, QuantHash:D $b --> Bool:D ) {
  320. for $a.keys {
  321. return False if $a{$_} > $b{$_};
  322. }
  323. True;
  324. }
  325. # U+227C PRECEDES OR EQUAL TO
  326. only sub infix:<≼>($a, $b --> Bool:D) is pure {
  327. $a (<+) $b;
  328. }
  329. proto sub infix:<<(>+)>>($, $ --> Bool:D) is pure {*}
  330. multi sub infix:<<(>+)>>(QuantHash:U $a, QuantHash:U $b --> True ) {}
  331. multi sub infix:<<(>+)>>(QuantHash:D $a, QuantHash:U $b --> True ) {}
  332. multi sub infix:<<(>+)>>(QuantHash:U $a, QuantHash:D $b --> Bool:D ) {
  333. not $b.keys;
  334. }
  335. multi sub infix:<<(>+)>>(QuantHash:D $a, QuantHash:D $b --> Bool:D) {
  336. for $b.keys {
  337. return False if $b{$_} > $a{$_};
  338. }
  339. True;
  340. }
  341. multi sub infix:<<(>+)>>(Any $a, Any $b --> Bool:D) {
  342. if nqp::istype($a, Mixy) or nqp::istype($b, Mixy) {
  343. $a.Mix(:view) (>+) $b.Mix(:view);
  344. } else {
  345. $a.Bag(:view) (>+) $b.Bag(:view);
  346. }
  347. }
  348. # U+227D SUCCEEDS OR EQUAL TO
  349. only sub infix:<≽>($a, $b --> Bool:D) is pure {
  350. $a (>+) $b;
  351. }
  352. sub set(*@a --> Set:D) { Set.new(@a) }
  353. sub bag(*@a --> Bag:D) { Bag.new(@a) }
  354. sub mix(*@a --> Mix:D) { Mix.new(@a) }