{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Iterate.SetAlgebra where
import Cardano.Binary
( Decoder,
FromCBOR (..),
ToCBOR (..),
decodeListLen,
decodeMapSkel,
dropMap,
)
import Codec.CBOR.Encoding (encodeListLen)
import Control.DeepSeq (NFData (rnf))
import Control.Iterate.Collect
import Control.Monad (void)
import Data.Coders (invalidKey)
import Data.List (sortBy)
import qualified Data.List as List
import Data.Map.Internal (Map (..), link, link2)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..))
import Text.PrettyPrint.ANSI.Leijen (Doc, align, parens, text, vsep, (<+>))
import Prelude hiding (lookup)
class Iter f => Basic f where
addpair:: (Ord k) => k -> v -> f k v -> f k v
addpair k
k v
v f k v
f = (k, v) -> f k v -> (v -> v -> v) -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) f k v
f (\ v
_old v
new -> v
new)
addkv :: Ord k => (k,v) -> f k v -> (v -> v -> v) -> f k v
removekey:: (Ord k) => k -> f k v -> f k v
domain:: Ord k => f k v -> Set k
range:: Ord v => f k v -> Set v
emptyc:: Ord k => f k v
emptyc = [Char] -> f k v
forall a. HasCallStack => [Char] -> a
error ([Char]
"emptyc only works on some types.")
instance Basic List where
addkv :: (k, v) -> List k v -> (v -> v -> v) -> List k v
addkv (k
k,v
v) (UnSafeList [(k, v)]
xs) v -> v -> v
comb = [(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList([(k, v)] -> [(k, v)]
insert [(k, v)]
xs) where
insert :: [(k, v)] -> [(k, v)]
insert [] = [(k
k,v
v)]
insert ((k
key,v
u):[(k, v)]
ys) =
case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
key k
k of
Ordering
LT -> (k
key,v
u) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)] -> [(k, v)]
insert [(k, v)]
ys
Ordering
GT -> (k
k,v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: (k
key,v
u) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
ys
Ordering
EQ -> (k
key,v -> v -> v
comb v
u v
v)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
ys
removekey :: k -> List k v -> List k v
removekey k
k (UnSafeList [(k, v)]
xs) = [(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList([(k, v)] -> [(k, v)]
remove [(k, v)]
xs) where
remove :: [(k, v)] -> [(k, v)]
remove [] = []
remove ((k
key,v
u):[(k, v)]
ys) = if k
keyk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k then [(k, v)]
ys else (k
k,v
u)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:([(k, v)] -> [(k, v)]
remove [(k, v)]
ys)
domain :: List k v -> Set k
domain (UnSafeList [(k, v)]
xs) = ((k, v) -> Set k -> Set k) -> Set k -> [(k, v)] -> Set k
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (k
k,v
_v) Set k
ans -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans) Set k
forall a. Set a
Set.empty [(k, v)]
xs
range :: List k v -> Set v
range (UnSafeList [(k, v)]
xs) = ((k, v) -> Set v -> Set v) -> Set v -> [(k, v)] -> Set v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (k
_k,v
v) Set v
ans -> v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v Set v
ans) Set v
forall a. Set a
Set.empty [(k, v)]
xs
emptyc :: List k v
emptyc = ([(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList [])
fromPairs:: Ord k => (v -> v -> v) -> [(k,v)] -> List k v
fromPairs :: (v -> v -> v) -> [(k, v)] -> List k v
fromPairs v -> v -> v
combine [(k, v)]
xs = [(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList((v -> v -> v) -> [(k, v)] -> [(k, v)]
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> [(k, v)]
normalize v -> v -> v
combine (((k, v) -> (k, v) -> Ordering) -> [(k, v)] -> [(k, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ (k, v)
x (k, v)
y -> k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
x) ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
y)) [(k, v)]
xs))
normalize :: Ord k => (v -> v -> v) -> [(k,v)] -> [(k,v)]
normalize :: (v -> v -> v) -> [(k, v)] -> [(k, v)]
normalize v -> v -> v
_combine [] = []
normalize v -> v -> v
_combine [(k
k,v
v)] = [(k
k,v
v)]
normalize v -> v -> v
combine ((k
k1,v
v1):(k
k2,v
v2):[(k, v)]
more) | k
k1k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k2 = (v -> v -> v) -> [(k, v)] -> [(k, v)]
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> [(k, v)]
normalize v -> v -> v
combine ((k
k1,v -> v -> v
combine v
v1 v
v2)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
more)
normalize v -> v -> v
combine ((k, v)
p:[(k, v)]
pairs) = (k, v)
p (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: (v -> v -> v) -> [(k, v)] -> [(k, v)]
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> [(k, v)]
normalize v -> v -> v
combine [(k, v)]
pairs
data Single k v where
Single :: k -> v -> Single k v
Fail :: Single k v
SetSingle :: k -> Single k ()
deriving instance (Eq k,Eq v) => Eq (Single k v)
instance Basic Single where
addkv :: (k, v) -> Single k v -> (v -> v -> v) -> Single k v
addkv (k
k,v
v) Single k v
set v -> v -> v
comb =
case Single k v
set of
(Single k
a v
b) -> k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
a (v -> v -> v
comb v
b v
v)
(SetSingle k
a) -> k -> Single k ()
forall k. k -> Single k ()
SetSingle k
a
Single k v
Fail -> k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
k v
v
removekey :: k -> Single k v -> Single k v
removekey k
key (Single k
a v
b) = if k
keyk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
a then Single k v
forall k v. Single k v
Fail else (k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
a v
b)
removekey k
key (SetSingle k
a) = if k
keyk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
a then Single k v
forall k v. Single k v
Fail else (k -> Single k ()
forall k. k -> Single k ()
SetSingle k
a)
removekey k
_key Single k v
Fail = Single k v
forall k v. Single k v
Fail
domain :: Single k v -> Set k
domain (Single k
a v
_b) = k -> Set k
forall a. a -> Set a
Set.singleton k
a
domain (SetSingle k
a) = k -> Set k
forall a. a -> Set a
Set.singleton k
a
domain Single k v
Fail = Set k
forall a. Set a
Set.empty
range :: Single k v -> Set v
range (Single k
_a v
b) = v -> Set v
forall a. a -> Set a
Set.singleton v
b
range (SetSingle k
_a) = () -> Set ()
forall a. a -> Set a
Set.singleton ()
range Single k v
Fail = Set v
forall a. Set a
Set.empty
emptyc :: Single k v
emptyc = Single k v
forall k v. Single k v
Fail
instance Basic Map.Map where
addkv :: (k, v) -> Map k v -> (v -> v -> v) -> Map k v
addkv (k
k,v
v) Map k v
m v -> v -> v
comb = (v -> v -> v) -> k -> v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((v -> v -> v) -> v -> v -> v
forall v. (v -> v -> v) -> v -> v -> v
mapflip v -> v -> v
comb) k
k v
v Map k v
m
removekey :: k -> Map k v -> Map k v
removekey k
k Map k v
m = k -> Map k v -> Map k v
forall k v. Ord k => k -> Map k v -> Map k v
Map.delete k
k Map k v
m
domain :: Map k v -> Set k
domain Map k v
x = Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k v
x
range :: Map k v -> Set v
range Map k v
xs = (k -> v -> Set v -> Set v) -> Set v -> Map k v -> Set v
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\ k
_k v
v Set v
ans -> v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v Set v
ans) Set v
forall a. Set a
Set.empty Map k v
xs
emptyc :: Map k v
emptyc = Map k v
forall k a. Map k a
Map.empty
mapflip :: (v -> v -> v) -> (v -> v -> v)
mapflip :: (v -> v -> v) -> v -> v -> v
mapflip v -> v -> v
f = (\v
old v
new -> v -> v -> v
f v
new v
old)
data BiMap v a b where MkBiMap:: (v ~ b) => !(Map.Map a b) -> !(Map.Map b (Set.Set a)) -> BiMap v a b
instance (Ord a, Ord b, ToCBOR a, ToCBOR b) => ToCBOR (BiMap b a b) where
toCBOR :: BiMap b a b -> Encoding
toCBOR (MkBiMap Map a b
l Map b (Set a)
_) = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map a b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map a b
l
instance
forall a b.
(Ord a, Ord b, FromCBOR a, FromCBOR b) =>
FromCBOR (BiMap b a b)
where
fromCBOR :: Decoder s (BiMap b a b)
fromCBOR =
Decoder s Int
forall s. Decoder s Int
decodeListLen Decoder s Int
-> (Int -> Decoder s (BiMap b a b)) -> Decoder s (BiMap b a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
1 -> Decoder s (BiMap b a b)
forall a b s.
(FromCBOR a, FromCBOR b, Ord a, Ord b) =>
Decoder s (BiMap b a b)
decodeMapAsBimap
Int
2 -> do
!BiMap b a b
x <- Decoder s (BiMap b a b)
forall a b s.
(FromCBOR a, FromCBOR b, Ord a, Ord b) =>
Decoder s (BiMap b a b)
decodeMapAsBimap
Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s
dropMap (Decoder s b -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Decoder s b -> Dropper s) -> Decoder s b -> Dropper s
forall a b. (a -> b) -> a -> b
$ forall s. FromCBOR b => Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR @b) (Decoder s a -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Decoder s a -> Dropper s) -> Decoder s a -> Dropper s
forall a b. (a -> b) -> a -> b
$ forall s. FromCBOR a => Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR @a)
BiMap b a b -> Decoder s (BiMap b a b)
forall (m :: * -> *) a. Monad m => a -> m a
return BiMap b a b
x
Int
k -> Word -> Decoder s (BiMap b a b)
forall s a. Word -> Decoder s a
invalidKey (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)
decodeMapAsBimap ::
(FromCBOR a, FromCBOR b, Ord a, Ord b) =>
Decoder s (BiMap b a b)
decodeMapAsBimap :: Decoder s (BiMap b a b)
decodeMapAsBimap = ([(a, b)] -> BiMap b a b) -> Decoder s (BiMap b a b)
forall k v m s.
(Ord k, FromCBOR k, FromCBOR v) =>
([(k, v)] -> m) -> Decoder s m
decodeMapSkel [(a, b)] -> BiMap b a b
forall k v. (Ord k, Ord v) => [(k, v)] -> BiMap v k v
biMapFromAscDistinctList
instance (NoThunks a,NoThunks b) => NoThunks(BiMap v a b) where
showTypeOf :: Proxy (BiMap v a b) -> [Char]
showTypeOf Proxy (BiMap v a b)
_ = [Char]
"BiMap"
wNoThunks :: Context -> BiMap v a b -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (MkBiMap Map a b
l Map b (Set a)
r) = Context -> (Map a b, Map b (Set a)) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (Map a b
l,Map b (Set a)
r)
instance NFData(BiMap v a b) where
rnf :: BiMap v a b -> ()
rnf (MkBiMap Map a b
l Map b (Set a)
r) = Map a b -> () -> ()
seq Map a b
l (Map b (Set a) -> () -> ()
seq Map b (Set a)
r ())
instance (Eq k,Eq v) => Eq (BiMap u k v) where
(MkBiMap Map k v
l Map v (Set k)
_) == :: BiMap u k v -> BiMap u k v -> Bool
== (MkBiMap Map k v
x Map v (Set k)
_) = Map k v
lMap k v -> Map k v -> Bool
forall a. Eq a => a -> a -> Bool
==Map k v
x
instance (Show k, Show v) => Show (BiMap u k v) where
show :: BiMap u k v -> [Char]
show (MkBiMap Map k v
l Map v (Set k)
_r) = Map k v -> [Char]
forall a. Show a => a -> [Char]
show Map k v
l
addBack :: (Ord v,Ord k) => v -> k -> Map.Map v (Set.Set k) -> Map.Map v (Set.Set k)
addBack :: v -> k -> Map v (Set k) -> Map v (Set k)
addBack v
newv k
k Map v (Set k)
m = (Set k -> Set k -> Set k)
-> v -> Set k -> Map v (Set k) -> Map v (Set k)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.union v
newv (k -> Set k
forall a. a -> Set a
Set.singleton k
k) Map v (Set k)
m
retract :: (Ord v,Ord k) => v -> k -> Map.Map v (Set.Set k) -> Map.Map v (Set.Set k)
retract :: v -> k -> Map v (Set k) -> Map v (Set k)
retract v
oldv k
k Map v (Set k)
m = (Set k -> Set k) -> v -> Map v (Set k) -> Map v (Set k)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.delete k
k) v
oldv Map v (Set k)
m
insertBackwards:: (Ord k,Ord v) => v -> v -> k -> Map.Map v (Set.Set k) -> Map.Map v (Set.Set k)
insertBackwards :: v -> v -> k -> Map v (Set k) -> Map v (Set k)
insertBackwards v
oldv v
newv k
k Map v (Set k)
m = v -> k -> Map v (Set k) -> Map v (Set k)
forall v k.
(Ord v, Ord k) =>
v -> k -> Map v (Set k) -> Map v (Set k)
addBack v
newv k
k (v -> k -> Map v (Set k) -> Map v (Set k)
forall v k.
(Ord v, Ord k) =>
v -> k -> Map v (Set k) -> Map v (Set k)
retract v
oldv k
k Map v (Set k)
m)
instance Ord v => Basic (BiMap v) where
addkv :: (k, v) -> BiMap v k v -> (v -> v -> v) -> BiMap v k v
addkv (k
k,v
v) (MkBiMap Map k v
f Map v (Set k)
b) v -> v -> v
comb = Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap ((v -> v -> v) -> k -> v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((v -> v -> v) -> v -> v -> v
forall v. (v -> v -> v) -> v -> v -> v
mapflip v -> v -> v
comb) k
k v
v Map k v
f) (v -> v -> k -> Map v (Set k) -> Map v (Set k)
forall k v.
(Ord k, Ord v) =>
v -> v -> k -> Map v (Set k) -> Map v (Set k)
insertBackwards v
oldv v
newv k
k Map v (Set k)
b)
where (v
oldv,v
newv) = case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
f of { Maybe v
Nothing -> (v
v,v
v); Just v
v2 -> (v
v2,v -> v -> v
comb v
v2 v
v)}
removekey :: k -> BiMap v k v -> BiMap v k v
removekey k
k (m :: BiMap v k v
m@(MkBiMap Map k v
m1 Map v (Set k)
m2)) =
case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
m1 of
Just v
v -> Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap (k -> Map k v -> Map k v
forall k v. Ord k => k -> Map k v -> Map k v
Map.delete k
k Map k v
m1) (v -> k -> Map v (Set k) -> Map v (Set k)
forall v k.
(Ord v, Ord k) =>
v -> k -> Map v (Set k) -> Map v (Set k)
retract v
v k
k Map v (Set k)
m2)
Maybe v
Nothing -> BiMap v k v
m
domain :: BiMap v k v -> Set k
domain (MkBiMap Map k v
left Map v (Set k)
_right) = Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k v
left
range :: BiMap v k v -> Set v
range (MkBiMap Map k v
_left Map v (Set k)
right) = Map v (Set k) -> Set v
forall k a. Map k a -> Set k
Map.keysSet Map v (Set k)
right
emptyc :: BiMap v k v
emptyc = [Char] -> BiMap v k v
forall a. HasCallStack => [Char] -> a
error ([Char]
"emptyc cannot be defined for BiMap, use the variable: biMapEmpty :: BiMap v k v")
biMapEmpty :: BiMap v k v
biMapEmpty :: BiMap v k v
biMapEmpty = Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap Map k v
forall k a. Map k a
Map.empty Map v (Set k)
forall k a. Map k a
Map.empty
biMapFromList:: (Ord k,Ord v) => (v -> v -> v) -> [(k,v)] -> BiMap v k v
biMapFromList :: (v -> v -> v) -> [(k, v)] -> BiMap v k v
biMapFromList v -> v -> v
comb [(k, v)]
xs = ((k, v) -> BiMap v k v -> BiMap v k v)
-> BiMap v k v -> [(k, v)] -> BiMap v k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (k, v) -> BiMap v k v -> BiMap v k v
addEntry BiMap v k v
forall v k. BiMap v k v
biMapEmpty [(k, v)]
xs
where addEntry :: (k, v) -> BiMap v k v -> BiMap v k v
addEntry (k
k,v
v) (MkBiMap Map k v
forward Map v (Set k)
backward) =
case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k v
forward of
Maybe v
Nothing -> Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap ((k, v) -> Map k v -> (v -> v -> v) -> Map k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) Map k v
forward v -> v -> v
comb) (v -> k -> Map v (Set k) -> Map v (Set k)
forall v k.
(Ord v, Ord k) =>
v -> k -> Map v (Set k) -> Map v (Set k)
addBack v
v k
k Map v (Set k)
backward)
Just v
oldv -> Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap ((k, v) -> Map k v -> (v -> v -> v) -> Map k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) Map k v
forward v -> v -> v
comb) (v -> v -> k -> Map v (Set k) -> Map v (Set k)
forall k v.
(Ord k, Ord v) =>
v -> v -> k -> Map v (Set k) -> Map v (Set k)
insertBackwards v
oldv v
newv k
k Map v (Set k)
backward)
where newv :: v
newv = v -> v -> v
comb v
oldv v
v
biMapFromAscDistinctList ::
(Ord k, Ord v) => [(k, v)] -> BiMap v k v
biMapFromAscDistinctList :: [(k, v)] -> BiMap v k v
biMapFromAscDistinctList [(k, v)]
xs = Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap Map k v
bmForward Map v (Set k)
bmBackward
where
bmForward :: Map k v
bmForward = [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList [(k, v)]
xs
bmBackward :: Map v (Set k)
bmBackward = ((k, v) -> Map v (Set k) -> Map v (Set k))
-> Map v (Set k) -> [(k, v)] -> Map v (Set k)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> v -> Map v (Set k) -> Map v (Set k))
-> (k, v) -> Map v (Set k) -> Map v (Set k)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((k -> v -> Map v (Set k) -> Map v (Set k))
-> (k, v) -> Map v (Set k) -> Map v (Set k))
-> (k -> v -> Map v (Set k) -> Map v (Set k))
-> (k, v)
-> Map v (Set k)
-> Map v (Set k)
forall a b. (a -> b) -> a -> b
$ (v -> k -> Map v (Set k) -> Map v (Set k))
-> k -> v -> Map v (Set k) -> Map v (Set k)
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> k -> Map v (Set k) -> Map v (Set k)
forall v k.
(Ord v, Ord k) =>
v -> k -> Map v (Set k) -> Map v (Set k)
addBack) Map v (Set k)
forall k a. Map k a
Map.empty [(k, v)]
xs
type Bimap k v = BiMap v k v
removeval:: (Ord k, Ord v) => v -> BiMap v k v -> BiMap v k v
removeval :: v -> BiMap v k v -> BiMap v k v
removeval v
v (m :: BiMap v k v
m@(MkBiMap Map k v
m1 Map v (Set k)
m2)) =
case v -> Map v (Set k) -> Maybe (Set k)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v (Set k)
m2 of
Just Set k
kset -> Map k v -> Map v (Set k) -> BiMap v k v
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap ((k -> Map k v -> Map k v) -> Map k v -> Set k -> Map k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\k
k Map k v
set -> k -> Map k v -> Map k v
forall k v. Ord k => k -> Map k v -> Map k v
Map.delete k
k Map k v
set) Map k v
m1 Set k
kset) (v -> Map v (Set k) -> Map v (Set k)
forall k v. Ord k => k -> Map k v -> Map k v
Map.delete v
v Map v (Set k)
m2)
Maybe (Set k)
Nothing -> BiMap v k v
m
data Sett k v where Sett :: (Set.Set k) -> Sett k ()
instance Basic Sett where
addpair :: k -> v -> Sett k v -> Sett k v
addpair k
key v
_unit (Sett Set k
m) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
key Set k
m)
addkv :: (k, v) -> Sett k v -> (v -> v -> v) -> Sett k v
addkv (k
k,v
_unit) (Sett Set k
m) v -> v -> v
_comb = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
m)
removekey :: k -> Sett k v -> Sett k v
removekey k
k (Sett Set k
m) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.delete k
k Set k
m)
domain :: Sett k v -> Set k
domain (Sett Set k
xs) = Set k
xs
range :: Sett k v -> Set v
range (Sett Set k
_xs) = () -> Set ()
forall a. a -> Set a
Set.singleton ()
emptyc :: Sett k v
emptyc = [Char] -> Sett k v
forall a. HasCallStack => [Char] -> a
error ([Char]
"Sett Set.empty has type (Sett k ()) and it needs type (Sett k v)")
instance Show key => Show (Sett key ()) where
show :: Sett key () -> [Char]
show (Sett Set key
ss) = Set key -> [Char]
forall a. Show a => a -> [Char]
show Set key
ss
deriving instance Eq k => Eq (Sett k ())
class Embed concrete base | concrete -> base where
toBase :: concrete -> base
fromBase :: base -> concrete
instance Ord k => Embed [(k,v)] (List k v) where
toBase :: [(k, v)] -> List k v
toBase [(k, v)]
xs = [(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList(((k, v) -> (k, v) -> Ordering) -> [(k, v)] -> [(k, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ (k, v)
x (k, v)
y -> k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
x) ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
y)) [(k, v)]
xs)
fromBase :: List k v -> [(k, v)]
fromBase (UnSafeList [(k, v)]
xs) = [(k, v)]
xs
instance Embed (Set.Set k) (Sett k ()) where
toBase :: Set k -> Sett k ()
toBase Set k
xs = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett Set k
xs
fromBase :: Sett k () -> Set k
fromBase (Sett Set k
xs) = Set k
xs
instance Embed (Map.Map k v) (Map.Map k v) where
toBase :: Map k v -> Map k v
toBase Map k v
xs = Map k v
xs
fromBase :: Map k v -> Map k v
fromBase Map k v
xs = Map k v
xs
instance Embed (BiMap v k v) (BiMap v k v) where
toBase :: BiMap v k v -> BiMap v k v
toBase BiMap v k v
xs = BiMap v k v
xs
fromBase :: BiMap v k v -> BiMap v k v
fromBase BiMap v k v
xs = BiMap v k v
xs
instance Embed (Single k v) (Single k v) where
toBase :: Single k v -> Single k v
toBase Single k v
xs = Single k v
xs
fromBase :: Single k v -> Single k v
fromBase Single k v
xs = Single k v
xs
instance Embed Bool Bool where
toBase :: Bool -> Bool
toBase Bool
xs = Bool
xs
fromBase :: Bool -> Bool
fromBase Bool
xs = Bool
xs
class Iter f where
nxt:: f a b -> Collect (a,b,f a b)
lub :: Ord k => k -> f k b -> Collect (k,b,f k b)
hasNxt :: f a b -> Maybe(a,b,f a b)
hasNxt f a b
f = Collect (a, b, f a b) -> Maybe (a, b, f a b)
forall t. Collect t -> Maybe t
hasElem (f a b -> Collect (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f a b
f)
hasLub :: Ord k => k -> f k b -> Maybe(k,b,f k b)
hasLub k
a f k b
f = Collect (k, b, f k b) -> Maybe (k, b, f k b)
forall t. Collect t -> Maybe t
hasElem (k -> f k b -> Collect (k, b, f k b)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Collect (k, b, f k b)
lub k
a f k b
f)
haskey:: Ord key => key -> f key b -> Bool
haskey key
k f key b
x = case key -> f key b -> Maybe (key, b, f key b)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Maybe (k, b, f k b)
hasLub key
k f key b
x of { Maybe (key, b, f key b)
Nothing -> Bool
False; Just (key
key,b
_,f key b
_) -> key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
key}
isnull:: f k v -> Bool
isnull f k v
f = Collect (k, v, f k v) -> Bool
forall t. Collect t -> Bool
isempty(f k v -> Collect (k, v, f k v)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f k v
f)
lookup:: Ord key => key -> f key rng -> Maybe rng
lookup key
k f key rng
x = case key -> f key rng -> Maybe (key, rng, f key rng)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Maybe (k, b, f k b)
hasLub key
k f key rng
x of { Maybe (key, rng, f key rng)
Nothing -> Maybe rng
forall a. Maybe a
Nothing; Just (key
key,rng
v,f key rng
_) -> if key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
key then rng -> Maybe rng
forall a. a -> Maybe a
Just rng
v else Maybe rng
forall a. Maybe a
Nothing}
element :: (Ord k) => k -> f k v -> Collect ()
element k
k f k v
f = Bool -> Collect ()
when (k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k f k v
f)
data List k v where UnSafeList :: Ord k => [(k,v)] -> List k v
unList :: List k v -> [(k, v)]
unList :: List k v -> [(k, v)]
unList (UnSafeList [(k, v)]
xs) = [(k, v)]
xs
deriving instance (Eq k,Eq v) => Eq (List k v)
instance Iter List where
nxt :: List a b -> Collect (a, b, List a b)
nxt (UnSafeList []) = Collect (a, b, List a b)
forall t. Collect t
none
nxt (UnSafeList ((a
k,b
v):[(a, b)]
xs)) = (a, b, List a b) -> Collect (a, b, List a b)
forall t. t -> Collect t
one(a
k,b
v,[(a, b)] -> List a b
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList [(a, b)]
xs)
lub :: k -> List k b -> Collect (k, b, List k b)
lub k
k (UnSafeList [(k, b)]
xs) = case ((k, b) -> Bool) -> [(k, b)] -> [(k, b)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\ (k
key,b
_v) -> k
key k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k) [(k, b)]
xs of
[] -> Collect (k, b, List k b)
forall t. Collect t
none
((k
key,b
v):[(k, b)]
ys) -> (k, b, List k b) -> Collect (k, b, List k b)
forall t. t -> Collect t
one (k
key,b
v,[(k, b)] -> List k b
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList [(k, b)]
ys)
isnull :: List k v -> Bool
isnull (UnSafeList [(k, v)]
xs) = [(k, v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(k, v)]
xs
lookup :: key -> List key rng -> Maybe rng
lookup key
k (UnSafeList [(key, rng)]
xs) = key -> [(key, rng)] -> Maybe rng
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup key
k [(key, rng)]
xs
hasNxt :: List a b -> Maybe (a, b, List a b)
hasNxt (UnSafeList []) = Maybe (a, b, List a b)
forall a. Maybe a
Nothing
hasNxt (UnSafeList (((a
k,b
v):[(a, b)]
ps))) = (a, b, List a b) -> Maybe (a, b, List a b)
forall a. a -> Maybe a
Just(a
k,b
v,[(a, b)] -> List a b
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList [(a, b)]
ps)
instance (Show k,Show v) => Show (List k v) where
show :: List k v -> [Char]
show (UnSafeList [(k, v)]
xs) = [(k, v)] -> [Char]
forall a. Show a => a -> [Char]
show [(k, v)]
xs
instance Iter Single where
nxt :: Single a b -> Collect (a, b, Single a b)
nxt (Single a
k b
v) = (forall ans. ans -> ((a, b, Single a b) -> ans -> ans) -> ans)
-> Collect (a, b, Single a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (a, b, Single a b) -> ans -> ans
f -> (a, b, Single a b) -> ans -> ans
f (a
k,b
v,Single a b
forall k v. Single k v
Fail) ans
ans)
nxt (SetSingle a
k) = (forall ans. ans -> ((a, b, Single a b) -> ans -> ans) -> ans)
-> Collect (a, b, Single a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (a, b, Single a b) -> ans -> ans
f -> (a, b, Single a b) -> ans -> ans
f (a
k,(),Single a ()
forall k v. Single k v
Fail) ans
ans)
nxt Single a b
Fail = (forall ans. ans -> ((a, b, Single a b) -> ans -> ans) -> ans)
-> Collect (a, b, Single a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (a, b, Single a b) -> ans -> ans
_f -> ans
ans)
lub :: k -> Single k b -> Collect (k, b, Single k b)
lub k
key (Single k
k b
v) = (forall ans. ans -> ((k, b, Single k b) -> ans -> ans) -> ans)
-> Collect (k, b, Single k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (k, b, Single k b) -> ans -> ans
f -> if k
kk -> k -> Bool
forall a. Ord a => a -> a -> Bool
<=k
key then (k, b, Single k b) -> ans -> ans
f (k
k,b
v,Single k b
forall k v. Single k v
Fail) ans
ans else ans
ans)
lub k
key (SetSingle k
k) = (forall ans. ans -> ((k, b, Single k b) -> ans -> ans) -> ans)
-> Collect (k, b, Single k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (k, b, Single k b) -> ans -> ans
f -> if k
kk -> k -> Bool
forall a. Ord a => a -> a -> Bool
<=k
key then (k, b, Single k b) -> ans -> ans
f(k
k,(),Single k ()
forall k v. Single k v
Fail) ans
ans else ans
ans)
lub k
_key Single k b
Fail = (forall ans. ans -> ((k, b, Single k b) -> ans -> ans) -> ans)
-> Collect (k, b, Single k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect(\ ans
ans (k, b, Single k b) -> ans -> ans
_f -> ans
ans)
haskey :: key -> Single key b -> Bool
haskey key
k (SetSingle key
a) = key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
a
haskey key
k (Single key
a b
_b) = key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
a
haskey key
_k Single key b
Fail = Bool
False
isnull :: Single k v -> Bool
isnull Single k v
Fail = Bool
True
isnull Single k v
_ = Bool
False
lookup :: key -> Single key rng -> Maybe rng
lookup key
k (SetSingle key
a) = if key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
a then () -> Maybe ()
forall a. a -> Maybe a
Just() else Maybe rng
forall a. Maybe a
Nothing
lookup key
k (Single key
a rng
b) = if key
kkey -> key -> Bool
forall a. Eq a => a -> a -> Bool
==key
a then rng -> Maybe rng
forall a. a -> Maybe a
Just rng
b else Maybe rng
forall a. Maybe a
Nothing
lookup key
_k Single key rng
Fail = Maybe rng
forall a. Maybe a
Nothing
instance (Show k,Show v) => Show (Single k v) where
show :: Single k v -> [Char]
show (Single k
k v
v) = [Char]
"(Single "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++k -> [Char]
forall a. Show a => a -> [Char]
show k
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++v -> [Char]
forall a. Show a => a -> [Char]
show v
v[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (SetSingle k
k) = [Char]
"(SetSingle "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++k -> [Char]
forall a. Show a => a -> [Char]
show k
k[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show Single k v
Fail = [Char]
"Fail"
instance Iter Sett where
nxt :: Sett a b -> Collect (a, b, Sett a b)
nxt (Sett Set a
m) = (forall ans. ans -> ((a, b, Sett a b) -> ans -> ans) -> ans)
-> Collect (a, b, Sett a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (a, b, Sett a b) -> ans -> ans
f -> if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
m then ans
ans else let (a
k,Set a
nextm) = Set a -> (a, Set a)
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set a
m in (a, b, Sett a b) -> ans -> ans
f (a
k,(),Set a -> Sett a ()
forall k. Set k -> Sett k ()
Sett Set a
nextm) ans
ans)
lub :: k -> Sett k b -> Collect (k, b, Sett k b)
lub k
key (Sett Set k
m) =
(forall ans. ans -> ((k, b, Sett k b) -> ans -> ans) -> ans)
-> Collect (k, b, Sett k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (k, b, Sett k b) -> ans -> ans
f -> if Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
m
then ans
ans
else case k -> Set k -> (Set k, Bool, Set k)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
key Set k
m of
(Set k
_left,Bool
True,Set k
right) -> (k, b, Sett k b) -> ans -> ans
f (k
key,(),Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett Set k
right) ans
ans
(Set k
_left,Bool
False,Set k
right) -> if Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
right
then ans
ans
else let (k
k,Set k
nextm) = Set k -> (k, Set k)
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set k
right in (k, b, Sett k b) -> ans -> ans
f (k
k,(),Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett Set k
nextm) ans
ans)
haskey :: key -> Sett key b -> Bool
haskey key
key (Sett Set key
m) = key -> Set key -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member key
key Set key
m
isnull :: Sett k v -> Bool
isnull (Sett Set k
x) = Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
x
lookup :: key -> Sett key rng -> Maybe rng
lookup key
k (Sett Set key
m) = if key -> Set key -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member key
k Set key
m then () -> Maybe ()
forall a. a -> Maybe a
Just() else Maybe rng
forall a. Maybe a
Nothing
instance Iter Map.Map where
nxt :: Map a b -> Collect (a, b, Map a b)
nxt Map a b
m = (forall ans. ans -> ((a, b, Map a b) -> ans -> ans) -> ans)
-> Collect (a, b, Map a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (a, b, Map a b) -> ans -> ans
f ->
case Map a b -> Maybe ((a, b), Map a b)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map a b
m of
Maybe ((a, b), Map a b)
Nothing -> ans
ans
Just((a
k,b
v),Map a b
nextm) -> (a, b, Map a b) -> ans -> ans
f (a
k,b
v,Map a b
nextm) ans
ans)
lub :: k -> Map k b -> Collect (k, b, Map k b)
lub k
key Map k b
m = (forall ans. ans -> ((k, b, Map k b) -> ans -> ans) -> ans)
-> Collect (k, b, Map k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (k, b, Map k b) -> ans -> ans
f ->
case k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
key Map k b
m of
(Map k b
_left,Just b
v,Map k b
right) -> (k, b, Map k b) -> ans -> ans
f (k
key,b
v,Map k b
right) ans
ans
(Map k b
_left,Maybe b
Nothing,Map k b
Tip) -> ans
ans
(Map k b
_left,Maybe b
Nothing,Map k b
right) -> (k, b, Map k b) -> ans -> ans
f (k
k,b
v,Map k b
m3) ans
ans
where ((k
k,b
v),Map k b
m3) = Map k b -> ((k, b), Map k b)
forall k a. Map k a -> ((k, a), Map k a)
Map.deleteFindMin Map k b
right)
haskey :: key -> Map key b -> Bool
haskey key
x Map key b
m = case key -> Map key b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
x Map key b
m of Just b
_ -> Bool
True; Maybe b
Nothing -> Bool
False
isnull :: Map k v -> Bool
isnull = Map k v -> Bool
forall k v. Map k v -> Bool
Map.null
lookup :: key -> Map key rng -> Maybe rng
lookup = key -> Map key rng -> Maybe rng
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
noKeys :: Ord k => Map k a -> Map k b -> Map k a
noKeys :: Map k a -> Map k b -> Map k a
noKeys Map k a
Tip Map k b
_ = Map k a
forall k a. Map k a
Tip
noKeys Map k a
m Map k b
Tip = Map k a
m
noKeys Map k a
m (Bin Int
_ k
k b
_ Map k b
ls Map k b
rs) = case k -> Map k a -> (Map k a, Map k a)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split k
k Map k a
m of
(Map k a
lm, Map k a
rm) -> Map k a -> Map k a -> Map k a
forall k a. Map k a -> Map k a -> Map k a
link2 Map k a
lm' Map k a
rm'
where !lm' :: Map k a
lm' = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
noKeys Map k a
lm Map k b
ls
!rm' :: Map k a
rm' = Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
noKeys Map k a
rm Map k b
rs
{-# INLINABLE noKeys #-}
keysEqual:: Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual :: Map k v1 -> Map k v2 -> Bool
keysEqual Map k v1
Tip Map k v2
Tip = Bool
True
keysEqual Map k v1
Tip (Bin Int
_ k
_ v2
_ Map k v2
_ Map k v2
_) = Bool
False
keysEqual (Bin Int
_ k
_ v1
_ Map k v1
_ Map k v1
_) Map k v2
Tip = Bool
False
keysEqual Map k v1
m (Bin Int
_ k
k v2
_ Map k v2
ls Map k v2
rs) =
case k -> Map k v1 -> (Map k v1, Bool, Map k v1)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k v1
m of
(Map k v1
lm,Bool
True,Map k v1
rm) -> Map k v2 -> Map k v1 -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual Map k v2
ls Map k v1
lm Bool -> Bool -> Bool
&& Map k v2 -> Map k v1 -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual Map k v2
rs Map k v1
rm
(Map k v1, Bool, Map k v1)
_ -> Bool
False
sameDomain:: (Ord k,Iter f,Iter g) => f k b -> g k c -> Bool
sameDomain :: f k b -> g k c -> Bool
sameDomain f k b
m g k c
n = Maybe (k, b, f k b) -> Maybe (k, c, g k c) -> Bool
forall a (f :: * -> * -> *) (f :: * -> * -> *) b b.
(Ord a, Iter f, Iter f) =>
Maybe (a, b, f a b) -> Maybe (a, b, f a b) -> Bool
loop (f k b -> Maybe (k, b, f k b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Maybe (a, b, f a b)
hasNxt f k b
m) (g k c -> Maybe (k, c, g k c)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Maybe (a, b, f a b)
hasNxt g k c
n)
where loop :: Maybe (a, b, f a b) -> Maybe (a, b, f a b) -> Bool
loop (Just(a
k1,b
_,f a b
nextm)) (Just(a
k2,b
_,f a b
nextn)) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
Ordering
EQ -> Maybe (a, b, f a b) -> Maybe (a, b, f a b) -> Bool
loop (f a b -> Maybe (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Maybe (a, b, f a b)
hasNxt f a b
nextm) (f a b -> Maybe (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Maybe (a, b, f a b)
hasNxt f a b
nextn)
Ordering
LT -> Bool
False
Ordering
GT -> Bool
False
loop Maybe (a, b, f a b)
Nothing Maybe (a, b, f a b)
Nothing = Bool
True
loop Maybe (a, b, f a b)
_ Maybe (a, b, f a b)
_ = Bool
False
splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
splitMember :: k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k0 Map k a
m = case k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k0 Map k a
m of
StrictTriple Map k a
l Bool
mv Map k a
r -> (Map k a
l, Bool
mv, Map k a
r)
where
go :: Ord k => k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go :: k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go !k
k Map k a
t =
case Map k a
t of
Map k a
Tip -> Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
forall k a. Map k a
Tip Bool
False Map k a
forall k a. Map k a
Tip
Bin Int
_ k
kx a
x Map k a
l Map k a
r -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
Ordering
LT -> let StrictTriple Map k a
lt Bool
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k Map k a
l
!gt' :: Map k a
gt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
gt Map k a
r
in Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt Bool
z Map k a
gt'
Ordering
GT -> let StrictTriple Map k a
lt Bool
z Map k a
gt = k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall k a.
Ord k =>
k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go k
k Map k a
r
!lt' :: Map k a
lt' = k -> a -> Map k a -> Map k a -> Map k a
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
kx a
x Map k a
l Map k a
lt
in Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
lt' Bool
z Map k a
gt
Ordering
EQ -> Map k a -> Bool -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
forall a b c. a -> b -> c -> StrictTriple a b c
StrictTriple Map k a
l Bool
True Map k a
r
{-# INLINABLE splitMember #-}
data StrictTriple a b c = StrictTriple !a !b !c
intersectDomP:: Ord k => (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
intersectDomP :: (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
intersectDomP k -> v2 -> Bool
_ Map k v1
Tip Map k v2
_ = Map k v2
forall k a. Map k a
Tip
intersectDomP k -> v2 -> Bool
_ Map k v1
_ Map k v2
Tip = Map k v2
forall k a. Map k a
Tip
intersectDomP k -> v2 -> Bool
p Map k v1
t1 (Bin Int
_ k
k v2
v Map k v2
l2 Map k v2
r2) =
if Bool
mb Bool -> Bool -> Bool
&& (k -> v2 -> Bool
p k
k v2
v)
then k -> v2 -> Map k v2 -> Map k v2 -> Map k v2
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k v2
v Map k v2
l1l2 Map k v2
r1r2
else Map k v2 -> Map k v2 -> Map k v2
forall k a. Map k a -> Map k a -> Map k a
link2 Map k v2
l1l2 Map k v2
r1r2
where
!(Map k v1
l1, Bool
mb, Map k v1
r1) = k -> Map k v1 -> (Map k v1, Bool, Map k v1)
forall k a. Ord k => k -> Map k a -> (Map k a, Bool, Map k a)
splitMember k
k Map k v1
t1
!l1l2 :: Map k v2
l1l2 = (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
intersectDomP k -> v2 -> Bool
p Map k v1
l1 Map k v2
l2
!r1r2 :: Map k v2
r1r2 = (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
intersectDomP k -> v2 -> Bool
p Map k v1
r1 Map k v2
r2
{-# INLINABLE intersectDomP #-}
intersectDomPLeft:: Ord k => (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft :: (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> v2 -> Bool
_ Map k v1
Tip Map k v2
_ = Map k v1
forall k a. Map k a
Tip
intersectDomPLeft k -> v2 -> Bool
_ Map k v1
_ Map k v2
Tip = Map k v1
forall k a. Map k a
Tip
intersectDomPLeft k -> v2 -> Bool
p (Bin Int
_ k
k v1
v1 Map k v1
l1 Map k v1
r1) Map k v2
t2 =
case Maybe v2
mb of
Just v2
v2 | k -> v2 -> Bool
p k
k v2
v2 -> k -> v1 -> Map k v1 -> Map k v1 -> Map k v1
forall k a. k -> a -> Map k a -> Map k a -> Map k a
link k
k v1
v1 Map k v1
l1l2 Map k v1
r1r2
Maybe v2
_other -> Map k v1 -> Map k v1 -> Map k v1
forall k a. Map k a -> Map k a -> Map k a
link2 Map k v1
l1l2 Map k v1
r1r2
where
!(Map k v2
l2, Maybe v2
mb, Map k v2
r2) = k -> Map k v2 -> (Map k v2, Maybe v2, Map k v2)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
k Map k v2
t2
!l1l2 :: Map k v1
l1l2 = (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> v2 -> Bool
p Map k v1
l1 Map k v2
l2
!r1r2 :: Map k v1
r1r2 = (k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft k -> v2 -> Bool
p Map k v1
r1 Map k v2
r2
{-# INLINABLE intersectDomPLeft #-}
intersectMapSetFold:: Ord k => (k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold :: (k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold k -> v -> ans -> ans
_accum Map k v
Tip Set k
_ !ans
ans = ans
ans
intersectMapSetFold k -> v -> ans -> ans
_accum Map k v
_ Set k
set !ans
ans | Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
set = ans
ans
intersectMapSetFold k -> v -> ans -> ans
accum (Bin Int
_ k
k v
v Map k v
l1 Map k v
l2) Set k
set !ans
ans =
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold k -> v -> ans -> ans
accum Map k v
l1 Set k
s1 (k -> v -> ans -> ans
addKV k
k v
v ((k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold k -> v -> ans -> ans
accum Map k v
l2 Set k
s2 ans
ans))
where (Set k
s1,Bool
found,Set k
s2) = k -> Set k -> (Set k, Bool, Set k)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
k Set k
set
addKV :: k -> v -> ans -> ans
addKV k
k1 v
v1 !ans
ans1 = if Bool
found then k -> v -> ans -> ans
accum k
k1 v
v1 ans
ans1 else ans
ans1
{-# INLINABLE intersectMapSetFold #-}
disjointMapSetFold:: Ord k => (k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold :: (k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold k -> v -> ans -> ans
_accum Map k v
Tip Set k
_ !ans
ans = ans
ans
disjointMapSetFold k -> v -> ans -> ans
accum Map k v
m Set k
set !ans
ans | Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
set = (k -> v -> ans -> ans) -> ans -> Map k v -> ans
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' k -> v -> ans -> ans
accum ans
ans Map k v
m
disjointMapSetFold k -> v -> ans -> ans
accum (Bin Int
_ k
k v
v Map k v
l1 Map k v
l2) Set k
set !ans
ans =
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold k -> v -> ans -> ans
accum Map k v
l1 Set k
s1 (k -> v -> ans -> ans
addKV k
k v
v ((k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold k -> v -> ans -> ans
accum Map k v
l2 Set k
s2 ans
ans))
where (Set k
s1,Bool
found,Set k
s2) = k -> Set k -> (Set k, Bool, Set k)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
k Set k
set
addKV :: k -> v -> ans -> ans
addKV k
k1 v
v1 !ans
ans1 = if Bool -> Bool
not Bool
found then k -> v -> ans -> ans
accum k
k1 v
v1 ans
ans1 else ans
ans1
instance Ord v => Iter (BiMap v) where
nxt :: BiMap v a b -> Collect (a, b, BiMap v a b)
nxt (MkBiMap Map a b
left Map b (Set a)
right) = (forall ans. ans -> ((a, b, BiMap v a b) -> ans -> ans) -> ans)
-> Collect (a, b, BiMap v a b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (a, b, BiMap v a b) -> ans -> ans
f ->
case Map a b -> Maybe ((a, b), Map a b)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map a b
left of
Maybe ((a, b), Map a b)
Nothing -> ans
ans
Just((a
k,b
v),Map a b
nextm) -> (a, b, BiMap v a b) -> ans -> ans
f (a
k,b
v,Map a b -> Map b (Set a) -> BiMap v a b
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap Map a b
nextm Map b (Set a)
right) ans
ans)
lub :: k -> BiMap v k b -> Collect (k, b, BiMap v k b)
lub k
key (MkBiMap Map k b
forward Map b (Set k)
backward) = (forall ans. ans -> ((k, b, BiMap v k b) -> ans -> ans) -> ans)
-> Collect (k, b, BiMap v k b)
forall tuple.
(forall ans. ans -> (tuple -> ans -> ans) -> ans) -> Collect tuple
Collect (\ ans
ans (k, b, BiMap v k b) -> ans -> ans
f ->
case k -> Map k b -> (Map k b, Maybe b, Map k b)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
key Map k b
forward of
(Map k b
_left,Just b
v,Map k b
right) -> (k, b, BiMap v k b) -> ans -> ans
f (k
key,b
v,Map k b -> Map b (Set k) -> BiMap v k b
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap Map k b
right Map b (Set k)
backward) ans
ans
(Map k b
_left,Maybe b
Nothing,Map k b
Tip) -> ans
ans
(Map k b
_left,Maybe b
Nothing,Map k b
right) -> (k, b, BiMap v k b) -> ans -> ans
f (k
k,b
v,Map k b -> Map b (Set k) -> BiMap v k b
forall v b a. (v ~ b) => Map a b -> Map b (Set a) -> BiMap v a b
MkBiMap Map k b
m3 Map b (Set k)
backward) ans
ans
where ((k
k,b
v),Map k b
m3) = Map k b -> ((k, b), Map k b)
forall k a. Map k a -> ((k, a), Map k a)
Map.deleteFindMin Map k b
right )
isnull :: BiMap v k v -> Bool
isnull (MkBiMap Map k v
f Map v (Set k)
_g) = Map k v -> Bool
forall (f :: * -> * -> *) k v. Iter f => f k v -> Bool
isnull Map k v
f
lookup :: key -> BiMap v key rng -> Maybe rng
lookup key
x (MkBiMap Map key rng
left Map rng (Set key)
_right) = key -> Map key rng -> Maybe rng
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
x Map key rng
left
haskey :: key -> BiMap v key b -> Bool
haskey key
k (MkBiMap Map key b
left Map b (Set key)
_right) = key -> Map key b -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey key
k Map key b
left
data BaseRep f k v where
MapR:: Basic Map.Map => BaseRep Map.Map k v
SetR:: Basic Sett => BaseRep Sett k ()
ListR:: Basic List => BaseRep List k v
SingleR:: Basic Single => BaseRep Single k v
BiMapR:: (Basic (BiMap v),Ord v) => BaseRep (BiMap v) k v
lifo :: Iter f => f k v -> Collect (k,v)
lifo :: f k v -> Collect (k, v)
lifo f k v
x = do { (k
k,v
v,f k v
x2) <- f k v -> Collect (k, v, f k v)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f k v
x; (k, v) -> Collect (k, v) -> Collect (k, v)
forall t. t -> Collect t -> Collect t
front (k
k,v
v) (f k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo f k v
x2) }
fifo :: Iter f => f k v -> Collect (k,v)
fifo :: f k v -> Collect (k, v)
fifo f k v
x = do { (k
k,v
v,f k v
x2) <- f k v -> Collect (k, v, f k v)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f k v
x; Collect (k, v) -> (k, v) -> Collect (k, v)
forall t. Collect t -> t -> Collect t
rear (f k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
fifo f k v
x2) (k
k,v
v)}
data Exp t where
Base:: (Ord k,Basic f) => BaseRep f k v -> f k v -> Exp (f k v)
Dom:: Ord k => Exp (f k v) -> Exp (Sett k ())
Rng:: (Ord k,Ord v) => Exp (f k v) -> Exp (Sett v ())
DRestrict:: (Ord k,Iter g) => Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
DExclude:: (Ord k,Iter g) => Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
RRestrict:: (Ord k,Iter g,Ord v) => Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
RExclude:: (Ord k,Iter g,Ord v) => Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
Elem :: (Ord k,Iter g,Show k) => k -> Exp(g k ()) -> Exp Bool
NotElem ::(Ord k,Iter g, Show k) => k -> Exp(g k ()) -> Exp Bool
Intersect :: (Ord k, Iter f, Iter g) => Exp(f k v) -> Exp(g k u) -> Exp(Sett k ())
Subset :: (Ord k, Iter f, Iter g) => Exp(f k v) -> Exp(g k u) -> Exp Bool
SetDiff :: (Ord k, Iter f, Iter g) => Exp(f k v) -> Exp(g k u) -> Exp(f k v)
UnionOverrideLeft:: (Show k, Show v,Ord k) => Exp (f k v) -> Exp (g k v) -> Exp(f k v)
UnionPlus:: (Ord k,Monoid n) => Exp (f k n) -> Exp (f k n) -> Exp(f k n)
UnionOverrideRight:: Ord k => Exp (f k v) -> Exp (g k v) -> Exp(f k v)
Singleton:: (Ord k) => k -> v -> Exp(Single k v)
SetSingleton:: (Ord k) => k -> Exp(Single k ())
KeyEqual:: (Ord k,Iter f,Iter g) => Exp (f k v) -> Exp(g k u) -> Exp Bool
dRestrict :: (Ord k,Iter g) => Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dRestrict :: Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dRestrict (Base BaseRep f k v
SetR (Sett x)) Exp (f k v)
y | Set k -> Int
forall a. Set a -> Int
Set.size Set k
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Exp (Single k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
DRestrict (k -> Exp (Single k ())
forall v. Ord v => v -> Exp (Single v ())
SetSingleton(Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set k
x)) Exp (f k v)
Exp (f k v)
y
dRestrict Exp (g k ())
x Exp (f k v)
y = Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
DRestrict Exp (g k ())
x Exp (f k v)
y
rRestrict :: (Ord k,Iter g,Ord v) => Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rRestrict :: Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rRestrict Exp (f k v)
y (Base BaseRep f k v
SetR (Sett x)) | Set k -> Int
forall a. Set a -> Int
Set.size Set k
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Exp (f k v) -> Exp (Single v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
RRestrict Exp (f k v)
y (k -> Exp (Single k ())
forall v. Ord v => v -> Exp (Single v ())
SetSingleton(Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set k
x))
rRestrict Exp (f k v)
y Exp (g v ())
x = Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
RRestrict Exp (f k v)
y Exp (g v ())
x
dExclude :: (Ord k,Iter g) => Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dExclude :: Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dExclude (Base BaseRep f k v
SetR (Sett x)) Exp (f k v)
y | Set k -> Int
forall a. Set a -> Int
Set.size Set k
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Exp (Single k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
DExclude (k -> Exp (Single k ())
forall v. Ord v => v -> Exp (Single v ())
SetSingleton(Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set k
x)) Exp (f k v)
Exp (f k v)
y
dExclude Exp (g k ())
x Exp (f k v)
y = Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
DExclude Exp (g k ())
x Exp (f k v)
y
rExclude ::(Ord k,Iter g,Ord v) => Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rExclude :: Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rExclude Exp (f k v)
y (Base BaseRep f k v
SetR (Sett x)) | Set k -> Int
forall a. Set a -> Int
Set.size Set k
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Exp (f k v) -> Exp (Single v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
RExclude Exp (f k v)
y (k -> Exp (Single k ())
forall v. Ord v => v -> Exp (Single v ())
SetSingleton(Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set k
x))
rExclude Exp (f k v)
y Exp (g v ())
x = Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
RExclude Exp (f k v)
y Exp (g v ())
x
class HasExp s t | s -> t where
toExp :: s -> Exp t
instance HasExp (Exp t) t where
toExp :: Exp t -> Exp t
toExp Exp t
x = Exp t
x
instance (Ord k) => HasExp (Map k v) (Map k v) where
toExp :: Map k v -> Exp (Map k v)
toExp Map k v
x = BaseRep Map k v -> Map k v -> Exp (Map k v)
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep Map k v
forall k v. Basic Map => BaseRep Map k v
MapR Map k v
x
instance (Ord k) => HasExp (Set.Set k) (Sett k ()) where
toExp :: Set k -> Exp (Sett k ())
toExp Set k
x = BaseRep Sett k () -> Sett k () -> Exp (Sett k ())
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett Set k
x)
instance (Ord k) => HasExp [(k,v)] (List k v) where
toExp :: [(k, v)] -> Exp (List k v)
toExp [(k, v)]
l = BaseRep List k v -> List k v -> Exp (List k v)
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep List k v
forall k v. Basic List => BaseRep List k v
ListR ([(k, v)] -> List k v
forall k v. Ord k => [(k, v)] -> List k v
UnSafeList (((k, v) -> (k, v) -> Ordering) -> [(k, v)] -> [(k, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ (k, v)
x (k, v)
y -> k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
x) ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
y)) [(k, v)]
l))
instance (Ord k) => HasExp (Single k v) (Single k v) where
toExp :: Single k v -> Exp (Single k v)
toExp Single k v
x = BaseRep Single k v -> Single k v -> Exp (Single k v)
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep Single k v
forall k v. Basic Single => BaseRep Single k v
SingleR Single k v
x
instance (Ord k,Ord v) => HasExp (Bimap k v) (Bimap k v) where
toExp :: Bimap k v -> Exp (Bimap k v)
toExp Bimap k v
x = BaseRep (BiMap v) k v -> Bimap k v -> Exp (Bimap k v)
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep (BiMap v) k v
forall v k. (Basic (BiMap v), Ord v) => BaseRep (BiMap v) k v
BiMapR Bimap k v
x
dom :: (Ord k,HasExp s (f k v)) => s -> Exp (Sett k ())
dom :: s -> Exp (Sett k ())
dom s
x = Exp (f k v) -> Exp (Sett k ())
forall k (f :: * -> * -> *) v.
Ord k =>
Exp (f k v) -> Exp (Sett k ())
Dom (s -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s
x)
rng:: (Ord k,Ord v) => HasExp s (f k v) => s -> Exp (Sett v ())
rng :: s -> Exp (Sett v ())
rng s
x = Exp (f k v) -> Exp (Sett v ())
forall k v (f :: * -> * -> *).
(Ord k, Ord v) =>
Exp (f k v) -> Exp (Sett v ())
Rng(s -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s
x)
(◁),(<|),drestrict :: (Ord k,HasExp s1 (Sett k ()), HasExp s2 (f k v)) => s1 -> s2 -> Exp (f k v)
◁ :: s1 -> s2 -> Exp (f k v)
(◁) s1
x s2
y = Exp (Sett k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dRestrict (s1 -> Exp (Sett k ())
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
drestrict :: s1 -> s2 -> Exp (f k v)
drestrict = s1 -> s2 -> Exp (f k v)
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
(◁)
<| :: s1 -> s2 -> Exp (f k v)
(<|) = s1 -> s2 -> Exp (f k v)
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
drestrict
(⋪),dexclude :: (Ord k,Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) => s1 -> s2 -> Exp (f k v)
⋪ :: s1 -> s2 -> Exp (f k v)
(⋪) s1
x s2
y = Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
forall k (g :: * -> * -> *) (f :: * -> * -> *) v.
(Ord k, Iter g) =>
Exp (g k ()) -> Exp (f k v) -> Exp (f k v)
dExclude (s1 -> Exp (g k ())
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
dexclude :: s1 -> s2 -> Exp (f k v)
dexclude = s1 -> s2 -> Exp (f k v)
forall k (g :: * -> * -> *) s1 s2 (f :: * -> * -> *) v.
(Ord k, Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
(⋪)
(▷),(|>),rrestrict :: (Ord k,Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) => s1 -> s2 -> Exp (f k v)
▷ :: s1 -> s2 -> Exp (f k v)
(▷) s1
x s2
y = Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rRestrict (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g v ())
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
rrestrict :: s1 -> s2 -> Exp (f k v)
rrestrict = s1 -> s2 -> Exp (f k v)
forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
(▷)
|> :: s1 -> s2 -> Exp (f k v)
(|>) = s1 -> s2 -> Exp (f k v)
forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
(▷)
(⋫),rexclude :: (Ord k,Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) => s1 -> s2 -> Exp (f k v)
⋫ :: s1 -> s2 -> Exp (f k v)
(⋫) s1
x s2
y = Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
forall k (g :: * -> * -> *) v (f :: * -> * -> *).
(Ord k, Iter g, Ord v) =>
Exp (f k v) -> Exp (g v ()) -> Exp (f k v)
rExclude (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g v ())
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
rexclude :: s1 -> s2 -> Exp (f k v)
rexclude = s1 -> s2 -> Exp (f k v)
forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
(⋫)
(∈) :: (Show k, Ord k,Iter g,HasExp s (g k ())) => k -> s -> Exp Bool
∈ :: k -> s -> Exp Bool
(∈) k
x s
y = k -> Exp (g k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
Elem k
x (s -> Exp (g k ())
forall s t. HasExp s t => s -> Exp t
toExp s
y)
(∉),notelem :: (Show k, Ord k,Iter g, HasExp s (g k ())) => k -> s -> Exp Bool
∉ :: k -> s -> Exp Bool
(∉) k
x s
y = k -> Exp (g k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
NotElem k
x (s -> Exp (g k ())
forall s t. HasExp s t => s -> Exp t
toExp s
y)
notelem :: k -> s -> Exp Bool
notelem = k -> s -> Exp Bool
forall k (g :: * -> * -> *) s.
(Show k, Ord k, Iter g, HasExp s (g k ())) =>
k -> s -> Exp Bool
(∉)
(∪),unionleft :: (Show k,Show v,Ord k,HasExp s1 (f k v), HasExp s2 (g k v)) => s1 -> s2 -> Exp (f k v)
∪ :: s1 -> s2 -> Exp (f k v)
(∪) s1
x s2
y = Exp (f k v) -> Exp (g k v) -> Exp (f k v)
forall k v (k :: * -> * -> *) (n :: * -> * -> *).
(Show k, Show v, Ord k) =>
Exp (k k v) -> Exp (n k v) -> Exp (k k v)
UnionOverrideLeft (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k v)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
unionleft :: s1 -> s2 -> Exp (f k v)
unionleft = s1 -> s2 -> Exp (f k v)
forall k v s1 (f :: * -> * -> *) s2 (g :: * -> * -> *).
(Show k, Show v, Ord k, HasExp s1 (f k v), HasExp s2 (g k v)) =>
s1 -> s2 -> Exp (f k v)
(∪)
(⨃),unionright :: (Ord k,HasExp s1 (f k v), HasExp s2 (g k v)) => s1 -> s2 -> Exp (f k v)
⨃ :: s1 -> s2 -> Exp (f k v)
(⨃) s1
x s2
y = Exp (f k v) -> Exp (g k v) -> Exp (f k v)
forall k (f :: * -> * -> *) k (v :: * -> * -> *).
Ord k =>
Exp (f k k) -> Exp (v k k) -> Exp (f k k)
UnionOverrideRight (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k v)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
unionright :: s1 -> s2 -> Exp (f k v)
unionright = s1 -> s2 -> Exp (f k v)
forall k s1 (f :: * -> * -> *) v s2 (g :: * -> * -> *).
(Ord k, HasExp s1 (f k v), HasExp s2 (g k v)) =>
s1 -> s2 -> Exp (f k v)
(⨃)
(∪+),unionplus :: (Ord k,Monoid n, HasExp s1 (f k n), HasExp s2 (f k n)) => s1 -> s2 -> Exp (f k n)
∪+ :: s1 -> s2 -> Exp (f k n)
(∪+) s1
x s2
y = Exp (f k n) -> Exp (f k n) -> Exp (f k n)
forall k n (f :: * -> * -> *).
(Ord k, Monoid n) =>
Exp (f k n) -> Exp (f k n) -> Exp (f k n)
UnionPlus (s1 -> Exp (f k n)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (f k n)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
unionplus :: s1 -> s2 -> Exp (f k n)
unionplus = s1 -> s2 -> Exp (f k n)
forall k n s1 (f :: * -> * -> *) s2.
(Ord k, Monoid n, HasExp s1 (f k n), HasExp s2 (f k n)) =>
s1 -> s2 -> Exp (f k n)
(∪+)
singleton :: (Ord k) => k -> v -> Exp (Single k v)
singleton :: k -> v -> Exp (Single k v)
singleton k
k v
v = k -> v -> Exp (Single k v)
forall k v. Ord k => k -> v -> Exp (Single k v)
Singleton k
k v
v
setSingleton :: (Ord k) => k -> Exp (Single k ())
setSingleton :: k -> Exp (Single k ())
setSingleton k
k = k -> Exp (Single k ())
forall v. Ord v => v -> Exp (Single v ())
SetSingleton k
k
(∩),intersect :: (Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) => s1 -> s2 -> Exp (Sett k ())
∩ :: s1 -> s2 -> Exp (Sett k ())
(∩) s1
x s2
y = Exp (f k v) -> Exp (g k u) -> Exp (Sett k ())
forall k (f :: * -> * -> *) (g :: * -> * -> *) v u.
(Ord k, Iter f, Iter g) =>
Exp (f k v) -> Exp (g k u) -> Exp (Sett k ())
Intersect (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k u)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
intersect :: s1 -> s2 -> Exp (Sett k ())
intersect = s1 -> s2 -> Exp (Sett k ())
forall k (f :: * -> * -> *) (g :: * -> * -> *) s1 v s2 u.
(Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) =>
s1 -> s2 -> Exp (Sett k ())
(∩)
(⊆),subset :: (Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) => s1 -> s2 -> Exp Bool
⊆ :: s1 -> s2 -> Exp Bool
(⊆) s1
x s2
y = Exp (f k v) -> Exp (g k u) -> Exp Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) v u.
(Ord k, Iter f, Iter g) =>
Exp (f k v) -> Exp (g k u) -> Exp Bool
Subset (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k u)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
subset :: s1 -> s2 -> Exp Bool
subset = s1 -> s2 -> Exp Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) s1 v s2 u.
(Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) =>
s1 -> s2 -> Exp Bool
(⊆)
(➖),setdiff :: (Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) => s1 -> s2 -> Exp(f k v)
➖ :: s1 -> s2 -> Exp (f k v)
(➖) s1
x s2
y = Exp (f k v) -> Exp (g k u) -> Exp (f k v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) v u.
(Ord k, Iter f, Iter g) =>
Exp (f k v) -> Exp (g k u) -> Exp (f k v)
SetDiff (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k u)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
setdiff :: s1 -> s2 -> Exp (f k v)
setdiff = s1 -> s2 -> Exp (f k v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) s1 v s2 u.
(Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) =>
s1 -> s2 -> Exp (f k v)
(➖)
(≍),keyeq :: (Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) => s1 -> s2 -> Exp Bool
≍ :: s1 -> s2 -> Exp Bool
(≍) s1
x s2
y = Exp (f k v) -> Exp (g k u) -> Exp Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) v u.
(Ord k, Iter f, Iter g) =>
Exp (f k v) -> Exp (g k u) -> Exp Bool
KeyEqual (s1 -> Exp (f k v)
forall s t. HasExp s t => s -> Exp t
toExp s1
x) (s2 -> Exp (g k u)
forall s t. HasExp s t => s -> Exp t
toExp s2
y)
keyeq :: s1 -> s2 -> Exp Bool
keyeq = s1 -> s2 -> Exp Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) s1 v s2 u.
(Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) =>
s1 -> s2 -> Exp Bool
(≍)
data Pat env t where
P1:: Pat (d,c,b,a) d
P2:: Pat (d,c,b,a) c
P3:: Pat (d,c,b,a) b
P4:: Pat (d,c,b,a) a
PPair:: Pat (d,c,b,a) a -> Pat (d,c,b,a) b -> Pat (d,c,b,a) (a,b)
data Expr env t where
X1:: Expr (d,c,b,a) d
X2:: Expr (d,c,b,a) c
X3:: Expr (d,c,b,a) b
X4:: Expr (d,c,b,a) a
HasKey:: (Iter f,Ord k) => Expr e k -> (f k v) -> Expr e Bool
Neg :: Expr e Bool -> Expr e Bool
Ap:: Lam(a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
EPair:: Expr e a -> Expr e b -> Expr e (a,b)
FST:: Expr e (a,b) -> Expr e a
SND:: Expr e (a,b) -> Expr e b
Lit :: Show t => t -> Expr env t
data Lam t where
Lam:: Pat (d,c,b,a) t -> Pat (d,c,b,a) s -> Expr (d,c,b,a) v -> Lam (t -> s -> v)
Add :: Num n => Lam (n -> n -> n)
Cat :: Monoid m => Lam (m -> m -> m)
Eql :: Eq t => Lam(t -> t -> Bool)
Both:: Lam (Bool -> Bool -> Bool)
Lift:: (a -> b -> c) -> Lam (a -> b -> c)
type StringEnv = (String,String,String,String)
bindE :: Pat (a,b,c,d) t -> Expr (w,x,y,z) t -> StringEnv -> StringEnv
bindE :: Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (a, b, c, d) t
P1 Expr (w, x, y, z) t
v (e :: StringEnv
e@([Char]
_,[Char]
c,[Char]
b,[Char]
a)) = (StringEnv -> Expr (w, x, y, z) t -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (w, x, y, z) t
v,[Char]
c,[Char]
b,[Char]
a)
bindE Pat (a, b, c, d) t
P2 Expr (w, x, y, z) t
v (e :: StringEnv
e@([Char]
d,[Char]
_,[Char]
b,[Char]
a)) = ([Char]
d,StringEnv -> Expr (w, x, y, z) t -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (w, x, y, z) t
v,[Char]
b,[Char]
a)
bindE Pat (a, b, c, d) t
P3 Expr (w, x, y, z) t
v (e :: StringEnv
e@([Char]
d,[Char]
c,[Char]
_,[Char]
a)) = ([Char]
d,[Char]
c,StringEnv -> Expr (w, x, y, z) t -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (w, x, y, z) t
v,[Char]
a)
bindE Pat (a, b, c, d) t
P4 Expr (w, x, y, z) t
v (e :: StringEnv
e@([Char]
d,[Char]
c,[Char]
b,[Char]
_)) = ([Char]
d,[Char]
c,[Char]
b,StringEnv -> Expr (w, x, y, z) t -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (w, x, y, z) t
v)
bindE (PPair Pat (d, c, b, a) a
p1 Pat (d, c, b, a) b
p2) (EPair Expr (w, x, y, z) a
e1 Expr (w, x, y, z) b
e2) StringEnv
env = Pat (d, c, b, a) a -> Expr (w, x, y, z) a -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) a
p1 Expr (w, x, y, z) a
Expr (w, x, y, z) a
e1 (Pat (d, c, b, a) b -> Expr (w, x, y, z) b -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) b
p2 Expr (w, x, y, z) b
Expr (w, x, y, z) b
e2 StringEnv
env)
bindE (PPair Pat (d, c, b, a) a
p1 Pat (d, c, b, a) b
p2) Expr (w, x, y, z) t
e StringEnv
env = Pat (d, c, b, a) b -> Expr (w, x, y, z) b -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) b
p2 (Expr (w, x, y, z) (d, b) -> Expr (w, x, y, z) b
forall e a b. Expr e (a, b) -> Expr e b
SND Expr (w, x, y, z) t
Expr (w, x, y, z) (d, b)
e) (Pat (d, c, b, a) a -> Expr (w, x, y, z) a -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) a
p1 (Expr (w, x, y, z) (a, c) -> Expr (w, x, y, z) a
forall e a b. Expr e (a, b) -> Expr e a
FST Expr (w, x, y, z) t
Expr (w, x, y, z) (a, c)
e) StringEnv
env)
showE :: StringEnv -> (Expr (a,b,c,d) t) -> String
showE :: StringEnv -> Expr (a, b, c, d) t -> [Char]
showE ([Char]
x,[Char]
_,[Char]
_,[Char]
_) Expr (a, b, c, d) t
X1 = [Char]
x
showE ([Char]
_,[Char]
y,[Char]
_,[Char]
_) Expr (a, b, c, d) t
X2 = [Char]
y
showE ([Char]
_,[Char]
_,[Char]
z,[Char]
_) Expr (a, b, c, d) t
X3 = [Char]
z
showE ([Char]
_,[Char]
_,[Char]
_,[Char]
w) Expr (a, b, c, d) t
X4 = [Char]
w
showE StringEnv
e (EPair Expr (a, b, c, d) a
a Expr (a, b, c, d) b
b) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) a -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) a
a[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) b -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) b
b[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
showE StringEnv
e (Ap (Lam Pat (d, c, b, a) t
p1 Pat (d, c, b, a) s
p2 Expr (d, c, b, a) v
expr) Expr (a, b, c, d) a
x Expr (a, b, c, d) b
y) = StringEnv -> Expr (d, c, b, a) v -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE (Pat (d, c, b, a) s -> Expr (a, b, c, d) s -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) s
p2 Expr (a, b, c, d) b
Expr (a, b, c, d) s
y (Pat (d, c, b, a) t -> Expr (a, b, c, d) t -> StringEnv -> StringEnv
forall a b c d t w x y z.
Pat (a, b, c, d) t -> Expr (w, x, y, z) t -> StringEnv -> StringEnv
bindE Pat (d, c, b, a) t
p1 Expr (a, b, c, d) a
Expr (a, b, c, d) t
x StringEnv
e)) Expr (d, c, b, a) v
expr
showE StringEnv
e (FST Expr (a, b, c, d) (t, b)
f) = [Char]
"(fst " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ StringEnv -> Expr (a, b, c, d) (t, b) -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) (t, b)
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
showE StringEnv
e (SND Expr (a, b, c, d) (a, t)
f) = [Char]
"(snd " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ StringEnv -> Expr (a, b, c, d) (a, t) -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) (a, t)
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
showE StringEnv
e (Ap Lam (a -> b -> t)
oper Expr (a, b, c, d) a
a Expr (a, b, c, d) b
b) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) a -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) a
a[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Lam (a -> b -> t) -> [Char]
forall t. StringEnv -> Lam t -> [Char]
showL StringEnv
e Lam (a -> b -> t)
oper[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) b -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) b
b[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
showE StringEnv
e (HasKey Expr (a, b, c, d) k
k f k v
_datum) = [Char]
"(haskey "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) k -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) k
k[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ?)"
showE StringEnv
e (Neg Expr (a, b, c, d) Bool
x) = [Char]
"(not "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (a, b, c, d) Bool -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (a, b, c, d) Bool
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
showE StringEnv
_ (Lit t
n) = t -> [Char]
forall a. Show a => a -> [Char]
show t
n
showL :: StringEnv -> Lam t -> String
showL :: StringEnv -> Lam t -> [Char]
showL StringEnv
e (Lam Pat (d, c, b, a) t
p1 Pat (d, c, b, a) s
p2 Expr (d, c, b, a) v
expr) = [Char]
"\\ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Pat (d, c, b, a) t -> [Char]
forall any t. StringEnv -> Pat any t -> [Char]
showP StringEnv
e Pat (d, c, b, a) t
p1[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Pat (d, c, b, a) s -> [Char]
forall any t. StringEnv -> Pat any t -> [Char]
showP StringEnv
e Pat (d, c, b, a) s
p2[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" -> "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Expr (d, c, b, a) v -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE StringEnv
e Expr (d, c, b, a) v
expr
showL StringEnv
_e Lam t
Add = [Char]
" + "
showL StringEnv
_e Lam t
Cat = [Char]
" <> "
showL StringEnv
_e Lam t
Eql = [Char]
" == "
showL StringEnv
_e Lam t
Both = [Char]
" && "
showL StringEnv
_e (Lift a -> b -> c
_f) = [Char]
"<lifted function>"
showP :: StringEnv -> (Pat any t) -> String
showP :: StringEnv -> Pat any t -> [Char]
showP ([Char]
x,[Char]
_,[Char]
_,[Char]
_) Pat any t
P1 = [Char]
x
showP ([Char]
_,[Char]
y,[Char]
_,[Char]
_) Pat any t
P2 = [Char]
y
showP ([Char]
_,[Char]
_,[Char]
z,[Char]
_) Pat any t
P3 = [Char]
z
showP ([Char]
_,[Char]
_,[Char]
_,[Char]
w) Pat any t
P4 = [Char]
w
showP StringEnv
env (PPair Pat (d, c, b, a) a
p1 Pat (d, c, b, a) b
p2) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Pat (d, c, b, a) a -> [Char]
forall any t. StringEnv -> Pat any t -> [Char]
showP StringEnv
env Pat (d, c, b, a) a
p1[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++StringEnv -> Pat (d, c, b, a) b -> [Char]
forall any t. StringEnv -> Pat any t -> [Char]
showP StringEnv
env Pat (d, c, b, a) b
p2[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
instance Show (Expr (a,b,c,d) t) where
show :: Expr (a, b, c, d) t -> [Char]
show Expr (a, b, c, d) t
x = StringEnv -> Expr (a, b, c, d) t -> [Char]
forall a b c d t. StringEnv -> Expr (a, b, c, d) t -> [Char]
showE ([Char]
"X1",[Char]
"X2",[Char]
"X3",[Char]
"X4") Expr (a, b, c, d) t
x
instance Show (Lam t) where
show :: Lam t -> [Char]
show Lam t
x = StringEnv -> Lam t -> [Char]
forall t. StringEnv -> Lam t -> [Char]
showL ([Char]
"X1",[Char]
"X2",[Char]
"X3",[Char]
"X4") Lam t
x
data Fun t = Fun (Lam t) t
instance Show (Fun t) where
show :: Fun t -> [Char]
show (Fun Lam t
lam t
_fun) = Lam t -> [Char]
forall a. Show a => a -> [Char]
show Lam t
lam
apply :: Fun t -> t
apply :: Fun t -> t
apply (Fun Lam t
_e t
f) = t
f
first :: Fun (v -> s -> v)
first :: Fun (v -> s -> v)
first = Lam (v -> s -> v) -> (v -> s -> v) -> Fun (v -> s -> v)
forall t. Lam t -> t -> Fun t
Fun (Pat (v, s, Any, Any) v
-> Pat (v, s, Any, Any) s
-> Expr (v, s, Any, Any) v
-> Lam (v -> s -> v)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (v, s, Any, Any) v
forall d c b a. Pat (d, c, b, a) d
P1 Pat (v, s, Any, Any) s
forall d c b a. Pat (d, c, b, a) c
P2 Expr (v, s, Any, Any) v
forall d c b a. Expr (d, c, b, a) d
X1) (\ v
x s
_y -> v
x)
second:: Fun (v -> s -> s)
second :: Fun (v -> s -> s)
second = Lam (v -> s -> s) -> (v -> s -> s) -> Fun (v -> s -> s)
forall t. Lam t -> t -> Fun t
Fun (Pat (v, s, Any, Any) v
-> Pat (v, s, Any, Any) s
-> Expr (v, s, Any, Any) s
-> Lam (v -> s -> s)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (v, s, Any, Any) v
forall d c b a. Pat (d, c, b, a) d
P1 Pat (v, s, Any, Any) s
forall d c b a. Pat (d, c, b, a) c
P2 Expr (v, s, Any, Any) s
forall d c b a. Expr (d, c, b, a) c
X2) (\ v
_x s
y -> s
y)
plus:: Monoid t => Fun (t -> t -> t)
plus :: Fun (t -> t -> t)
plus = (Lam (t -> t -> t) -> (t -> t -> t) -> Fun (t -> t -> t)
forall t. Lam t -> t -> Fun t
Fun Lam (t -> t -> t)
forall m. Monoid m => Lam (m -> m -> m)
Cat t -> t -> t
forall a. Semigroup a => a -> a -> a
(<>))
eql :: Eq t => Fun (t -> t -> Bool)
eql :: Fun (t -> t -> Bool)
eql = (Lam (t -> t -> Bool) -> (t -> t -> Bool) -> Fun (t -> t -> Bool)
forall t. Lam t -> t -> Fun t
Fun Lam (t -> t -> Bool)
forall t. Eq t => Lam (t -> t -> Bool)
Eql t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(==))
constant:: Show c => c -> Fun(a -> b -> c)
constant :: c -> Fun (a -> b -> c)
constant c
c = Lam (a -> b -> c) -> (a -> b -> c) -> Fun (a -> b -> c)
forall t. Lam t -> t -> Fun t
Fun (Pat (a, b, Any, Any) a
-> Pat (a, b, Any, Any) b
-> Expr (a, b, Any, Any) c
-> Lam (a -> b -> c)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (a, b, Any, Any) a
forall d c b a. Pat (d, c, b, a) d
P1 Pat (a, b, Any, Any) b
forall d c b a. Pat (d, c, b, a) c
P2 (c -> Expr (a, b, Any, Any) c
forall t env. Show t => t -> Expr env t
Lit c
c)) (\ a
_x b
_y -> c
c)
rngElem:: (Ord rng,Iter f) => f rng v -> Fun(dom -> rng -> Bool)
rngElem :: f rng v -> Fun (dom -> rng -> Bool)
rngElem f rng v
realset = Lam (dom -> rng -> Bool)
-> (dom -> rng -> Bool) -> Fun (dom -> rng -> Bool)
forall t. Lam t -> t -> Fun t
Fun (Pat (dom, rng, Any, Any) dom
-> Pat (dom, rng, Any, Any) rng
-> Expr (dom, rng, Any, Any) Bool
-> Lam (dom -> rng -> Bool)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (dom, rng, Any, Any) dom
forall d c b a. Pat (d, c, b, a) d
P1 Pat (dom, rng, Any, Any) rng
forall d c b a. Pat (d, c, b, a) c
P2 (Expr (dom, rng, Any, Any) rng
-> f rng v -> Expr (dom, rng, Any, Any) Bool
forall (f :: * -> * -> *) k e a.
(Iter f, Ord k) =>
Expr e k -> f k a -> Expr e Bool
HasKey Expr (dom, rng, Any, Any) rng
forall d c b a. Expr (d, c, b, a) c
X2 f rng v
realset)) (\ dom
_x rng
y -> rng -> f rng v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey rng
y f rng v
realset)
domElem:: (Ord dom,Iter f) => f dom v -> Fun(dom -> rng -> Bool)
domElem :: f dom v -> Fun (dom -> rng -> Bool)
domElem f dom v
realset = Lam (dom -> rng -> Bool)
-> (dom -> rng -> Bool) -> Fun (dom -> rng -> Bool)
forall t. Lam t -> t -> Fun t
Fun (Pat (dom, rng, Any, Any) dom
-> Pat (dom, rng, Any, Any) rng
-> Expr (dom, rng, Any, Any) Bool
-> Lam (dom -> rng -> Bool)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (dom, rng, Any, Any) dom
forall d c b a. Pat (d, c, b, a) d
P1 Pat (dom, rng, Any, Any) rng
forall d c b a. Pat (d, c, b, a) c
P2 (Expr (dom, rng, Any, Any) dom
-> f dom v -> Expr (dom, rng, Any, Any) Bool
forall (f :: * -> * -> *) k e a.
(Iter f, Ord k) =>
Expr e k -> f k a -> Expr e Bool
HasKey Expr (dom, rng, Any, Any) dom
forall d c b a. Expr (d, c, b, a) d
X1 f dom v
realset)) (\ dom
x rng
_y -> dom -> f dom v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey dom
x f dom v
realset)
rngFst:: Fun(x -> (a,b) -> a)
rngFst :: Fun (x -> (a, b) -> a)
rngFst = Lam (x -> (a, b) -> a)
-> (x -> (a, b) -> a) -> Fun (x -> (a, b) -> a)
forall t. Lam t -> t -> Fun t
Fun (Pat (x, a, b, a) x
-> Pat (x, a, b, a) (a, b)
-> Expr (x, a, b, a) a
-> Lam (x -> (a, b) -> a)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (x, a, b, a) x
forall d c b a. Pat (d, c, b, a) d
P1 (Pat (x, a, b, a) a -> Pat (x, a, b, a) b -> Pat (x, a, b, a) (a, b)
forall d c b a.
Pat (d, c, b, a) a -> Pat (d, c, b, a) b -> Pat (d, c, b, a) (a, b)
PPair Pat (x, a, b, a) a
forall d c b a. Pat (d, c, b, a) c
P2 Pat (x, a, b, a) b
forall d c b a. Pat (d, c, b, a) b
P3) Expr (x, a, b, a) a
forall d c b a. Expr (d, c, b, a) c
X2) (\ x
_x (a
a,b
_b) -> a
a)
rngSnd:: Fun(x -> (a,b) -> b)
rngSnd :: Fun (x -> (a, b) -> b)
rngSnd = Lam (x -> (a, b) -> b)
-> (x -> (a, b) -> b) -> Fun (x -> (a, b) -> b)
forall t. Lam t -> t -> Fun t
Fun (Pat (x, a, b, a) x
-> Pat (x, a, b, a) (a, b)
-> Expr (x, a, b, a) b
-> Lam (x -> (a, b) -> b)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (x, a, b, a) x
forall d c b a. Pat (d, c, b, a) d
P1 (Pat (x, a, b, a) a -> Pat (x, a, b, a) b -> Pat (x, a, b, a) (a, b)
forall d c b a.
Pat (d, c, b, a) a -> Pat (d, c, b, a) b -> Pat (d, c, b, a) (a, b)
PPair Pat (x, a, b, a) a
forall d c b a. Pat (d, c, b, a) c
P2 Pat (x, a, b, a) b
forall d c b a. Pat (d, c, b, a) b
P3) Expr (x, a, b, a) b
forall d c b a. Expr (d, c, b, a) b
X3) (\ x
_x (a, b)
y -> (a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
y)
compose1 :: Fun (t1 -> t2 -> t3) -> Fun (t1 -> t4 -> t2) -> Fun (t1 -> t4 -> t3)
compose1 :: Fun (t1 -> t2 -> t3)
-> Fun (t1 -> t4 -> t2) -> Fun (t1 -> t4 -> t3)
compose1 (Fun Lam (t1 -> t2 -> t3)
e1 t1 -> t2 -> t3
f1) (Fun Lam (t1 -> t4 -> t2)
e2 t1 -> t4 -> t2
f2) = Lam (t1 -> t4 -> t3) -> (t1 -> t4 -> t3) -> Fun (t1 -> t4 -> t3)
forall t. Lam t -> t -> Fun t
Fun (Pat (t1, t4, Any, Any) t1
-> Pat (t1, t4, Any, Any) t4
-> Expr (t1, t4, Any, Any) t3
-> Lam (t1 -> t4 -> t3)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (t1, t4, Any, Any) t1
forall d c b a. Pat (d, c, b, a) d
P1 Pat (t1, t4, Any, Any) t4
forall d c b a. Pat (d, c, b, a) c
P2 (Lam (t1 -> t2 -> t3)
-> Expr (t1, t4, Any, Any) t1
-> Expr (t1, t4, Any, Any) t2
-> Expr (t1, t4, Any, Any) t3
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (t1 -> t2 -> t3)
e1 Expr (t1, t4, Any, Any) t1
forall d c b a. Expr (d, c, b, a) d
X1 (Lam (t1 -> t4 -> t2)
-> Expr (t1, t4, Any, Any) t1
-> Expr (t1, t4, Any, Any) t4
-> Expr (t1, t4, Any, Any) t2
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (t1 -> t4 -> t2)
e2 Expr (t1, t4, Any, Any) t1
forall d c b a. Expr (d, c, b, a) d
X1 Expr (t1, t4, Any, Any) t4
forall d c b a. Expr (d, c, b, a) c
X2))) (\ t1
a t4
b -> t1 -> t2 -> t3
f1 t1
a (t1 -> t4 -> t2
f2 t1
a t4
b))
compSndL:: Fun(k -> (a,b) -> c) -> Fun(k -> d -> a) -> Fun(k -> (d,b) -> c)
compSndL :: Fun (k -> (a, b) -> c)
-> Fun (k -> d -> a) -> Fun (k -> (d, b) -> c)
compSndL (Fun Lam (k -> (a, b) -> c)
m k -> (a, b) -> c
mf) (Fun Lam (k -> d -> a)
g k -> d -> a
mg) = Lam (k -> (d, b) -> c)
-> (k -> (d, b) -> c) -> Fun (k -> (d, b) -> c)
forall t. Lam t -> t -> Fun t
Fun (Pat (k, d, b, d) k
-> Pat (k, d, b, d) (d, b)
-> Expr (k, d, b, d) c
-> Lam (k -> (d, b) -> c)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (k, d, b, d) k
forall d c b a. Pat (d, c, b, a) d
P1 (Pat (k, d, b, d) d -> Pat (k, d, b, d) b -> Pat (k, d, b, d) (d, b)
forall d c b a.
Pat (d, c, b, a) a -> Pat (d, c, b, a) b -> Pat (d, c, b, a) (a, b)
PPair Pat (k, d, b, d) d
forall d c b a. Pat (d, c, b, a) c
P2 Pat (k, d, b, d) b
forall d c b a. Pat (d, c, b, a) b
P3) (Lam (k -> (a, b) -> c)
-> Expr (k, d, b, d) k
-> Expr (k, d, b, d) (a, b)
-> Expr (k, d, b, d) c
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> (a, b) -> c)
m Expr (k, d, b, d) k
forall d c b a. Expr (d, c, b, a) d
X1 (Expr (k, d, b, d) a
-> Expr (k, d, b, d) b -> Expr (k, d, b, d) (a, b)
forall e a b. Expr e a -> Expr e b -> Expr e (a, b)
EPair (Lam (k -> d -> a)
-> Expr (k, d, b, d) k
-> Expr (k, d, b, d) d
-> Expr (k, d, b, d) a
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> d -> a)
g Expr (k, d, b, d) k
forall d c b a. Expr (d, c, b, a) d
X1 Expr (k, d, b, d) d
forall d c b a. Expr (d, c, b, a) c
X2) Expr (k, d, b, d) b
forall d c b a. Expr (d, c, b, a) b
X3))) (\ k
x (d
a,b
b) -> k -> (a, b) -> c
mf k
x (k -> d -> a
mg k
x d
a,b
b))
compSndR:: Fun(k -> (a,b) -> c) -> Fun(k -> d -> b) -> Fun(k -> (a,d) -> c)
compSndR :: Fun (k -> (a, b) -> c)
-> Fun (k -> d -> b) -> Fun (k -> (a, d) -> c)
compSndR (Fun Lam (k -> (a, b) -> c)
m k -> (a, b) -> c
mf) (Fun Lam (k -> d -> b)
g k -> d -> b
mg) = (Lam (k -> (a, d) -> c)
-> (k -> (a, d) -> c) -> Fun (k -> (a, d) -> c)
forall t. Lam t -> t -> Fun t
Fun (Pat (k, a, d, a) k
-> Pat (k, a, d, a) (a, d)
-> Expr (k, a, d, a) c
-> Lam (k -> (a, d) -> c)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (k, a, d, a) k
forall d c b a. Pat (d, c, b, a) d
P1 (Pat (k, a, d, a) a -> Pat (k, a, d, a) d -> Pat (k, a, d, a) (a, d)
forall d c b a.
Pat (d, c, b, a) a -> Pat (d, c, b, a) b -> Pat (d, c, b, a) (a, b)
PPair Pat (k, a, d, a) a
forall d c b a. Pat (d, c, b, a) c
P2 Pat (k, a, d, a) d
forall d c b a. Pat (d, c, b, a) b
P3) (Lam (k -> (a, b) -> c)
-> Expr (k, a, d, a) k
-> Expr (k, a, d, a) (a, b)
-> Expr (k, a, d, a) c
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> (a, b) -> c)
m Expr (k, a, d, a) k
forall d c b a. Expr (d, c, b, a) d
X1 (Expr (k, a, d, a) a
-> Expr (k, a, d, a) b -> Expr (k, a, d, a) (a, b)
forall e a b. Expr e a -> Expr e b -> Expr e (a, b)
EPair Expr (k, a, d, a) a
forall d c b a. Expr (d, c, b, a) c
X2 (Lam (k -> d -> b)
-> Expr (k, a, d, a) k
-> Expr (k, a, d, a) d
-> Expr (k, a, d, a) b
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> d -> b)
g Expr (k, a, d, a) k
forall d c b a. Expr (d, c, b, a) d
X1 Expr (k, a, d, a) d
forall d c b a. Expr (d, c, b, a) b
X3)))) (\ k
x (a
a,d
b) -> k -> (a, b) -> c
mf k
x (a
a,k -> d -> b
mg k
x d
b)))
compCurryR :: Fun(k -> (a,b) -> d) -> Fun(a -> c -> b) -> Fun(k -> (a,c) -> d)
compCurryR :: Fun (k -> (a, b) -> d)
-> Fun (a -> c -> b) -> Fun (k -> (a, c) -> d)
compCurryR (Fun Lam (k -> (a, b) -> d)
ef k -> (a, b) -> d
f) (Fun Lam (a -> c -> b)
eg a -> c -> b
g) = Lam (k -> (a, c) -> d)
-> (k -> (a, c) -> d) -> Fun (k -> (a, c) -> d)
forall t. Lam t -> t -> Fun t
Fun (Pat (k, a, c, a) k
-> Pat (k, a, c, a) (a, c)
-> Expr (k, a, c, a) d
-> Lam (k -> (a, c) -> d)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (k, a, c, a) k
forall d c b a. Pat (d, c, b, a) d
P1 (Pat (k, a, c, a) a -> Pat (k, a, c, a) c -> Pat (k, a, c, a) (a, c)
forall d c b a.
Pat (d, c, b, a) a -> Pat (d, c, b, a) b -> Pat (d, c, b, a) (a, b)
PPair Pat (k, a, c, a) a
forall d c b a. Pat (d, c, b, a) c
P2 Pat (k, a, c, a) c
forall d c b a. Pat (d, c, b, a) b
P3) (Lam (k -> (a, b) -> d)
-> Expr (k, a, c, a) k
-> Expr (k, a, c, a) (a, b)
-> Expr (k, a, c, a) d
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> (a, b) -> d)
ef Expr (k, a, c, a) k
forall d c b a. Expr (d, c, b, a) d
X1 (Expr (k, a, c, a) a
-> Expr (k, a, c, a) b -> Expr (k, a, c, a) (a, b)
forall e a b. Expr e a -> Expr e b -> Expr e (a, b)
EPair Expr (k, a, c, a) a
forall d c b a. Expr (d, c, b, a) c
X2 (Lam (a -> c -> b)
-> Expr (k, a, c, a) a
-> Expr (k, a, c, a) c
-> Expr (k, a, c, a) b
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (a -> c -> b)
eg Expr (k, a, c, a) a
forall d c b a. Expr (d, c, b, a) c
X2 Expr (k, a, c, a) c
forall d c b a. Expr (d, c, b, a) b
X3)))) (\ k
x (a
a,c
b) -> k -> (a, b) -> d
f k
x(a
a,a -> c -> b
g a
a c
b))
nEgate:: Fun(k -> v -> Bool) -> Fun(k -> v -> Bool)
nEgate :: Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
nEgate (Fun Lam (k -> v -> Bool)
ef k -> v -> Bool
f) = Lam (k -> v -> Bool) -> (k -> v -> Bool) -> Fun (k -> v -> Bool)
forall t. Lam t -> t -> Fun t
Fun (Pat (k, v, Any, Any) k
-> Pat (k, v, Any, Any) v
-> Expr (k, v, Any, Any) Bool
-> Lam (k -> v -> Bool)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (k, v, Any, Any) k
forall d c b a. Pat (d, c, b, a) d
P1 Pat (k, v, Any, Any) v
forall d c b a. Pat (d, c, b, a) c
P2 (Expr (k, v, Any, Any) Bool -> Expr (k, v, Any, Any) Bool
forall e. Expr e Bool -> Expr e Bool
Neg (Lam (k -> v -> Bool)
-> Expr (k, v, Any, Any) k
-> Expr (k, v, Any, Any) v
-> Expr (k, v, Any, Any) Bool
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (k -> v -> Bool)
ef Expr (k, v, Any, Any) k
forall d c b a. Expr (d, c, b, a) d
X1 Expr (k, v, Any, Any) v
forall d c b a. Expr (d, c, b, a) c
X2))) (\ k
x v
y -> Bool -> Bool
not(k -> v -> Bool
f k
x v
y))
always:: Fun(a -> b -> Bool)
always :: Fun (a -> b -> Bool)
always = Bool -> Fun (a -> b -> Bool)
forall c a b. Show c => c -> Fun (a -> b -> c)
constant Bool
True
both:: Fun(a -> b -> Bool) -> Fun(a -> b -> Bool) -> Fun(a -> b -> Bool)
both :: Fun (a -> b -> Bool)
-> Fun (a -> b -> Bool) -> Fun (a -> b -> Bool)
both (Fun Lam (a -> b -> Bool)
ef a -> b -> Bool
e) (Fun Lam (a -> b -> Bool)
ff a -> b -> Bool
f) = Lam (a -> b -> Bool) -> (a -> b -> Bool) -> Fun (a -> b -> Bool)
forall t. Lam t -> t -> Fun t
Fun (Pat (a, b, Any, Any) a
-> Pat (a, b, Any, Any) b
-> Expr (a, b, Any, Any) Bool
-> Lam (a -> b -> Bool)
forall d c b a m a b.
Pat (d, c, b, a) m
-> Pat (d, c, b, a) a -> Expr (d, c, b, a) b -> Lam (m -> a -> b)
Lam Pat (a, b, Any, Any) a
forall d c b a. Pat (d, c, b, a) d
P1 Pat (a, b, Any, Any) b
forall d c b a. Pat (d, c, b, a) c
P2 (Lam (Bool -> Bool -> Bool)
-> Expr (a, b, Any, Any) Bool
-> Expr (a, b, Any, Any) Bool
-> Expr (a, b, Any, Any) Bool
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (Bool -> Bool -> Bool)
Both (Lam (a -> b -> Bool)
-> Expr (a, b, Any, Any) a
-> Expr (a, b, Any, Any) b
-> Expr (a, b, Any, Any) Bool
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (a -> b -> Bool)
ef Expr (a, b, Any, Any) a
forall d c b a. Expr (d, c, b, a) d
X1 Expr (a, b, Any, Any) b
forall d c b a. Expr (d, c, b, a) c
X2) (Lam (a -> b -> Bool)
-> Expr (a, b, Any, Any) a
-> Expr (a, b, Any, Any) b
-> Expr (a, b, Any, Any) Bool
forall a b c e.
Lam (a -> b -> c) -> Expr e a -> Expr e b -> Expr e c
Ap Lam (a -> b -> Bool)
ff Expr (a, b, Any, Any) a
forall d c b a. Expr (d, c, b, a) d
X1 Expr (a, b, Any, Any) b
forall d c b a. Expr (d, c, b, a) c
X2))) (\ a
a b
b -> (a -> b -> Bool
e a
a b
b) Bool -> Bool -> Bool
&& (a -> b -> Bool
f a
a b
b))
lift :: (a -> b -> c) -> Fun (a -> b -> c)
lift :: (a -> b -> c) -> Fun (a -> b -> c)
lift a -> b -> c
f = Lam (a -> b -> c) -> (a -> b -> c) -> Fun (a -> b -> c)
forall t. Lam t -> t -> Fun t
Fun ((a -> b -> c) -> Lam (a -> b -> c)
forall a b c. (a -> b -> c) -> Lam (a -> b -> c)
Lift a -> b -> c
f) a -> b -> c
f
materialize :: (Ord k) => BaseRep f k v -> Collect (k,v) -> f k v
materialize :: BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
ListR Collect (k, v)
x = (v -> v -> v) -> [(k, v)] -> List k v
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> List k v
fromPairs (\ v
l v
_r -> v
l) (Collect (k, v)
-> [(k, v)] -> ((k, v) -> [(k, v)] -> [(k, v)]) -> [(k, v)]
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect Collect (k, v)
x [] (:))
materialize BaseRep f k v
MapR Collect (k, v)
x = Collect (k, v)
-> Map k v -> ((k, v) -> Map k v -> Map k v) -> Map k v
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect Collect (k, v)
x Map k v
forall k a. Map k a
Map.empty (\ (k
k,v
v) Map k v
ans -> k -> v -> Map k v -> Map k v
forall k v. Ord k => k -> v -> Map k v -> Map k v
Map.insert k
k v
v Map k v
ans)
materialize BaseRep f k v
SetR Collect (k, v)
x = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Collect (k, v) -> Set k -> ((k, v) -> Set k -> Set k) -> Set k
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect Collect (k, v)
x Set k
forall a. Set a
Set.empty (\ (k
k,v
_) Set k
ans -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans))
materialize BaseRep f k v
BiMapR Collect (k, v)
x = Collect (k, v)
-> BiMap v k v
-> ((k, v) -> BiMap v k v -> BiMap v k v)
-> BiMap v k v
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect Collect (k, v)
x BiMap v k v
forall v k. BiMap v k v
biMapEmpty (\ (k
k,v
v) BiMap v k v
ans -> k -> v -> BiMap v k v -> BiMap v k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
k -> v -> f k v -> f k v
addpair k
k v
v BiMap v k v
ans)
materialize BaseRep f k v
SingleR Collect (k, v)
x = Collect (k, v)
-> Single k v -> ((k, v) -> Single k v -> Single k v) -> Single k v
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect Collect (k, v)
x Single k v
forall k v. Single k v
Fail (\ (k
k,v
v) Single k v
_ignore -> k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
k v
v)
addp :: (Ord k,Basic f) => (v -> v -> v) -> (k,v) -> f k v -> f k v
addp :: (v -> v -> v) -> (k, v) -> f k v -> f k v
addp v -> v -> v
combine (k
k,v
v) f k v
xs = (k, v) -> f k v -> (v -> v -> v) -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) f k v
xs v -> v -> v
combine
fromList:: Ord k => BaseRep f k v -> (v -> v -> v) -> [(k,v)] -> f k v
fromList :: BaseRep f k v -> (v -> v -> v) -> [(k, v)] -> f k v
fromList BaseRep f k v
MapR v -> v -> v
combine [(k, v)]
xs = (v -> v -> v) -> [(k, v)] -> Map k v
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith v -> v -> v
combine [(k, v)]
xs
fromList BaseRep f k v
ListR v -> v -> v
combine [(k, v)]
xs = (v -> v -> v) -> [(k, v)] -> List k v
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> List k v
fromPairs v -> v -> v
combine [(k, v)]
xs
fromList BaseRep f k v
SetR v -> v -> v
combine [(k, v)]
xs = ((k, v) -> Sett k v -> Sett k v)
-> Sett k v -> [(k, v)] -> Sett k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((v -> v -> v) -> (k, v) -> Sett k v -> Sett k v
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
(v -> v -> v) -> (k, v) -> f k v -> f k v
addp v -> v -> v
combine) (Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k
forall a. Set a
Set.empty)) [(k, v)]
xs
fromList BaseRep f k v
BiMapR v -> v -> v
combine [(k, v)]
xs = (v -> v -> v) -> [(k, v)] -> BiMap v k v
forall k v.
(Ord k, Ord v) =>
(v -> v -> v) -> [(k, v)] -> BiMap v k v
biMapFromList v -> v -> v
combine [(k, v)]
xs
fromList BaseRep f k v
SingleR v -> v -> v
combine [(k, v)]
xs = ((k, v) -> Single k v -> Single k v)
-> Single k v -> [(k, v)] -> Single k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((v -> v -> v) -> (k, v) -> Single k v -> Single k v
forall k (f :: * -> * -> *) v.
(Ord k, Basic f) =>
(v -> v -> v) -> (k, v) -> f k v -> f k v
addp v -> v -> v
combine) Single k v
forall k v. Single k v
Fail [(k, v)]
xs
(⨝) :: (Ord k,Iter f,Iter g) => f k b -> g k c -> Collect (k,b,c)
⨝ :: f k b -> g k c -> Collect (k, b, c)
(⨝) = f k b -> g k c -> Collect (k, b, c)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
domEq
domEq:: (Ord k,Iter f,Iter g) => f k b -> g k c -> Collect (k,b,c)
domEq :: f k b -> g k c -> Collect (k, b, c)
domEq f k b
m g k c
n = do
(k, b, f k b)
triplem <- f k b -> Collect (k, b, f k b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f k b
m
(k, c, g k c)
triplen <- g k c -> Collect (k, c, g k c)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt g k c
n
let loop :: (k, b, f k b) -> (k, b, f k b) -> Collect (k, b, b)
loop (mt :: (k, b, f k b)
mt@(k
k1,b
b,f k b
nextm)) (nt :: (k, b, f k b)
nt@(k
k2,b
c,f k b
nextn)) =
case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
Ordering
EQ -> (k, b, b) -> Collect (k, b, b) -> Collect (k, b, b)
forall t. t -> Collect t -> Collect t
front (k
k1,b
b,b
c) (f k b -> f k b -> Collect (k, b, b)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
domEq f k b
nextm f k b
nextn)
Ordering
LT -> do { (k, b, f k b)
mt' <- k -> f k b -> Collect (k, b, f k b)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Collect (k, b, f k b)
lub k
k2 f k b
nextm; (k, b, f k b) -> (k, b, f k b) -> Collect (k, b, b)
loop (k, b, f k b)
mt' (k, b, f k b)
nt }
Ordering
GT -> do { (k, b, f k b)
nt' <- k -> f k b -> Collect (k, b, f k b)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Collect (k, b, f k b)
lub k
k1 f k b
nextn; (k, b, f k b) -> (k, b, f k b) -> Collect (k, b, b)
loop (k, b, f k b)
mt (k, b, f k b)
nt' }
(k, b, f k b) -> (k, c, g k c) -> Collect (k, b, c)
forall k (f :: * -> * -> *) (f :: * -> * -> *) b b.
(Ord k, Iter f, Iter f) =>
(k, b, f k b) -> (k, b, f k b) -> Collect (k, b, b)
loop (k, b, f k b)
triplem (k, c, g k c)
triplen
domEqSlow:: (Ord k,Iter f, Iter g) => f k b -> g k c -> Collect (k,b,c)
domEqSlow :: f k b -> g k c -> Collect (k, b, c)
domEqSlow f k b
m g k c
n = do
(k, b, f k b)
triplem <- f k b -> Collect (k, b, f k b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f k b
m
(k, c, g k c)
triplen <- g k c -> Collect (k, c, g k c)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt g k c
n
let loop :: (a, b, f a b) -> (a, b, f a b) -> Collect (a, b, b)
loop (mt :: (a, b, f a b)
mt@(a
k1,b
b,f a b
nextm)) (nt :: (a, b, f a b)
nt@(a
k2,b
c,f a b
nextn)) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
Ordering
EQ -> (a, b, b) -> Collect (a, b, b) -> Collect (a, b, b)
forall t. t -> Collect t -> Collect t
front (a
k1,b
b,b
c) (f a b -> f a b -> Collect (a, b, b)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
domEqSlow f a b
nextm f a b
nextn)
Ordering
LT -> do { (a, b, f a b)
mt' <- f a b -> Collect (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f a b
nextm; (a, b, f a b) -> (a, b, f a b) -> Collect (a, b, b)
loop (a, b, f a b)
mt' (a, b, f a b)
nt }
Ordering
GT -> do { (a, b, f a b)
nt' <- f a b -> Collect (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f a b
nextn; (a, b, f a b) -> (a, b, f a b) -> Collect (a, b, b)
loop (a, b, f a b)
mt (a, b, f a b)
nt' }
(k, b, f k b) -> (k, c, g k c) -> Collect (k, b, c)
forall k (f :: * -> * -> *) (f :: * -> * -> *) b b.
(Ord k, Iter f, Iter f) =>
(k, b, f k b) -> (k, b, f k b) -> Collect (k, b, b)
loop (k, b, f k b)
triplem (k, c, g k c)
triplen
data Query k v where
BaseD :: (Iter f,Ord k) => BaseRep f k v -> f k v -> Query k v
ProjectD :: Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
AndD :: Ord k => Query k v -> Query k w -> Query k (v,w)
ChainD:: (Ord k,Ord v) => Query k v -> Query v w -> Fun(k -> (v,w) -> u) -> Query k u
AndPD:: Ord k => Query k v -> Query k u -> Fun(k -> (v,u) -> w) -> Query k w
OrD:: Ord k => Query k v -> Query k v -> Fun(v -> v -> v) -> Query k v
GuardD:: Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
DiffD :: Ord k => Query k v -> Query k u -> Query k v
smart :: Bool
smart :: Bool
smart = Bool
True
projD :: Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
projD :: Query k v -> Fun (k -> v -> u) -> Query k u
projD Query k v
x Fun (k -> v -> u)
y = case (Query k v
x,Fun (k -> v -> u)
y) of
(ProjectD Query k v
f Fun (k -> v -> v)
p, Fun (k -> v -> u)
q) | Bool
smart -> Query k v -> Fun (k -> v -> u) -> Query k u
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
projD Query k v
f (Fun (k -> v -> u) -> Fun (k -> v -> v) -> Fun (k -> v -> u)
forall t1 t2 t3 t4.
Fun (t1 -> t2 -> t3)
-> Fun (t1 -> t4 -> t2) -> Fun (t1 -> t4 -> t3)
compose1 Fun (k -> v -> u)
q Fun (k -> v -> v)
p)
(AndD Query k v
f Query k w
g,Fun (k -> v -> u)
q) | Bool
smart -> Query k v -> Query k w -> Fun (k -> (v, w) -> u) -> Query k u
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD Query k v
f Query k w
g (Fun (k -> v -> u) -> Fun (k -> v -> v) -> Fun (k -> v -> u)
forall t1 t2 t3 t4.
Fun (t1 -> t2 -> t3)
-> Fun (t1 -> t4 -> t2) -> Fun (t1 -> t4 -> t3)
compose1 Fun (k -> v -> u)
q Fun (k -> v -> v)
forall v s. Fun (v -> s -> s)
second)
(AndPD Query k v
f Query k u
g Fun (k -> (v, u) -> v)
p, Fun (k -> v -> u)
q) | Bool
smart -> Query k v -> Query k u -> Fun (k -> (v, u) -> u) -> Query k u
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD Query k v
f Query k u
g (Fun (k -> v -> u)
-> Fun (k -> (v, u) -> v) -> Fun (k -> (v, u) -> u)
forall t1 t2 t3 t4.
Fun (t1 -> t2 -> t3)
-> Fun (t1 -> t4 -> t2) -> Fun (t1 -> t4 -> t3)
compose1 Fun (k -> v -> u)
q Fun (k -> (v, u) -> v)
p)
(Query k v
f, Fun (k -> v -> u)
p) -> Query k v -> Fun (k -> v -> u) -> Query k u
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
ProjectD Query k v
f Fun (k -> v -> u)
p
andD :: Ord k => Query k v1 -> Query k v2 -> Query k (v1, v2)
andD :: Query k v1 -> Query k v2 -> Query k (v1, v2)
andD (ProjectD Query k v
f Fun (k -> v -> v1)
p) Query k v2
g | Bool
smart = Query k v
-> Query k v2 -> Fun (k -> (v, v2) -> (v1, v2)) -> Query k (v1, v2)
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
AndPD Query k v
f Query k v2
g (Fun (k -> (v1, v2) -> (v1, v2))
-> Fun (k -> v -> v1) -> Fun (k -> (v, v2) -> (v1, v2))
forall k a b c d.
Fun (k -> (a, b) -> c)
-> Fun (k -> d -> a) -> Fun (k -> (d, b) -> c)
compSndL Fun (k -> (v1, v2) -> (v1, v2))
forall v s. Fun (v -> s -> s)
second Fun (k -> v -> v1)
p)
andD Query k v1
f (ProjectD Query k v
g Fun (k -> v -> v2)
p) | Bool
smart = Query k v1
-> Query k v -> Fun (k -> (v1, v) -> (v1, v2)) -> Query k (v1, v2)
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
AndPD Query k v1
f Query k v
g (Fun (k -> (v1, v2) -> (v1, v2))
-> Fun (k -> v -> v2) -> Fun (k -> (v1, v) -> (v1, v2))
forall k a b c d.
Fun (k -> (a, b) -> c)
-> Fun (k -> d -> b) -> Fun (k -> (a, d) -> c)
compSndR Fun (k -> (v1, v2) -> (v1, v2))
forall v s. Fun (v -> s -> s)
second Fun (k -> v -> v2)
p)
andD Query k v1
f Query k v2
g = Query k v1 -> Query k v2 -> Query k (v1, v2)
forall k v w. Ord k => Query k v -> Query k w -> Query k (v, w)
AndD Query k v1
f Query k v2
g
andPD :: Ord k => Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD :: Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD (ProjectD Query k v
f Fun (k -> v -> v1)
p) Query k u
g Fun (k -> (v1, u) -> v)
q | Bool
smart = Query k v -> Query k u -> Fun (k -> (v, u) -> v) -> Query k v
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD Query k v
f Query k u
g (Fun (k -> (v1, u) -> v)
-> Fun (k -> v -> v1) -> Fun (k -> (v, u) -> v)
forall k a b c d.
Fun (k -> (a, b) -> c)
-> Fun (k -> d -> a) -> Fun (k -> (d, b) -> c)
compSndL Fun (k -> (v1, u) -> v)
q Fun (k -> v -> v1)
p)
andPD Query k v1
f Query k u
g Fun (k -> (v1, u) -> v)
p = Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
AndPD Query k v1
f Query k u
g Fun (k -> (v1, u) -> v)
p
chainD :: (Ord k,Ord v) => Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
chainD :: Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
chainD Query k v
f (ProjectD Query v v
g Fun (v -> v -> w)
p) Fun (k -> (v, w) -> u)
q | Bool
smart = Query k v -> Query v v -> Fun (k -> (v, v) -> u) -> Query k u
forall k v w u.
(Ord k, Ord v) =>
Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
chainD Query k v
f Query v v
g (Fun (k -> (v, w) -> u)
-> Fun (v -> v -> w) -> Fun (k -> (v, v) -> u)
forall k a b d c.
Fun (k -> (a, b) -> d)
-> Fun (a -> c -> b) -> Fun (k -> (a, c) -> d)
compCurryR Fun (k -> (v, w) -> u)
q Fun (v -> v -> w)
p)
chainD Query k v
f Query v w
g Fun (k -> (v, w) -> u)
p = Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
forall k v w u.
(Ord k, Ord v) =>
Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
ChainD Query k v
f Query v w
g Fun (k -> (v, w) -> u)
p
guardD :: Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
guardD :: Query k v -> Fun (k -> v -> Bool) -> Query k v
guardD (GuardD Query k v
q1 Fun (k -> v -> Bool)
test1) Fun (k -> v -> Bool)
test2 | Bool
smart = Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query k v
q1 (Fun (k -> v -> Bool)
-> Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
forall a b.
Fun (a -> b -> Bool)
-> Fun (a -> b -> Bool) -> Fun (a -> b -> Bool)
both Fun (k -> v -> Bool)
test1 Fun (k -> v -> Bool)
test2)
guardD Query k v
qry Fun (k -> v -> Bool)
test = Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query k v
qry Fun (k -> v -> Bool)
test
compileSubterm :: Exp a -> Exp (f k v) -> Query k v
compileSubterm :: Exp a -> Exp (f k v) -> Query k v
compileSubterm Exp a
_whole Exp (f k v)
sub = (Query k v, BaseRep f k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
sub)
compile:: Exp (f k v) -> (Query k v,BaseRep f k v)
compile :: Exp (f k v) -> (Query k v, BaseRep f k v)
compile (Base BaseRep f k v
rep f k v
relation) = (BaseRep f k v -> f k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep f k v
rep f k v
relation,BaseRep f k v
BaseRep f k v
rep)
compile (Singleton k
d v
r) = (BaseRep Single k v -> Single k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Single k v
forall k v. Basic Single => BaseRep Single k v
SingleR (k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
d v
r),BaseRep f k v
forall k v. Basic Single => BaseRep Single k v
SingleR)
compile (SetSingleton k
d ) = (BaseRep Single k () -> Single k () -> Query k ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Single k ()
forall k v. Basic Single => BaseRep Single k v
SingleR (k -> Single k ()
forall k. k -> Single k ()
SetSingle k
d ),BaseRep f k v
forall k v. Basic Single => BaseRep Single k v
SingleR)
compile (Dom (Base BaseRep f k v
SetR f k v
rel)) = (BaseRep Sett k () -> Sett k () -> Query k ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR f k v
Sett k ()
rel,BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Dom (Singleton k
k v
_v)) = (BaseRep Sett k () -> Sett k () -> Query k ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(k -> Set k
forall a. a -> Set a
Set.singleton k
k)),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Dom (SetSingleton k
k)) = (BaseRep Sett k () -> Sett k () -> Query k ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(k -> Set k
forall a. a -> Set a
Set.singleton k
k)),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Dom Exp (f k v)
x) = (Query k v -> Fun (k -> v -> ()) -> Query k ()
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
projD ((Query k v, BaseRep f k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
x)) (() -> Fun (k -> v -> ())
forall c a b. Show c => c -> Fun (a -> b -> c)
constant ()),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Rng (Base BaseRep f k v
SetR f k v
_rel)) = (BaseRep Sett () () -> Sett () () -> Query () ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett () ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set () -> Sett () ()
forall k. Set k -> Sett k ()
Sett(() -> Set ()
forall a. a -> Set a
Set.singleton ())),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Rng (Singleton k
_k v
v)) = (BaseRep Sett v () -> Sett v () -> Query v ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett v ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set v -> Sett v ()
forall k. Set k -> Sett k ()
Sett(v -> Set v
forall a. a -> Set a
Set.singleton v
v)),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Rng (SetSingleton k
_k)) = (BaseRep Sett () () -> Sett () () -> Query () ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett () ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set () -> Sett () ()
forall k. Set k -> Sett k ()
Sett(() -> Set ()
forall a. a -> Set a
Set.singleton ())),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (Rng Exp (f k v)
f) = (BaseRep Sett v () -> Sett v () -> Query v ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett v ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Query k v -> Sett v ()
forall v k. Ord v => Query k v -> Sett v ()
rngStep ((Query k v, BaseRep f k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
f))),BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (DRestrict Exp (g k ())
set Exp (f k v)
rel) = (Query k ((), v) -> Fun (k -> ((), v) -> v) -> Query k v
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
projD (Query k () -> Query k v -> Query k ((), v)
forall k v w. Ord k => Query k v -> Query k w -> Query k (v, w)
andD ((Query k (), BaseRep g k ()) -> Query k ()
forall a b. (a, b) -> a
fst(Exp (g k ()) -> (Query k (), BaseRep g k ())
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k ())
set)) Query k v
reld) Fun (k -> ((), v) -> v)
forall x a b. Fun (x -> (a, b) -> b)
rngSnd,BaseRep f k v
BaseRep f k v
rep)
where (Query k v
reld,BaseRep f k v
rep) = Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel
compile (DExclude Exp (g k ())
set Exp (f k v)
rel) = (Query k v -> Query k () -> Query k v
forall k v u. Ord k => Query k v -> Query k u -> Query k v
DiffD Query k v
reld ((Query k (), BaseRep g k ()) -> Query k ()
forall a b. (a, b) -> a
fst(Exp (g k ()) -> (Query k (), BaseRep g k ())
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k ())
set)),BaseRep f k v
BaseRep f k v
rep)
where (Query k v
reld,BaseRep f k v
rep) = Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel
compile (RRestrict Exp (f k v)
rel Exp (g v ())
set) =
case (Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel,Exp (g v ()) -> (Query v (), BaseRep g v ())
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g v ())
set) of
((Query k v
reld,BaseRep f k v
rep),(BaseD BaseRep f v ()
_ f v ()
x,BaseRep g v ()
_)) -> (Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query k v
reld (f v () -> Fun (k -> v -> Bool)
forall rng (f :: * -> * -> *) v dom.
(Ord rng, Iter f) =>
f rng v -> Fun (dom -> rng -> Bool)
rngElem f v ()
x),BaseRep f k v
BaseRep f k v
rep)
((Query k v
reld,BaseRep f k v
rep),(Query v ()
setd,BaseRep g v ()
_)) -> (Query k v -> Query v () -> Fun (k -> (v, ()) -> v) -> Query k v
forall k v w u.
(Ord k, Ord v) =>
Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
chainD Query k v
reld Query v ()
setd Fun (k -> (v, ()) -> v)
forall x a b. Fun (x -> (a, b) -> a)
rngFst,BaseRep f k v
BaseRep f k v
rep)
compile (RExclude Exp (f k v)
rel Exp (g v ())
set) =
case (Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel,Exp (g v ()) -> (Query v (), BaseRep g v ())
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g v ())
set) of
((Query k v
reld,BaseRep f k v
rep),(BaseD BaseRep f v ()
_ f v ()
x,BaseRep g v ()
_)) -> (Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query k v
reld (Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
forall k v. Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
nEgate (f v () -> Fun (k -> v -> Bool)
forall rng (f :: * -> * -> *) v dom.
(Ord rng, Iter f) =>
f rng v -> Fun (dom -> rng -> Bool)
rngElem f v ()
x)),BaseRep f k v
BaseRep f k v
rep)
((Query k v
reld,BaseRep f k v
rep),(Query v (), BaseRep g v ())
_) -> (Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query k v
reld (Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
forall k v. Fun (k -> v -> Bool) -> Fun (k -> v -> Bool)
nEgate (g v () -> Fun (k -> v -> Bool)
forall rng (f :: * -> * -> *) v dom.
(Ord rng, Iter f) =>
f rng v -> Fun (dom -> rng -> Bool)
rngElem (Exp (g v ()) -> g v ()
forall t. Exp t -> t
compute Exp (g v ())
set))),BaseRep f k v
BaseRep f k v
rep)
compile (UnionOverrideLeft Exp (f k v)
rel1 Exp (g k v)
rel2) = (Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
rel1d ((Query k v, BaseRep g k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (g k v) -> (Query k v, BaseRep g k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k v)
rel2)) Fun (v -> v -> v)
forall v s. Fun (v -> s -> v)
first,BaseRep f k v
BaseRep f k v
rep)
where (Query k v
rel1d,BaseRep f k v
rep) = Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel1
compile (UnionOverrideRight Exp (f k v)
rel1 Exp (g k v)
rel2) = (Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
rel1d ((Query k v, BaseRep g k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (g k v) -> (Query k v, BaseRep g k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k v)
rel2)) Fun (v -> v -> v)
forall v s. Fun (v -> s -> s)
second,BaseRep f k v
BaseRep f k v
rep)
where (Query k v
rel1d,BaseRep f k v
rep) = Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel1
compile (UnionPlus Exp (f k n)
rel1 Exp (f k n)
rel2) = (Query k n -> Query k n -> Fun (n -> n -> n) -> Query k n
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k n
rel1d ((Query k n, BaseRep f k n) -> Query k n
forall a b. (a, b) -> a
fst(Exp (f k n) -> (Query k n, BaseRep f k n)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k n)
rel2)) Fun (n -> n -> n)
forall t. Monoid t => Fun (t -> t -> t)
plus,BaseRep f k v
BaseRep f k n
rep)
where (Query k n
rel1d,BaseRep f k n
rep) = Exp (f k n) -> (Query k n, BaseRep f k n)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k n)
rel1
compile (Intersect Exp (f k v)
rel1 Exp (g k u)
rel2) = (Query k v -> Query k u -> Fun (k -> (v, u) -> ()) -> Query k ()
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
andPD ((Query k v, BaseRep f k v) -> Query k v
forall a b. (a, b) -> a
fst(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel1)) ((Query k u, BaseRep g k u) -> Query k u
forall a b. (a, b) -> a
fst(Exp (g k u) -> (Query k u, BaseRep g k u)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k u)
rel2)) (() -> Fun (k -> (v, u) -> ())
forall c a b. Show c => c -> Fun (a -> b -> c)
constant ()) ,BaseRep f k v
forall k. Basic Sett => BaseRep Sett k ()
SetR)
compile (SetDiff Exp (f k v)
rel1 Exp (g k u)
rel2) = (Query k v -> Query k u -> Query k v
forall k v u. Ord k => Query k v -> Query k u -> Query k v
DiffD Query k v
rel1d ((Query k u, BaseRep g k u) -> Query k u
forall a b. (a, b) -> a
fst (Exp (g k u) -> (Query k u, BaseRep g k u)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g k u)
rel2)), BaseRep f k v
BaseRep f k v
rep)
where (Query k v
rel1d,BaseRep f k v
rep) = Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
rel1
testing :: Bool
testing :: Bool
testing = Bool
False
runSetExp:: Ord k => Exp (f k v) -> f k v
runSetExp :: Exp (f k v) -> f k v
runSetExp Exp (f k v)
e =
if Bool
testing
then [Char] -> f k v
forall a. HasCallStack => [Char] -> a
error ([Char]
"In Testing mode, SetAlgebra expression: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
e[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" falls through to slow mode.")
else (Query k v, BaseRep f k v) -> f k v
forall k v (f :: * -> * -> *).
Ord k =>
(Query k v, BaseRep f k v) -> f k v
run(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
e)
runSet :: Ord k => Exp (f k v) -> f k v
runSet :: Exp (f k v) -> f k v
runSet Exp (f k v)
e = (Query k v, BaseRep f k v) -> f k v
forall k v (f :: * -> * -> *).
Ord k =>
(Query k v, BaseRep f k v) -> f k v
run(Exp (f k v) -> (Query k v, BaseRep f k v)
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (f k v)
e)
run ::(Ord k) => (Query k v,BaseRep f k v) -> f k v
run :: (Query k v, BaseRep f k v) -> f k v
run (BaseD BaseRep f k v
SetR f k v
x,BaseRep f k v
SetR) = f k v
f k v
x
run (BaseD BaseRep f k v
MapR f k v
x,BaseRep f k v
MapR) = f k v
f k v
x
run (BaseD BaseRep f k v
SingleR f k v
x,BaseRep f k v
SingleR) = f k v
f k v
x
run (BaseD BaseRep f k v
BiMapR f k v
x,BaseRep f k v
BiMapR) = f k v
f k v
x
run (BaseD BaseRep f k v
ListR f k v
x,BaseRep f k v
ListR) = f k v
f k v
x
run (BaseD BaseRep f k v
_source f k v
x,BaseRep f k v
ListR) = BaseRep List k v -> Collect (k, v) -> List k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep List k v
forall k v. Basic List => BaseRep List k v
ListR (f k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
fifo f k v
x)
run (BaseD BaseRep f k v
_source f k v
x,BaseRep f k v
target) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
target (f k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo f k v
x)
run (Query k v
other,BaseRep f k v
ListR) = BaseRep List k v -> Collect (k, v) -> List k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep List k v
forall k v. Basic List => BaseRep List k v
ListR (Query k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
fifo Query k v
other)
run (Query k v
other,BaseRep f k v
target) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
target (Query k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo Query k v
other)
runBoolExp :: Exp Bool -> Bool
runBoolExp :: Exp Bool -> Bool
runBoolExp Exp Bool
e =
if Bool
testing
then [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char]
"In Testing mode, SetAlgebra expression: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp Bool -> [Char]
forall a. Show a => a -> [Char]
show Exp Bool
e[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" falls through to slow mode.")
else Exp Bool -> Bool
runBool Exp Bool
e
runBool :: Exp Bool -> Bool
runBool :: Exp Bool -> Bool
runBool (Elem k
k Exp (g k ())
v) = k -> g k () -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k (Exp (g k ()) -> g k ()
forall t. Exp t -> t
compute Exp (g k ())
v)
runBool (NotElem k
k Exp (g k ())
set) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> g k () -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k (Exp (g k ()) -> g k ()
forall t. Exp t -> t
compute Exp (g k ())
set)
runBool (w :: Exp Bool
w@(KeyEqual Exp (f k v)
x Exp (g k u)
y)) = Query k v -> Query k u -> Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Bool
sameDomain (Exp Bool -> Exp (f k v) -> Query k v
forall a (f :: * -> * -> *) k v. Exp a -> Exp (f k v) -> Query k v
compileSubterm Exp Bool
w Exp (f k v)
x) (Exp Bool -> Exp (g k u) -> Query k u
forall a (f :: * -> * -> *) k v. Exp a -> Exp (f k v) -> Query k v
compileSubterm Exp Bool
w Exp (g k u)
y)
runBool (w :: Exp Bool
w@(Subset Exp (f k v)
x Exp (g k u)
y)) = Collect (k, v) -> Bool -> ((k, v) -> Bool -> Bool) -> Bool
forall tuple.
Collect tuple -> forall ans. ans -> (tuple -> ans -> ans) -> ans
runCollect (Query k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo Query k v
left) Bool
True (\ (k
k,v
_v) Bool
ans -> k -> Query k u -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k Query k u
right Bool -> Bool -> Bool
&& Bool
ans)
where left :: Query k v
left = Exp Bool -> Exp (f k v) -> Query k v
forall a (f :: * -> * -> *) k v. Exp a -> Exp (f k v) -> Query k v
compileSubterm Exp Bool
w Exp (f k v)
x
right :: Query k u
right = Exp Bool -> Exp (g k u) -> Query k u
forall a (f :: * -> * -> *) k v. Exp a -> Exp (f k v) -> Query k v
compileSubterm Exp Bool
w Exp (g k u)
y
compute:: Exp t -> t
compute :: Exp t -> t
compute (Base BaseRep f k v
_rep f k v
relation) = t
f k v
relation
compute (Dom (Base BaseRep f k v
SetR f k v
rel)) = t
f k v
rel
compute (Dom (Base BaseRep f k v
MapR f k v
x)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet f k v
Map k v
x)
compute (Dom (Singleton k
k v
_v)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (k -> Set k
forall a. a -> Set a
Set.singleton k
k)
compute (Dom (SetSingleton k
k)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (k -> Set k
forall a. a -> Set a
Set.singleton k
k)
compute (Dom (Base BaseRep f k v
_rep f k v
rel)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(f k v -> Set k
forall (f :: * -> * -> *) k v. (Basic f, Ord k) => f k v -> Set k
domain f k v
rel)
compute (Dom (RRestrict (Base BaseRep f k v
MapR f k v
xs) (SetSingleton k
v))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((Set k -> k -> k -> Set k) -> Set k -> Map k k -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> k -> Set k
accum Set k
forall a. Set a
Set.empty f k v
Map k k
xs)
where accum :: Set k -> k -> k -> Set k
accum Set k
ans k
k k
u = if k
uk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
v then k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans else Set k
ans
compute (Dom (RRestrict (Base BaseRep f k v
MapR f k v
xs) (Base BaseRep f k v
SetR (Sett set)))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((Set k -> k -> k -> Set k) -> Set k -> Map k k -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> k -> Set k
accum Set k
forall a. Set a
Set.empty f k v
Map k k
xs)
where accum :: Set k -> k -> k -> Set k
accum Set k
ans k
k k
u = if k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
u Set k
set then k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans else Set k
ans
compute (Dom (RExclude (Base BaseRep f k v
MapR f k v
xs) (SetSingleton k
v))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((Set k -> k -> k -> Set k) -> Set k -> Map k k -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> k -> Set k
accum Set k
forall a. Set a
Set.empty f k v
Map k k
xs)
where accum :: Set k -> k -> k -> Set k
accum Set k
ans k
k k
u = if Bool -> Bool
not(k
uk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
v) then k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans else Set k
ans
compute (Dom (RExclude (Base BaseRep f k v
MapR f k v
xs) (Base BaseRep f k v
SetR (Sett set)))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((Set k -> k -> k -> Set k) -> Set k -> Map k k -> Set k
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set k -> k -> k -> Set k
accum Set k
forall a. Set a
Set.empty f k v
Map k k
xs)
where accum :: Set k -> k -> k -> Set k
accum Set k
ans k
k k
u = if Bool -> Bool
not(k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
u Set k
set) then k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
k Set k
ans else Set k
ans
compute (Dom (DRestrict (SetSingleton k
v) (Base BaseRep f k v
MapR f k v
xs))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> v -> Set k -> Set k) -> Map k v -> Set k -> Set k -> Set k
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold k -> v -> Set k -> Set k
forall a p. Ord a => a -> p -> Set a -> Set a
accum f k v
Map k v
xs (k -> Set k
forall a. a -> Set a
Set.singleton k
v) Set k
forall a. Set a
Set.empty)
where accum :: a -> p -> Set a -> Set a
accum a
k p
_u Set a
ans = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
compute (Dom (DRestrict (Base BaseRep f k v
SetR (Sett set)) (Base BaseRep f k v
MapR f k v
xs))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> v -> Set k -> Set k) -> Map k v -> Set k -> Set k -> Set k
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
intersectMapSetFold k -> v -> Set k -> Set k
forall a p. Ord a => a -> p -> Set a -> Set a
accum f k v
Map k v
xs Set k
Set k
set Set k
forall a. Set a
Set.empty)
where accum :: a -> p -> Set a -> Set a
accum a
k p
_u Set a
ans = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
compute (Dom (DExclude (SetSingleton k
v) (Base BaseRep f k v
MapR f k v
xs))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> v -> Set k -> Set k) -> Map k v -> Set k -> Set k -> Set k
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold k -> v -> Set k -> Set k
forall a p. Ord a => a -> p -> Set a -> Set a
accum f k v
Map k v
xs (k -> Set k
forall a. a -> Set a
Set.singleton k
v) Set k
forall a. Set a
Set.empty)
where accum :: a -> p -> Set a -> Set a
accum a
k p
_u Set a
ans = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
compute (Dom (DExclude (Base BaseRep f k v
SetR (Sett set)) (Base BaseRep f k v
MapR f k v
xs))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> v -> Set k -> Set k) -> Map k v -> Set k -> Set k -> Set k
forall k v ans.
Ord k =>
(k -> v -> ans -> ans) -> Map k v -> Set k -> ans -> ans
disjointMapSetFold k -> v -> Set k -> Set k
forall a p. Ord a => a -> p -> Set a -> Set a
accum f k v
Map k v
xs Set k
Set k
set Set k
forall a. Set a
Set.empty)
where accum :: a -> p -> Set a -> Set a
accum a
k p
_u Set a
ans = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
compute (e :: Exp t
e@(Dom Exp (f k v)
_)) = Exp (Sett k ()) -> Sett k ()
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (Sett k ())
e
compute (Rng (Base BaseRep f k v
SetR f k v
_rel)) = Set () -> Sett () ()
forall k. Set k -> Sett k ()
Sett (() -> Set ()
forall a. a -> Set a
Set.singleton ())
compute (Rng (Singleton k
_k v
v)) = Set v -> Sett v ()
forall k. Set k -> Sett k ()
Sett (v -> Set v
forall a. a -> Set a
Set.singleton v
v)
compute (Rng (SetSingleton k
_k)) = Set () -> Sett () ()
forall k. Set k -> Sett k ()
Sett (() -> Set ()
forall a. a -> Set a
Set.singleton ())
compute (Rng (Base BaseRep f k v
_rep f k v
rel)) = Set v -> Sett v ()
forall k. Set k -> Sett k ()
Sett(f k v -> Set v
forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range f k v
rel)
compute (e :: Exp t
e@(Rng Exp (f k v)
_ )) = Exp (Sett v ()) -> Sett v ()
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (Sett v ())
e
compute (DRestrict (Base BaseRep f k v
SetR (Sett set)) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys f k v
Map k v
m Set k
Set k
set
compute (DRestrict (SetSingleton k
k) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys f k v
Map k v
m (k -> Set k
forall a. a -> Set a
Set.singleton k
k)
compute (DRestrict (Singleton k
k v
_v) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys f k v
Map k v
m (k -> Set k
forall a. a -> Set a
Set.singleton k
k)
compute (DRestrict (Dom (Base BaseRep f k v
MapR f k v
x)) (Base BaseRep f k v
MapR f k v
y)) = Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection f k v
Map k v
y f k v
Map k v
x
compute (DRestrict (Dom (RRestrict (Base BaseRep f k v
MapR f k v
delegs) (SetSingleton k
hk))) (Base BaseRep f k v
MapR f k v
stake)) =
(k -> k -> Bool) -> Map k v -> Map k k -> Map k v
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft (\ k
_k k
v2 -> k
v2k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
hk) f k v
Map k v
stake f k v
Map k k
delegs
compute (DRestrict (Dom (RRestrict (Base BaseRep f k v
MapR f k v
delegs) (Base BaseRep f k v
_ f k v
rngf))) (Base BaseRep f k v
MapR f k v
stake)) =
(k -> k -> Bool) -> Map k v -> Map k k -> Map k v
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft (\ k
_k k
v2 -> k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
v2 f k v
rngf) f k v
Map k v
stake f k v
Map k k
delegs
compute (DRestrict Exp (g k ())
set (Base BaseRep f k v
MapR f k v
ys)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys f k v
Map k v
ys Set k
set2
where Sett Set k
set2 = BaseRep Sett k () -> Collect (k, ()) -> Sett k ()
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (g k () -> Collect (k, ())
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo (Exp (g k ()) -> g k ()
forall t. Exp t -> t
compute Exp (g k ())
set))
compute (DRestrict (Base BaseRep f k v
SetR (Sett s1)) (Base BaseRep f k v
SetR (Sett s2))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett(Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set k
s1 Set k
Set k
s2)
compute (DRestrict (Base BaseRep f k v
SetR f k v
x1) (Base BaseRep f k v
rep f k v
x2)) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
x,v
_,v
z) <- f k v
x1 f k v -> f k v -> Collect (k, v, v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f k v
f k v
x2; (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
x,v
z) }
compute (DRestrict (Dom (Base BaseRep f k v
_ f k v
x1)) (Base BaseRep f k v
rep f k v
x2)) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
x,v
_,v
z) <- f k v
x1 f k v -> f k v -> Collect (k, v, v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f k v
f k v
x2; (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
x,v
z) }
compute (DRestrict (SetSingleton k
k) (Base BaseRep f k v
rep f k v
x2)) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
x,()
_,v
z) <- (k -> Single k ()
forall k. k -> Single k ()
SetSingle k
k) Single k () -> f k v -> Collect (k, (), v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f k v
f k v
x2; (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
x,v
z) }
compute (DRestrict (Dom (Singleton k
k v
_)) (Base BaseRep f k v
rep f k v
x2)) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
x,()
_,v
z) <- (k -> Single k ()
forall k. k -> Single k ()
SetSingle k
k) Single k () -> f k v -> Collect (k, (), v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f k v
f k v
x2; (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
x,v
z) }
compute (DRestrict (Rng (Singleton k
_ v
v)) (Base BaseRep f k v
rep f k v
x2)) = BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (v
x,()
_,v
z) <- (v -> Single v ()
forall k. k -> Single k ()
SetSingle v
v) Single v () -> f v v -> Collect (v, (), v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f v v
f k v
x2; (v, v) -> Collect (v, v)
forall t. t -> Collect t
one (v
x,v
z) }
compute (e :: Exp t
e@(DRestrict Exp (g k ())
_ Exp (f k v)
_)) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (DExclude (SetSingleton k
n) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
m (k -> Set k
forall a. a -> Set a
Set.singleton k
n)
compute (DExclude (Dom (Singleton k
n v
_v)) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
m (k -> Set k
forall a. a -> Set a
Set.singleton k
n)
compute (DExclude (Rng (Singleton k
_n v
v)) (Base BaseRep f k v
MapR f k v
m)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
m (v -> Set v
forall a. a -> Set a
Set.singleton v
v)
compute (DExclude (Base BaseRep f k v
SetR (Sett x1)) (Base BaseRep f k v
MapR f k v
x2)) = Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
x2 Set k
Set k
x1
compute (DExclude (Dom (Base BaseRep f k v
MapR f k v
x1)) (Base BaseRep f k v
MapR f k v
x2)) = Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
noKeys f k v
Map k v
x2 f k v
Map k v
x1
compute (DExclude (SetSingleton k
k) (Base BaseRep f k v
BiMapR f k v
x)) = k -> f k v -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
k -> f k v -> f k v
removekey k
k f k v
f k v
x
compute (DExclude (Dom (Singleton k
k v
_)) (Base BaseRep f k v
BiMapR f k v
x)) = k -> f k v -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
k -> f k v -> f k v
removekey k
k f k v
f k v
x
compute (DExclude (Rng (Singleton k
_ v
v)) (Base BaseRep f k v
BiMapR f k v
x)) = v -> f v v -> f v v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
k -> f k v -> f k v
removekey v
v f v v
f k v
x
compute (e :: Exp t
e@(DExclude Exp (g k ())
_ Exp (f k v)
_ )) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (RExclude (Base BaseRep f k v
BiMapR f k v
x) (SetSingleton k
k)) = k -> BiMap k k k -> BiMap k k k
forall k v. (Ord k, Ord v) => v -> BiMap v k v -> BiMap v k v
removeval k
k f k v
BiMap k k k
x
compute (RExclude (Base BaseRep f k v
BiMapR f k v
x) (Dom (Singleton k
k v
_v))) = k -> BiMap k k k -> BiMap k k k
forall k v. (Ord k, Ord v) => v -> BiMap v k v -> BiMap v k v
removeval k
k f k v
BiMap k k k
x
compute (RExclude (Base BaseRep f k v
BiMapR f k v
x) (Rng (Singleton k
_k v
v))) = v -> BiMap v k v -> BiMap v k v
forall k v. (Ord k, Ord v) => v -> BiMap v k v -> BiMap v k v
removeval v
v f k v
BiMap v k v
x
compute (RExclude (Base BaseRep f k v
MapR f k v
xs) (Base BaseRep f k v
SetR (Sett y))) = (k -> Bool) -> Map k k -> Map k k
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\ k
x -> Bool -> Bool
not (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
x Set k
y)) f k v
Map k k
xs
compute (RExclude (Base BaseRep f k v
MapR f k v
xs) (SetSingleton k
k)) = (k -> Bool) -> Map k k -> Map k k
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (k -> Bool) -> k -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k)) f k v
Map k k
xs
compute (RExclude (Base BaseRep f k v
_rep f k v
lhs) (Base BaseRep f k v
SetR (Sett rhs))) | Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
rhs = t
f k v
lhs
compute (RExclude (Base BaseRep f k v
_rep f k v
lhs) (Base BaseRep f k v
SingleR f k v
Fail)) = t
f k v
lhs
compute (RExclude (Base BaseRep f k v
rep f k v
lhs) Exp (g v ())
y) =
BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
rep (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
a,v
b) <- f k v -> Collect (k, v)
forall (f :: * -> * -> *) k v. Iter f => f k v -> Collect (k, v)
lifo f k v
lhs; Bool -> Collect ()
when (Bool -> Bool
not(v -> Query v () -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey v
b Query v ()
Query v ()
rhs)); (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
a,v
b)} where (Query v ()
rhs,BaseRep g v ()
_) = Exp (g v ()) -> (Query v (), BaseRep g v ())
forall (f :: * -> * -> *) k v.
Exp (f k v) -> (Query k v, BaseRep f k v)
compile Exp (g v ())
y
compute (e :: Exp t
e@(RExclude Exp (f k v)
_ Exp (g v ())
_ )) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (RRestrict (Base BaseRep f k v
MapR f k v
xs) (SetSingleton k
k)) = (k -> Bool) -> Map k k -> Map k k
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\ k
x -> k
xk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k) f k v
Map k k
xs
compute (RRestrict (DRestrict (Dom (Base BaseRep f k v
MapR f k v
x)) (Base BaseRep f k v
MapR f k v
y)) (Dom (Base BaseRep f k v
MapR f k v
z))) = (k -> k -> Bool) -> Map k v -> Map k k -> Map k k
forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v2
intersectDomP (\ k
_k k
v -> k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
Map.member k
v f k v
Map k v
z) f k v
Map k v
x f k v
Map k k
y
compute (RRestrict (DRestrict (Dom (Base BaseRep f k v
_r1 f k v
stkcreds)) (Base BaseRep f k v
r2 f k v
delegs)) (Dom (Base BaseRep f k v
_r3 f k v
stpools))) =
BaseRep f k v -> Collect (k, v) -> f k v
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep f k v
r2 (Collect (k, v) -> f k v) -> Collect (k, v) -> f k v
forall a b. (a -> b) -> a -> b
$ do { (k
x,v
_,v
y) <- f k v
stkcreds f k v -> f k v -> Collect (k, v, v)
forall k (f :: * -> * -> *) (g :: * -> * -> *) b c.
(Ord k, Iter f, Iter g) =>
f k b -> g k c -> Collect (k, b, c)
`domEq` f k v
f k v
delegs; v
y v -> f v v -> Collect ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
k -> f k v -> Collect ()
`element` f v v
f k v
stpools; (k, v) -> Collect (k, v)
forall t. t -> Collect t
one (k
x,v
y)}
compute (e :: Exp t
e@(RRestrict Exp (f k v)
_ Exp (g v ())
_ )) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (Elem k
k (Dom (Base BaseRep f k v
_rep f k v
x))) = k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k f k v
f k v
x
compute (Elem k
k (Base BaseRep f k v
_rep f k v
rel)) = k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k f k v
f k v
rel
compute (Elem k
k (Dom (Singleton k
key v
_v))) = k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k
key
compute (Elem k
k (Rng (Singleton k
_ v
key))) = k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
v
key
compute (Elem k
k (SetSingleton k
key)) = k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k
key
compute (Elem k
k (UnionOverrideLeft (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (Elem k
k (UnionOverrideRight (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (Elem k
k (UnionPlus (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (Elem k
k (Intersect (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
&& k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (Elem k
k (DRestrict Exp (g k ())
s1 Exp (f k v)
m1)) = Exp Bool -> Bool
forall t. Exp t -> t
compute (k -> Exp (g k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
Elem k
k Exp (g k ())
Exp (g k ())
s1) Bool -> Bool -> Bool
&& Exp Bool -> Bool
forall t. Exp t -> t
compute (k -> Exp (f k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
Elem k
k Exp (f k ())
Exp (f k v)
m1)
compute (Elem k
k (DExclude Exp (g k ())
s1 Exp (f k v)
m1)) = Bool -> Bool
not (Exp Bool -> Bool
forall t. Exp t -> t
compute(k -> Exp (g k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
Elem k
k Exp (g k ())
Exp (g k ())
s1)) Bool -> Bool -> Bool
&& Exp Bool -> Bool
forall t. Exp t -> t
compute(k -> Exp (f k ()) -> Exp Bool
forall k (g :: * -> * -> *).
(Ord k, Iter g, Show k) =>
k -> Exp (g k ()) -> Exp Bool
Elem k
k Exp (f k ())
Exp (f k v)
m1)
compute (e :: Exp t
e@(Elem k
_ Exp (g k ())
_)) = Exp Bool -> Bool
runBoolExp Exp t
Exp Bool
e
compute (NotElem k
k (Dom (Base BaseRep f k v
_rep f k v
x))) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k f k v
f k v
x
compute (NotElem k
k (Base BaseRep f k v
_rep f k v
rel)) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> f k v -> Bool
forall (f :: * -> * -> *) key b.
(Iter f, Ord key) =>
key -> f key b -> Bool
haskey k
k f k v
f k v
rel
compute (NotElem k
k (Dom (Singleton k
key v
_v))) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k
key
compute (NotElem k
k (Rng (Singleton k
_ v
key))) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
v
key
compute (NotElem k
k (SetSingleton k
key)) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k
key
compute (NotElem k
k (UnionOverrideLeft (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = Bool -> Bool
not(k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (NotElem k
k (UnionOverrideRight (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = Bool -> Bool
not(k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (NotElem k
k (UnionPlus (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = Bool -> Bool
not(k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
|| k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (NotElem k
k (Intersect (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y)))) = Bool -> Bool
not (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
x Bool -> Bool -> Bool
&& k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
Set k
y)
compute (e :: Exp t
e@(NotElem k
_ Exp (g k ())
_)) = Exp Bool -> Bool
runBoolExp Exp t
Exp Bool
e
compute (Subset (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Set k -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set k
x Set k
Set k
y
compute (Subset (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
MapR f k v
y)) = (k -> Bool) -> Set k -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
`Map.member` f k v
Map k v
y) Set k
Set k
x
compute (Subset (Base BaseRep f k v
SetR (Sett x)) (Dom (Base BaseRep f k v
MapR f k v
y))) = (k -> Bool) -> Set k -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
`Map.member` f k v
Map k v
y) Set k
Set k
x
compute (Subset (Base BaseRep f k v
MapR f k v
x) (Base BaseRep f k v
MapR f k v
y)) = (k -> v -> Bool -> Bool) -> Bool -> Map k v -> Bool
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> v -> Bool -> Bool
accum Bool
True f k v
Map k v
x
where accum :: k -> v -> Bool -> Bool
accum k
k v
_a Bool
ans = k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
Map.member k
k f k v
Map k v
y Bool -> Bool -> Bool
&& Bool
ans
compute (Subset (Dom (Base BaseRep f k v
MapR f k v
x)) (Dom (Base BaseRep f k v
MapR f k v
y))) = (k -> v -> Bool -> Bool) -> Bool -> Map k v -> Bool
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> v -> Bool -> Bool
accum Bool
True f k v
Map k v
x
where accum :: k -> v -> Bool -> Bool
accum k
k v
_a Bool
ans = k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
Map.member k
k f k v
Map k v
y Bool -> Bool -> Bool
&& Bool
ans
compute (e :: Exp t
e@(Subset Exp (f k v)
_ Exp (g k u)
_)) = Exp Bool -> Bool
runBoolExp Exp t
Exp Bool
e
compute (Intersect (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set k
x Set k
Set k
y)
compute (Intersect (Base BaseRep f k v
MapR f k v
x) (Base BaseRep f k v
MapR f k v
y)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet(Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection f k v
Map k v
x f k v
Map k v
y))
compute (e :: Exp t
e@(Intersect Exp (f k v)
_ Exp (g k u)
_)) = Exp (Sett k ()) -> Sett k ()
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (Sett k ())
e
compute (SetDiff (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set k
x Set k
Set k
y)
compute (SetDiff (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
MapR f k v
y)) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> Bool) -> Set k -> Set k
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\ k
e -> Bool -> Bool
not(k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
Map.member k
e f k v
Map k v
y)) Set k
Set k
x)
compute (SetDiff (Base BaseRep f k v
SetR (Sett x)) (Dom (Base BaseRep f k v
MapR f k v
y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett((k -> Bool) -> Set k -> Set k
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\ k
e -> Bool -> Bool
not(k -> Map k v -> Bool
forall key b. Ord key => key -> Map key b -> Bool
Map.member k
e f k v
Map k v
y)) Set k
Set k
x)
compute (SetDiff (Base BaseRep f k v
MapR f k v
x) (Dom (Base BaseRep f k v
MapR f k v
y))) = Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference f k v
Map k v
x f k v
Map k v
y
compute (SetDiff (Base BaseRep f k v
MapR f k v
x) (Base BaseRep f k v
MapR f k v
y)) = (Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference f k v
Map k v
x f k v
Map k v
y)
compute (SetDiff (Base BaseRep f k v
MapR f k v
x) (Base BaseRep f k v
SetR (Sett y))) = (Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
x Set k
Set k
y)
compute (e :: Exp t
e@(SetDiff Exp (f k v)
_ Exp (g k u)
_)) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (UnionOverrideLeft (Base BaseRep f k v
_rep f k v
x) (Singleton k
k v
v)) = (k, v) -> f k v -> (v -> v -> v) -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) f k v
f k v
x (\ v
old v
_new -> v
old)
compute (UnionOverrideLeft (Base BaseRep f k v
MapR f k v
d0) (Base BaseRep f k v
MapR f k v
d1)) = Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union f k v
Map k v
d0 f k v
Map k v
d1
compute (UnionOverrideLeft (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set k
x Set k
Set k
y)
compute (UnionOverrideLeft (DExclude (SetSingleton k
k) (Base BaseRep f k v
MapR f k v
xs)) (Base BaseRep f k v
MapR f k v
ys)) = Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (k -> Map k v -> Map k v
forall k v. Ord k => k -> Map k v -> Map k v
Map.delete k
k f k v
Map k v
xs) f k v
Map k v
ys
compute (UnionOverrideLeft (DExclude (Base BaseRep f k v
SetR (Sett s1)) (Base BaseRep f k v
MapR f k v
m2)) (Base BaseRep f k v
MapR f k v
m3)) = Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys f k v
Map k v
m2 Set k
Set k
s1) f k v
Map k v
m3
compute (e :: Exp t
e@(UnionOverrideLeft Exp (f k v)
_ Exp (g k v)
_)) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (UnionOverrideRight (Base BaseRep f k v
_rep f k v
x) (Singleton k
k v
v)) = (k, v) -> f k v -> (v -> v -> v) -> f k v
forall (f :: * -> * -> *) k v.
(Basic f, Ord k) =>
(k, v) -> f k v -> (v -> v -> v) -> f k v
addkv (k
k,v
v) f k v
f k v
x (\ v
_old v
new -> v
new)
compute (UnionOverrideRight (Base BaseRep f k v
MapR f k v
d0) (Base BaseRep f k v
MapR f k v
d1)) = Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union f k v
Map k v
d1 f k v
Map k v
d0
compute (UnionOverrideRight (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set k
x Set k
Set k
y)
compute (e :: Exp t
e@(UnionOverrideRight Exp (f k v)
_ Exp (g k v)
_)) = Exp (f k v) -> f k v
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k v)
e
compute (UnionPlus (Base BaseRep f k v
MapR f k v
x) (Base BaseRep f k v
MapR f k v
y)) = (v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>) f k v
Map k v
x f k v
Map k v
y
compute (UnionPlus (Base BaseRep f k v
SetR (Sett x)) (Base BaseRep f k v
SetR (Sett y))) = Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set k
x Set k
Set k
y)
compute (e :: Exp t
e@(UnionPlus Exp (f k n)
_ Exp (f k n)
_)) = Exp (f k n) -> f k n
forall k (f :: * -> * -> *) v. Ord k => Exp (f k v) -> f k v
runSetExp Exp t
Exp (f k n)
e
compute (Singleton k
k v
v) = k -> v -> Single k v
forall k v. k -> v -> Single k v
Single k
k v
v
compute (SetSingleton k
k) = (k -> Single k ()
forall k. k -> Single k ()
SetSingle k
k)
compute (KeyEqual (Base BaseRep f k v
MapR f k v
m) (Base BaseRep f k v
MapR f k v
n)) = Map k v -> Map k v -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual f k v
Map k v
m f k v
Map k v
n
compute (KeyEqual (Base BaseRep f k v
BiMapR (MkBiMap m _)) (Base BaseRep f k v
BiMapR (MkBiMap n _))) = Map k v -> Map k v -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual Map k v
m Map k v
Map k v
n
compute (KeyEqual (Dom (Base BaseRep f k v
MapR f k v
m)) (Dom (Base BaseRep f k v
MapR f k v
n))) = Map k v -> Map k v -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual f k v
Map k v
m f k v
Map k v
n
compute (KeyEqual (Dom (Base BaseRep f k v
BiMapR (MkBiMap m _))) (Dom (Base BaseRep f k v
BiMapR (MkBiMap n _)))) = Map k v -> Map k v -> Bool
forall k v1 v2. Ord k => Map k v1 -> Map k v2 -> Bool
keysEqual Map k v
m Map k v
Map k v
n
compute (KeyEqual (Base BaseRep f k v
SetR (Sett m)) (Base BaseRep f k v
SetR (Sett n))) = Set k
nSet k -> Set k -> Bool
forall a. Eq a => a -> a -> Bool
==Set k
Set k
m
compute (KeyEqual (Base BaseRep f k v
MapR f k v
xs) (Base BaseRep f k v
SetR (Sett ys))) = Map k v -> Set k
forall k a. Map k a -> Set k
Map.keysSet f k v
Map k v
xs Set k -> Set k -> Bool
forall a. Eq a => a -> a -> Bool
== Set k
Set k
ys
compute (e :: Exp t
e@(KeyEqual Exp (f k v)
_ Exp (g k u)
_ )) = Exp Bool -> Bool
runBoolExp Exp t
Exp Bool
e
eval :: Embed s t => Exp t -> s
eval :: Exp t -> s
eval Exp t
x = t -> s
forall concrete base. Embed concrete base => base -> concrete
fromBase (Exp t -> t
forall t. Exp t -> t
compute Exp t
x)
projStep
:: Ord k =>
(t -> Collect (k, v, Query k v))
-> Fun (k -> v -> u) -> t -> Collect (k, u, Query k u)
projStep :: (t -> Collect (k, v, Query k v))
-> Fun (k -> v -> u) -> t -> Collect (k, u, Query k u)
projStep t -> Collect (k, v, Query k v)
next Fun (k -> v -> u)
p t
f = do { (k
k,v
v,Query k v
f') <- t -> Collect (k, v, Query k v)
next t
f; (k, u, Query k u) -> Collect (k, u, Query k u)
forall t. t -> Collect t
one (k
k,Fun (k -> v -> u) -> k -> v -> u
forall t. Fun t -> t
apply Fun (k -> v -> u)
p k
k v
v,Query k v -> Fun (k -> v -> u) -> Query k u
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
ProjectD Query k v
f' Fun (k -> v -> u)
p) }
andStep
:: Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep :: (a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep (ftrip :: (a, b1, Query a b1)
ftrip@(a
k1,b1
v1,Query a b1
f1)) (gtrip :: (a, b2, Query a b2)
gtrip@(a
k2,b2
v2,Query a b2
g2)) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
Ordering
EQ -> (a, (b1, b2), Query a (b1, b2))
-> Collect (a, (b1, b2), Query a (b1, b2))
forall t. t -> Collect t
one (a
k1,(b1
v1,b2
v2), Query a b1 -> Query a b2 -> Query a (b1, b2)
forall k v w. Ord k => Query k v -> Query k w -> Query k (v, w)
AndD Query a b1
f1 Query a b2
g2)
Ordering
LT -> do { (a, b1, Query a b1)
ftrip' <- a -> Query a b1 -> Collect (a, b1, Query a b1)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
k2 Query a b1
f1; (a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
forall a b1 b2.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep (a, b1, Query a b1)
ftrip' (a, b2, Query a b2)
gtrip }
Ordering
GT -> do { (a, b2, Query a b2)
gtrip' <- a -> Query a b2 -> Collect (a, b2, Query a b2)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
k1 Query a b2
g2; (a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
forall a b1 b2.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep (a, b1, Query a b1)
ftrip (a, b2, Query a b2)
gtrip' }
chainStep
:: (Ord b, Ord a) =>
(a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
chainStep :: (a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
chainStep (a
d,b
r1,Query a b
f1) Query b w
g Fun (a -> (b, w) -> u)
comb =
case b -> Query b w -> Maybe w
forall (f :: * -> * -> *) key rng.
(Iter f, Ord key) =>
key -> f key rng -> Maybe rng
lookup b
r1 Query b w
g of
Just w
w -> (a, u, Query a u) -> Collect (a, u, Query a u)
forall t. t -> Collect t
one(a
d,Fun (a -> (b, w) -> u) -> a -> (b, w) -> u
forall t. Fun t -> t
apply Fun (a -> (b, w) -> u)
comb a
d (b
r1,w
w),Query a b -> Query b w -> Fun (a -> (b, w) -> u) -> Query a u
forall k v w u.
(Ord k, Ord v) =>
Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
ChainD Query a b
f1 Query b w
g Fun (a -> (b, w) -> u)
comb)
Maybe w
Nothing -> do { (a, b, Query a b)
trip <- Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a b
f1; (a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
forall b a w u.
(Ord b, Ord a) =>
(a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
chainStep (a, b, Query a b)
trip Query b w
g Fun (a -> (b, w) -> u)
comb}
andPstep
:: Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep :: (a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep (ftrip :: (a, b1, Query a b1)
ftrip@(a
k1,b1
v1,Query a b1
f1)) (gtrip :: (a, b2, Query a b2)
gtrip@(a
k2,b2
v2,Query a b2
g2)) Fun (a -> (b1, b2) -> w)
p =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
Ordering
EQ -> (a, w, Query a w) -> Collect (a, w, Query a w)
forall t. t -> Collect t
one (a
k1,(Fun (a -> (b1, b2) -> w) -> a -> (b1, b2) -> w
forall t. Fun t -> t
apply Fun (a -> (b1, b2) -> w)
p a
k1 (b1
v1,b2
v2)), Query a b1 -> Query a b2 -> Fun (a -> (b1, b2) -> w) -> Query a w
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
AndPD Query a b1
f1 Query a b2
g2 Fun (a -> (b1, b2) -> w)
p)
Ordering
LT -> do { (a, b1, Query a b1)
ftrip' <- a -> Query a b1 -> Collect (a, b1, Query a b1)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
k2 Query a b1
f1; (a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
forall a b1 b2 w.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep (a, b1, Query a b1)
ftrip' (a, b2, Query a b2)
gtrip Fun (a -> (b1, b2) -> w)
p }
Ordering
GT -> do { (a, b2, Query a b2)
gtrip' <- a -> Query a b2 -> Collect (a, b2, Query a b2)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
k1 Query a b2
g2; (a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
forall a b1 b2 w.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep (a, b1, Query a b1)
ftrip (a, b2, Query a b2)
gtrip' Fun (a -> (b1, b2) -> w)
p }
orStep
:: (Ord k, Ord a) =>
(Query k v -> Collect (a, v, Query k v))
-> Query k v
-> Query k v
-> Fun (v -> v -> v)
-> Collect (a, v, Query k v)
orStep :: (Query k v -> Collect (a, v, Query k v))
-> Query k v
-> Query k v
-> Fun (v -> v -> v)
-> Collect (a, v, Query k v)
orStep Query k v -> Collect (a, v, Query k v)
next Query k v
f Query k v
g Fun (v -> v -> v)
comb =
case (Collect (a, v, Query k v) -> Maybe (a, v, Query k v)
forall t. Collect t -> Maybe t
hasElem (Query k v -> Collect (a, v, Query k v)
next Query k v
f), Collect (a, v, Query k v) -> Maybe (a, v, Query k v)
forall t. Collect t -> Maybe t
hasElem (Query k v -> Collect (a, v, Query k v)
next Query k v
g)) of
(Maybe (a, v, Query k v)
Nothing,Maybe (a, v, Query k v)
Nothing) -> Collect (a, v, Query k v)
forall t. Collect t
none
(Just(a
k1,v
v1,Query k v
f1),Maybe (a, v, Query k v)
Nothing) -> (a, v, Query k v) -> Collect (a, v, Query k v)
forall t. t -> Collect t
one (a
k1,v
v1,Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
f1 Query k v
g Fun (v -> v -> v)
comb)
(Maybe (a, v, Query k v)
Nothing,Just(a
k1,v
v1,Query k v
g1)) -> (a, v, Query k v) -> Collect (a, v, Query k v)
forall t. t -> Collect t
one (a
k1,v
v1,Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
f Query k v
g1 Fun (v -> v -> v)
comb)
(Just(a
k1,v
v1,Query k v
f1),Just(a
k2,v
v2,Query k v
g2)) ->
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2 of
Ordering
EQ -> (a, v, Query k v) -> Collect (a, v, Query k v)
forall t. t -> Collect t
one (a
k1,Fun (v -> v -> v) -> v -> v -> v
forall t. Fun t -> t
apply Fun (v -> v -> v)
comb v
v1 v
v2,Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
f1 Query k v
g2 Fun (v -> v -> v)
comb)
Ordering
LT -> (a, v, Query k v) -> Collect (a, v, Query k v)
forall t. t -> Collect t
one (a
k1,v
v1,Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
f1 Query k v
g Fun (v -> v -> v)
comb)
Ordering
GT -> (a, v, Query k v) -> Collect (a, v, Query k v)
forall t. t -> Collect t
one (a
k2,v
v2,Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD Query k v
f Query k v
g2 Fun (v -> v -> v)
comb)
guardStep
:: Ord a =>
(Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
guardStep :: (Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
guardStep Query a b -> Collect (a, b, Query a b)
next Fun (a -> b -> Bool)
p Query a b
f = do { (a, b, Query a b)
triple <- Query a b -> Collect (a, b, Query a b)
next Query a b
f; (a, b, Query a b) -> Collect (a, b, Query a b)
loop (a, b, Query a b)
triple }
where loop :: (a, b, Query a b) -> Collect (a, b, Query a b)
loop (a
k,b
v,Query a b
f') = if (Fun (a -> b -> Bool) -> a -> b -> Bool
forall t. Fun t -> t
apply Fun (a -> b -> Bool)
p a
k b
v) then (a, b, Query a b) -> Collect (a, b, Query a b)
forall t. t -> Collect t
one (a
k,b
v,Query a b -> Fun (a -> b -> Bool) -> Query a b
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD Query a b
f' Fun (a -> b -> Bool)
p) else do { (a, b, Query a b)
triple <- Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a b
f'; (a, b, Query a b) -> Collect (a, b, Query a b)
loop (a, b, Query a b)
triple}
diffStep :: Ord k => (k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
diffStep :: (k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
diffStep (k
k1,v
u1,Query k v
f1) Query k u
g =
case Collect (k, u, Query k u) -> Maybe (k, u, Query k u)
forall t. Collect t -> Maybe t
hasElem (k -> Query k u -> Collect (k, u, Query k u)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery k
k1 Query k u
g) of
Maybe (k, u, Query k u)
Nothing -> (k, v, Query k v) -> Collect (k, v, Query k v)
forall t. t -> Collect t
one (k
k1,v
u1,Query k v -> Query k u -> Query k v
forall k v u. Ord k => Query k v -> Query k u -> Query k v
DiffD Query k v
f1 Query k u
g)
Just (k
k2,u
_u2,Query k u
g2) -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k1 k
k2 of
Ordering
EQ -> do { (k, v, Query k v)
tup <- Query k v -> Collect (k, v, Query k v)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query k v
f1; (k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
forall k v u.
Ord k =>
(k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
diffStep (k, v, Query k v)
tup Query k u
g2 }
Ordering
LT -> (k, v, Query k v) -> Collect (k, v, Query k v)
forall t. t -> Collect t
one (k
k1,v
u1,Query k v -> Query k u -> Query k v
forall k v u. Ord k => Query k v -> Query k u -> Query k v
DiffD Query k v
f1 Query k u
g)
Ordering
GT -> (k, v, Query k v) -> Collect (k, v, Query k v)
forall t. t -> Collect t
one (k
k1,v
u1,Query k v -> Query k u -> Query k v
forall k v u. Ord k => Query k v -> Query k u -> Query k v
DiffD Query k v
f1 Query k u
g)
rngStep :: Ord v => Query k v -> Sett v ()
rngStep :: Query k v -> Sett v ()
rngStep Query k v
dat = BaseRep Sett v () -> Collect (v, ()) -> Sett v ()
forall k (f :: * -> * -> *) v.
Ord k =>
BaseRep f k v -> Collect (k, v) -> f k v
materialize BaseRep Sett v ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Query k v -> Collect (v, ())
forall (f :: * -> * -> *) a a. Iter f => f a a -> Collect (a, ())
loop Query k v
dat)
where loop :: f a a -> Collect (a, ())
loop f a a
x = do { (a
_k,a
v,f a a
x2) <- f a a -> Collect (a, a, f a a)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f a a
x; (a, ()) -> Collect (a, ()) -> Collect (a, ())
forall t. t -> Collect t -> Collect t
front (a
v,()) (f a a -> Collect (a, ())
loop f a a
x2) }
nxtQuery :: Query a b -> Collect (a, b, Query a b)
nxtQuery :: Query a b -> Collect (a, b, Query a b)
nxtQuery (BaseD BaseRep f a b
rep f a b
x) = do {(a
k,b
v,f a b
x2) <- f a b -> Collect (a, b, f a b)
forall (f :: * -> * -> *) a b.
Iter f =>
f a b -> Collect (a, b, f a b)
nxt f a b
x; (a, b, Query a b) -> Collect (a, b, Query a b)
forall t. t -> Collect t
one(a
k,b
v,BaseRep f a b -> f a b -> Query a b
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep f a b
rep f a b
x2)}
nxtQuery (ProjectD Query a v
x Fun (a -> v -> b)
p) = (Query a v -> Collect (a, v, Query a v))
-> Fun (a -> v -> b) -> Query a v -> Collect (a, b, Query a b)
forall k t v u.
Ord k =>
(t -> Collect (k, v, Query k v))
-> Fun (k -> v -> u) -> t -> Collect (k, u, Query k u)
projStep Query a v -> Collect (a, v, Query a v)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Fun (a -> v -> b)
p Query a v
x
nxtQuery (AndD Query a v
f Query a w
g) = do { (a, v, Query a v)
triple1 <- Query a v -> Collect (a, v, Query a v)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a v
f; (a, w, Query a w)
triple2 <- Query a w -> Collect (a, w, Query a w)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a w
g; (a, v, Query a v)
-> (a, w, Query a w) -> Collect (a, (v, w), Query a (v, w))
forall a b1 b2.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep (a, v, Query a v)
triple1 (a, w, Query a w)
triple2 }
nxtQuery (ChainD Query a v
f Query v w
g Fun (a -> (v, w) -> b)
p) = do { (a, v, Query a v)
trip <- Query a v -> Collect (a, v, Query a v)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a v
f; (a, v, Query a v)
-> Query v w -> Fun (a -> (v, w) -> b) -> Collect (a, b, Query a b)
forall b a w u.
(Ord b, Ord a) =>
(a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
chainStep (a, v, Query a v)
trip Query v w
g Fun (a -> (v, w) -> b)
p}
nxtQuery (AndPD Query a v
f Query a u
g Fun (a -> (v, u) -> b)
p) = do { (a, v, Query a v)
triple1 <- Query a v -> Collect (a, v, Query a v)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a v
f; (a, u, Query a u)
triple2 <- Query a u -> Collect (a, u, Query a u)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a u
g; (a, v, Query a v)
-> (a, u, Query a u)
-> Fun (a -> (v, u) -> b)
-> Collect (a, b, Query a b)
forall a b1 b2 w.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep (a, v, Query a v)
triple1 (a, u, Query a u)
triple2 Fun (a -> (v, u) -> b)
p }
nxtQuery (OrD Query a b
f Query a b
g Fun (b -> b -> b)
comb) = (Query a b -> Collect (a, b, Query a b))
-> Query a b
-> Query a b
-> Fun (b -> b -> b)
-> Collect (a, b, Query a b)
forall k a v.
(Ord k, Ord a) =>
(Query k v -> Collect (a, v, Query k v))
-> Query k v
-> Query k v
-> Fun (v -> v -> v)
-> Collect (a, v, Query k v)
orStep Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a b
f Query a b
g Fun (b -> b -> b)
comb
nxtQuery (GuardD Query a b
f Fun (a -> b -> Bool)
p) = (Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
forall a b.
Ord a =>
(Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
guardStep Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Fun (a -> b -> Bool)
p Query a b
f
nxtQuery (DiffD Query a b
f Query a u
g) = do { (a, b, Query a b)
trip <- Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery Query a b
f; (a, b, Query a b) -> Query a u -> Collect (a, b, Query a b)
forall k v u.
Ord k =>
(k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
diffStep (a, b, Query a b)
trip Query a u
g }
lubQuery :: Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery :: a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key (BaseD BaseRep f a b
rep f a b
x) = do {(a
k,b
v,f a b
x2) <- a -> f a b -> Collect (a, b, f a b)
forall (f :: * -> * -> *) k b.
(Iter f, Ord k) =>
k -> f k b -> Collect (k, b, f k b)
lub a
key f a b
x; (a, b, Query a b) -> Collect (a, b, Query a b)
forall t. t -> Collect t
one(a
k,b
v,BaseRep f a b -> f a b -> Query a b
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep f a b
rep f a b
x2)}
lubQuery a
key (ProjectD Query a v
x Fun (a -> v -> b)
p) = (Query a v -> Collect (a, v, Query a v))
-> Fun (a -> v -> b) -> Query a v -> Collect (a, b, Query a b)
forall k t v u.
Ord k =>
(t -> Collect (k, v, Query k v))
-> Fun (k -> v -> u) -> t -> Collect (k, u, Query k u)
projStep (a -> Query a v -> Collect (a, v, Query a v)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key) Fun (a -> v -> b)
p Query a v
x
lubQuery a
key (AndD Query a v
f Query a w
g) = do { (a, v, Query a v)
triple1 <- a -> Query a v -> Collect (a, v, Query a v)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a v
f; (a, w, Query a w)
triple2 <- a -> Query a w -> Collect (a, w, Query a w)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a w
g; (a, v, Query a v)
-> (a, w, Query a w) -> Collect (a, (v, w), Query a (v, w))
forall a b1 b2.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2) -> Collect (a, (b1, b2), Query a (b1, b2))
andStep (a, v, Query a v)
triple1 (a, w, Query a w)
triple2 }
lubQuery a
key (ChainD Query a v
f Query v w
g Fun (a -> (v, w) -> b)
p) = do { (a, v, Query a v)
trip <- a -> Query a v -> Collect (a, v, Query a v)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a v
f; (a, v, Query a v)
-> Query v w -> Fun (a -> (v, w) -> b) -> Collect (a, b, Query a b)
forall b a w u.
(Ord b, Ord a) =>
(a, b, Query a b)
-> Query b w -> Fun (a -> (b, w) -> u) -> Collect (a, u, Query a u)
chainStep (a, v, Query a v)
trip Query v w
g Fun (a -> (v, w) -> b)
p}
lubQuery a
key (AndPD Query a v
f Query a u
g Fun (a -> (v, u) -> b)
p) = do { (a, v, Query a v)
triple1 <- a -> Query a v -> Collect (a, v, Query a v)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a v
f; (a, u, Query a u)
triple2 <- a -> Query a u -> Collect (a, u, Query a u)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a u
g; (a, v, Query a v)
-> (a, u, Query a u)
-> Fun (a -> (v, u) -> b)
-> Collect (a, b, Query a b)
forall a b1 b2 w.
Ord a =>
(a, b1, Query a b1)
-> (a, b2, Query a b2)
-> Fun (a -> (b1, b2) -> w)
-> Collect (a, w, Query a w)
andPstep (a, v, Query a v)
triple1 (a, u, Query a u)
triple2 Fun (a -> (v, u) -> b)
p}
lubQuery a
key (OrD Query a b
f Query a b
g Fun (b -> b -> b)
comb) = (Query a b -> Collect (a, b, Query a b))
-> Query a b
-> Query a b
-> Fun (b -> b -> b)
-> Collect (a, b, Query a b)
forall k a v.
(Ord k, Ord a) =>
(Query k v -> Collect (a, v, Query k v))
-> Query k v
-> Query k v
-> Fun (v -> v -> v)
-> Collect (a, v, Query k v)
orStep (a -> Query a b -> Collect (a, b, Query a b)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key) Query a b
f Query a b
g Fun (b -> b -> b)
comb
lubQuery a
key (GuardD Query a b
f Fun (a -> b -> Bool)
p) = (Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
forall a b.
Ord a =>
(Query a b -> Collect (a, b, Query a b))
-> Fun (a -> b -> Bool) -> Query a b -> Collect (a, b, Query a b)
guardStep (a -> Query a b -> Collect (a, b, Query a b)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key) Fun (a -> b -> Bool)
p Query a b
f
lubQuery a
key (DiffD Query a b
f Query a u
g) = do { (a, b, Query a b)
trip <- a -> Query a b -> Collect (a, b, Query a b)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery a
key Query a b
f; (a, b, Query a b) -> Query a u -> Collect (a, b, Query a b)
forall k v u.
Ord k =>
(k, v, Query k v) -> Query k u -> Collect (k, v, Query k v)
diffStep (a, b, Query a b)
trip Query a u
g}
instance Iter Query where
nxt :: Query a b -> Collect (a, b, Query a b)
nxt = Query a b -> Collect (a, b, Query a b)
forall a b. Query a b -> Collect (a, b, Query a b)
nxtQuery
lub :: k -> Query k b -> Collect (k, b, Query k b)
lub = k -> Query k b -> Collect (k, b, Query k b)
forall a b. Ord a => a -> Query a b -> Collect (a, b, Query a b)
lubQuery
projectQ :: (Ord k, HasQuery c k v) => c -> Fun (k -> v -> u) -> Query k u
projectQ :: c -> Fun (k -> v -> u) -> Query k u
projectQ c
q Fun (k -> v -> u)
fun = Query k v -> Fun (k -> v -> u) -> Query k u
forall k v u. Ord k => Query k v -> Fun (k -> v -> u) -> Query k u
ProjectD (c -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query c
q) Fun (k -> v -> u)
fun
andQ :: (Ord k, HasQuery concrete1 k v, HasQuery concrete2 k w) => concrete1 -> concrete2 -> Query k (v, w)
andQ :: concrete1 -> concrete2 -> Query k (v, w)
andQ concrete1
x concrete2
y = Query k v -> Query k w -> Query k (v, w)
forall k v w. Ord k => Query k v -> Query k w -> Query k (v, w)
AndD (concrete1 -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete1
x) (concrete2 -> Query k w
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete2
y)
orQ ::
(Ord k, HasQuery concrete1 k v, HasQuery concrete2 k v) =>
concrete1 -> concrete2 -> Fun (v -> v -> v) -> Query k v
orQ :: concrete1 -> concrete2 -> Fun (v -> v -> v) -> Query k v
orQ concrete1
x concrete2
y Fun (v -> v -> v)
comb = Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
forall k v.
Ord k =>
Query k v -> Query k v -> Fun (v -> v -> v) -> Query k v
OrD (concrete1 -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete1
x) (concrete2 -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete2
y) Fun (v -> v -> v)
comb
chainQ ::
(Ord k, Ord v, HasQuery concrete1 k v,HasQuery concrete2 v w) =>
concrete1 -> concrete2 -> Fun (k -> (v, w) -> u) -> Query k u
chainQ :: concrete1 -> concrete2 -> Fun (k -> (v, w) -> u) -> Query k u
chainQ concrete1
x concrete2
y Fun (k -> (v, w) -> u)
p = Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
forall k v w u.
(Ord k, Ord v) =>
Query k v -> Query v w -> Fun (k -> (v, w) -> u) -> Query k u
ChainD (concrete1 -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete1
x) (concrete2 -> Query v w
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete2
y) Fun (k -> (v, w) -> u)
p
andPQ ::
(Ord k, HasQuery concrete1 k v, HasQuery concrete2 k u) =>
concrete1 -> concrete2 -> Fun (k -> (v, u) -> w) -> Query k w
andPQ :: concrete1 -> concrete2 -> Fun (k -> (v, u) -> w) -> Query k w
andPQ concrete1
x concrete2
y Fun (k -> (v, u) -> w)
p = Query k v -> Query k u -> Fun (k -> (v, u) -> w) -> Query k w
forall k v1 u v.
Ord k =>
Query k v1 -> Query k u -> Fun (k -> (v1, u) -> v) -> Query k v
AndPD (concrete1 -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete1
x) (concrete2 -> Query k u
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete2
y) Fun (k -> (v, u) -> w)
p
guardQ ::
(Ord k, HasQuery concrete k v) =>
concrete -> Fun (k -> v -> Bool) -> Query k v
guardQ :: concrete -> Fun (k -> v -> Bool) -> Query k v
guardQ concrete
x Fun (k -> v -> Bool)
p = Query k v -> Fun (k -> v -> Bool) -> Query k v
forall k v. Ord k => Query k v -> Fun (k -> v -> Bool) -> Query k v
GuardD (concrete -> Query k v
forall concrete k v. HasQuery concrete k v => concrete -> Query k v
query concrete
x) Fun (k -> v -> Bool)
p
class HasQuery concrete k v where
query :: concrete -> Query k v
instance HasQuery (Query k v) k v where
query :: Query k v -> Query k v
query Query k v
xs = Query k v
xs
instance Ord k => HasQuery [(k,v)] k v where
query :: [(k, v)] -> Query k v
query [(k, v)]
xs = BaseRep List k v -> List k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep List k v
forall k v. Basic List => BaseRep List k v
ListR ((v -> v -> v) -> [(k, v)] -> List k v
forall k v. Ord k => (v -> v -> v) -> [(k, v)] -> List k v
fromPairs (\ v
l v
_r -> v
l) [(k, v)]
xs)
instance Ord k => HasQuery (Set.Set k) k () where
query :: Set k -> Query k ()
query Set k
xs = BaseRep Sett k () -> Sett k () -> Query k ()
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Sett k ()
forall k. Basic Sett => BaseRep Sett k ()
SetR (Set k -> Sett k ()
forall k. Set k -> Sett k ()
Sett Set k
xs)
instance Ord k => HasQuery (Map.Map k v) k v where
query :: Map k v -> Query k v
query Map k v
xs = BaseRep Map k v -> Map k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Map k v
forall k v. Basic Map => BaseRep Map k v
MapR Map k v
xs
instance (Ord v,Ord k) => HasQuery (BiMap v k v) k v where
query :: BiMap v k v -> Query k v
query BiMap v k v
xs = BaseRep (BiMap v) k v -> BiMap v k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep (BiMap v) k v
forall v k. (Basic (BiMap v), Ord v) => BaseRep (BiMap v) k v
BiMapR BiMap v k v
xs
instance Ord k => HasQuery (Single k v) k v where
query :: Single k v -> Query k v
query Single k v
xs = BaseRep Single k v -> Single k v -> Query k v
forall (f :: * -> * -> *) k v.
(Iter f, Ord k) =>
BaseRep f k v -> f k v -> Query k v
BaseD BaseRep Single k v
forall k v. Basic Single => BaseRep Single k v
SingleR Single k v
xs
instance Show (BaseRep f k v) where
show :: BaseRep f k v -> [Char]
show BaseRep f k v
MapR = [Char]
"Map"
show BaseRep f k v
SetR = [Char]
"Set"
show BaseRep f k v
ListR = [Char]
"List"
show BaseRep f k v
SingleR = [Char]
"Single"
show BaseRep f k v
BiMapR = [Char]
"BiMap"
instance Show (Exp t) where
show :: Exp t -> [Char]
show (Base BaseRep f k v
MapR f k v
x) = [Char]
"Map("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show(Map k v -> Int
forall k a. Map k a -> Int
Map.size f k v
Map k v
x)[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")?"
show (Base BaseRep f k v
SetR (Sett x)) = [Char]
"Set("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show(Set k -> Int
forall a. Set a -> Int
Set.size Set k
x)[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")?"
show (Base BaseRep f k v
ListR f k v
xs) = [Char]
"List("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show([(k, v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (List k v -> [(k, v)]
forall k v. List k v -> [(k, v)]
unList f k v
List k v
xs))[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")?"
show (Base BaseRep f k v
SingleR (Single _ _)) = [Char]
"Single(_ _)"
show (Base BaseRep f k v
SingleR (SetSingle _ )) = [Char]
"SetSingle(_)"
show (Base BaseRep f k v
rep f k v
_x) = BaseRep f k v -> [Char]
forall a. Show a => a -> [Char]
show BaseRep f k v
rep[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"?"
show (Dom Exp (f k v)
x) = [Char]
"(dom "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (Rng Exp (f k v)
x) = [Char]
"(rng "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (DRestrict Exp (g k ())
x Exp (f k v)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k ())
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ◁ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (DExclude Exp (g k ())
x Exp (f k v)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k ())
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ⋪ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (RRestrict Exp (f k v)
x Exp (g v ())
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ▷ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g v ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g v ())
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (RExclude Exp (f k v)
x Exp (g v ())
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ⋫ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g v ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g v ())
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (Elem k
k Exp (g k ())
x) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++k -> [Char]
forall a. Show a => a -> [Char]
show k
k[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ∈ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k ())
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (NotElem k
k Exp (g k ())
x) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++k -> [Char]
forall a. Show a => a -> [Char]
show k
k[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ∉ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k ()) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k ())
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (Intersect Exp (f k v)
x Exp (g k u)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ∩ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k u) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k u)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (SetDiff Exp (f k v)
x Exp (g k u)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ➖ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k u) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k u)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (Subset Exp (f k v)
x Exp (g k u)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ⊆ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k u) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k u)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (UnionOverrideLeft Exp (f k v)
x Exp (g k v)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ∪ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k v)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (UnionPlus Exp (f k n)
x Exp (f k n)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k n) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k n)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ∪+ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k n) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k n)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (UnionOverrideRight Exp (f k v)
x Exp (g k v)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ⨃ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k v)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
show (Singleton k
_ v
_) = [Char]
"(singleton _ _ )"
show (SetSingleton k
_) = [Char]
"(setSingleton _ )"
show (KeyEqual Exp (f k v)
x Exp (g k u)
y) = [Char]
"("[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (f k v) -> [Char]
forall a. Show a => a -> [Char]
show Exp (f k v)
x[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" ≍ "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Exp (g k u) -> [Char]
forall a. Show a => a -> [Char]
show Exp (g k u)
y[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
")"
ppQuery :: Query k v -> Doc
ppQuery :: Query k v -> Doc
ppQuery (BaseD BaseRep f k v
rep f k v
_f) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text(BaseRep f k v -> [Char]
forall a. Show a => a -> [Char]
show BaseRep f k v
rep)
ppQuery (ProjectD Query k v
f Fun (k -> v -> v)
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Proj" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,[Char] -> Doc
text(Fun (k -> v -> v) -> [Char]
forall a. Show a => a -> [Char]
show Fun (k -> v -> v)
p)])
ppQuery (AndD Query k v
f Query k w
g) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"And" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,Query k w -> Doc
forall k v. Query k v -> Doc
ppQuery Query k w
g])
ppQuery (ChainD Query k v
f Query v w
g Fun (k -> (v, w) -> v)
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Chain" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,Query v w -> Doc
forall k v. Query k v -> Doc
ppQuery Query v w
g,[Char] -> Doc
text(Fun (k -> (v, w) -> v) -> [Char]
forall a. Show a => a -> [Char]
show Fun (k -> (v, w) -> v)
p)])
ppQuery (OrD Query k v
f Query k v
g Fun (v -> v -> v)
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Or" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
g,[Char] -> Doc
text(Fun (v -> v -> v) -> [Char]
forall a. Show a => a -> [Char]
show Fun (v -> v -> v)
p)])
ppQuery (GuardD Query k v
f Fun (k -> v -> Bool)
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Guard" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,[Char] -> Doc
text(Fun (k -> v -> Bool) -> [Char]
forall a. Show a => a -> [Char]
show Fun (k -> v -> Bool)
p)])
ppQuery (DiffD Query k v
f Query k u
g) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Diff" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,Query k u -> Doc
forall k v. Query k v -> Doc
ppQuery Query k u
g])
ppQuery (AndPD Query k v
f Query k u
g Fun (k -> (v, u) -> v)
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"AndP" Doc -> Doc -> Doc
<+> Doc -> Doc
align([Doc] -> Doc
vsep[Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
f,Query k u -> Doc
forall k v. Query k v -> Doc
ppQuery Query k u
g,[Char] -> Doc
text(Fun (k -> (v, u) -> v) -> [Char]
forall a. Show a => a -> [Char]
show Fun (k -> (v, u) -> v)
p)])
instance Show (Query k v) where
show :: Query k v -> [Char]
show Query k v
x = Doc -> [Char]
forall a. Show a => a -> [Char]
show(Query k v -> Doc
forall k v. Query k v -> Doc
ppQuery Query k v
x)