module Funcons.Operations.Multisets where

import Funcons.Operations.Booleans
import Funcons.Operations.Internal

import qualified Data.MultiSet as MS

library :: (HasValues t, Ord t) => Library t
library :: Library t
library = [(OP, ValueOp t)] -> Library t
forall t. [(OP, ValueOp t)] -> Library t
libFromList [
    (OP
"multisets", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
Funcons.Operations.Multisets.multisets)  
  , (OP
"multiset", NaryExpr t -> ValueOp t
forall t. NaryExpr t -> ValueOp t
NaryExpr NaryExpr t
forall t. (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
multiset_)
  , (OP
"multiset-elements", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
multiset_elements)
  , (OP
"multiset-occurrences", BinaryExpr t -> ValueOp t
forall t. BinaryExpr t -> ValueOp t
BinaryExpr BinaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_occurrences)
  , (OP
"multiset-insert", BinaryExpr t -> ValueOp t
forall t. BinaryExpr t -> ValueOp t
BinaryExpr BinaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_insert)
  , (OP
"multiset-delete", TernaryExpr t -> ValueOp t
forall t. TernaryExpr t -> ValueOp t
TernaryExpr TernaryExpr t
forall t.
(Ord t, HasValues t) =>
OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
multiset_delete)
  , (OP
"is-submultiset", BinaryExpr t -> ValueOp t
forall t. BinaryExpr t -> ValueOp t
BinaryExpr BinaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
is_submultiset)
  ]

multisets_ :: HasValues t => [OpExpr t] -> OpExpr t
multisets_ :: [OpExpr t] -> OpExpr t
multisets_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
Funcons.Operations.Multisets.multisets
multisets :: HasValues t => OpExpr t -> OpExpr t
multisets :: OpExpr t -> OpExpr t
multisets = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"multisets" UnaryVOp t
forall t. HasValues t => Values t -> Result t
op   
  where op :: Values t -> Result t
op (ComputationType (Type Types t
t)) = 
          t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t -> Types t
forall t. HasValues t => Types t -> Types t
Funcons.Operations.Internal.multisets Types t
t
        op Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"multisets not applied to a type" 

multiset_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
multiset_ :: [OpExpr t] -> OpExpr t
multiset_ = OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
forall t. HasValues t => OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
vNaryOp OP
"multiset" NaryVOp t
forall t. (HasValues t, Ord t) => [Values t] -> Result t
op
  where op :: [Values t] -> Result t
op [Values t]
vs = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ MultiSet (Values t) -> Values t
forall t. MultiSet (Values t) -> Values t
Multiset ([Values t] -> MultiSet (Values t)
forall a. Ord a => [a] -> MultiSet a
MS.fromList [Values t]
vs)

multiset_elements_ :: HasValues t => [OpExpr t] -> OpExpr t
multiset_elements_ :: [OpExpr t] -> OpExpr t
multiset_elements_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
multiset_elements
multiset_elements :: HasValues t => OpExpr t -> OpExpr t
multiset_elements :: OpExpr t -> OpExpr t
multiset_elements = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"multiset-elements" UnaryVOp t
forall t. HasValues t => Values t -> Result t
op
 where op :: Values t -> Result t
op (Multiset MultiSet (Values t)
s) = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ [t] -> Values t
forall t. HasValues t => [t] -> Values t
multi ([t] -> Values t) -> [t] -> Values t
forall a b. (a -> b) -> a -> b
$ (Values t -> t) -> [Values t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> t
forall t. HasValues t => Values t -> t
inject ([Values t] -> [t]) -> [Values t] -> [t]
forall a b. (a -> b) -> a -> b
$ MultiSet (Values t) -> [Values t]
forall a. MultiSet a -> [a]
MS.toList MultiSet (Values t)
s
       op Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"multiset-elements not applied to a multiset"

multiset_occurrences_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
multiset_occurrences_ :: [OpExpr t] -> OpExpr t
multiset_occurrences_ = BinaryExpr t -> [OpExpr t] -> OpExpr t
forall t. BinaryExpr t -> [OpExpr t] -> OpExpr t
binaryOp BinaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_occurrences
multiset_occurrences :: (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_occurrences :: OpExpr t -> OpExpr t -> OpExpr t
multiset_occurrences = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"multiset-occurrences" BinaryVOp t
forall t t.
(HasValues t, Ord t) =>
Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Result t
op Values t
v (Multiset MultiSet (Values t)
ms) = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Integer -> Values t
forall t. Integer -> Values t
Int Integer
count 
          where count :: Integer
count = Occur -> Integer
forall a. Integral a => a -> Integer
toInteger (Occur -> Integer) -> Occur -> Integer
forall a b. (a -> b) -> a -> b
$ Values t -> MultiSet (Values t) -> Occur
forall a. Ord a => a -> MultiSet a -> Occur
MS.occur Values t
v MultiSet (Values t)
ms 
        op Values t
_ Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"multiset-occurrences not applied to a value and a multiset"

multiset_insert_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
multiset_insert_ :: [OpExpr t] -> OpExpr t
multiset_insert_ = BinaryExpr t -> [OpExpr t] -> OpExpr t
forall t. BinaryExpr t -> [OpExpr t] -> OpExpr t
binaryOp BinaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_insert
multiset_insert :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
multiset_insert :: OpExpr t -> OpExpr t -> OpExpr t
multiset_insert = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"multiset-insert" BinaryVOp t
forall t. (HasValues t, Ord t) => Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Result t
op Values t
e (Multiset MultiSet (Values t)
s) = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ MultiSet (Values t) -> Values t
forall t. MultiSet (Values t) -> Values t
Multiset (Values t
e Values t -> MultiSet (Values t) -> MultiSet (Values t)
forall a. Ord a => a -> MultiSet a -> MultiSet a
`MS.insert` MultiSet (Values t)
s)
        op Values t
_ Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"second argument of multiset-insert is not a multiset"

multiset_delete_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
multiset_delete_ :: [OpExpr t] -> OpExpr t
multiset_delete_ = TernaryExpr t -> [OpExpr t] -> OpExpr t
forall t. TernaryExpr t -> [OpExpr t] -> OpExpr t
ternaryOp TernaryExpr t
forall t.
(Ord t, HasValues t) =>
OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
multiset_delete
multiset_delete :: (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
multiset_delete :: OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
multiset_delete = OP -> TernaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> TernaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
vTernaryOp OP
"multiset-delete" TernaryVOp t
forall t t.
(HasValues t, Ord t) =>
Values t -> Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Values t -> Result t
op (Multiset MultiSet (Values t)
s) Values t
gv Values t
x | Nat Integer
n <- Values t -> Values t
forall t. Values t -> Values t
upcastNaturals Values t
x
          = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ MultiSet (Values t) -> Values t
forall t. MultiSet (Values t) -> Values t
Multiset (Values t -> Occur -> MultiSet (Values t) -> MultiSet (Values t)
forall a. Ord a => a -> Occur -> MultiSet a -> MultiSet a
MS.deleteMany Values t
gv (Integer -> Occur
forall a. Num a => Integer -> a
fromInteger Integer
n) MultiSet (Values t)
s)
        op Values t
_ Values t
_ Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"multiset-delete not applied to a multiset, a potential element, and a natural number"

is_submultiset_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
is_submultiset_ :: [OpExpr t] -> OpExpr t
is_submultiset_ = BinaryExpr t -> [OpExpr t] -> OpExpr t
forall t. BinaryExpr t -> [OpExpr t] -> OpExpr t
binaryOp BinaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
is_submultiset
is_submultiset :: (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t
is_submultiset :: OpExpr t -> OpExpr t -> OpExpr t
is_submultiset = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"is-submultiset" BinaryVOp t
forall t t.
(HasValues t, Ord t) =>
Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Result t
op (Multiset MultiSet (Values t)
s1) (Multiset MultiSet (Values t)
s2) = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Bool -> Values t
forall t. Bool -> Values t
tobool (MultiSet (Values t)
s1 MultiSet (Values t) -> MultiSet (Values t) -> Bool
forall a. Ord a => MultiSet a -> MultiSet a -> Bool
`MS.isSubsetOf` MultiSet (Values t)
s2)
        op Values t
_ Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"is-submultiset not applied to two multisets"