{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Values.Composite.Collections.Multisets where

import Funcons.EDSL
import Funcons.Core.Values.Primitive.BoolBuiltin

import qualified Data.MultiSet as MS

library = libFromList [
        ("multiset-empty", NullaryFuncon (rewritten (Multiset MS.empty)))
    ,   ("sets-to-multisets", ValueOp stepSetsToMultisets)
    ,   ("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"
stepSetsToMultisets 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"