{-# LANGUAGE OverloadedStrings #-}

module Funcons.Operations.Maps where

import Funcons.Operations.Booleans
import Funcons.Operations.Internal
import Funcons.Operations.Sets
import qualified Data.Map as M
import qualified Data.Set as S 
import Data.Maybe (fromJust)

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
"map-empty", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
map_empty)
  , (OP
"map-singleton", 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
map_singleton)
  , (OP
"is-map-empty", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
is_map_empty)
  , (OP
"map-insert", TernaryExpr t -> ValueOp t
forall t. TernaryExpr t -> ValueOp t
TernaryExpr TernaryExpr t
forall t.
(HasValues t, Ord t) =>
OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
map_insert)
  , (OP
"map-lookup", 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
map_lookup)
  , (OP
"lookup", 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
map_lookup)
  , (OP
"map-domain", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain)
  , (OP
"domain", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain)
  , (OP
"dom", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain)
  , (OP
"map-delete", 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
map_delete)
  , (OP
"is-in-domain", 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_in_domain)
  , (OP
"map-unite", NaryExpr t -> ValueOp t
forall t. NaryExpr t -> ValueOp t
NaryExpr NaryExpr t
forall t. (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_unite)
  , (OP
"map-override", NaryExpr t -> ValueOp t
forall t. NaryExpr t -> ValueOp t
NaryExpr NaryExpr t
forall t. (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_override_)
  , (OP
"maps", BinaryExpr t -> ValueOp t
forall t. BinaryExpr t -> ValueOp t
BinaryExpr BinaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t -> OpExpr t
Funcons.Operations.Maps.maps)
  , (OP
"map", NaryExpr t -> ValueOp t
forall t. NaryExpr t -> ValueOp t
NaryExpr NaryExpr t
forall t. (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
map_)
  , (OP
"map-elements", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t
map_elements)
  ]

map_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
map_ :: [OpExpr t] -> OpExpr t
map_ = OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
forall t. HasValues t => OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
vNaryOp OP
"map" NaryVOp t
forall t. (Ord t, HasValues t) => [Values t] -> Result t
op
  where op :: [Values t] -> Result t
op [Values t]
vs | Bool
areBindings, Bool
allDistinct = 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
$ ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map (ValueMaps (Values t) -> Values t)
-> ValueMaps (Values t) -> Values t
forall a b. (a -> b) -> a -> b
$ ([Values t] -> [Values t] -> [Values t])
-> [(Values t, [Values t])] -> ValueMaps (Values t)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [Values t] -> [Values t] -> [Values t]
forall a b. a -> b -> a
const [(Values t, [Values t])]
assocs
              | Bool -> Bool
not (Bool
areBindings)  = OP -> Result t
forall t. OP -> Result t
SortErr OP
"map not applied to pairs"
              | Bool
otherwise       = 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
forall t. Values t
null_value__ 
          where areBindings :: Bool
areBindings   = (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. HasValues t => Values t -> Bool
isBinding [Values t]
vs
                  where isBinding :: Values t -> Bool
isBinding (ADTVal Name
"tuple" (t
k:[t]
vs))
                          | Just Values t
_ <- t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project t
k
                          , Just [Values t]
_ <- (t -> Maybe (Values t)) -> [t] -> Maybe [Values t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project [t]
vs = Bool
True
                        isBinding Values t
_                   = Bool
False
                assocs :: [(Values t, [Values t])]
assocs     = (Values t -> (Values t, [Values t]))
-> [Values t] -> [(Values t, [Values t])]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> (Values t, [Values t])
forall t. HasValues t => Values t -> (Values t, [Values t])
mkBinding [Values t]
vs
                  where mkBinding :: Values t -> (Values t, [Values t])
mkBinding (ADTVal Name
"tuple" (t
k:[t]
vs)) = 
                          (Maybe (Values t) -> Values t
forall a. HasCallStack => Maybe a -> a
fromJust (t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project t
k), (t -> Values t) -> [t] -> [Values t]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values t) -> Values t
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values t) -> Values t)
-> (t -> Maybe (Values t)) -> t -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project) [t]
vs)
                        mkBinding Values t
_ = OP -> (Values t, [Values t])
forall a. HasCallStack => OP -> a
error OP
"assert: map$mkBinding"
                allDistinct :: Bool
allDistinct = [Values t] -> Bool
forall a. Ord a => [a] -> Bool
recDistinct (((Values t, [Values t]) -> Values t)
-> [(Values t, [Values t])] -> [Values t]
forall a b. (a -> b) -> [a] -> [b]
map (Values t, [Values t]) -> Values t
forall a b. (a, b) -> a
fst [(Values t, [Values t])]
assocs)
                  where recDistinct :: [a] -> Bool
recDistinct [] = Bool
True
                        recDistinct (a
k:[a]
ks) = Bool -> Bool
not (a
k a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
ks))
                                             Bool -> Bool -> Bool
&& [a] -> Bool
recDistinct [a]
ks    
  
maps_ :: HasValues t => [OpExpr t] -> OpExpr t
maps_ :: [OpExpr t] -> OpExpr t
maps_ = BinaryExpr t -> [OpExpr t] -> OpExpr t
forall t. BinaryExpr t -> [OpExpr t] -> OpExpr t
binaryOp BinaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t -> OpExpr t
Funcons.Operations.Maps.maps
maps :: HasValues t => OpExpr t -> OpExpr t -> OpExpr t
maps :: OpExpr t -> OpExpr t -> OpExpr t
maps = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"maps" BinaryVOp t
forall t. HasValues t => Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Result t
op Values t
t1 Values t
t2 = 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 (t -> t -> Types t
forall t. HasValues t => t -> t -> Types t
Funcons.Operations.Internal.maps (Values t -> t
forall t. HasValues t => Values t -> t
inject Values t
t1) (Values t -> t
forall t. HasValues t => Values t -> t
inject Values t
t2))

map_empty_ :: HasValues t => [OpExpr t] -> OpExpr t 
map_empty_ :: [OpExpr t] -> OpExpr t
map_empty_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
map_empty
map_empty :: HasValues t => OpExpr t 
map_empty :: OpExpr t
map_empty = OP -> NullaryOp t -> OpExpr t
forall t. OP -> NullaryOp t -> OpExpr t
NullaryOp OP
"map-empty" (t -> NullaryOp t
forall t. t -> Result t
Normal (t -> NullaryOp t) -> t -> NullaryOp t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map ValueMaps (Values t)
forall k a. Map k a
M.empty))

map_singleton_ :: (HasValues t,Ord t) => [OpExpr t] -> OpExpr t
map_singleton_ :: [OpExpr t] -> OpExpr t
map_singleton_ = 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
map_singleton
map_singleton :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t 
map_singleton :: OpExpr t -> OpExpr t -> OpExpr t
map_singleton OpExpr t
k OpExpr t
v = OP -> OpExpr t -> [OpExpr t] -> OpExpr t
forall t. OP -> OpExpr t -> [OpExpr t] -> OpExpr t
RewritesTo OP
"map-insert" (OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
(HasValues t, Ord t) =>
OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
map_insert OpExpr t
forall t. HasValues t => OpExpr t
map_empty OpExpr t
k OpExpr t
v) [OpExpr t
k,OpExpr t
v]

is_map_empty_ :: HasValues t => [OpExpr t] -> OpExpr t
is_map_empty_ :: [OpExpr t] -> OpExpr t
is_map_empty_ = 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
is_map_empty
is_map_empty :: HasValues t => OpExpr t -> OpExpr t 
is_map_empty :: OpExpr t -> OpExpr t
is_map_empty = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"is-map-empty" UnaryVOp t
forall t t. HasValues t => Values t -> Result t
op 
  where op :: Values t -> Result t
op (Map ValueMaps (Values t)
m)  = 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 (ValueMaps (Values t) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ValueMaps (Values t)
m)
        op Values t
_        = OP -> Result t
forall t. OP -> Result t
SortErr OP
"is-map-empty(M) not applied to a map"

map_insert_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_insert_ :: [OpExpr t] -> OpExpr t
map_insert_ = TernaryExpr t -> [OpExpr t] -> OpExpr t
forall t. TernaryExpr t -> [OpExpr t] -> OpExpr t
ternaryOp TernaryExpr t
forall t.
(HasValues t, Ord t) =>
OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
map_insert 
map_insert :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
map_insert :: OpExpr t -> OpExpr t -> OpExpr t -> OpExpr t
map_insert = 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
"map-insert" TernaryVOp t
forall 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 Values t
xv Values t
k Values t
v = case Values t
xv of 
              Map ValueMaps (Values t)
m -> 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
$ ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map (Values t
-> [Values t] -> ValueMaps (Values t) -> ValueMaps (Values t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Values t
k [Values t
v] ValueMaps (Values t)
m)
              Values t
_     -> OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-insert(M,K,V) not applied to a map (first argument)"

map_lookup_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_lookup_ :: [OpExpr t] -> OpExpr t
map_lookup_ = 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
map_lookup
map_lookup :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
map_lookup :: OpExpr t -> OpExpr t -> OpExpr t
map_lookup = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"map-lookup" 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
xv Values t
k = case Values t
xv of 
                    Map ValueMaps (Values t)
m -> 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
$ [Values t] -> Values t
forall t. HasValues t => [Values t] -> Values t
multi_ ([Values t] -> Values t) -> [Values t] -> Values t
forall a b. (a -> b) -> a -> b
$ [Values t]
-> ([Values t] -> [Values t]) -> Maybe [Values t] -> [Values t]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Values t] -> [Values t]
forall a. a -> a
id (Maybe [Values t] -> [Values t]) -> Maybe [Values t] -> [Values t]
forall a b. (a -> b) -> a -> b
$ Values t -> ValueMaps (Values t) -> Maybe [Values t]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Values t
k ValueMaps (Values t)
m 
                    Values t
_ -> OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-lookup(M,V) not applied to a map and a value"

map_delete_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_delete_ :: [OpExpr t] -> OpExpr t
map_delete_ = 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
map_delete
map_delete :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
map_delete :: OpExpr t -> OpExpr t -> OpExpr t
map_delete = OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
forall t.
HasValues t =>
OP -> BinaryVOp t -> OpExpr t -> OpExpr t -> OpExpr t
vBinaryOp OP
"map-delete" BinaryVOp t
forall t. (HasValues t, Ord t) => Values t -> Values t -> Result t
op
  where op :: Values t -> Values t -> Result t
op (Map ValueMaps (Values t)
m) (Set ValueSets (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
$ ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map ((Values t -> ValueMaps (Values t) -> ValueMaps (Values t))
-> ValueMaps (Values t)
-> ValueSets (Values t)
-> ValueMaps (Values t)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Values t -> ValueMaps (Values t) -> ValueMaps (Values t)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ValueMaps (Values t)
m ValueSets (Values t)
s)
        op Values t
_ Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-delete(M,S) not applied to a map and a set"

is_in_domain_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t 
is_in_domain_ :: [OpExpr t] -> OpExpr t
is_in_domain_ = 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_in_domain
is_in_domain :: (Ord t, HasValues t) => OpExpr t -> OpExpr t -> OpExpr t 
is_in_domain :: OpExpr t -> OpExpr t -> OpExpr t
is_in_domain OpExpr t
x OpExpr t
y = OP -> OpExpr t -> [OpExpr t] -> OpExpr t
forall t. OP -> OpExpr t -> [OpExpr t] -> OpExpr t
RewritesTo OP
"is-in-domain" (OpExpr t -> OpExpr t -> OpExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t
is_in_set OpExpr t
x (OpExpr t -> OpExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain OpExpr t
y)) [OpExpr t
x,OpExpr t
y] 

domain_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
domain_ :: [OpExpr t] -> OpExpr t
domain_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain
domain :: (HasValues t, Ord t) => OpExpr t -> OpExpr t
domain :: OpExpr t -> OpExpr t
domain = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"domain" UnaryVOp t
forall t. (HasValues t, Ord t) => Values t -> Result t
op
  where op :: Values t -> Result t
op (Map ValueMaps (Values t)
m)  = 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
$ ValueSets (Values t) -> Values t
forall t. ValueSets (Values t) -> Values t
Set (ValueSets (Values t) -> Values t)
-> ValueSets (Values t) -> Values t
forall a b. (a -> b) -> a -> b
$ [Values t] -> ValueSets (Values t)
forall a. Ord a => [a] -> Set a
S.fromList ([Values t] -> ValueSets (Values t))
-> [Values t] -> ValueSets (Values t)
forall a b. (a -> b) -> a -> b
$ ValueMaps (Values t) -> [Values t]
forall k a. Map k a -> [k]
M.keys ValueMaps (Values t)
m
        op Values t
_        = OP -> Result t
forall t. OP -> Result t
SortErr OP
"domain(M) not applied to a map"

map_override_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_override_ :: [OpExpr t] -> OpExpr t
map_override_ = OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
forall t. HasValues t => OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
vNaryOp OP
"map-override" NaryVOp t
forall t. (HasValues t, Ord t) => [Values t] -> Result t
op
  where op :: [Values t] -> Result t
op [Values t]
vs | (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. Values t -> Bool
isMap [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
$ ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map ([ValueMaps (Values t)] -> ValueMaps (Values t)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ((Values t -> ValueMaps (Values t))
-> [Values t] -> [ValueMaps (Values t)]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> ValueMaps (Values t)
forall t. Values t -> ValueMaps (Values t)
toMap [Values t]
vs))
        op [Values t]
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-override not applied to maps"

map_unite_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_unite_ :: [OpExpr t] -> OpExpr t
map_unite_ = [OpExpr t] -> OpExpr t
forall t. (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_unite 
map_unite :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t
map_unite :: [OpExpr t] -> OpExpr t
map_unite = OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
forall t. HasValues t => OP -> NaryVOp t -> [OpExpr t] -> OpExpr t
vNaryOp OP
"map-unite" NaryVOp t
forall t. (Ord t, HasValues t) => [Values t] -> Result t
op
  where op :: [Values t] -> Result t
op [Values t]
args 
          | (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. Values t -> Bool
isMap [Values t]
args =
              let maps :: [ValueMaps (Values t)]
maps = (Values t -> ValueMaps (Values t))
-> [Values t] -> [ValueMaps (Values t)]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> ValueMaps (Values t)
forall t. Values t -> ValueMaps (Values t)
toMap [Values t]
args
                  domains :: [Set (Values t)]
domains = (ValueMaps (Values t) -> Set (Values t))
-> [ValueMaps (Values t)] -> [Set (Values t)]
forall a b. (a -> b) -> [a] -> [b]
map (ValueMaps (Values t) -> Set (Values t)
forall k a. Map k a -> Set k
M.keysSet) [ValueMaps (Values t)]
maps
              in if ((Set (Values t), Set (Values t)) -> Bool)
-> [(Set (Values t), Set (Values t))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set (Values t) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set (Values t) -> Bool)
-> ((Set (Values t), Set (Values t)) -> Set (Values t))
-> (Set (Values t), Set (Values t))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Values t) -> Set (Values t) -> Set (Values t))
-> (Set (Values t), Set (Values t)) -> Set (Values t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Set (Values t) -> Set (Values t) -> Set (Values t)
forall a. Ord a => Set a -> Set a -> Set a
S.intersection) ([Set (Values t)] -> [(Set (Values t), Set (Values t))]
forall a. [a] -> [(a, a)]
allDomainPairs [Set (Values t)]
domains)
                  then 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
$ ValueMaps (Values t) -> Values t
forall t. ValueMaps (Values t) -> Values t
Map (ValueMaps (Values t) -> Values t)
-> ValueMaps (Values t) -> Values t
forall a b. (a -> b) -> a -> b
$ [ValueMaps (Values t)] -> ValueMaps (Values t)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [ValueMaps (Values t)]
maps
                  else 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
forall t. Values t
null__ 
          | Bool
otherwise     = OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-unite(M1,...,Mn) not applied to maps"

toMap :: Values t -> ValueMaps (Values t)
toMap (Map ValueMaps (Values t)
m) = ValueMaps (Values t)
m
toMap Values t
_       = OP -> ValueMaps (Values t)
forall a. HasCallStack => OP -> a
error OP
"map_unite"

allDomainPairs :: [a] -> [(a,a)] 
allDomainPairs :: [a] -> [(a, a)]
allDomainPairs (a
x:[a]
xs) = [ (a
x,a
y)  | a
y <- [a]
xs ] [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
allDomainPairs [a]
xs
allDomainPairs [] = []

map_elements_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t
map_elements_ :: [OpExpr t] -> OpExpr t
map_elements_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. (Ord t, HasValues t) => OpExpr t -> OpExpr t
map_elements
map_elements :: (Ord t, HasValues t) => OpExpr t -> OpExpr t
map_elements :: OpExpr t -> OpExpr t
map_elements = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"map-elements" UnaryVOp t
forall t. HasValues t => Values t -> Result t
op
  where op :: Values t -> Result t
op (Map ValueMaps (Values t)
m) = 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
$ (Values t -> [Values t] -> [Values t] -> [Values t])
-> [Values t] -> ValueMaps (Values t) -> [Values t]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey Values t -> [Values t] -> [Values t] -> [Values t]
forall t.
HasValues t =>
Values t -> [Values t] -> [Values t] -> [Values t]
combine [] ValueMaps (Values t)
m
          where combine :: Values t -> [Values t] -> [Values t] -> [Values t]
combine Values t
k [Values t]
vs [Values t]
ls = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"tuple" (Values t -> t
forall t. HasValues t => Values t -> t
inject Values t
k t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (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]
vs)Values t -> [Values t] -> [Values t]
forall a. a -> [a] -> [a]
:[Values t]
ls
        op Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"map-elements not applied to a map"