-- | 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 -- | A two-level bidirectional encoder which adapts types to types and terms to terms data Adapter s1 s2 t1 t2 v1 v2 = Adapter { adapterIsLossy :: Bool, adapterSource :: t1, adapterTarget :: t2, adapterCoder :: (Coder s1 s2 v1 v2)} _Adapter = (Core.Name "hydra/compute.Adapter") _Adapter_isLossy = (Core.FieldName "isLossy") _Adapter_source = (Core.FieldName "source") _Adapter_target = (Core.FieldName "target") _Adapter_coder = (Core.FieldName "coder") -- | An evaluation context together with a source language and a target language data AdapterContext m = AdapterContext { adapterContextEvaluation :: (Context m), adapterContextSource :: (Language m), adapterContextTarget :: (Language m)} _AdapterContext = (Core.Name "hydra/compute.AdapterContext") _AdapterContext_evaluation = (Core.FieldName "evaluation") _AdapterContext_source = (Core.FieldName "source") _AdapterContext_target = (Core.FieldName "target") -- | A typeclass-like construct providing common functions for working with annotations data AnnotationClass m = AnnotationClass { annotationClassDefault :: m, annotationClassEqual :: (m -> m -> Bool), annotationClassCompare :: (m -> m -> Mantle.Comparison), annotationClassShow :: (m -> String), annotationClassRead :: (String -> Maybe m), annotationClassTermMeta :: (Core.Term m -> m), annotationClassTypeMeta :: (Core.Type m -> m), annotationClassTermDescription :: (Core.Term m -> Flow (Context m) (Maybe String)), annotationClassTypeDescription :: (Core.Type m -> Flow (Context m) (Maybe String)), annotationClassTermType :: (Core.Term m -> Flow (Context m) (Maybe (Core.Type m))), annotationClassSetTermDescription :: (Context m -> Maybe String -> Core.Term m -> Core.Term m), annotationClassSetTermType :: (Context m -> Maybe (Core.Type m) -> Core.Term m -> Core.Term m), annotationClassTypeOf :: (m -> Flow (Context m) (Maybe (Core.Type m))), annotationClassSetTypeOf :: (Maybe (Core.Type m) -> m -> m)} _AnnotationClass = (Core.Name "hydra/compute.AnnotationClass") _AnnotationClass_default = (Core.FieldName "default") _AnnotationClass_equal = (Core.FieldName "equal") _AnnotationClass_compare = (Core.FieldName "compare") _AnnotationClass_show = (Core.FieldName "show") _AnnotationClass_read = (Core.FieldName "read") _AnnotationClass_termMeta = (Core.FieldName "termMeta") _AnnotationClass_typeMeta = (Core.FieldName "typeMeta") _AnnotationClass_termDescription = (Core.FieldName "termDescription") _AnnotationClass_typeDescription = (Core.FieldName "typeDescription") _AnnotationClass_termType = (Core.FieldName "termType") _AnnotationClass_setTermDescription = (Core.FieldName "setTermDescription") _AnnotationClass_setTermType = (Core.FieldName "setTermType") _AnnotationClass_typeOf = (Core.FieldName "typeOf") _AnnotationClass_setTypeOf = (Core.FieldName "setTypeOf") -- | An encoder and decoder; a bidirectional flow between two types data Coder s1 s2 v1 v2 = Coder { coderEncode :: (v1 -> Flow s1 v2), coderDecode :: (v2 -> Flow s2 v1)} _Coder = (Core.Name "hydra/compute.Coder") _Coder_encode = (Core.FieldName "encode") _Coder_decode = (Core.FieldName "decode") -- | Indicates either the 'out' or the 'in' direction of a coder data CoderDirection = CoderDirectionEncode | CoderDirectionDecode deriving (Eq, Ord, Read, Show) _CoderDirection = (Core.Name "hydra/compute.CoderDirection") _CoderDirection_encode = (Core.FieldName "encode") _CoderDirection_decode = (Core.FieldName "decode") -- | An environment containing a graph together with primitive functions and other necessary components for evaluation data Context m = Context { contextGraph :: (Mantle.Graph m), contextFunctions :: (Map Core.Name (PrimitiveFunction m)), contextStrategy :: EvaluationStrategy, contextAnnotations :: (AnnotationClass m)} _Context = (Core.Name "hydra/compute.Context") _Context_graph = (Core.FieldName "graph") _Context_functions = (Core.FieldName "functions") _Context_strategy = (Core.FieldName "strategy") _Context_annotations = (Core.FieldName "annotations") -- | Settings which determine how terms are evaluated data EvaluationStrategy = EvaluationStrategy { evaluationStrategyOpaqueTermVariants :: (Set Mantle.TermVariant)} deriving (Eq, Ord, Read, Show) _EvaluationStrategy = (Core.Name "hydra/compute.EvaluationStrategy") _EvaluationStrategy_opaqueTermVariants = (Core.FieldName "opaqueTermVariants") -- | A variant of the State monad with built-in logging and error handling newtype Flow s a = Flow { unFlow :: (s -> Trace -> FlowState s a)} _Flow = (Core.Name "hydra/compute.Flow") -- | The result of evaluating a Flow data FlowState s a = FlowState { flowStateValue :: (Maybe a), flowStateState :: s, flowStateTrace :: Trace} deriving (Eq, Ord, Read, Show) _FlowState = (Core.Name "hydra/compute.FlowState") _FlowState_value = (Core.FieldName "value") _FlowState_state = (Core.FieldName "state") _FlowState_trace = (Core.FieldName "trace") -- | A named language together with language-specific constraints data Language m = Language { languageName :: LanguageName, languageConstraints :: (LanguageConstraints m)} _Language = (Core.Name "hydra/compute.Language") _Language_name = (Core.FieldName "name") _Language_constraints = (Core.FieldName "constraints") -- | A set of constraints on valid type and term expressions, characterizing a language data LanguageConstraints m = LanguageConstraints { languageConstraintsEliminationVariants :: (Set Mantle.EliminationVariant), languageConstraintsLiteralVariants :: (Set Mantle.LiteralVariant), languageConstraintsFloatTypes :: (Set Core.FloatType), languageConstraintsFunctionVariants :: (Set Mantle.FunctionVariant), languageConstraintsIntegerTypes :: (Set Core.IntegerType), languageConstraintsTermVariants :: (Set Mantle.TermVariant), languageConstraintsTypeVariants :: (Set Mantle.TypeVariant), languageConstraintsTypes :: (Core.Type m -> Bool)} _LanguageConstraints = (Core.Name "hydra/compute.LanguageConstraints") _LanguageConstraints_eliminationVariants = (Core.FieldName "eliminationVariants") _LanguageConstraints_literalVariants = (Core.FieldName "literalVariants") _LanguageConstraints_floatTypes = (Core.FieldName "floatTypes") _LanguageConstraints_functionVariants = (Core.FieldName "functionVariants") _LanguageConstraints_integerTypes = (Core.FieldName "integerTypes") _LanguageConstraints_termVariants = (Core.FieldName "termVariants") _LanguageConstraints_typeVariants = (Core.FieldName "typeVariants") _LanguageConstraints_types = (Core.FieldName "types") -- | The unique name of a language newtype LanguageName = LanguageName { -- | The unique name of a language unLanguageName :: String} deriving (Eq, Ord, Read, Show) _LanguageName = (Core.Name "hydra/compute.LanguageName") -- | A built-in metadata container for terms data Meta = Meta { -- | A map of annotation names to annotation values metaAnnotations :: (Map String (Core.Term Meta))} deriving (Eq, Ord, Read, Show) _Meta = (Core.Name "hydra/compute.Meta") _Meta_annotations = (Core.FieldName "annotations") -- | A built-in function data PrimitiveFunction m = PrimitiveFunction { primitiveFunctionName :: Core.Name, primitiveFunctionType :: (Core.FunctionType m), primitiveFunctionImplementation :: ([Core.Term m] -> Flow (Context m) (Core.Term m))} _PrimitiveFunction = (Core.Name "hydra/compute.PrimitiveFunction") _PrimitiveFunction_name = (Core.FieldName "name") _PrimitiveFunction_type = (Core.FieldName "type") _PrimitiveFunction_implementation = (Core.FieldName "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 { termCoderType :: (Core.Type m), termCoderCoder :: (Coder (Context m) (Context m) (Core.Term m) a)} _TermCoder = (Core.Name "hydra/compute.TermCoder") _TermCoder_type = (Core.FieldName "type") _TermCoder_coder = (Core.FieldName "coder") -- | A container for logging and error information data Trace = Trace { traceStack :: [String], traceMessages :: [String], -- | A map of string keys to arbitrary terms as values, for application-specific use traceOther :: (Map String (Core.Term Meta))} deriving (Eq, Ord, Read, Show) _Trace = (Core.Name "hydra/compute.Trace") _Trace_stack = (Core.FieldName "stack") _Trace_messages = (Core.FieldName "messages") _Trace_other = (Core.FieldName "other") -- | Specifies either a pre-order or post-order traversal data TraversalOrder = -- | Pre-order traversal TraversalOrderPre | -- | Post-order traversal TraversalOrderPost deriving (Eq, Ord, Read, Show) _TraversalOrder = (Core.Name "hydra/compute.TraversalOrder") _TraversalOrder_pre = (Core.FieldName "pre") _TraversalOrder_post = (Core.FieldName "post")