{-# LANGUAGE UndecidableInstances, OverloadedStrings, TupleSections, RankNTypes, FlexibleInstances, LambdaCase #-}

module Funcons.Operations.Values where

import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.Set as S
import qualified Data.MultiSet as MS

import qualified Data.Char as C
import Data.Text (Text, unpack)
import Data.List (intercalate)
import Data.Maybe (fromJust,isJust)
import Data.String

import Control.Monad (liftM2)
import Control.Arrow ((***))

type Name = Text
type MVar = String

-- | 
-- This datatype provides a number of builtin value types.
-- The type `t` is expected to be a super-type of `Values t`,
-- such that there is a projection and injection between `t` and `Values t`,
-- (see 'HasValues')
data Values t   = ADTVal Name [t]
                | Atom String
                | ComputationType (ComputationTypes t)
                | Float Double 
                | IEEE_Float_32 Float
                | IEEE_Float_64 Double
                | Int Integer
                | Map (ValueMaps (Values t))
                | Multiset (MS.MultiSet (Values t))
                | Nat Integer
                | Rational Rational
                | Set (ValueSets (Values t))
                | Vector (ValueVectors (Values t))
                | VAny -- used whenever funcon terms may have holes in them
                       -- currently only the case in "downwards" flowing signals
                | ValSeq [t] -- represents a multitude of values
        deriving (Values t -> Values t -> Bool
(Values t -> Values t -> Bool)
-> (Values t -> Values t -> Bool) -> Eq (Values t)
forall t. Eq t => Values t -> Values t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Values t -> Values t -> Bool
$c/= :: forall t. Eq t => Values t -> Values t -> Bool
== :: Values t -> Values t -> Bool
$c== :: forall t. Eq t => Values t -> Values t -> Bool
Eq,Eq (Values t)
Eq (Values t)
-> (Values t -> Values t -> Ordering)
-> (Values t -> Values t -> Bool)
-> (Values t -> Values t -> Bool)
-> (Values t -> Values t -> Bool)
-> (Values t -> Values t -> Bool)
-> (Values t -> Values t -> Values t)
-> (Values t -> Values t -> Values t)
-> Ord (Values t)
Values t -> Values t -> Bool
Values t -> Values t -> Ordering
Values t -> Values t -> Values t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (Values t)
forall t. Ord t => Values t -> Values t -> Bool
forall t. Ord t => Values t -> Values t -> Ordering
forall t. Ord t => Values t -> Values t -> Values t
min :: Values t -> Values t -> Values t
$cmin :: forall t. Ord t => Values t -> Values t -> Values t
max :: Values t -> Values t -> Values t
$cmax :: forall t. Ord t => Values t -> Values t -> Values t
>= :: Values t -> Values t -> Bool
$c>= :: forall t. Ord t => Values t -> Values t -> Bool
> :: Values t -> Values t -> Bool
$c> :: forall t. Ord t => Values t -> Values t -> Bool
<= :: Values t -> Values t -> Bool
$c<= :: forall t. Ord t => Values t -> Values t -> Bool
< :: Values t -> Values t -> Bool
$c< :: forall t. Ord t => Values t -> Values t -> Bool
compare :: Values t -> Values t -> Ordering
$ccompare :: forall t. Ord t => Values t -> Values t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (Values t)
Ord,Int -> Values t -> ShowS
[Values t] -> ShowS
Values t -> String
(Int -> Values t -> ShowS)
-> (Values t -> String) -> ([Values t] -> ShowS) -> Show (Values t)
forall t. Show t => Int -> Values t -> ShowS
forall t. Show t => [Values t] -> ShowS
forall t. Show t => Values t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values t] -> ShowS
$cshowList :: forall t. Show t => [Values t] -> ShowS
show :: Values t -> String
$cshow :: forall t. Show t => Values t -> String
showsPrec :: Int -> Values t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Values t -> ShowS
Show,ReadPrec [Values t]
ReadPrec (Values t)
Int -> ReadS (Values t)
ReadS [Values t]
(Int -> ReadS (Values t))
-> ReadS [Values t]
-> ReadPrec (Values t)
-> ReadPrec [Values t]
-> Read (Values t)
forall t. (Read t, Ord t) => ReadPrec [Values t]
forall t. (Read t, Ord t) => ReadPrec (Values t)
forall t. (Read t, Ord t) => Int -> ReadS (Values t)
forall t. (Read t, Ord t) => ReadS [Values t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Values t]
$creadListPrec :: forall t. (Read t, Ord t) => ReadPrec [Values t]
readPrec :: ReadPrec (Values t)
$creadPrec :: forall t. (Read t, Ord t) => ReadPrec (Values t)
readList :: ReadS [Values t]
$creadList :: forall t. (Read t, Ord t) => ReadS [Values t]
readsPrec :: Int -> ReadS (Values t)
$creadsPrec :: forall t. (Read t, Ord t) => Int -> ReadS (Values t)
Read)

ascii_cons, unicode_cons :: Name 
ascii_cons :: Name
ascii_cons = Name
"ascii-character"
unicode_cons :: Name
unicode_cons = Name
"unicode-character"

tuple :: HasValues t => [Values t] -> Values t
tuple :: [Values t] -> Values t
tuple = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"tuple" ([t] -> Values t) -> ([Values t] -> [t]) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values t -> t) -> [Values t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> t
forall t. HasValues t => Values t -> t
inject

list :: HasValues t => [Values t] -> Values t
list :: [Values t] -> Values t
list = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"list" ([t] -> Values t) -> ([Values t] -> [t]) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values t -> t) -> [Values t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> t
forall t. HasValues t => Values t -> t
inject

set :: (Ord t, HasValues t) => [Values t] -> Values t
set :: [Values t] -> Values t
set = ValueSets (Values t) -> Values t
forall t. ValueSets (Values t) -> Values t
Set (ValueSets (Values t) -> Values t)
-> ([Values t] -> ValueSets (Values t)) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values t] -> ValueSets (Values t)
forall a. Ord a => [a] -> Set a
S.fromList

vector :: HasValues t => [Values t] -> Values t
vector :: [Values t] -> Values t
vector = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"vector" ([t] -> Values t) -> ([Values t] -> [t]) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values t -> t) -> [Values t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> t
forall t. HasValues t => Values t -> t
inject 

multi :: HasValues t => [t] -> Values t 
multi :: [t] -> Values t
multi = [t] -> Values t
forall t. [t] -> Values t
ValSeq 

multi_ :: HasValues t => [Values t] -> Values t
multi_ :: [Values t] -> Values t
multi_ = [t] -> Values t
forall t. HasValues t => [t] -> Values t
multi ([t] -> Values t) -> ([Values t] -> [t]) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values t -> t) -> [Values t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Values t -> t
forall t. HasValues t => Values t -> t
inject

instance HasValues t => IsString (Values t) where
  fromString :: String -> Values t
fromString = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"list" ([t] -> Values t) -> (String -> [t]) -> String -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> t) -> String -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> (Char -> Values t) -> Char -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Values t
forall t. HasValues t => Char -> Values t
mk_unicode_characters)

type ValueMaps t      = M.Map t [t] 
type ValueSets t      = S.Set t
type ValueVectors t   = V.Vector t

-- | Postfix operators for specifying sequences.
data SeqSortOp = StarOp | PlusOp | QuestionMarkOp
                deriving (Int -> SeqSortOp -> ShowS
[SeqSortOp] -> ShowS
SeqSortOp -> String
(Int -> SeqSortOp -> ShowS)
-> (SeqSortOp -> String)
-> ([SeqSortOp] -> ShowS)
-> Show SeqSortOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqSortOp] -> ShowS
$cshowList :: [SeqSortOp] -> ShowS
show :: SeqSortOp -> String
$cshow :: SeqSortOp -> String
showsPrec :: Int -> SeqSortOp -> ShowS
$cshowsPrec :: Int -> SeqSortOp -> ShowS
Show, SeqSortOp -> SeqSortOp -> Bool
(SeqSortOp -> SeqSortOp -> Bool)
-> (SeqSortOp -> SeqSortOp -> Bool) -> Eq SeqSortOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqSortOp -> SeqSortOp -> Bool
$c/= :: SeqSortOp -> SeqSortOp -> Bool
== :: SeqSortOp -> SeqSortOp -> Bool
$c== :: SeqSortOp -> SeqSortOp -> Bool
Eq, Eq SeqSortOp
Eq SeqSortOp
-> (SeqSortOp -> SeqSortOp -> Ordering)
-> (SeqSortOp -> SeqSortOp -> Bool)
-> (SeqSortOp -> SeqSortOp -> Bool)
-> (SeqSortOp -> SeqSortOp -> Bool)
-> (SeqSortOp -> SeqSortOp -> Bool)
-> (SeqSortOp -> SeqSortOp -> SeqSortOp)
-> (SeqSortOp -> SeqSortOp -> SeqSortOp)
-> Ord SeqSortOp
SeqSortOp -> SeqSortOp -> Bool
SeqSortOp -> SeqSortOp -> Ordering
SeqSortOp -> SeqSortOp -> SeqSortOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SeqSortOp -> SeqSortOp -> SeqSortOp
$cmin :: SeqSortOp -> SeqSortOp -> SeqSortOp
max :: SeqSortOp -> SeqSortOp -> SeqSortOp
$cmax :: SeqSortOp -> SeqSortOp -> SeqSortOp
>= :: SeqSortOp -> SeqSortOp -> Bool
$c>= :: SeqSortOp -> SeqSortOp -> Bool
> :: SeqSortOp -> SeqSortOp -> Bool
$c> :: SeqSortOp -> SeqSortOp -> Bool
<= :: SeqSortOp -> SeqSortOp -> Bool
$c<= :: SeqSortOp -> SeqSortOp -> Bool
< :: SeqSortOp -> SeqSortOp -> Bool
$c< :: SeqSortOp -> SeqSortOp -> Bool
compare :: SeqSortOp -> SeqSortOp -> Ordering
$ccompare :: SeqSortOp -> SeqSortOp -> Ordering
$cp1Ord :: Eq SeqSortOp
Ord, ReadPrec [SeqSortOp]
ReadPrec SeqSortOp
Int -> ReadS SeqSortOp
ReadS [SeqSortOp]
(Int -> ReadS SeqSortOp)
-> ReadS [SeqSortOp]
-> ReadPrec SeqSortOp
-> ReadPrec [SeqSortOp]
-> Read SeqSortOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SeqSortOp]
$creadListPrec :: ReadPrec [SeqSortOp]
readPrec :: ReadPrec SeqSortOp
$creadPrec :: ReadPrec SeqSortOp
readList :: ReadS [SeqSortOp]
$creadList :: ReadS [SeqSortOp]
readsPrec :: Int -> ReadS SeqSortOp
$creadsPrec :: Int -> ReadS SeqSortOp
Read)


-- | Computation type /S=>T/ reflects a type of term
-- whose given value is of type /S/ and result is of type /T/.
data ComputationTypes t = Type (Types t) -- | /=>T/
                        | ComputesType (Types t) -- | /S=>T/
                        | ComputesFromType (Types t) (Types t)
                        deriving (Eq (ComputationTypes t)
Eq (ComputationTypes t)
-> (ComputationTypes t -> ComputationTypes t -> Ordering)
-> (ComputationTypes t -> ComputationTypes t -> Bool)
-> (ComputationTypes t -> ComputationTypes t -> Bool)
-> (ComputationTypes t -> ComputationTypes t -> Bool)
-> (ComputationTypes t -> ComputationTypes t -> Bool)
-> (ComputationTypes t -> ComputationTypes t -> ComputationTypes t)
-> (ComputationTypes t -> ComputationTypes t -> ComputationTypes t)
-> Ord (ComputationTypes t)
ComputationTypes t -> ComputationTypes t -> Bool
ComputationTypes t -> ComputationTypes t -> Ordering
ComputationTypes t -> ComputationTypes t -> ComputationTypes t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (ComputationTypes t)
forall t. Ord t => ComputationTypes t -> ComputationTypes t -> Bool
forall t.
Ord t =>
ComputationTypes t -> ComputationTypes t -> Ordering
forall t.
Ord t =>
ComputationTypes t -> ComputationTypes t -> ComputationTypes t
min :: ComputationTypes t -> ComputationTypes t -> ComputationTypes t
$cmin :: forall t.
Ord t =>
ComputationTypes t -> ComputationTypes t -> ComputationTypes t
max :: ComputationTypes t -> ComputationTypes t -> ComputationTypes t
$cmax :: forall t.
Ord t =>
ComputationTypes t -> ComputationTypes t -> ComputationTypes t
>= :: ComputationTypes t -> ComputationTypes t -> Bool
$c>= :: forall t. Ord t => ComputationTypes t -> ComputationTypes t -> Bool
> :: ComputationTypes t -> ComputationTypes t -> Bool
$c> :: forall t. Ord t => ComputationTypes t -> ComputationTypes t -> Bool
<= :: ComputationTypes t -> ComputationTypes t -> Bool
$c<= :: forall t. Ord t => ComputationTypes t -> ComputationTypes t -> Bool
< :: ComputationTypes t -> ComputationTypes t -> Bool
$c< :: forall t. Ord t => ComputationTypes t -> ComputationTypes t -> Bool
compare :: ComputationTypes t -> ComputationTypes t -> Ordering
$ccompare :: forall t.
Ord t =>
ComputationTypes t -> ComputationTypes t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (ComputationTypes t)
Ord,ComputationTypes t -> ComputationTypes t -> Bool
(ComputationTypes t -> ComputationTypes t -> Bool)
-> (ComputationTypes t -> ComputationTypes t -> Bool)
-> Eq (ComputationTypes t)
forall t. Eq t => ComputationTypes t -> ComputationTypes t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputationTypes t -> ComputationTypes t -> Bool
$c/= :: forall t. Eq t => ComputationTypes t -> ComputationTypes t -> Bool
== :: ComputationTypes t -> ComputationTypes t -> Bool
$c== :: forall t. Eq t => ComputationTypes t -> ComputationTypes t -> Bool
Eq,Int -> ComputationTypes t -> ShowS
[ComputationTypes t] -> ShowS
ComputationTypes t -> String
(Int -> ComputationTypes t -> ShowS)
-> (ComputationTypes t -> String)
-> ([ComputationTypes t] -> ShowS)
-> Show (ComputationTypes t)
forall t. Show t => Int -> ComputationTypes t -> ShowS
forall t. Show t => [ComputationTypes t] -> ShowS
forall t. Show t => ComputationTypes t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputationTypes t] -> ShowS
$cshowList :: forall t. Show t => [ComputationTypes t] -> ShowS
show :: ComputationTypes t -> String
$cshow :: forall t. Show t => ComputationTypes t -> String
showsPrec :: Int -> ComputationTypes t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> ComputationTypes t -> ShowS
Show, ReadPrec [ComputationTypes t]
ReadPrec (ComputationTypes t)
Int -> ReadS (ComputationTypes t)
ReadS [ComputationTypes t]
(Int -> ReadS (ComputationTypes t))
-> ReadS [ComputationTypes t]
-> ReadPrec (ComputationTypes t)
-> ReadPrec [ComputationTypes t]
-> Read (ComputationTypes t)
forall t. Read t => ReadPrec [ComputationTypes t]
forall t. Read t => ReadPrec (ComputationTypes t)
forall t. Read t => Int -> ReadS (ComputationTypes t)
forall t. Read t => ReadS [ComputationTypes t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComputationTypes t]
$creadListPrec :: forall t. Read t => ReadPrec [ComputationTypes t]
readPrec :: ReadPrec (ComputationTypes t)
$creadPrec :: forall t. Read t => ReadPrec (ComputationTypes t)
readList :: ReadS [ComputationTypes t]
$creadList :: forall t. Read t => ReadS [ComputationTypes t]
readsPrec :: Int -> ReadS (ComputationTypes t)
$creadsPrec :: forall t. Read t => Int -> ReadS (ComputationTypes t)
Read)

-- | Representation of builtin types.
data Types t= ADTs
            | ADT Name [t]
            | AnnotatedType (Types t) SeqSortOp
            | AsciiCharacters
            | ISOLatinCharacters
            | BMPCharacters
            | Atoms
            | IntegersFrom Integer -- value-dependent type
            | IntegersUpTo Integer
            | Characters
            | Complement (Types t)
            | ComputationTypes
            | EmptyType
            | IEEEFloats IEEEFormats
            | Integers
            | Intersection (Types t) (Types t)
            | Naturals
            | NullType 
            | Rationals
            | Types
            | UnicodeCharacters
            | Union (Types t) (Types t)
            | Values
              deriving (Eq (Types t)
Eq (Types t)
-> (Types t -> Types t -> Ordering)
-> (Types t -> Types t -> Bool)
-> (Types t -> Types t -> Bool)
-> (Types t -> Types t -> Bool)
-> (Types t -> Types t -> Bool)
-> (Types t -> Types t -> Types t)
-> (Types t -> Types t -> Types t)
-> Ord (Types t)
Types t -> Types t -> Bool
Types t -> Types t -> Ordering
Types t -> Types t -> Types t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (Types t)
forall t. Ord t => Types t -> Types t -> Bool
forall t. Ord t => Types t -> Types t -> Ordering
forall t. Ord t => Types t -> Types t -> Types t
min :: Types t -> Types t -> Types t
$cmin :: forall t. Ord t => Types t -> Types t -> Types t
max :: Types t -> Types t -> Types t
$cmax :: forall t. Ord t => Types t -> Types t -> Types t
>= :: Types t -> Types t -> Bool
$c>= :: forall t. Ord t => Types t -> Types t -> Bool
> :: Types t -> Types t -> Bool
$c> :: forall t. Ord t => Types t -> Types t -> Bool
<= :: Types t -> Types t -> Bool
$c<= :: forall t. Ord t => Types t -> Types t -> Bool
< :: Types t -> Types t -> Bool
$c< :: forall t. Ord t => Types t -> Types t -> Bool
compare :: Types t -> Types t -> Ordering
$ccompare :: forall t. Ord t => Types t -> Types t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (Types t)
Ord,Types t -> Types t -> Bool
(Types t -> Types t -> Bool)
-> (Types t -> Types t -> Bool) -> Eq (Types t)
forall t. Eq t => Types t -> Types t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Types t -> Types t -> Bool
$c/= :: forall t. Eq t => Types t -> Types t -> Bool
== :: Types t -> Types t -> Bool
$c== :: forall t. Eq t => Types t -> Types t -> Bool
Eq,Int -> Types t -> ShowS
[Types t] -> ShowS
Types t -> String
(Int -> Types t -> ShowS)
-> (Types t -> String) -> ([Types t] -> ShowS) -> Show (Types t)
forall t. Show t => Int -> Types t -> ShowS
forall t. Show t => [Types t] -> ShowS
forall t. Show t => Types t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Types t] -> ShowS
$cshowList :: forall t. Show t => [Types t] -> ShowS
show :: Types t -> String
$cshow :: forall t. Show t => Types t -> String
showsPrec :: Int -> Types t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Types t -> ShowS
Show,ReadPrec [Types t]
ReadPrec (Types t)
Int -> ReadS (Types t)
ReadS [Types t]
(Int -> ReadS (Types t))
-> ReadS [Types t]
-> ReadPrec (Types t)
-> ReadPrec [Types t]
-> Read (Types t)
forall t. Read t => ReadPrec [Types t]
forall t. Read t => ReadPrec (Types t)
forall t. Read t => Int -> ReadS (Types t)
forall t. Read t => ReadS [Types t]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Types t]
$creadListPrec :: forall t. Read t => ReadPrec [Types t]
readPrec :: ReadPrec (Types t)
$creadPrec :: forall t. Read t => ReadPrec (Types t)
readList :: ReadS [Types t]
$creadList :: forall t. Read t => ReadS [Types t]
readsPrec :: Int -> ReadS (Types t)
$creadsPrec :: forall t. Read t => Int -> ReadS (Types t)
Read)

sets :: HasValues t => Types t -> Types t
sets :: Types t -> Types t
sets Types t
t = Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"sets" [Types t -> t
forall t. HasTypes t => Types t -> t
injectT Types t
t]

multisets :: HasValues t => Types t -> Types t
multisets :: Types t -> Types t
multisets Types t
t = Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"multisets" [Types t -> t
forall t. HasTypes t => Types t -> t
injectT Types t
t]

maps :: HasValues t => t -> t -> Types t
maps :: t -> t -> Types t
maps t
k t
v = Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"maps" [t
k, t
v]

vectors :: HasValues t => Types t -> Types t
vectors :: Types t -> Types t
vectors Types t
t = Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"vectors" [Types t -> t
forall t. HasTypes t => Types t -> t
injectT Types t
t]

class HasValues t where
  project :: t -> Maybe (Values t)
  inject  :: Values t -> t
class HasComputationTypes t where
  projectCT :: t -> Maybe (ComputationTypes t)
  injectCT  :: ComputationTypes t -> t
class HasTypes t where
  projectT  :: t -> Maybe (Types t)
  injectT   :: Types t -> t
instance HasValues t => HasComputationTypes t where
  projectCT :: t -> Maybe (ComputationTypes t)
projectCT t
v = t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project t
v Maybe (Values t)
-> (Values t -> Maybe (ComputationTypes t))
-> Maybe (ComputationTypes t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                ComputationType ComputationTypes t
t -> ComputationTypes t -> Maybe (ComputationTypes t)
forall a. a -> Maybe a
Just ComputationTypes t
t
                Values t
_      -> Maybe (ComputationTypes t)
forall a. Maybe a
Nothing
                
  injectCT :: ComputationTypes t -> t
injectCT  = Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t)
-> (ComputationTypes t -> Values t) -> ComputationTypes t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputationTypes t -> Values t
forall t. ComputationTypes t -> Values t
ComputationType
instance HasComputationTypes t => HasTypes t where
  projectT :: t -> Maybe (Types t)
projectT t
ct = t -> Maybe (ComputationTypes t)
forall t. HasComputationTypes t => t -> Maybe (ComputationTypes t)
projectCT t
ct Maybe (ComputationTypes t)
-> (ComputationTypes t -> Maybe (Types t)) -> Maybe (Types t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case 
                  Type Types t
t -> Types t -> Maybe (Types t)
forall a. a -> Maybe a
Just Types t
t 
                  ComputationTypes t
_      -> Maybe (Types t)
forall a. Maybe a
Nothing
  injectT :: Types t -> t
injectT = ComputationTypes t -> t
forall t. HasComputationTypes t => ComputationTypes t -> t
injectCT (ComputationTypes t -> t)
-> (Types t -> ComputationTypes t) -> Types t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Types t -> ComputationTypes t
forall t. Types t -> ComputationTypes t
Type

data IEEEFormats = Binary32 | Binary64
        deriving (Int -> IEEEFormats
IEEEFormats -> Int
IEEEFormats -> [IEEEFormats]
IEEEFormats -> IEEEFormats
IEEEFormats -> IEEEFormats -> [IEEEFormats]
IEEEFormats -> IEEEFormats -> IEEEFormats -> [IEEEFormats]
(IEEEFormats -> IEEEFormats)
-> (IEEEFormats -> IEEEFormats)
-> (Int -> IEEEFormats)
-> (IEEEFormats -> Int)
-> (IEEEFormats -> [IEEEFormats])
-> (IEEEFormats -> IEEEFormats -> [IEEEFormats])
-> (IEEEFormats -> IEEEFormats -> [IEEEFormats])
-> (IEEEFormats -> IEEEFormats -> IEEEFormats -> [IEEEFormats])
-> Enum IEEEFormats
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IEEEFormats -> IEEEFormats -> IEEEFormats -> [IEEEFormats]
$cenumFromThenTo :: IEEEFormats -> IEEEFormats -> IEEEFormats -> [IEEEFormats]
enumFromTo :: IEEEFormats -> IEEEFormats -> [IEEEFormats]
$cenumFromTo :: IEEEFormats -> IEEEFormats -> [IEEEFormats]
enumFromThen :: IEEEFormats -> IEEEFormats -> [IEEEFormats]
$cenumFromThen :: IEEEFormats -> IEEEFormats -> [IEEEFormats]
enumFrom :: IEEEFormats -> [IEEEFormats]
$cenumFrom :: IEEEFormats -> [IEEEFormats]
fromEnum :: IEEEFormats -> Int
$cfromEnum :: IEEEFormats -> Int
toEnum :: Int -> IEEEFormats
$ctoEnum :: Int -> IEEEFormats
pred :: IEEEFormats -> IEEEFormats
$cpred :: IEEEFormats -> IEEEFormats
succ :: IEEEFormats -> IEEEFormats
$csucc :: IEEEFormats -> IEEEFormats
Enum,Int -> IEEEFormats -> ShowS
[IEEEFormats] -> ShowS
IEEEFormats -> String
(Int -> IEEEFormats -> ShowS)
-> (IEEEFormats -> String)
-> ([IEEEFormats] -> ShowS)
-> Show IEEEFormats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IEEEFormats] -> ShowS
$cshowList :: [IEEEFormats] -> ShowS
show :: IEEEFormats -> String
$cshow :: IEEEFormats -> String
showsPrec :: Int -> IEEEFormats -> ShowS
$cshowsPrec :: Int -> IEEEFormats -> ShowS
Show,IEEEFormats -> IEEEFormats -> Bool
(IEEEFormats -> IEEEFormats -> Bool)
-> (IEEEFormats -> IEEEFormats -> Bool) -> Eq IEEEFormats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IEEEFormats -> IEEEFormats -> Bool
$c/= :: IEEEFormats -> IEEEFormats -> Bool
== :: IEEEFormats -> IEEEFormats -> Bool
$c== :: IEEEFormats -> IEEEFormats -> Bool
Eq,Eq IEEEFormats
Eq IEEEFormats
-> (IEEEFormats -> IEEEFormats -> Ordering)
-> (IEEEFormats -> IEEEFormats -> Bool)
-> (IEEEFormats -> IEEEFormats -> Bool)
-> (IEEEFormats -> IEEEFormats -> Bool)
-> (IEEEFormats -> IEEEFormats -> Bool)
-> (IEEEFormats -> IEEEFormats -> IEEEFormats)
-> (IEEEFormats -> IEEEFormats -> IEEEFormats)
-> Ord IEEEFormats
IEEEFormats -> IEEEFormats -> Bool
IEEEFormats -> IEEEFormats -> Ordering
IEEEFormats -> IEEEFormats -> IEEEFormats
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IEEEFormats -> IEEEFormats -> IEEEFormats
$cmin :: IEEEFormats -> IEEEFormats -> IEEEFormats
max :: IEEEFormats -> IEEEFormats -> IEEEFormats
$cmax :: IEEEFormats -> IEEEFormats -> IEEEFormats
>= :: IEEEFormats -> IEEEFormats -> Bool
$c>= :: IEEEFormats -> IEEEFormats -> Bool
> :: IEEEFormats -> IEEEFormats -> Bool
$c> :: IEEEFormats -> IEEEFormats -> Bool
<= :: IEEEFormats -> IEEEFormats -> Bool
$c<= :: IEEEFormats -> IEEEFormats -> Bool
< :: IEEEFormats -> IEEEFormats -> Bool
$c< :: IEEEFormats -> IEEEFormats -> Bool
compare :: IEEEFormats -> IEEEFormats -> Ordering
$ccompare :: IEEEFormats -> IEEEFormats -> Ordering
$cp1Ord :: Eq IEEEFormats
Ord,ReadPrec [IEEEFormats]
ReadPrec IEEEFormats
Int -> ReadS IEEEFormats
ReadS [IEEEFormats]
(Int -> ReadS IEEEFormats)
-> ReadS [IEEEFormats]
-> ReadPrec IEEEFormats
-> ReadPrec [IEEEFormats]
-> Read IEEEFormats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IEEEFormats]
$creadListPrec :: ReadPrec [IEEEFormats]
readPrec :: ReadPrec IEEEFormats
$creadPrec :: ReadPrec IEEEFormats
readList :: ReadS [IEEEFormats]
$creadList :: ReadS [IEEEFormats]
readsPrec :: Int -> ReadS IEEEFormats
$creadsPrec :: Int -> ReadS IEEEFormats
Read)

-- Specialised version of 'fmap'
vmap :: (Ord b) => (a -> b) -> Values a -> Values b
vmap :: (a -> b) -> Values a -> Values b
vmap a -> b
f Values a
v = case Values a
v of
    ADTVal Name
nm [a]
ts      -> Name -> [b] -> Values b
forall t. Name -> [t] -> Values t
ADTVal Name
nm ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ts)
    Atom String
a            -> String -> Values b
forall t. String -> Values t
Atom String
a
    ComputationType ComputationTypes a
t -> ComputationTypes b -> Values b
forall t. ComputationTypes t -> Values t
ComputationType ((a -> b) -> ComputationTypes a -> ComputationTypes b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ComputationTypes a
t)
    Float Double
f           -> Double -> Values b
forall t. Double -> Values t
Float Double
f
    IEEE_Float_32 Float
f   -> Float -> Values b
forall t. Float -> Values t
IEEE_Float_32 Float
f
    IEEE_Float_64 Double
f   -> Double -> Values b
forall t. Double -> Values t
IEEE_Float_64 Double
f
    Int Integer
i             -> Integer -> Values b
forall t. Integer -> Values t
Int Integer
i
    Map ValueMaps (Values a)
m             -> ValueMaps (Values b) -> Values b
forall t. ValueMaps (Values t) -> Values t
Map (ValueMaps (Values b) -> Values b)
-> ValueMaps (Values b) -> Values b
forall a b. (a -> b) -> a -> b
$ [(Values b, [Values b])] -> ValueMaps (Values b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Values b, [Values b])] -> ValueMaps (Values b))
-> [(Values b, [Values b])] -> ValueMaps (Values b)
forall a b. (a -> b) -> a -> b
$ ((Values a, [Values a]) -> (Values b, [Values b]))
-> [(Values a, [Values a])] -> [(Values b, [Values b])]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Values a -> Values b
forall b a. Ord b => (a -> b) -> Values a -> Values b
vmap a -> b
f (Values a -> Values b)
-> ([Values a] -> [Values b])
-> (Values a, [Values a])
-> (Values b, [Values b])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Values a -> Values b) -> [Values a] -> [Values b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Values a -> Values b
forall b a. Ord b => (a -> b) -> Values a -> Values b
vmap a -> b
f)) ([(Values a, [Values a])] -> [(Values b, [Values b])])
-> [(Values a, [Values a])] -> [(Values b, [Values b])]
forall a b. (a -> b) -> a -> b
$ ValueMaps (Values a) -> [(Values a, [Values a])]
forall k a. Map k a -> [(k, a)]
M.assocs ValueMaps (Values a)
m
    Set ValueSets (Values a)
s             -> ValueSets (Values b) -> Values b
forall t. ValueSets (Values t) -> Values t
Set (ValueSets (Values b) -> Values b)
-> ValueSets (Values b) -> Values b
forall a b. (a -> b) -> a -> b
$ (Values a -> Values b)
-> ValueSets (Values a) -> ValueSets (Values b)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ((a -> b) -> Values a -> Values b
forall b a. Ord b => (a -> b) -> Values a -> Values b
vmap a -> b
f) ValueSets (Values a)
s
    Multiset MultiSet (Values a)
ms       -> MultiSet (Values b) -> Values b
forall t. MultiSet (Values t) -> Values t
Multiset (MultiSet (Values b) -> Values b)
-> MultiSet (Values b) -> Values b
forall a b. (a -> b) -> a -> b
$ (Values a -> Values b)
-> MultiSet (Values a) -> MultiSet (Values b)
forall b a. Ord b => (a -> b) -> MultiSet a -> MultiSet b
MS.map ((a -> b) -> Values a -> Values b
forall b a. Ord b => (a -> b) -> Values a -> Values b
vmap a -> b
f) MultiSet (Values a)
ms
    Nat Integer
n             -> Integer -> Values b
forall t. Integer -> Values t
Nat Integer
n
    Rational Rational
r        -> Rational -> Values b
forall t. Rational -> Values t
Rational Rational
r
    Vector ValueVectors (Values a)
v          -> ValueVectors (Values b) -> Values b
forall t. ValueVectors (Values t) -> Values t
Vector (ValueVectors (Values b) -> Values b)
-> ValueVectors (Values b) -> Values b
forall a b. (a -> b) -> a -> b
$ (Values a -> Values b)
-> ValueVectors (Values a) -> ValueVectors (Values b)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((a -> b) -> Values a -> Values b
forall b a. Ord b => (a -> b) -> Values a -> Values b
vmap a -> b
f) ValueVectors (Values a)
v
    Values a
VAny              -> Values b
forall t. Values t
VAny 
    ValSeq [a]
ts         -> [b] -> Values b
forall t. [t] -> Values t
ValSeq ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ts)

 
traverseV :: (Ord b, Monad m, HasValues a, HasValues b) => 
  (a -> m b) -> Values a -> m (Values b)
traverseV :: (a -> m b) -> Values a -> m (Values b)
traverseV a -> m b
f = (a -> m b) -> ([a] -> m [b]) -> Values a -> m (Values b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Values a -> m (Values b)
traverseVM a -> m b
f ((a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f)

traverseVM :: (Ord b, Monad m, HasValues a, HasValues b) => 
  (a -> m b) -> ([a] -> m [b]) -> Values a -> m (Values b)
traverseVM :: (a -> m b) -> ([a] -> m [b]) -> Values a -> m (Values b)
traverseVM a -> m b
f [a] -> m [b]
fs Values a
v = case Values a
v of
    ADTVal Name
nm [a]
vs      -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b))
-> ([b] -> Values b) -> [b] -> m (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [b] -> Values b
forall t. Name -> [t] -> Values t
ADTVal Name
nm ([b] -> m (Values b)) -> m [b] -> m (Values b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> m [b]
fs [a]
vs
    Atom String
a            -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ String -> Values b
forall t. String -> Values t
Atom String
a
    ComputationType ComputationTypes a
t -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b))
-> (ComputationTypes b -> Values b)
-> ComputationTypes b
-> m (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputationTypes b -> Values b
forall t. ComputationTypes t -> Values t
ComputationType   (ComputationTypes b -> m (Values b))
-> m (ComputationTypes b) -> m (Values b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> m b)
-> ([a] -> m [b]) -> ComputationTypes a -> m (ComputationTypes b)
forall (m :: * -> *) b a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b)
-> ([a] -> m [b]) -> ComputationTypes a -> m (ComputationTypes b)
traverseCTM a -> m b
f [a] -> m [b]
fs ComputationTypes a
t
    Float Double
f           -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Double -> Values b
forall t. Double -> Values t
Float Double
f
    IEEE_Float_32 Float
f   -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Float -> Values b
forall t. Float -> Values t
IEEE_Float_32 Float
f
    IEEE_Float_64 Double
f   -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Double -> Values b
forall t. Double -> Values t
IEEE_Float_64 Double
f
    Int Integer
i             -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Integer -> Values b
forall t. Integer -> Values t
Int Integer
i
    Map ValueMaps (Values a)
m             -> do 
        let ([Values a]
keys, [[Values a]]
valss) = [(Values a, [Values a])] -> ([Values a], [[Values a]])
forall a b. [(a, b)] -> ([a], [b])
unzip (ValueMaps (Values a) -> [(Values a, [Values a])]
forall k a. Map k a -> [(k, a)]
M.assocs ValueMaps (Values a)
m)
        [Values b]
keys' <- (b -> Values b) -> [b] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values b) -> Values b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values b) -> Values b)
-> (b -> Maybe (Values b)) -> b -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Values b)
forall t. HasValues t => t -> Maybe (Values t)
project) ([b] -> [Values b]) -> m [b] -> m [Values b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m [b]
fs ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject [Values a]
keys)
        [[Values b]]
vals' <- ([b] -> [Values b]) -> [[b]] -> [[Values b]]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Values b) -> [b] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values b) -> Values b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values b) -> Values b)
-> (b -> Maybe (Values b)) -> b -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Values b)
forall t. HasValues t => t -> Maybe (Values t)
project)) ([[b]] -> [[Values b]]) -> m [[b]] -> m [[Values b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Values a] -> m [b]) -> [[Values a]] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([a] -> m [b]
fs ([a] -> m [b]) -> ([Values a] -> [a]) -> [Values a] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject) [[Values a]]
valss
        Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueMaps (Values b) -> Values b
forall t. ValueMaps (Values t) -> Values t
Map (ValueMaps (Values b) -> Values b)
-> ValueMaps (Values b) -> Values b
forall a b. (a -> b) -> a -> b
$ [(Values b, [Values b])] -> ValueMaps (Values b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Values b, [Values b])] -> ValueMaps (Values b))
-> [(Values b, [Values b])] -> ValueMaps (Values b)
forall a b. (a -> b) -> a -> b
$ [Values b] -> [[Values b]] -> [(Values b, [Values b])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Values b]
keys' [[Values b]]
vals')
    Set ValueSets (Values a)
s             -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b))
-> ([b] -> Values b) -> [b] -> m (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSets (Values b) -> Values b
forall t. ValueSets (Values t) -> Values t
Set (ValueSets (Values b) -> Values b)
-> ([b] -> ValueSets (Values b)) -> [b] -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values b] -> ValueSets (Values b)
forall a. Ord a => [a] -> Set a
S.fromList ([Values b] -> ValueSets (Values b))
-> ([b] -> [Values b]) -> [b] -> ValueSets (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Values b) -> [b] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values b) -> Values b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values b) -> Values b)
-> (b -> Maybe (Values b)) -> b -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Values b)
forall t. HasValues t => t -> Maybe (Values t)
project) ([b] -> m (Values b)) -> m [b] -> m (Values b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> m [b]
fs ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject ([Values a] -> [a]) -> [Values a] -> [a]
forall a b. (a -> b) -> a -> b
$ ValueSets (Values a) -> [Values a]
forall a. Set a -> [a]
S.toList ValueSets (Values a)
s)
    Multiset MultiSet (Values a)
ms       -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b))
-> ([b] -> Values b) -> [b] -> m (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSet (Values b) -> Values b
forall t. MultiSet (Values t) -> Values t
Multiset (MultiSet (Values b) -> Values b)
-> ([b] -> MultiSet (Values b)) -> [b] -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values b] -> MultiSet (Values b)
forall a. Ord a => [a] -> MultiSet a
MS.fromList ([Values b] -> MultiSet (Values b))
-> ([b] -> [Values b]) -> [b] -> MultiSet (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Values b) -> [b] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values b) -> Values b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values b) -> Values b)
-> (b -> Maybe (Values b)) -> b -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Values b)
forall t. HasValues t => t -> Maybe (Values t)
project) ([b] -> m (Values b)) -> m [b] -> m (Values b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> m [b]
fs ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject ([Values a] -> [a]) -> [Values a] -> [a]
forall a b. (a -> b) -> a -> b
$ MultiSet (Values a) -> [Values a]
forall a. MultiSet a -> [a]
MS.toList MultiSet (Values a)
ms)
    Nat Integer
n             -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Integer -> Values b
forall t. Integer -> Values t
Nat Integer
n
    Rational Rational
r        -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b)) -> Values b -> m (Values b)
forall a b. (a -> b) -> a -> b
$ Rational -> Values b
forall t. Rational -> Values t
Rational Rational
r
    Vector ValueVectors (Values a)
v          -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Values b -> m (Values b))
-> ([b] -> Values b) -> [b] -> m (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueVectors (Values b) -> Values b
forall t. ValueVectors (Values t) -> Values t
Vector (ValueVectors (Values b) -> Values b)
-> ([b] -> ValueVectors (Values b)) -> [b] -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values b] -> ValueVectors (Values b)
forall a. [a] -> Vector a
V.fromList ([Values b] -> ValueVectors (Values b))
-> ([b] -> [Values b]) -> [b] -> ValueVectors (Values b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Values b) -> [b] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Values b) -> Values b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Values b) -> Values b)
-> (b -> Maybe (Values b)) -> b -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Values b)
forall t. HasValues t => t -> Maybe (Values t)
project) ([b] -> m (Values b)) -> m [b] -> m (Values b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> m [b]
fs ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject ([Values a] -> [a]) -> [Values a] -> [a]
forall a b. (a -> b) -> a -> b
$ ValueVectors (Values a) -> [Values a]
forall a. Vector a -> [a]
V.toList ValueVectors (Values a)
v)
    Values a
VAny -> Values b -> m (Values b)
forall (m :: * -> *) a. Monad m => a -> m a
return Values b
forall t. Values t
VAny
    ValSeq [a]
ts -> [b] -> Values b
forall t. [t] -> Values t
ValSeq ([b] -> Values b) -> m [b] -> m (Values b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m [b]
fs [a]
ts

traverseT :: (Ord b, Monad m, HasValues a, HasValues b) => 
  (a -> m b) -> Types a -> m (Types b)
traverseT :: (a -> m b) -> Types a -> m (Types b)
traverseT a -> m b
f = (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f ((a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f)
traverseTM :: (Ord b, Monad m, HasValues a, HasValues b) => 
  (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM :: (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t = case Types a
t of
  Types a
ADTs -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
ADTs
  ADT Name
nm [a]
ts -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Types b -> m (Types b)) -> ([b] -> Types b) -> [b] -> m (Types b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [b] -> Types b
forall t. Name -> [t] -> Types t
ADT Name
nm ([b] -> m (Types b)) -> m [b] -> m (Types b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> m [b]
fs [a]
ts
  Types a
AsciiCharacters -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
AsciiCharacters
  Types a
ISOLatinCharacters -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
ISOLatinCharacters
  Types a
BMPCharacters -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
BMPCharacters
  Types a
Atoms ->  Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Atoms
  AnnotatedType Types a
ty SeqSortOp
op -> Types b -> SeqSortOp -> Types b
forall t. Types t -> SeqSortOp -> Types t
AnnotatedType (Types b -> SeqSortOp -> Types b)
-> m (Types b) -> m (SeqSortOp -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
ty m (SeqSortOp -> Types b) -> m SeqSortOp -> m (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqSortOp -> m SeqSortOp
forall (m :: * -> *) a. Monad m => a -> m a
return SeqSortOp
op
  Types a
Characters -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Characters
  Types a
ComputationTypes -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
ComputationTypes
  Complement Types a
t -> Types b -> Types b
forall t. Types t -> Types t
Complement (Types b -> Types b) -> m (Types b) -> m (Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t  
  IntegersFrom Integer
f -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Types b
forall t. Integer -> Types t
IntegersFrom Integer
f)
  IntegersUpTo Integer
f -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Types b
forall t. Integer -> Types t
IntegersUpTo Integer
f)
  Intersection Types a
t1 Types a
t2 -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Intersection (Types b -> Types b -> Types b)
-> m (Types b) -> m (Types b -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t1 m (Types b -> Types b) -> m (Types b) -> m (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t2
  Types a
NullType -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
NullType
  Types a
EmptyType -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
EmptyType
  IEEEFloats IEEEFormats
i -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return (IEEEFormats -> Types b
forall t. IEEEFormats -> Types t
IEEEFloats IEEEFormats
i)
  Types a
Integers -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Integers
  Types a
Naturals -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Naturals
  Types a
Rationals -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Rationals
  Types a
Types -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Types 
  Types a
UnicodeCharacters -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
UnicodeCharacters
  Union Types a
t1 Types a
t2 -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Union (Types b -> Types b -> Types b)
-> m (Types b) -> m (Types b -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t1 m (Types b -> Types b) -> m (Types b) -> m (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t2
  Types a
Values -> Types b -> m (Types b)
forall (m :: * -> *) a. Monad m => a -> m a
return Types b
forall t. Types t
Values

traverseCTM :: (a -> m b)
-> ([a] -> m [b]) -> ComputationTypes a -> m (ComputationTypes b)
traverseCTM a -> m b
f [a] -> m [b]
fs ComputationTypes a
t = case ComputationTypes a
t of
  Type Types a
t -> Types b -> ComputationTypes b
forall t. Types t -> ComputationTypes t
Type (Types b -> ComputationTypes b)
-> m (Types b) -> m (ComputationTypes b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t
  ComputesType Types a
t -> Types b -> ComputationTypes b
forall t. Types t -> ComputationTypes t
ComputesType (Types b -> ComputationTypes b)
-> m (Types b) -> m (ComputationTypes b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
t
  ComputesFromType Types a
ty Types a
ty2 -> Types b -> Types b -> ComputationTypes b
forall t. Types t -> Types t -> ComputationTypes t
ComputesFromType (Types b -> Types b -> ComputationTypes b)
-> m (Types b) -> m (Types b -> ComputationTypes b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
ty
                                              m (Types b -> ComputationTypes b)
-> m (Types b) -> m (ComputationTypes b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
forall b (m :: * -> *) a.
(Ord b, Monad m, HasValues a, HasValues b) =>
(a -> m b) -> ([a] -> m [b]) -> Types a -> m (Types b)
traverseTM a -> m b
f [a] -> m [b]
fs Types a
ty2

structVcompare :: (Monoid m, HasValues a, HasValues b) => 
  (a -> b -> Maybe m) -> Values a -> Values b -> Maybe (Maybe m)
structVcompare :: (a -> b -> Maybe m) -> Values a -> Values b -> Maybe (Maybe m)
structVcompare a -> b -> Maybe m
comp = (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> Values a
-> Values b
-> Maybe (Maybe m)
forall m b a.
(Monoid m, HasValues b, HasValues a) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> Values a
-> Values b
-> Maybe (Maybe m)
structVMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps
  where comps :: [a] -> [b] -> Maybe m
comps [a]
xs [b]
ys | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys = ([m] -> m) -> Maybe [m] -> Maybe m
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [m] -> m
forall a. Monoid a => [a] -> a
mconcat (Maybe [m] -> Maybe m) -> Maybe [m] -> Maybe m
forall a b. (a -> b) -> a -> b
$ [Maybe m] -> Maybe [m]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe m] -> Maybe [m]) -> [Maybe m] -> Maybe [m]
forall a b. (a -> b) -> a -> b
$ (a -> b -> Maybe m) -> [a] -> [b] -> [Maybe m]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> Maybe m
comp [a]
xs [b]
ys
                    | Bool
otherwise = Maybe m
forall a. Maybe a
Nothing

structCTMcompare :: (Monoid m, HasValues a, HasValues b) => 
  (a -> b -> Maybe m) -> ([a] -> [b] -> Maybe m) ->
    ComputationTypes a -> ComputationTypes b -> (Maybe (Maybe m))
structCTMcompare :: (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> ComputationTypes a
-> ComputationTypes b
-> Maybe (Maybe m)
structCTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps ComputationTypes a
va ComputationTypes b
vb = case (ComputationTypes a
va,ComputationTypes b
vb) of
  (Type Types a
x, Type Types b
y)  -> (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
x Types b
y 
  (Type Types a
_,ComputationTypes b
_)        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ComputationTypes a
_, Type Types b
_)       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ComputesType Types a
x, ComputesType Types b
y)  -> (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
x Types b
y 
  (ComputesType Types a
_, ComputationTypes b
_)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing 
  (ComputationTypes a
_, ComputesType Types b
_)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ComputesFromType Types a
x Types a
y, ComputesFromType Types b
x' Types b
y') -> 
    (Maybe m -> Maybe m -> Maybe m)
-> Maybe (Maybe m) -> Maybe (Maybe m) -> Maybe (Maybe m)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe m -> Maybe m -> Maybe m
forall a. Monoid a => a -> a -> a
mappend ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
x Types b
x') ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
y Types b
y')

structVMcompare :: (Monoid m, HasValues b, HasValues a) => 
  (a -> b -> Maybe m) -> ([a] -> [b] -> Maybe m) -> 
    Values a -> Values b -> Maybe (Maybe m)
structVMcompare :: (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> Values a
-> Values b
-> Maybe (Maybe m)
structVMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Values a
va Values b
vb = case (Values a
va, Values b
vb) of
  (ADTVal Name
nm1 [a]
vs1, ADTVal Name
nm2 [b]
vs2) 
    | Name
nm1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nm2 -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> Maybe m
comps [a]
vs1 [b]
vs2
  (ADTVal Name
_ [a]
_, Values b
_) -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, ADTVal Name
_ [b]
_) -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Atom String
x, Atom String
y) | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y   -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Atom String
_, Values b
_)                 -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Atom String
_)                 -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ComputationType ComputationTypes a
x
    ,ComputationType ComputationTypes b
y)       -> (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> ComputationTypes a
-> ComputationTypes b
-> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m)
-> ComputationTypes a
-> ComputationTypes b
-> Maybe (Maybe m)
structCTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps ComputationTypes a
x ComputationTypes b
y 
  (Values a
_, ComputationType ComputationTypes b
x)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ComputationType ComputationTypes a
_, Values b
_)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Float Double
x, Float Double
y) | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Float Double
_, Values b
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Float Double
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IEEE_Float_32 Float
x, IEEE_Float_32 Float
y) | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IEEE_Float_32 Float
_, Values b
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, IEEE_Float_32 Float
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IEEE_Float_64 Double
x, IEEE_Float_64 Double
y) | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IEEE_Float_64 Double
_, Values b
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, IEEE_Float_64 Double
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Int Integer
x, Int Integer
y) | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y                     -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Int Integer
_, Values b
_)                                  -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Int Integer
_)                                  -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Map ValueMaps (Values a)
m1, Map ValueMaps (Values b)
m2) -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ (m -> m -> m) -> Maybe m -> Maybe m -> Maybe m
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 m -> m -> m
forall a. Monoid a => a -> a -> a
mappend ([Values a] -> [Values b] -> Maybe m
comps' (ValueMaps (Values a) -> [Values a]
forall k a. Map k a -> [k]
M.keys ValueMaps (Values a)
m1) (ValueMaps (Values b) -> [Values b]
forall k a. Map k a -> [k]
M.keys ValueMaps (Values b)
m2))
                                            ([Values a] -> [Values b] -> Maybe m
comps' (([Values a] -> Values a) -> [[Values a]] -> [Values a]
forall a b. (a -> b) -> [a] -> [b]
map [Values a] -> Values a
forall t. HasValues t => [Values t] -> Values t
list ([[Values a]] -> [Values a]) -> [[Values a]] -> [Values a]
forall a b. (a -> b) -> a -> b
$ ValueMaps (Values a) -> [[Values a]]
forall k a. Map k a -> [a]
M.elems ValueMaps (Values a)
m1)
                                                    (([Values b] -> Values b) -> [[Values b]] -> [Values b]
forall a b. (a -> b) -> [a] -> [b]
map [Values b] -> Values b
forall t. HasValues t => [Values t] -> Values t
list ([[Values b]] -> [Values b]) -> [[Values b]] -> [Values b]
forall a b. (a -> b) -> a -> b
$ ValueMaps (Values b) -> [[Values b]]
forall k a. Map k a -> [a]
M.elems ValueMaps (Values b)
m2))
  (Map ValueMaps (Values a)
_, Values b
_)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Map ValueMaps (Values b)
_)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Set ValueSets (Values a)
x, Set ValueSets (Values b)
y) -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ [Values a] -> [Values b] -> Maybe m
comps' (ValueSets (Values a) -> [Values a]
forall a. Set a -> [a]
S.toList ValueSets (Values a)
x) (ValueSets (Values b) -> [Values b]
forall a. Set a -> [a]
S.toList ValueSets (Values b)
y)
  (Set ValueSets (Values a)
_, Values b
_)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Set ValueSets (Values b)
_)      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Multiset MultiSet (Values a)
x, Multiset MultiSet (Values b)
y) -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> Maybe m
comps ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject ([Values a] -> [a]) -> [Values a] -> [a]
forall a b. (a -> b) -> a -> b
$ MultiSet (Values a) -> [Values a]
forall a. MultiSet a -> [a]
MS.toList MultiSet (Values a)
x) 
                                           ((Values b -> b) -> [Values b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Values b -> b
forall t. HasValues t => Values t -> t
inject ([Values b] -> [b]) -> [Values b] -> [b]
forall a b. (a -> b) -> a -> b
$ MultiSet (Values b) -> [Values b]
forall a. MultiSet a -> [a]
MS.toList MultiSet (Values b)
y)
  (Multiset MultiSet (Values a)
_, Values b
_)           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Multiset MultiSet (Values b)
_)           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Nat Integer
x, Nat Integer
y)  | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Nat Integer
_, Values b
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Nat Integer
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Rational Rational
x, Rational Rational
y) | Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Rational Rational
_, Values b
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, Rational Rational
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Vector ValueVectors (Values a)
x, Vector ValueVectors (Values b)
y) -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> Maybe m
comps ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject ([Values a] -> [a]) -> [Values a] -> [a]
forall a b. (a -> b) -> a -> b
$ ValueVectors (Values a) -> [Values a]
forall a. Vector a -> [a]
V.toList ValueVectors (Values a)
x) ((Values b -> b) -> [Values b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Values b -> b
forall t. HasValues t => Values t -> t
inject ([Values b] -> [b]) -> [Values b] -> [b]
forall a b. (a -> b) -> a -> b
$ ValueVectors (Values b) -> [Values b]
forall a. Vector a -> [a]
V.toList ValueVectors (Values b)
y)
  (Values a
VAny, Values b
VAny)  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Values a
_, Values b
VAny)     -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
VAny, Values b
_)     -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ValSeq [a]
ts, ValSeq [b]
ts') -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just ([a] -> [b] -> Maybe m
comps [a]
ts [b]
ts')
  (ValSeq [a]
_, Values b
_)           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Values a
_, ValSeq [b]
_)           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  where comps' :: [Values a] -> [Values b] -> Maybe m
comps' [Values a]
xs [Values b]
ys = [a] -> [b] -> Maybe m
comps ((Values a -> a) -> [Values a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Values a -> a
forall t. HasValues t => Values t -> t
inject [Values a]
xs) ((Values b -> b) -> [Values b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Values b -> b
forall t. HasValues t => Values t -> t
inject [Values b]
ys)

structTMcompare :: (Monoid m, HasValues a, HasValues b) => 
  (a -> b -> Maybe m) -> ([a] -> [b] -> Maybe m) -> 
    Types a -> Types b -> Maybe (Maybe m)
structTMcompare :: (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
ta Types b
tb = case (Types a
ta, Types b
tb) of
  (Types a
ADTs, Types b
ADTs)                        -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
ADTs, Types b
_)                           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
ADTs)                           -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (ADT Name
nm1 [a]
ts, ADT Name
nm2 [b]
ts') | Name
nm1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nm2 -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (Maybe m -> Maybe (Maybe m)) -> Maybe m -> Maybe (Maybe m)
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> Maybe m
comps [a]
ts [b]
ts'
  (ADT Name
_ [a]
_, Types b
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, ADT Name
_ [b]
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Atoms, Types b
Atoms)                      -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
Atoms, Types b
_)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
Atoms)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
AsciiCharacters, Types b
AsciiCharacters)  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty) 
  (Types a
AsciiCharacters, Types b
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
AsciiCharacters)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
ISOLatinCharacters, Types b
ISOLatinCharacters)  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty) 
  (Types a
ISOLatinCharacters, Types b
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
ISOLatinCharacters)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
BMPCharacters, Types b
BMPCharacters)  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty) 
  (Types a
BMPCharacters, Types b
_)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
BMPCharacters)                -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (AnnotatedType Types a
t1 SeqSortOp
op1, AnnotatedType Types b
t2 SeqSortOp
op2) | SeqSortOp
op1 SeqSortOp -> SeqSortOp -> Bool
forall a. Eq a => a -> a -> Bool
== SeqSortOp
op2 -> (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
t1 Types b
t2
  (AnnotatedType Types a
_ SeqSortOp
_, Types b
_)              -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, AnnotatedType Types b
_ SeqSortOp
_)              -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Characters, Types b
Characters)            -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
Characters, Types b
_)                     -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
Characters)                     -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Complement Types a
x, Complement Types b
y)        -> (a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
x Types b
y
  (Types a
_, Complement Types b
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Complement Types a
_, Types b
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
ComputationTypes, Types b
ComputationTypes)-> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
_, Types b
ComputationTypes)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
ComputationTypes, Types b
_)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IntegersFrom Integer
mx, IntegersFrom Integer
mx') | Integer
mx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
mx' -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (IntegersFrom Integer
_, Types b
_)                 -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, IntegersFrom Integer
_)                 -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IntegersUpTo Integer
mx, IntegersUpTo Integer
mx') | Integer
mx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
mx' -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (IntegersUpTo Integer
_, Types b
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, IntegersUpTo Integer
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
EmptyType, Types b
EmptyType)              -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
_, Types b
EmptyType)                      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
EmptyType, Types b
_)                      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (IEEEFloats IEEEFormats
x, IEEEFloats IEEEFormats
y) | IEEEFormats
x IEEEFormats -> IEEEFormats -> Bool
forall a. Eq a => a -> a -> Bool
==IEEEFormats
y-> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (IEEEFloats IEEEFormats
_, Types b
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, IEEEFloats IEEEFormats
_)                   -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Integers, Types b
Integers)                -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
Integers, Types b
_)                       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
Integers)                       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Intersection Types a
x Types a
y, Intersection Types b
x' Types b
y') -> (Maybe m -> Maybe m -> Maybe m)
-> Maybe (Maybe m) -> Maybe (Maybe m) -> Maybe (Maybe m)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe m -> Maybe m -> Maybe m
forall a. Monoid a => a -> a -> a
mappend ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
x Types b
x') ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
y Types b
y')
  (Intersection Types a
_ Types a
_, Types b
_)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Intersection Types b
_ Types b
_)               -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Naturals, Types b
Naturals)                -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
_, Types b
Naturals)                       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Naturals, Types b
_)                       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
NullType, Types b
NullType)                -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
_, Types b
NullType)                       -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
NullType,Types b
_)                        -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Rationals, Types b
Rationals)              -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
Rationals, Types b
_)                      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
Rationals)                      -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Types, Types b
Types)                      -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
_, Types b
Types)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Types, Types b
_)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
UnicodeCharacters, Types b
UnicodeCharacters)  -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)
  (Types a
UnicodeCharacters, Types b
_)                  -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Types b
UnicodeCharacters)                  -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Union Types a
u Types a
v, Union Types b
x Types b
y)                  -> (Maybe m -> Maybe m -> Maybe m)
-> Maybe (Maybe m) -> Maybe (Maybe m) -> Maybe (Maybe m)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe m -> Maybe m -> Maybe m
forall a. Monoid a => a -> a -> a
mappend ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
u Types b
x) ((a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
forall m a b.
(Monoid m, HasValues a, HasValues b) =>
(a -> b -> Maybe m)
-> ([a] -> [b] -> Maybe m) -> Types a -> Types b -> Maybe (Maybe m)
structTMcompare a -> b -> Maybe m
comp [a] -> [b] -> Maybe m
comps Types a
v Types b
y)
  (Union Types a
_ Types a
_, Types b
_)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
_, Union Types b
_ Types b
_)                          -> Maybe (Maybe m)
forall a. Maybe a
Nothing
  (Types a
Values, Types b
Values)                        -> Maybe m -> Maybe (Maybe m)
forall a. a -> Maybe a
Just (m -> Maybe m
forall a. a -> Maybe a
Just m
forall a. Monoid a => a
mempty)

instance Functor Types where
  fmap :: (a -> b) -> Types a -> Types b
fmap a -> b
f Types a
t = case Types a
t of 
    ADT Name
nm [a]
ts           -> Name -> [b] -> Types b
forall t. Name -> [t] -> Types t
ADT Name
nm ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
ts) 
    Types a
ADTs                -> Types b
forall t. Types t
ADTs
    Types a
AsciiCharacters     -> Types b
forall t. Types t
AsciiCharacters
    Types a
ISOLatinCharacters  -> Types b
forall t. Types t
ISOLatinCharacters
    Types a
BMPCharacters       -> Types b
forall t. Types t
BMPCharacters
    Types a
Atoms               -> Types b
forall t. Types t
Atoms
    AnnotatedType Types a
ty SeqSortOp
op -> Types b -> SeqSortOp -> Types b
forall t. Types t -> SeqSortOp -> Types t
AnnotatedType ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
ty) SeqSortOp
op
    Complement Types a
t1       -> Types b -> Types b
forall t. Types t -> Types t
Complement ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t1)
    Types a
ComputationTypes    -> Types b
forall t. Types t
ComputationTypes
    IntegersFrom Integer
p      -> Integer -> Types b
forall t. Integer -> Types t
IntegersFrom Integer
p
    IntegersUpTo Integer
p      -> Integer -> Types b
forall t. Integer -> Types t
IntegersUpTo Integer
p
    Types a
Characters          -> Types b
forall t. Types t
Characters   
    Types a
EmptyType           -> Types b
forall t. Types t
EmptyType
    IEEEFloats IEEEFormats
b        -> IEEEFormats -> Types b
forall t. IEEEFormats -> Types t
IEEEFloats IEEEFormats
b
    Types a
Integers            -> Types b
forall t. Types t
Integers
    Intersection Types a
t1 Types a
t2  -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Intersection ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t1) ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t2)
    Types a
Naturals            -> Types b
forall t. Types t
Naturals
    Types a
NullType            -> Types b
forall t. Types t
NullType
    Types a
Rationals           -> Types b
forall t. Types t
Rationals
    Types a
Types               -> Types b
forall t. Types t
Types
    Types a
UnicodeCharacters   -> Types b
forall t. Types t
UnicodeCharacters
    Union Types a
t1 Types a
t2         -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Union ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t1) ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t2)
    Types a
Values              -> Types b
forall t. Types t
Values 

instance Functor ComputationTypes where
  fmap :: (a -> b) -> ComputationTypes a -> ComputationTypes b
fmap a -> b
f ComputationTypes a
t = case ComputationTypes a
t of
    Type Types a
t -> Types b -> ComputationTypes b
forall t. Types t -> ComputationTypes t
Type (Types b -> ComputationTypes b) -> Types b -> ComputationTypes b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t
    ComputesType Types a
t -> Types b -> ComputationTypes b
forall t. Types t -> ComputationTypes t
ComputesType (Types b -> ComputationTypes b) -> Types b -> ComputationTypes b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t
    ComputesFromType Types a
t1 Types a
t2 -> Types b -> Types b -> ComputationTypes b
forall t. Types t -> Types t -> ComputationTypes t
ComputesFromType ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t1) ((a -> b) -> Types a -> Types b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Types a
t2)

instance Foldable Types where
  foldMap :: (a -> m) -> Types a -> m
foldMap a -> m
f Types a
fa = case Types a
fa of 
    ADT Name
_ [a]
ts            -> (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
ts
    Types a
ADTs                -> m
forall a. Monoid a => a
mempty
    Types a
AsciiCharacters     -> m
forall a. Monoid a => a
mempty
    Types a
ISOLatinCharacters  -> m
forall a. Monoid a => a
mempty
    Types a
BMPCharacters       -> m
forall a. Monoid a => a
mempty
    Types a
Atoms               -> m
forall a. Monoid a => a
mempty
    AnnotatedType Types a
ty SeqSortOp
op -> (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
ty
    Types a
Characters          -> m
forall a. Monoid a => a
mempty
    Complement Types a
t1       -> (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
t1
    Types a
ComputationTypes    -> m
forall a. Monoid a => a
mempty
    IntegersUpTo Integer
q      -> m
forall a. Monoid a => a
mempty
    IntegersFrom Integer
q      -> m
forall a. Monoid a => a
mempty
    Intersection Types a
t1 Types a
t2  -> (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
t1 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
t2
    Types a
EmptyType           -> m
forall a. Monoid a => a
mempty
    IEEEFloats IEEEFormats
b        -> m
forall a. Monoid a => a
mempty 
    Types a
Integers            -> m
forall a. Monoid a => a
mempty
    Types a
Naturals            -> m
forall a. Monoid a => a
mempty 
    Types a
NullType            -> m
forall a. Monoid a => a
mempty
    Types a
Rationals           -> m
forall a. Monoid a => a
mempty
    Types a
Types               -> m
forall a. Monoid a => a
mempty 
    Types a
UnicodeCharacters   -> m
forall a. Monoid a => a
mempty 
    Union Types a
t1 Types a
t2         -> (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
t1 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Types a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Types a
t2
    Types a
Values              -> m
forall a. Monoid a => a
mempty 

instance Traversable Types where
  traverse :: (a -> f b) -> Types a -> f (Types b)
traverse a -> f b
f Types a
ta = case Types a
ta of 
    Types a
ADTs                -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
ADTs
    ADT Name
nm [a]
ts           -> Name -> [b] -> Types b
forall t. Name -> [t] -> Types t
ADT Name
nm ([b] -> Types b) -> f [b] -> f (Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
ts
    Types a
AsciiCharacters     -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
AsciiCharacters
    Types a
ISOLatinCharacters  -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
ISOLatinCharacters
    Types a
BMPCharacters       -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
BMPCharacters
    AnnotatedType Types a
ty SeqSortOp
op -> Types b -> SeqSortOp -> Types b
forall t. Types t -> SeqSortOp -> Types t
AnnotatedType (Types b -> SeqSortOp -> Types b)
-> f (Types b) -> f (SeqSortOp -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
ty f (SeqSortOp -> Types b) -> f SeqSortOp -> f (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqSortOp -> f SeqSortOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqSortOp
op
    Types a
Atoms               -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Atoms
    Types a
Characters          -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Characters
    Complement Types a
t        -> Types b -> Types b
forall t. Types t -> Types t
Complement (Types b -> Types b) -> f (Types b) -> f (Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
t
    Types a
ComputationTypes    -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
ComputationTypes
    IntegersFrom Integer
n      -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Types b -> f (Types b)) -> Types b -> f (Types b)
forall a b. (a -> b) -> a -> b
$ Integer -> Types b
forall t. Integer -> Types t
IntegersFrom Integer
n
    IntegersUpTo Integer
n        -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Types b -> f (Types b)) -> Types b -> f (Types b)
forall a b. (a -> b) -> a -> b
$ Integer -> Types b
forall t. Integer -> Types t
IntegersUpTo Integer
n
    Types a
EmptyType           -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
EmptyType
    IEEEFloats IEEEFormats
b        -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Types b -> f (Types b)) -> Types b -> f (Types b)
forall a b. (a -> b) -> a -> b
$ IEEEFormats -> Types b
forall t. IEEEFormats -> Types t
IEEEFloats IEEEFormats
b
    Types a
Integers            -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Integers
    Intersection Types a
t1 Types a
t2  -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Intersection (Types b -> Types b -> Types b)
-> f (Types b) -> f (Types b -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
t1 f (Types b -> Types b) -> f (Types b) -> f (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
t2
    Types a
Naturals            -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Naturals
    Types a
NullType            -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
NullType
    Types a
Rationals           -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Rationals
    Types a
Types               -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Types
    Types a
UnicodeCharacters   -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
UnicodeCharacters
    Union Types a
t1 Types a
t2         -> Types b -> Types b -> Types b
forall t. Types t -> Types t -> Types t
Union (Types b -> Types b -> Types b)
-> f (Types b) -> f (Types b -> Types b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
t1 f (Types b -> Types b) -> f (Types b) -> f (Types b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Types a -> f (Types b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Types a
t2
    Types a
Values              -> Types b -> f (Types b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Types b
forall t. Types t
Values 

downcastValueType :: Values t -> Types t
downcastValueType :: Values t -> Types t
downcastValueType (ComputationType (Type Types t
t)) = Types t
t
downcastValueType (ComputationType (ComputesType Types t
t)) = Types t
t
downcastValueType (ComputationType (ComputesFromType Types t
_ Types t
t)) = Types t
t
downcastValueType Values t
_ = String -> Types t
forall a. HasCallStack => String -> a
error String
"valueType: not a type"

-- | Returns the /rational/ representation of a value if it is a subtype.
-- Otherwise it returns the original value.
upcastRationals :: Values t -> Values t
upcastRationals :: Values t -> Values t
upcastRationals (Nat Integer
n) = Rational -> Values t
forall t. Rational -> Values t
Rational (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
n)
upcastRationals (Int Integer
i) = Rational -> Values t
forall t. Rational -> Values t
Rational (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
i)
upcastRationals Values t
v       = Values t
v

-- | Returns the /integer/ representation of a value if it is a subtype.
-- Otherwise it returns the original value.
upcastIntegers :: Values t -> Values t
upcastIntegers :: Values t -> Values t
upcastIntegers (Nat Integer
n)  = Integer -> Values t
forall t. Integer -> Values t
Int Integer
n
upcastIntegers Values t
v        = Values t
v

-- | Returns the /natural/ representation of a value if it is a subtype.
-- Otherwise it returns the original value.
upcastNaturals :: Values t -> Values t
upcastNaturals :: Values t -> Values t
upcastNaturals (Int Integer
i) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Integer -> Values t
forall t. Integer -> Values t
Nat Integer
i
upcastNaturals Values t
v = Values t
v

upcastCharacter :: HasValues t => Values t -> Maybe Char
upcastCharacter :: Values t -> Maybe Char
upcastCharacter (ADTVal Name
c [t
v]) 
  | Just (Int Integer
p) <- t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project t
v = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
C.chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
p)) 
upcastCharacter Values t
v = Maybe Char
forall a. Maybe a
Nothing

castType :: HasValues t => Values t -> Maybe (Types t)
castType :: Values t -> Maybe (Types t)
castType (ComputationType (Type Types t
ty)) = Types t -> Maybe (Types t)
forall a. a -> Maybe a
Just Types t
ty
castType (ComputationType (ComputesType Types t
ty)) = Types t -> Maybe (Types t)
forall a. a -> Maybe a
Just Types t
ty
castType (ComputationType (ComputesFromType Types t
_ Types t
ty)) = Types t -> Maybe (Types t)
forall a. a -> Maybe a
Just Types t
ty
castType Values t
_            = Maybe (Types t)
forall a. Maybe a
Nothing

-- numbers
mk_integers :: Integer -> Values t
mk_integers :: Integer -> Values t
mk_integers Integer
i   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0    = Integer -> Values t
forall t. Integer -> Values t
mk_naturals Integer
i
                | Bool
otherwise = Integer -> Values t
forall t. Integer -> Values t
Int Integer
i

mk_naturals :: Integer -> Values t
mk_naturals :: Integer -> Values t
mk_naturals = Integer -> Values t
forall t. Integer -> Values t
Nat

mk_unicode_characters :: HasValues t => Char -> Values t
mk_unicode_characters :: Char -> Values t
mk_unicode_characters = Char -> Values t
forall t. HasValues t => Char -> Values t
downcast_unicode_characters

-- | 
-- Checks whetDoes not check whether the `unicode-point` of 
downcast_unicode_characters :: HasValues t => Char -> Values t
downcast_unicode_characters :: Char -> Values t
downcast_unicode_characters Char
c = 
  Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
unicode_cons [Values t -> t
forall t. HasValues t => Values t -> t
inject (Integer -> Values t
forall t. Integer -> Values t
Int (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
C.ord Char
c)))] 

--- Value specific

(===) :: (HasValues t, Eq t {- UNNECESSARY CONSTRAINT -}) => Values t -> Values t -> Bool
Values t
v1 === :: Values t -> Values t -> Bool
=== Values t
v2 = Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround Values t
v1 Bool -> Bool -> Bool
&& Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround Values t
v2 Bool -> Bool -> Bool
&& (Values t
v1 Values t -> Values t -> Bool
forall a. Eq a => a -> a -> Bool
== Values t
v2)

(=/=) :: (HasValues t, Eq t {- UNNECESSARY CONSTRAINT -}) => Values t -> Values t -> Bool
Values t
v1 =/= :: Values t -> Values t -> Bool
=/= Values t
v2 = Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround Values t
v1 Bool -> Bool -> Bool
&& Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround Values t
v2 Bool -> Bool -> Bool
&& (Values t
v1 Values t -> Values t -> Bool
forall a. Eq a => a -> a -> Bool
/= Values t
v2)

isGround :: HasValues t => Values t -> Bool
isGround :: Values t -> Bool
isGround (ADTVal Name
_ [t]
mv)            = (t -> Bool) -> [t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> (Values t -> Bool) -> Maybe (Values t) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround (Maybe (Values t) -> Bool) -> (t -> Maybe (Values t)) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project) [t]
mv
isGround (Atom String
_)                 = Bool
True
isGround (Float Double
_)                = Bool
True
isGround (IEEE_Float_32 Float
_)        = Bool
True
isGround (IEEE_Float_64 Double
_)        = Bool
True
isGround (Int Integer
_)                  = Bool
True
isGround (Map ValueMaps (Values t)
m)                  = ([Values t] -> Bool) -> [[Values t]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround) (ValueMaps (Values t) -> [[Values t]]
forall k a. Map k a -> [a]
M.elems ValueMaps (Values t)
m)
isGround (Multiset MultiSet (Values t)
ms)            = (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround (MultiSet (Values t) -> [Values t]
forall a. MultiSet a -> [a]
MS.elems MultiSet (Values t)
ms)
isGround (Nat Integer
_)                  = Bool
True
isGround (ComputationType ComputationTypes t
_)      = Bool
True
isGround (Rational Rational
_)             = Bool
True
isGround (Set ValueSets (Values t)
s)                  = (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround (ValueSets (Values t) -> [Values t]
forall a. Set a -> [a]
S.toList ValueSets (Values t)
s)
isGround (Vector ValueVectors (Values t)
v)               = (Values t -> Bool) -> [Values t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround (ValueVectors (Values t) -> [Values t]
forall a. Vector a -> [a]
V.toList ValueVectors (Values t)
v)
isGround Values t
VAny                     = Bool
False
isGround (ValSeq [t]
ts)              = (t -> Bool) -> [t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> (Values t -> Bool) -> Maybe (Values t) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Values t -> Bool
forall t. HasValues t => Values t -> Bool
isGround (Maybe (Values t) -> Bool) -> (t -> Maybe (Values t)) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project) [t]
ts

-- functions that check simple properties of funcons
-- TODO: Some of these are used, and all are exported by Funcons.EDSL
--       But are all of them still needed.  E.g isId doesn't seem very useful now that ids are just strings.
isNat :: Values t -> Bool
isNat ((Int Integer
_))                     = Bool
True
isNat Values t
_                             = Bool
False
isInt :: Values t -> Bool
isInt ((Int Integer
_))                     = Bool
True
isInt Values t
_                             = Bool
False
isEnv :: Values t -> Bool
isEnv Values t
f                             = Values t -> Bool
forall t. Values t -> Bool
isMap Values t
f
isMap :: Values t -> Bool
isMap ((Map ValueMaps (Values t)
_))                     = Bool
True
isMap Values t
_                             = Bool
False
isSet :: Values t -> Bool
isSet ((Set ValueSets (Values t)
_))                     = Bool
True
isSet Values t
_                             = Bool
False
isString_ :: HasValues t => Values t -> Bool
isString_ :: Values t -> Bool
isString_ (ADTVal Name
"list" [t]
vs)        = Bool -> Bool
not ([t] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
vs) Bool -> Bool -> Bool
&& (Maybe (Values t) -> Bool) -> [Maybe (Values t)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> (Values t -> Bool) -> Maybe (Values t) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool)
-> (Values t -> Maybe Char) -> Values t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values t -> Maybe Char
forall t. HasValues t => Values t -> Maybe Char
upcastCharacter)) ((t -> Maybe (Values t)) -> [t] -> [Maybe (Values t)]
forall a b. (a -> b) -> [a] -> [b]
map t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project [t]
vs)
isString_ Values t
_                         = Bool
False
isType :: Values t -> Bool
isType (ComputationType ComputationTypes t
_)          = Bool
True
isType Values t
_                            = Bool
False
isVec :: Values t -> Bool
isVec ((Vector ValueVectors (Values t)
_))                  = Bool
True
isVec Values t
_                             = Bool
False

unString :: HasValues t => Values t -> String
unString :: Values t -> String
unString (ADTVal Name
"list" [t]
vs) 
  | Just [Maybe Char]
vs' <- [Maybe (Maybe Char)] -> Maybe [Maybe Char]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((t -> Maybe (Maybe Char)) -> [t] -> [Maybe (Maybe Char)]
forall a b. (a -> b) -> [a] -> [b]
map ((Values t -> Maybe Char) -> Maybe (Values t) -> Maybe (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Values t -> Maybe Char
forall t. HasValues t => Values t -> Maybe Char
upcastCharacter (Maybe (Values t) -> Maybe (Maybe Char))
-> (t -> Maybe (Values t)) -> t -> Maybe (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (Values t)
forall t. HasValues t => t -> Maybe (Values t)
project) [t]
vs)
  , (Maybe Char -> Bool) -> [Maybe Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust [Maybe Char]
vs' = (Maybe Char -> Char) -> [Maybe Char] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\(Just Char
c) -> Char
c) [Maybe Char]
vs'
unString Values t
_ = ShowS
forall a. HasCallStack => String -> a
error String
"unString"

null__ :: Values t
null__ :: Values t
null__ = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"null" []

null_value__ :: Values t
null_value__ :: Values t
null_value__ = Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"null-value" []

isNull :: Values t -> Bool
isNull :: Values t -> Bool
isNull (ADTVal Name
"null" [t]
_) = Bool
True
isNull (ADTVal Name
"null-value" [t]
_) = Bool
True
isNull Values t
_ = Bool
False

isDefinedVal :: Values t -> Bool
isDefinedVal :: Values t -> Bool
isDefinedVal Values t
f = Bool -> Bool
not (Values t -> Bool
forall t. Values t -> Bool
isNull Values t
f)

set_ :: Ord t => [Values t] -> Values t
set_ :: [Values t] -> Values t
set_ = ValueSets (Values t) -> Values t
forall t. ValueSets (Values t) -> Values t
Set (ValueSets (Values t) -> Values t)
-> ([Values t] -> ValueSets (Values t)) -> [Values t] -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Values t] -> ValueSets (Values t)
forall a. Ord a => [a] -> Set a
S.fromList 

ppValues :: HasValues t => (t -> String) -> Values t -> String
ppValues :: (t -> String) -> Values t -> String
ppValues t -> String
showT v :: Values t
v@(ADTVal Name
"list" [t]
vs)
  | Values t -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values t
v, Bool -> Bool
not ([t] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
vs) = ShowS
forall a. Show a => a -> String
show (Values t -> String
forall t. HasValues t => Values t -> String
unString Values t
v)
  | Bool
otherwise                  = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs_ ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
showT [t]
vs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
ppValues t -> String
showT (ADTVal Name
c []) = Name -> String
unpack Name
c
ppValues t -> String
showT (ADTVal Name
c [t]
vs) = Name -> String
unpack Name
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
showT [t]
vs)
ppValues t -> String
showT (Atom String
c)       = String
"atom("String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
ppValues t -> String
showT (Float Double
f)      = Double -> String
forall a. Show a => a -> String
show Double
f
-- rationals
ppValues t -> String
showT (IEEE_Float_32 Float
f) = Float -> String
forall a. Show a => a -> String
show Float
f
ppValues t -> String
showT (IEEE_Float_64 Double
d) = Double -> String
forall a. Show a => a -> String
show Double
d
ppValues t -> String
showT (Rational Rational
r)   = Rational -> String
forall a. Show a => a -> String
show Rational
r
ppValues t -> String
showT (Int Integer
f)        = Integer -> String
forall a. Show a => a -> String
show Integer
f
ppValues t -> String
showT (Nat Integer
f)        = Integer -> String
forall a. Show a => a -> String
show Integer
f
ppValues t -> String
showT (Map ValueMaps (Values t)
m)        = if ValueMaps (Values t) -> Bool
forall k a. Map k a -> Bool
M.null ValueMaps (Values t)
m then String
"map-empty"
                               else String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key_values String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
 where key_values :: String
key_values = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((Values t, [Values t]) -> String)
-> [(Values t, [Values t])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Values t, [Values t]) -> String
showKP ([(Values t, [Values t])] -> [String])
-> [(Values t, [Values t])] -> [String]
forall a b. (a -> b) -> a -> b
$ ValueMaps (Values t) -> [(Values t, [Values t])]
forall k a. Map k a -> [(k, a)]
M.assocs ValueMaps (Values t)
m)
        where showKP :: (Values t, [Values t]) -> String
showKP (Values t
k,[Values t]
vs) = (t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT Values t
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" |-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++   
                case [Values t]
vs of [Values t
v] -> (t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT Values t
v
                           [Values t]
_   -> [String] -> String
showArgs ((Values t -> String) -> [Values t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT) [Values t]
vs)
ppValues t -> String
showT (Multiset MultiSet (Values t)
s) = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs ((Values t -> String) -> [Values t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT) (MultiSet (Values t) -> [Values t]
forall a. MultiSet a -> [a]
MS.toList MultiSet (Values t)
s)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
ppValues t -> String
showT (Set ValueSets (Values t)
s) =  String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs ((Values t -> String) -> [Values t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT) (ValueSets (Values t) -> [Values t]
forall a. Set a -> [a]
S.toList ValueSets (Values t)
s)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
ppValues t -> String
showT (Vector ValueVectors (Values t)
v) =  String
"vector" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs ((Values t -> String) -> [Values t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> String) -> Values t -> String
forall t. HasValues t => (t -> String) -> Values t -> String
ppValues t -> String
showT) (ValueVectors (Values t) -> [Values t]
forall a. Vector a -> [a]
V.toList ValueVectors (Values t)
v))
ppValues t -> String
showT (ComputationType ComputationTypes t
ty) = (t -> String) -> ComputationTypes t -> String
forall t.
HasValues t =>
(t -> String) -> ComputationTypes t -> String
ppComputationTypes t -> String
showT ComputationTypes t
ty
ppValues t -> String
showT Values t
VAny = String
"_"
ppValues t -> String
showT (ValSeq [t]
ts) = [String] -> String
showArgs_ ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
showT [t]
ts)

ppComputationTypes :: HasValues t => (t -> String) -> ComputationTypes t -> String
ppComputationTypes :: (t -> String) -> ComputationTypes t -> String
ppComputationTypes t -> String
showT (Type Types t
t) = (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
t
ppComputationTypes t -> String
showT (ComputesType Types t
ty) = String
"=>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
ty
ppComputationTypes t -> String
showT (ComputesFromType Types t
s Types t
t) = (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=>" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
t

ppTypes :: HasValues t => (t -> String) -> Types t -> String
ppTypes :: (t -> String) -> Types t -> String
ppTypes t -> String
showT (AnnotatedType Types t
ty SeqSortOp
op)  = (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
ty String -> ShowS
forall a. [a] -> [a] -> [a]
++ SeqSortOp -> String
ppOp SeqSortOp
op
ppTypes t -> String
showT (Complement Types t
ty)        = String
"~(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
ty String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
ppTypes t -> String
showT Types t
ComputationTypes       = String
"computation-types"
ppTypes t -> String
showT Types t
NullType               = String
"null-type"
ppTypes t -> String
showT Types t
Atoms                  = String
"atoms"
ppTypes t -> String
showT Types t
AsciiCharacters        = String
"ascii-characters"
ppTypes t -> String
showT Types t
ISOLatinCharacters     = String
"iso-latin-1-characters"
ppTypes t -> String
showT Types t
BMPCharacters          = String
"basic-multilingual-plane-characters"
ppTypes t -> String
showT Types t
Characters             = String
"characters"
ppTypes t -> String
showT (Intersection Types t
t1 Types t
t2)   = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
ppTypes t -> String
showT (IntegersFrom Integer
n)       = String
"integers-from(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
ppTypes t -> String
showT (IntegersUpTo Integer
n)       = String
"integers-to(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
ppTypes t -> String
showT Types t
EmptyType              = String
"empty-type"
ppTypes t -> String
showT (Types t
UnicodeCharacters)    = String
"unicode-characters"
ppTypes t -> String
showT (Types t
Integers)             = String
"integers"
ppTypes t -> String
showT (Types t
Values)               = String
"values"
ppTypes t -> String
showT Types t
Types                  = String
"types"
ppTypes t -> String
showT Types t
ADTs                   = String
"algebraic-datatypes"
ppTypes t -> String
showT (ADT Name
nm [t]
ts)            = Name -> String
unpack Name
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
showT [t]
ts)
ppTypes t -> String
showT (IEEEFloats IEEEFormats
format)    = String
"ieee-floats(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IEEEFormats -> String
forall a. Show a => a -> String
show IEEEFormats
format String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
ppTypes t -> String
showT Types t
Naturals               = String
"naturals"
ppTypes t -> String
showT Types t
Rationals              = String
"rationals"
ppTypes t -> String
showT (Union Types t
ty1 Types t
ty2)        = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
ty1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (t -> String) -> Types t -> String
forall t. HasValues t => (t -> String) -> Types t -> String
ppTypes t -> String
showT Types t
ty2 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"

ppOp :: SeqSortOp -> String
ppOp :: SeqSortOp -> String
ppOp SeqSortOp
StarOp = String
"*"
ppOp SeqSortOp
PlusOp = String
"+"
ppOp SeqSortOp
QuestionMarkOp = String
"?"

showArgs :: [String] -> String
showArgs :: [String] -> String
showArgs [String]
args = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showArgs_ [String]
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
showArgs_ :: [String] -> String
showArgs_ :: [String] -> String
showArgs_ [String]
args = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
args