{-# LANGUAGE OverloadedStrings #-}
module Funcons.Core.Values.Composite.MultisetsBuiltin where
import Funcons.EDSL
import Funcons.Operations hiding (Values)
import Funcons.Core.Values.Primitive.BoolBuiltin
import qualified Data.MultiSet as MS
library = libFromList [
("multiset-empty", NullaryFuncon (rewritten (Multiset MS.empty)))
, ("sets-to-multiset", ValueOp stepSetsToMultiset)
, ("multiset-to-set", ValueOp stepMultisetToSet)
, ("multiset-occurrences", ValueOp stepMultisetOccurrences)
, ("multiset-insert", ValueOp stepMultisetInsert)
, ("multiset-delete", ValueOp stepMultisetDelete)
, ("is-submultiset", ValueOp stepIsSubMultiset)
]
is_sub_multiset = applyFuncon "is-sub-multiset"
stepIsSubMultiset [Multiset s1, Multiset s2] =
rewriteTo $ FValue $ tobool (s1 `MS.isSubsetOf`s2)
stepIsSubMultiset vs = sortErr (is_sub_multiset (map FValue vs))
"is-sub-multiset not applied to two multisets"
multiset_delete = applyFuncon "multiset-delete"
stepMultisetDelete [Multiset ms, v, vn]
| Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.deleteMany v (fromInteger n) ms)
stepMultisetDelete vs = sortErr (multiset_delete (map FValue vs))
"multiset-delete not applied to a multiset, value and natural number"
multiset_insert = applyFuncon "multiset-insert"
stepMultisetInsert [v, vn, Multiset ms]
| Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.insertMany v (fromInteger n) ms)
stepMultisetInsert vs = sortErr (multiset_insert (map FValue vs))
"multiset-insert not applied to a value, natural number and multiset"
multiset_occurrences = applyFuncon "multiset-occurrences"
stepMultisetOccurrences [v, Multiset ms] = rewriteTo $ int_ (MS.occur v ms)
stepMultisetOccurrences vs = sortErr (multiset_occurrences (map FValue vs))
"multiset-occurrences not applied to a value and a multiset"
multiset_to_set = applyFuncon "multiset-to-set"
stepMultisetToSet [Multiset ms] = rewriteTo $ FValue $ Set (MS.toSet ms)
stepMultisetToSet vs = sortErr (multiset_to_set (map FValue vs))
"multiset-to-set not applied to a multiset"
sets_to_multiset = applyFuncon "sets-to-multiset"
stepSetsToMultiset vs
| all isSet_ vs = rewriteTo $ FValue $ Multiset (MS.unions (map toMS vs))
| otherwise = sortErr (sets_to_multiset (map FValue vs))
"sets-to-multiset not applied to sets"
where isSet_ (Set _) = True
isSet_ _ = False
toMS (Set s) = MS.fromSet s
toMS _ = error "sets-to-multiset"