-- | Abstractions for evaluation and transformations

module Hydra.Compute where

import qualified Hydra.Core as Core
import qualified Hydra.Mantle as Mantle
import Data.List
import Data.Map
import Data.Set

data Adapter s1 s2 t1 t2 v1 v2 = 
  Adapter {
    forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy :: Bool,
    forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t1
adapterSource :: t1,
    forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget :: t2,
    forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder :: (Coder s1 s2 v1 v2)}

_Adapter :: Name
_Adapter = (String -> Name
Core.Name String
"hydra/compute.Adapter")

_Adapter_isLossy :: FieldName
_Adapter_isLossy = (String -> FieldName
Core.FieldName String
"isLossy")

_Adapter_source :: FieldName
_Adapter_source = (String -> FieldName
Core.FieldName String
"source")

_Adapter_target :: FieldName
_Adapter_target = (String -> FieldName
Core.FieldName String
"target")

_Adapter_coder :: FieldName
_Adapter_coder = (String -> FieldName
Core.FieldName String
"coder")

data AdapterContext m = 
  AdapterContext {
    forall m. AdapterContext m -> Context m
adapterContextEvaluation :: (Context m),
    forall m. AdapterContext m -> Language m
adapterContextSource :: (Language m),
    forall m. AdapterContext m -> Language m
adapterContextTarget :: (Language m)}

_AdapterContext :: Name
_AdapterContext = (String -> Name
Core.Name String
"hydra/compute.AdapterContext")

_AdapterContext_evaluation :: FieldName
_AdapterContext_evaluation = (String -> FieldName
Core.FieldName String
"evaluation")

_AdapterContext_source :: FieldName
_AdapterContext_source = (String -> FieldName
Core.FieldName String
"source")

_AdapterContext_target :: FieldName
_AdapterContext_target = (String -> FieldName
Core.FieldName String
"target")

-- | A typeclass-like construct providing common functions for working with annotations
data AnnotationClass m = 
  AnnotationClass {
    forall m. AnnotationClass m -> m
annotationClassDefault :: m,
    forall m. AnnotationClass m -> m -> m -> Bool
annotationClassEqual :: (m -> m -> Bool),
    forall m. AnnotationClass m -> m -> m -> Comparison
annotationClassCompare :: (m -> m -> Mantle.Comparison),
    forall m. AnnotationClass m -> m -> String
annotationClassShow :: (m -> String),
    forall m. AnnotationClass m -> String -> Maybe m
annotationClassRead :: (String -> Maybe m),
    forall m. AnnotationClass m -> Term m -> m
annotationClassTermMeta :: (Core.Term m -> m),
    forall m. AnnotationClass m -> Type m -> m
annotationClassTypeMeta :: (Core.Type m -> m),
    forall m.
AnnotationClass m -> Term m -> Flow (Context m) (Maybe String)
annotationClassTermDescription :: (Core.Term m -> Flow (Context m) (Maybe String)),
    forall m.
AnnotationClass m -> Type m -> Flow (Context m) (Maybe String)
annotationClassTypeDescription :: (Core.Type m -> Flow (Context m) (Maybe String)),
    forall m.
AnnotationClass m -> Term m -> Flow (Context m) (Maybe (Type m))
annotationClassTermType :: (Core.Term m -> Flow (Context m) (Maybe (Core.Type m))),
    forall m.
AnnotationClass m -> Context m -> Maybe String -> Term m -> Term m
annotationClassSetTermDescription :: (Context m -> Maybe String -> Core.Term m -> Core.Term m),
    forall m.
AnnotationClass m
-> Context m -> Maybe (Type m) -> Term m -> Term m
annotationClassSetTermType :: (Context m -> Maybe (Core.Type m) -> Core.Term m -> Core.Term m),
    forall m.
AnnotationClass m -> m -> Flow (Context m) (Maybe (Type m))
annotationClassTypeOf :: (m -> Flow (Context m) (Maybe (Core.Type m))),
    forall m. AnnotationClass m -> Maybe (Type m) -> m -> m
annotationClassSetTypeOf :: (Maybe (Core.Type m) -> m -> m)}

_AnnotationClass :: Name
_AnnotationClass = (String -> Name
Core.Name String
"hydra/compute.AnnotationClass")

_AnnotationClass_default :: FieldName
_AnnotationClass_default = (String -> FieldName
Core.FieldName String
"default")

_AnnotationClass_equal :: FieldName
_AnnotationClass_equal = (String -> FieldName
Core.FieldName String
"equal")

_AnnotationClass_compare :: FieldName
_AnnotationClass_compare = (String -> FieldName
Core.FieldName String
"compare")

_AnnotationClass_show :: FieldName
_AnnotationClass_show = (String -> FieldName
Core.FieldName String
"show")

_AnnotationClass_read :: FieldName
_AnnotationClass_read = (String -> FieldName
Core.FieldName String
"read")

_AnnotationClass_termMeta :: FieldName
_AnnotationClass_termMeta = (String -> FieldName
Core.FieldName String
"termMeta")

_AnnotationClass_typeMeta :: FieldName
_AnnotationClass_typeMeta = (String -> FieldName
Core.FieldName String
"typeMeta")

_AnnotationClass_termDescription :: FieldName
_AnnotationClass_termDescription = (String -> FieldName
Core.FieldName String
"termDescription")

_AnnotationClass_typeDescription :: FieldName
_AnnotationClass_typeDescription = (String -> FieldName
Core.FieldName String
"typeDescription")

_AnnotationClass_termType :: FieldName
_AnnotationClass_termType = (String -> FieldName
Core.FieldName String
"termType")

_AnnotationClass_setTermDescription :: FieldName
_AnnotationClass_setTermDescription = (String -> FieldName
Core.FieldName String
"setTermDescription")

_AnnotationClass_setTermType :: FieldName
_AnnotationClass_setTermType = (String -> FieldName
Core.FieldName String
"setTermType")

_AnnotationClass_typeOf :: FieldName
_AnnotationClass_typeOf = (String -> FieldName
Core.FieldName String
"typeOf")

_AnnotationClass_setTypeOf :: FieldName
_AnnotationClass_setTypeOf = (String -> FieldName
Core.FieldName String
"setTypeOf")

-- | An encoder and decoder; a bidirectional flow between two types
data Coder s1 s2 v1 v2 = 
  Coder {
    forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode :: (v1 -> Flow s1 v2),
    forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode :: (v2 -> Flow s2 v1)}

_Coder :: Name
_Coder = (String -> Name
Core.Name String
"hydra/compute.Coder")

_Coder_encode :: FieldName
_Coder_encode = (String -> FieldName
Core.FieldName String
"encode")

_Coder_decode :: FieldName
_Coder_decode = (String -> FieldName
Core.FieldName String
"decode")

-- | Indicates either the 'out' or the 'in' direction of a coder
data CoderDirection = 
  CoderDirectionEncode  |
  CoderDirectionDecode 
  deriving (CoderDirection -> CoderDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoderDirection -> CoderDirection -> Bool
$c/= :: CoderDirection -> CoderDirection -> Bool
== :: CoderDirection -> CoderDirection -> Bool
$c== :: CoderDirection -> CoderDirection -> Bool
Eq, Eq CoderDirection
CoderDirection -> CoderDirection -> Bool
CoderDirection -> CoderDirection -> Ordering
CoderDirection -> CoderDirection -> CoderDirection
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 :: CoderDirection -> CoderDirection -> CoderDirection
$cmin :: CoderDirection -> CoderDirection -> CoderDirection
max :: CoderDirection -> CoderDirection -> CoderDirection
$cmax :: CoderDirection -> CoderDirection -> CoderDirection
>= :: CoderDirection -> CoderDirection -> Bool
$c>= :: CoderDirection -> CoderDirection -> Bool
> :: CoderDirection -> CoderDirection -> Bool
$c> :: CoderDirection -> CoderDirection -> Bool
<= :: CoderDirection -> CoderDirection -> Bool
$c<= :: CoderDirection -> CoderDirection -> Bool
< :: CoderDirection -> CoderDirection -> Bool
$c< :: CoderDirection -> CoderDirection -> Bool
compare :: CoderDirection -> CoderDirection -> Ordering
$ccompare :: CoderDirection -> CoderDirection -> Ordering
Ord, ReadPrec [CoderDirection]
ReadPrec CoderDirection
Int -> ReadS CoderDirection
ReadS [CoderDirection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CoderDirection]
$creadListPrec :: ReadPrec [CoderDirection]
readPrec :: ReadPrec CoderDirection
$creadPrec :: ReadPrec CoderDirection
readList :: ReadS [CoderDirection]
$creadList :: ReadS [CoderDirection]
readsPrec :: Int -> ReadS CoderDirection
$creadsPrec :: Int -> ReadS CoderDirection
Read, Int -> CoderDirection -> ShowS
[CoderDirection] -> ShowS
CoderDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoderDirection] -> ShowS
$cshowList :: [CoderDirection] -> ShowS
show :: CoderDirection -> String
$cshow :: CoderDirection -> String
showsPrec :: Int -> CoderDirection -> ShowS
$cshowsPrec :: Int -> CoderDirection -> ShowS
Show)

_CoderDirection :: Name
_CoderDirection = (String -> Name
Core.Name String
"hydra/compute.CoderDirection")

_CoderDirection_encode :: FieldName
_CoderDirection_encode = (String -> FieldName
Core.FieldName String
"encode")

_CoderDirection_decode :: FieldName
_CoderDirection_decode = (String -> FieldName
Core.FieldName String
"decode")

-- | An environment containing a graph together with primitive functions and other necessary components for evaluation
data Context m = 
  Context {
    forall m. Context m -> Graph m
contextGraph :: (Mantle.Graph m),
    forall m. Context m -> Map Name (PrimitiveFunction m)
contextFunctions :: (Map Core.Name (PrimitiveFunction m)),
    forall m. Context m -> EvaluationStrategy
contextStrategy :: EvaluationStrategy,
    forall m. Context m -> AnnotationClass m
contextAnnotations :: (AnnotationClass m)}

_Context :: Name
_Context = (String -> Name
Core.Name String
"hydra/compute.Context")

_Context_graph :: FieldName
_Context_graph = (String -> FieldName
Core.FieldName String
"graph")

_Context_functions :: FieldName
_Context_functions = (String -> FieldName
Core.FieldName String
"functions")

_Context_strategy :: FieldName
_Context_strategy = (String -> FieldName
Core.FieldName String
"strategy")

_Context_annotations :: FieldName
_Context_annotations = (String -> FieldName
Core.FieldName String
"annotations")

-- | Settings which determine how terms are evaluated
data EvaluationStrategy = 
  EvaluationStrategy {
    EvaluationStrategy -> Set TermVariant
evaluationStrategyOpaqueTermVariants :: (Set Mantle.TermVariant)}
  deriving (EvaluationStrategy -> EvaluationStrategy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c/= :: EvaluationStrategy -> EvaluationStrategy -> Bool
== :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c== :: EvaluationStrategy -> EvaluationStrategy -> Bool
Eq, Eq EvaluationStrategy
EvaluationStrategy -> EvaluationStrategy -> Bool
EvaluationStrategy -> EvaluationStrategy -> Ordering
EvaluationStrategy -> EvaluationStrategy -> EvaluationStrategy
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 :: EvaluationStrategy -> EvaluationStrategy -> EvaluationStrategy
$cmin :: EvaluationStrategy -> EvaluationStrategy -> EvaluationStrategy
max :: EvaluationStrategy -> EvaluationStrategy -> EvaluationStrategy
$cmax :: EvaluationStrategy -> EvaluationStrategy -> EvaluationStrategy
>= :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c>= :: EvaluationStrategy -> EvaluationStrategy -> Bool
> :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c> :: EvaluationStrategy -> EvaluationStrategy -> Bool
<= :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c<= :: EvaluationStrategy -> EvaluationStrategy -> Bool
< :: EvaluationStrategy -> EvaluationStrategy -> Bool
$c< :: EvaluationStrategy -> EvaluationStrategy -> Bool
compare :: EvaluationStrategy -> EvaluationStrategy -> Ordering
$ccompare :: EvaluationStrategy -> EvaluationStrategy -> Ordering
Ord, ReadPrec [EvaluationStrategy]
ReadPrec EvaluationStrategy
Int -> ReadS EvaluationStrategy
ReadS [EvaluationStrategy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluationStrategy]
$creadListPrec :: ReadPrec [EvaluationStrategy]
readPrec :: ReadPrec EvaluationStrategy
$creadPrec :: ReadPrec EvaluationStrategy
readList :: ReadS [EvaluationStrategy]
$creadList :: ReadS [EvaluationStrategy]
readsPrec :: Int -> ReadS EvaluationStrategy
$creadsPrec :: Int -> ReadS EvaluationStrategy
Read, Int -> EvaluationStrategy -> ShowS
[EvaluationStrategy] -> ShowS
EvaluationStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluationStrategy] -> ShowS
$cshowList :: [EvaluationStrategy] -> ShowS
show :: EvaluationStrategy -> String
$cshow :: EvaluationStrategy -> String
showsPrec :: Int -> EvaluationStrategy -> ShowS
$cshowsPrec :: Int -> EvaluationStrategy -> ShowS
Show)

_EvaluationStrategy :: Name
_EvaluationStrategy = (String -> Name
Core.Name String
"hydra/compute.EvaluationStrategy")

_EvaluationStrategy_opaqueTermVariants :: FieldName
_EvaluationStrategy_opaqueTermVariants = (String -> FieldName
Core.FieldName String
"opaqueTermVariants")

-- | A variant of the State monad with built-in logging and error handling
newtype Flow s a = 
  Flow {
    forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow :: (s -> Trace -> FlowState s a)}

_Flow :: Name
_Flow = (String -> Name
Core.Name String
"hydra/compute.Flow")

data FlowState s a = 
  FlowState {
    forall s a. FlowState s a -> Maybe a
flowStateValue :: (Maybe a),
    forall s a. FlowState s a -> s
flowStateState :: s,
    forall s a. FlowState s a -> Trace
flowStateTrace :: Trace}
  deriving (FlowState s a -> FlowState s a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a. (Eq a, Eq s) => FlowState s a -> FlowState s a -> Bool
/= :: FlowState s a -> FlowState s a -> Bool
$c/= :: forall s a. (Eq a, Eq s) => FlowState s a -> FlowState s a -> Bool
== :: FlowState s a -> FlowState s a -> Bool
$c== :: forall s a. (Eq a, Eq s) => FlowState s a -> FlowState s a -> Bool
Eq, FlowState s a -> FlowState s a -> Bool
FlowState s a -> FlowState s a -> Ordering
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 {s} {a}. (Ord a, Ord s) => Eq (FlowState s a)
forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Bool
forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Ordering
forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> FlowState s a
min :: FlowState s a -> FlowState s a -> FlowState s a
$cmin :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> FlowState s a
max :: FlowState s a -> FlowState s a -> FlowState s a
$cmax :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> FlowState s a
>= :: FlowState s a -> FlowState s a -> Bool
$c>= :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Bool
> :: FlowState s a -> FlowState s a -> Bool
$c> :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Bool
<= :: FlowState s a -> FlowState s a -> Bool
$c<= :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Bool
< :: FlowState s a -> FlowState s a -> Bool
$c< :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Bool
compare :: FlowState s a -> FlowState s a -> Ordering
$ccompare :: forall s a.
(Ord a, Ord s) =>
FlowState s a -> FlowState s a -> Ordering
Ord, ReadPrec [FlowState s a]
ReadPrec (FlowState s a)
ReadS [FlowState s a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall s a. (Read a, Read s) => ReadPrec [FlowState s a]
forall s a. (Read a, Read s) => ReadPrec (FlowState s a)
forall s a. (Read a, Read s) => Int -> ReadS (FlowState s a)
forall s a. (Read a, Read s) => ReadS [FlowState s a]
readListPrec :: ReadPrec [FlowState s a]
$creadListPrec :: forall s a. (Read a, Read s) => ReadPrec [FlowState s a]
readPrec :: ReadPrec (FlowState s a)
$creadPrec :: forall s a. (Read a, Read s) => ReadPrec (FlowState s a)
readList :: ReadS [FlowState s a]
$creadList :: forall s a. (Read a, Read s) => ReadS [FlowState s a]
readsPrec :: Int -> ReadS (FlowState s a)
$creadsPrec :: forall s a. (Read a, Read s) => Int -> ReadS (FlowState s a)
Read, Int -> FlowState s a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. (Show a, Show s) => Int -> FlowState s a -> ShowS
forall s a. (Show a, Show s) => [FlowState s a] -> ShowS
forall s a. (Show a, Show s) => FlowState s a -> String
showList :: [FlowState s a] -> ShowS
$cshowList :: forall s a. (Show a, Show s) => [FlowState s a] -> ShowS
show :: FlowState s a -> String
$cshow :: forall s a. (Show a, Show s) => FlowState s a -> String
showsPrec :: Int -> FlowState s a -> ShowS
$cshowsPrec :: forall s a. (Show a, Show s) => Int -> FlowState s a -> ShowS
Show)

_FlowState :: Name
_FlowState = (String -> Name
Core.Name String
"hydra/compute.FlowState")

_FlowState_value :: FieldName
_FlowState_value = (String -> FieldName
Core.FieldName String
"value")

_FlowState_state :: FieldName
_FlowState_state = (String -> FieldName
Core.FieldName String
"state")

_FlowState_trace :: FieldName
_FlowState_trace = (String -> FieldName
Core.FieldName String
"trace")

data Language m = 
  Language {
    forall m. Language m -> LanguageName
languageName :: LanguageName,
    forall m. Language m -> LanguageConstraints m
languageConstraints :: (LanguageConstraints m)}

_Language :: Name
_Language = (String -> Name
Core.Name String
"hydra/compute.Language")

_Language_name :: FieldName
_Language_name = (String -> FieldName
Core.FieldName String
"name")

_Language_constraints :: FieldName
_Language_constraints = (String -> FieldName
Core.FieldName String
"constraints")

data LanguageConstraints m = 
  LanguageConstraints {
    forall m. LanguageConstraints m -> Set EliminationVariant
languageConstraintsEliminationVariants :: (Set Mantle.EliminationVariant),
    forall m. LanguageConstraints m -> Set LiteralVariant
languageConstraintsLiteralVariants :: (Set Mantle.LiteralVariant),
    forall m. LanguageConstraints m -> Set FloatType
languageConstraintsFloatTypes :: (Set Core.FloatType),
    forall m. LanguageConstraints m -> Set FunctionVariant
languageConstraintsFunctionVariants :: (Set Mantle.FunctionVariant),
    forall m. LanguageConstraints m -> Set IntegerType
languageConstraintsIntegerTypes :: (Set Core.IntegerType),
    forall m. LanguageConstraints m -> Set TermVariant
languageConstraintsTermVariants :: (Set Mantle.TermVariant),
    forall m. LanguageConstraints m -> Set TypeVariant
languageConstraintsTypeVariants :: (Set Mantle.TypeVariant),
    forall m. LanguageConstraints m -> Type m -> Bool
languageConstraintsTypes :: (Core.Type m -> Bool)}

_LanguageConstraints :: Name
_LanguageConstraints = (String -> Name
Core.Name String
"hydra/compute.LanguageConstraints")

_LanguageConstraints_eliminationVariants :: FieldName
_LanguageConstraints_eliminationVariants = (String -> FieldName
Core.FieldName String
"eliminationVariants")

_LanguageConstraints_literalVariants :: FieldName
_LanguageConstraints_literalVariants = (String -> FieldName
Core.FieldName String
"literalVariants")

_LanguageConstraints_floatTypes :: FieldName
_LanguageConstraints_floatTypes = (String -> FieldName
Core.FieldName String
"floatTypes")

_LanguageConstraints_functionVariants :: FieldName
_LanguageConstraints_functionVariants = (String -> FieldName
Core.FieldName String
"functionVariants")

_LanguageConstraints_integerTypes :: FieldName
_LanguageConstraints_integerTypes = (String -> FieldName
Core.FieldName String
"integerTypes")

_LanguageConstraints_termVariants :: FieldName
_LanguageConstraints_termVariants = (String -> FieldName
Core.FieldName String
"termVariants")

_LanguageConstraints_typeVariants :: FieldName
_LanguageConstraints_typeVariants = (String -> FieldName
Core.FieldName String
"typeVariants")

_LanguageConstraints_types :: FieldName
_LanguageConstraints_types = (String -> FieldName
Core.FieldName String
"types")

newtype LanguageName = 
  LanguageName {
    LanguageName -> String
unLanguageName :: String}
  deriving (LanguageName -> LanguageName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LanguageName -> LanguageName -> Bool
$c/= :: LanguageName -> LanguageName -> Bool
== :: LanguageName -> LanguageName -> Bool
$c== :: LanguageName -> LanguageName -> Bool
Eq, Eq LanguageName
LanguageName -> LanguageName -> Bool
LanguageName -> LanguageName -> Ordering
LanguageName -> LanguageName -> LanguageName
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 :: LanguageName -> LanguageName -> LanguageName
$cmin :: LanguageName -> LanguageName -> LanguageName
max :: LanguageName -> LanguageName -> LanguageName
$cmax :: LanguageName -> LanguageName -> LanguageName
>= :: LanguageName -> LanguageName -> Bool
$c>= :: LanguageName -> LanguageName -> Bool
> :: LanguageName -> LanguageName -> Bool
$c> :: LanguageName -> LanguageName -> Bool
<= :: LanguageName -> LanguageName -> Bool
$c<= :: LanguageName -> LanguageName -> Bool
< :: LanguageName -> LanguageName -> Bool
$c< :: LanguageName -> LanguageName -> Bool
compare :: LanguageName -> LanguageName -> Ordering
$ccompare :: LanguageName -> LanguageName -> Ordering
Ord, ReadPrec [LanguageName]
ReadPrec LanguageName
Int -> ReadS LanguageName
ReadS [LanguageName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LanguageName]
$creadListPrec :: ReadPrec [LanguageName]
readPrec :: ReadPrec LanguageName
$creadPrec :: ReadPrec LanguageName
readList :: ReadS [LanguageName]
$creadList :: ReadS [LanguageName]
readsPrec :: Int -> ReadS LanguageName
$creadsPrec :: Int -> ReadS LanguageName
Read, Int -> LanguageName -> ShowS
[LanguageName] -> ShowS
LanguageName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LanguageName] -> ShowS
$cshowList :: [LanguageName] -> ShowS
show :: LanguageName -> String
$cshow :: LanguageName -> String
showsPrec :: Int -> LanguageName -> ShowS
$cshowsPrec :: Int -> LanguageName -> ShowS
Show)

_LanguageName :: Name
_LanguageName = (String -> Name
Core.Name String
"hydra/compute.LanguageName")

-- | A built-in metadata container for terms
data Meta = 
  Meta {
    -- | A map of annotation names to annotation values
    Meta -> Map String (Term Meta)
metaAnnotations :: (Map String (Core.Term Meta))}
  deriving (Meta -> Meta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Eq Meta
Meta -> Meta -> Bool
Meta -> Meta -> Ordering
Meta -> Meta -> Meta
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 :: Meta -> Meta -> Meta
$cmin :: Meta -> Meta -> Meta
max :: Meta -> Meta -> Meta
$cmax :: Meta -> Meta -> Meta
>= :: Meta -> Meta -> Bool
$c>= :: Meta -> Meta -> Bool
> :: Meta -> Meta -> Bool
$c> :: Meta -> Meta -> Bool
<= :: Meta -> Meta -> Bool
$c<= :: Meta -> Meta -> Bool
< :: Meta -> Meta -> Bool
$c< :: Meta -> Meta -> Bool
compare :: Meta -> Meta -> Ordering
$ccompare :: Meta -> Meta -> Ordering
Ord, ReadPrec [Meta]
ReadPrec Meta
Int -> ReadS Meta
ReadS [Meta]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Meta]
$creadListPrec :: ReadPrec [Meta]
readPrec :: ReadPrec Meta
$creadPrec :: ReadPrec Meta
readList :: ReadS [Meta]
$creadList :: ReadS [Meta]
readsPrec :: Int -> ReadS Meta
$creadsPrec :: Int -> ReadS Meta
Read, Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show)

_Meta :: Name
_Meta = (String -> Name
Core.Name String
"hydra/compute.Meta")

_Meta_annotations :: FieldName
_Meta_annotations = (String -> FieldName
Core.FieldName String
"annotations")

-- | A built-in function
data PrimitiveFunction m = 
  PrimitiveFunction {
    forall m. PrimitiveFunction m -> Name
primitiveFunctionName :: Core.Name,
    forall m. PrimitiveFunction m -> FunctionType m
primitiveFunctionType :: (Core.FunctionType m),
    forall m.
PrimitiveFunction m -> [Term m] -> Flow (Context m) (Term m)
primitiveFunctionImplementation :: ([Core.Term m] -> Flow (Context m) (Core.Term m))}

_PrimitiveFunction :: Name
_PrimitiveFunction = (String -> Name
Core.Name String
"hydra/compute.PrimitiveFunction")

_PrimitiveFunction_name :: FieldName
_PrimitiveFunction_name = (String -> FieldName
Core.FieldName String
"name")

_PrimitiveFunction_type :: FieldName
_PrimitiveFunction_type = (String -> FieldName
Core.FieldName String
"type")

_PrimitiveFunction_implementation :: FieldName
_PrimitiveFunction_implementation = (String -> FieldName
Core.FieldName String
"implementation")

-- | A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms
data TermCoder m a = 
  TermCoder {
    forall m a. TermCoder m a -> Type m
termCoderType :: (Core.Type m),
    forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder :: (Coder (Context m) (Context m) (Core.Term m) a)}

_TermCoder :: Name
_TermCoder = (String -> Name
Core.Name String
"hydra/compute.TermCoder")

_TermCoder_type :: FieldName
_TermCoder_type = (String -> FieldName
Core.FieldName String
"type")

_TermCoder_coder :: FieldName
_TermCoder_coder = (String -> FieldName
Core.FieldName String
"coder")

-- | A container for logging and error information
data Trace = 
  Trace {
    Trace -> [String]
traceStack :: [String],
    Trace -> [String]
traceMessages :: [String],
    -- | A map of string keys to arbitrary terms as values, for application-specific use
    Trace -> Map String (Term Meta)
traceOther :: (Map String (Core.Term Meta))}
  deriving (Trace -> Trace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trace -> Trace -> Bool
$c/= :: Trace -> Trace -> Bool
== :: Trace -> Trace -> Bool
$c== :: Trace -> Trace -> Bool
Eq, Eq Trace
Trace -> Trace -> Bool
Trace -> Trace -> Ordering
Trace -> Trace -> Trace
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 :: Trace -> Trace -> Trace
$cmin :: Trace -> Trace -> Trace
max :: Trace -> Trace -> Trace
$cmax :: Trace -> Trace -> Trace
>= :: Trace -> Trace -> Bool
$c>= :: Trace -> Trace -> Bool
> :: Trace -> Trace -> Bool
$c> :: Trace -> Trace -> Bool
<= :: Trace -> Trace -> Bool
$c<= :: Trace -> Trace -> Bool
< :: Trace -> Trace -> Bool
$c< :: Trace -> Trace -> Bool
compare :: Trace -> Trace -> Ordering
$ccompare :: Trace -> Trace -> Ordering
Ord, ReadPrec [Trace]
ReadPrec Trace
Int -> ReadS Trace
ReadS [Trace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Trace]
$creadListPrec :: ReadPrec [Trace]
readPrec :: ReadPrec Trace
$creadPrec :: ReadPrec Trace
readList :: ReadS [Trace]
$creadList :: ReadS [Trace]
readsPrec :: Int -> ReadS Trace
$creadsPrec :: Int -> ReadS Trace
Read, Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show)

_Trace :: Name
_Trace = (String -> Name
Core.Name String
"hydra/compute.Trace")

_Trace_stack :: FieldName
_Trace_stack = (String -> FieldName
Core.FieldName String
"stack")

_Trace_messages :: FieldName
_Trace_messages = (String -> FieldName
Core.FieldName String
"messages")

_Trace_other :: FieldName
_Trace_other = (String -> FieldName
Core.FieldName String
"other")

data TraversalOrder = 
  -- | Pre-order traversal
  TraversalOrderPre  |
  -- | Post-order traversal
  TraversalOrderPost 
  deriving (TraversalOrder -> TraversalOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraversalOrder -> TraversalOrder -> Bool
$c/= :: TraversalOrder -> TraversalOrder -> Bool
== :: TraversalOrder -> TraversalOrder -> Bool
$c== :: TraversalOrder -> TraversalOrder -> Bool
Eq, Eq TraversalOrder
TraversalOrder -> TraversalOrder -> Bool
TraversalOrder -> TraversalOrder -> Ordering
TraversalOrder -> TraversalOrder -> TraversalOrder
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 :: TraversalOrder -> TraversalOrder -> TraversalOrder
$cmin :: TraversalOrder -> TraversalOrder -> TraversalOrder
max :: TraversalOrder -> TraversalOrder -> TraversalOrder
$cmax :: TraversalOrder -> TraversalOrder -> TraversalOrder
>= :: TraversalOrder -> TraversalOrder -> Bool
$c>= :: TraversalOrder -> TraversalOrder -> Bool
> :: TraversalOrder -> TraversalOrder -> Bool
$c> :: TraversalOrder -> TraversalOrder -> Bool
<= :: TraversalOrder -> TraversalOrder -> Bool
$c<= :: TraversalOrder -> TraversalOrder -> Bool
< :: TraversalOrder -> TraversalOrder -> Bool
$c< :: TraversalOrder -> TraversalOrder -> Bool
compare :: TraversalOrder -> TraversalOrder -> Ordering
$ccompare :: TraversalOrder -> TraversalOrder -> Ordering
Ord, ReadPrec [TraversalOrder]
ReadPrec TraversalOrder
Int -> ReadS TraversalOrder
ReadS [TraversalOrder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TraversalOrder]
$creadListPrec :: ReadPrec [TraversalOrder]
readPrec :: ReadPrec TraversalOrder
$creadPrec :: ReadPrec TraversalOrder
readList :: ReadS [TraversalOrder]
$creadList :: ReadS [TraversalOrder]
readsPrec :: Int -> ReadS TraversalOrder
$creadsPrec :: Int -> ReadS TraversalOrder
Read, Int -> TraversalOrder -> ShowS
[TraversalOrder] -> ShowS
TraversalOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraversalOrder] -> ShowS
$cshowList :: [TraversalOrder] -> ShowS
show :: TraversalOrder -> String
$cshow :: TraversalOrder -> String
showsPrec :: Int -> TraversalOrder -> ShowS
$cshowsPrec :: Int -> TraversalOrder -> ShowS
Show)

_TraversalOrder :: Name
_TraversalOrder = (String -> Name
Core.Name String
"hydra/compute.TraversalOrder")

_TraversalOrder_pre :: FieldName
_TraversalOrder_pre = (String -> FieldName
Core.FieldName String
"pre")

_TraversalOrder_post :: FieldName
_TraversalOrder_post = (String -> FieldName
Core.FieldName String
"post")