-- | A module for miscellaneous tier-1 functions and constants.

module Hydra.Tier1 where

import qualified Hydra.Coders as Coders
import qualified Hydra.Compute as Compute
import qualified Hydra.Constants as Constants
import qualified Hydra.Core as Core
import qualified Hydra.Lib.Equality as Equality
import qualified Hydra.Lib.Lists as Lists
import qualified Hydra.Lib.Literals as Literals
import qualified Hydra.Lib.Logic as Logic
import qualified Hydra.Lib.Maps as Maps
import qualified Hydra.Lib.Optionals as Optionals
import qualified Hydra.Lib.Sets as Sets
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Mantle as Mantle
import qualified Hydra.Module as Module
import qualified Hydra.Strip as Strip
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | Convert a floating-point value of any precision to a bigfloat
floatValueToBigfloat :: (Core.FloatValue -> Double)
floatValueToBigfloat :: FloatValue -> Double
floatValueToBigfloat FloatValue
x = case FloatValue
x of
  Core.FloatValueBigfloat Double
v0 -> (Double -> Double
forall x. x -> x
Equality.identity Double
v0)
  Core.FloatValueFloat32 Float
v1 -> (Float -> Double
Literals.float32ToBigfloat Float
v1)
  Core.FloatValueFloat64 Double
v2 -> (Double -> Double
Literals.float64ToBigfloat Double
v2)

-- | Convert an integer value of any precision to a bigint
integerValueToBigint :: (Core.IntegerValue -> Integer)
integerValueToBigint :: IntegerValue -> Integer
integerValueToBigint IntegerValue
x = case IntegerValue
x of
  Core.IntegerValueBigint Integer
v3 -> (Integer -> Integer
forall x. x -> x
Equality.identity Integer
v3)
  Core.IntegerValueInt8 Int8
v4 -> (Int8 -> Integer
Literals.int8ToBigint Int8
v4)
  Core.IntegerValueInt16 Int16
v5 -> (Int16 -> Integer
Literals.int16ToBigint Int16
v5)
  Core.IntegerValueInt32 Int
v6 -> (Int -> Integer
Literals.int32ToBigint Int
v6)
  Core.IntegerValueInt64 Int64
v7 -> (Int64 -> Integer
Literals.int64ToBigint Int64
v7)
  Core.IntegerValueUint8 Int16
v8 -> (Int16 -> Integer
Literals.uint8ToBigint Int16
v8)
  Core.IntegerValueUint16 Int
v9 -> (Int -> Integer
Literals.uint16ToBigint Int
v9)
  Core.IntegerValueUint32 Int64
v10 -> (Int64 -> Integer
Literals.uint32ToBigint Int64
v10)
  Core.IntegerValueUint64 Integer
v11 -> (Integer -> Integer
Literals.uint64ToBigint Integer
v11)

-- | Check whether a term is a lambda, possibly nested within let and/or annotation terms
isLambda :: (Core.Term -> Bool)
isLambda :: Term -> Bool
isLambda Term
term = ((\Term
x -> case Term
x of
  Core.TermFunction Function
v12 -> ((\Function
x -> case Function
x of
    Core.FunctionLambda Lambda
_ -> Bool
True
    Function
_ -> Bool
False) Function
v12)
  Core.TermLet Let
v14 -> (Term -> Bool
isLambda (Let -> Term
Core.letEnvironment Let
v14))
  Term
_ -> Bool
False) (Term -> Term
Strip.fullyStripTerm Term
term))

-- | Convert a qualified name to a dot-separated name
unqualifyName :: (Module.QualifiedName -> Core.Name)
unqualifyName :: QualifiedName -> Name
unqualifyName QualifiedName
qname =  
  let prefix :: String
prefix = ((\Maybe Namespace
x -> case Maybe Namespace
x of
          Maybe Namespace
Nothing -> String
""
          Just Namespace
v15 -> ([String] -> String
Strings.cat [
            Namespace -> String
Module.unNamespace Namespace
v15,
            String
"."])) (QualifiedName -> Maybe Namespace
Module.qualifiedNameNamespace QualifiedName
qname))
  in (String -> Name
Core.Name ([String] -> String
Strings.cat [
    String
prefix,
    (QualifiedName -> String
Module.qualifiedNameLocal QualifiedName
qname)]))

-- | Fold over a term, traversing its subterms in the specified order
foldOverTerm :: (Coders.TraversalOrder -> (x -> Core.Term -> x) -> x -> Core.Term -> x)
foldOverTerm :: forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld x
b0 Term
term = ((\TraversalOrder
x -> case TraversalOrder
x of
  TraversalOrder
Coders.TraversalOrderPre -> ((x -> Term -> x) -> x -> [Term] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld) (x -> Term -> x
fld x
b0 Term
term) (Term -> [Term]
subterms Term
term))
  TraversalOrder
Coders.TraversalOrderPost -> (x -> Term -> x
fld ((x -> Term -> x) -> x -> [Term] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld) x
b0 (Term -> [Term]
subterms Term
term)) Term
term)) TraversalOrder
order)

-- | Fold over a type, traversing its subtypes in the specified order
foldOverType :: (Coders.TraversalOrder -> (x -> Core.Type -> x) -> x -> Core.Type -> x)
foldOverType :: forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld x
b0 Type
typ = ((\TraversalOrder
x -> case TraversalOrder
x of
  TraversalOrder
Coders.TraversalOrderPre -> ((x -> Type -> x) -> x -> [Type] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld) (x -> Type -> x
fld x
b0 Type
typ) (Type -> [Type]
subtypes Type
typ))
  TraversalOrder
Coders.TraversalOrderPost -> (x -> Type -> x
fld ((x -> Type -> x) -> x -> [Type] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld) x
b0 (Type -> [Type]
subtypes Type
typ)) Type
typ)) TraversalOrder
order)

-- | Find the free variables (i.e. variables not bound by a lambda or let) in a term
freeVariablesInTerm :: (Core.Term -> Set Core.Name)
freeVariablesInTerm :: Term -> Set Name
freeVariablesInTerm Term
term =  
  let dfltVars :: Set Name
dfltVars = ((Set Name -> Term -> Set Name) -> Set Name -> [Term] -> Set Name
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (\Set Name
s -> \Term
t -> Set Name -> Set Name -> Set Name
forall x. Ord x => Set x -> Set x -> Set x
Sets.union Set Name
s (Term -> Set Name
freeVariablesInTerm Term
t)) Set Name
forall x. Set x
Sets.empty (Term -> [Term]
subterms Term
term))
  in ((\Term
x -> case Term
x of
    Core.TermFunction Function
v20 -> ((\Function
x -> case Function
x of
      Core.FunctionLambda Lambda
v21 -> (Name -> Set Name -> Set Name
forall x. Ord x => x -> Set x -> Set x
Sets.remove (Lambda -> Name
Core.lambdaParameter Lambda
v21) (Term -> Set Name
freeVariablesInTerm (Lambda -> Term
Core.lambdaBody Lambda
v21)))
      Function
_ -> Set Name
dfltVars) Function
v20)
    Core.TermVariable Name
v22 -> (Name -> Set Name
forall x. x -> Set x
Sets.singleton Name
v22)
    Term
_ -> Set Name
dfltVars) Term
term)

-- | Find the free variables (i.e. variables not bound by a lambda or let) in a type
freeVariablesInType :: (Core.Type -> Set Core.Name)
freeVariablesInType :: Type -> Set Name
freeVariablesInType Type
typ =  
  let dfltVars :: Set Name
dfltVars = ((Set Name -> Type -> Set Name) -> Set Name -> [Type] -> Set Name
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (\Set Name
s -> \Type
t -> Set Name -> Set Name -> Set Name
forall x. Ord x => Set x -> Set x -> Set x
Sets.union Set Name
s (Type -> Set Name
freeVariablesInType Type
t)) Set Name
forall x. Set x
Sets.empty (Type -> [Type]
subtypes Type
typ))
  in ((\Type
x -> case Type
x of
    Core.TypeLambda LambdaType
v23 -> (Name -> Set Name -> Set Name
forall x. Ord x => x -> Set x -> Set x
Sets.remove (LambdaType -> Name
Core.lambdaTypeParameter LambdaType
v23) (Type -> Set Name
freeVariablesInType (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v23)))
    Core.TypeVariable Name
v24 -> (Name -> Set Name
forall x. x -> Set x
Sets.singleton Name
v24)
    Type
_ -> Set Name
dfltVars) Type
typ)

-- | Find the children of a given term
subterms :: (Core.Term -> [Core.Term])
subterms :: Term -> [Term]
subterms Term
x = case Term
x of
  Core.TermAnnotated AnnotatedTerm
v25 -> [
    AnnotatedTerm -> Term
Core.annotatedTermSubject AnnotatedTerm
v25]
  Core.TermApplication Application
v26 -> [
    Application -> Term
Core.applicationFunction Application
v26,
    (Application -> Term
Core.applicationArgument Application
v26)]
  Core.TermFunction Function
v27 -> ((\Function
x -> case Function
x of
    Core.FunctionElimination Elimination
v28 -> ((\Elimination
x -> case Elimination
x of
      Core.EliminationList Term
v29 -> [
        Term
v29]
      Core.EliminationOptional OptionalCases
v30 -> [
        OptionalCases -> Term
Core.optionalCasesNothing OptionalCases
v30,
        (OptionalCases -> Term
Core.optionalCasesJust OptionalCases
v30)]
      Core.EliminationUnion CaseStatement
v31 -> ([Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
Lists.concat2 ((\Maybe Term
x -> case Maybe Term
x of
        Maybe Term
Nothing -> []
        Just Term
v32 -> [
          Term
v32]) (CaseStatement -> Maybe Term
Core.caseStatementDefault CaseStatement
v31)) ((Field -> Term) -> [Field] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Field -> Term
Core.fieldTerm (CaseStatement -> [Field]
Core.caseStatementCases CaseStatement
v31)))
      Elimination
_ -> []) Elimination
v28)
    Core.FunctionLambda Lambda
v33 -> [
      Lambda -> Term
Core.lambdaBody Lambda
v33]
    Function
_ -> []) Function
v27)
  Core.TermLet Let
v34 -> (Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
Lists.cons (Let -> Term
Core.letEnvironment Let
v34) ((LetBinding -> Term) -> [LetBinding] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map LetBinding -> Term
Core.letBindingTerm (Let -> [LetBinding]
Core.letBindings Let
v34)))
  Core.TermList [Term]
v35 -> [Term]
v35
  Core.TermLiteral Literal
_ -> []
  Core.TermMap Map Term Term
v37 -> ([[Term]] -> [Term]
forall a. [[a]] -> [a]
Lists.concat (((Term, Term) -> [Term]) -> [(Term, Term)] -> [[Term]]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\(Term, Term)
p -> [
    (Term, Term) -> Term
forall a b. (a, b) -> a
fst (Term, Term)
p,
    ((Term, Term) -> Term
forall a b. (a, b) -> b
snd (Term, Term)
p)]) (Map Term Term -> [(Term, Term)]
forall k v. Map k v -> [(k, v)]
Maps.toList Map Term Term
v37)))
  Core.TermOptional Maybe Term
v38 -> ((\Maybe Term
x -> case Maybe Term
x of
    Maybe Term
Nothing -> []
    Just Term
v39 -> [
      Term
v39]) Maybe Term
v38)
  Core.TermProduct [Term]
v40 -> [Term]
v40
  Core.TermRecord Record
v41 -> ((Field -> Term) -> [Field] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Field -> Term
Core.fieldTerm (Record -> [Field]
Core.recordFields Record
v41))
  Core.TermSet Set Term
v42 -> (Set Term -> [Term]
forall x. Ord x => Set x -> [x]
Sets.toList Set Term
v42)
  Core.TermSum Sum
v43 -> [
    Sum -> Term
Core.sumTerm Sum
v43]
  Core.TermTypeAbstraction TypeAbstraction
v44 -> [
    TypeAbstraction -> Term
Core.typeAbstractionBody TypeAbstraction
v44]
  Core.TermTypeApplication TypedTerm
v45 -> [
    TypedTerm -> Term
Core.typedTermTerm TypedTerm
v45]
  Core.TermTyped TypedTerm
v46 -> [
    TypedTerm -> Term
Core.typedTermTerm TypedTerm
v46]
  Core.TermUnion Injection
v47 -> [
    Field -> Term
Core.fieldTerm (Injection -> Field
Core.injectionField Injection
v47)]
  Core.TermVariable Name
_ -> []
  Core.TermWrap WrappedTerm
v49 -> [
    WrappedTerm -> Term
Core.wrappedTermObject WrappedTerm
v49]

-- | Find the children of a given term
subtermsWithAccessors :: (Core.Term -> [(Mantle.TermAccessor, Core.Term)])
subtermsWithAccessors :: Term -> [(TermAccessor, Term)]
subtermsWithAccessors Term
x = case Term
x of
  Core.TermAnnotated AnnotatedTerm
v50 -> [
    (TermAccessor
Mantle.TermAccessorAnnotatedSubject, (AnnotatedTerm -> Term
Core.annotatedTermSubject AnnotatedTerm
v50))]
  Core.TermApplication Application
v51 -> [
    (TermAccessor
Mantle.TermAccessorApplicationFunction, (Application -> Term
Core.applicationFunction Application
v51)),
    (TermAccessor
Mantle.TermAccessorApplicationArgument, (Application -> Term
Core.applicationArgument Application
v51))]
  Core.TermFunction Function
v52 -> ((\Function
x -> case Function
x of
    Core.FunctionElimination Elimination
v53 -> ((\Elimination
x -> case Elimination
x of
      Core.EliminationList Term
v54 -> [
        (TermAccessor
Mantle.TermAccessorListFold, Term
v54)]
      Core.EliminationOptional OptionalCases
v55 -> [
        (TermAccessor
Mantle.TermAccessorOptionalCasesNothing, (OptionalCases -> Term
Core.optionalCasesNothing OptionalCases
v55)),
        (TermAccessor
Mantle.TermAccessorOptionalCasesJust, (OptionalCases -> Term
Core.optionalCasesJust OptionalCases
v55))]
      Core.EliminationUnion CaseStatement
v56 -> ([(TermAccessor, Term)]
-> [(TermAccessor, Term)] -> [(TermAccessor, Term)]
forall a. [a] -> [a] -> [a]
Lists.concat2 ((\Maybe Term
x -> case Maybe Term
x of
        Maybe Term
Nothing -> []
        Just Term
v57 -> [
          (TermAccessor
Mantle.TermAccessorUnionCasesDefault, Term
v57)]) (CaseStatement -> Maybe Term
Core.caseStatementDefault CaseStatement
v56)) ((Field -> (TermAccessor, Term))
-> [Field] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\Field
f -> (Name -> TermAccessor
Mantle.TermAccessorUnionCasesBranch (Field -> Name
Core.fieldName Field
f), (Field -> Term
Core.fieldTerm Field
f))) (CaseStatement -> [Field]
Core.caseStatementCases CaseStatement
v56)))
      Elimination
_ -> []) Elimination
v53)
    Core.FunctionLambda Lambda
v58 -> [
      (TermAccessor
Mantle.TermAccessorLambdaBody, (Lambda -> Term
Core.lambdaBody Lambda
v58))]
    Function
_ -> []) Function
v52)
  Core.TermLet Let
v59 -> ((TermAccessor, Term)
-> [(TermAccessor, Term)] -> [(TermAccessor, Term)]
forall a. a -> [a] -> [a]
Lists.cons (TermAccessor
Mantle.TermAccessorLetEnvironment, (Let -> Term
Core.letEnvironment Let
v59)) ((LetBinding -> (TermAccessor, Term))
-> [LetBinding] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\LetBinding
b -> (Name -> TermAccessor
Mantle.TermAccessorLetBinding (LetBinding -> Name
Core.letBindingName LetBinding
b), (LetBinding -> Term
Core.letBindingTerm LetBinding
b))) (Let -> [LetBinding]
Core.letBindings Let
v59)))
  Core.TermList [Term]
v60 -> ((Term -> (TermAccessor, Term)) -> [Term] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\Term
e -> (Int -> TermAccessor
Mantle.TermAccessorListElement Int
0, Term
e)) [Term]
v60)
  Core.TermLiteral Literal
_ -> []
  Core.TermMap Map Term Term
v62 -> ([[(TermAccessor, Term)]] -> [(TermAccessor, Term)]
forall a. [[a]] -> [a]
Lists.concat (((Term, Term) -> [(TermAccessor, Term)])
-> [(Term, Term)] -> [[(TermAccessor, Term)]]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\(Term, Term)
p -> [
    (Int -> TermAccessor
Mantle.TermAccessorMapKey Int
0, ((Term, Term) -> Term
forall a b. (a, b) -> a
fst (Term, Term)
p)),
    (Int -> TermAccessor
Mantle.TermAccessorMapValue Int
0, ((Term, Term) -> Term
forall a b. (a, b) -> b
snd (Term, Term)
p))]) (Map Term Term -> [(Term, Term)]
forall k v. Map k v -> [(k, v)]
Maps.toList Map Term Term
v62)))
  Core.TermOptional Maybe Term
v63 -> ((\Maybe Term
x -> case Maybe Term
x of
    Maybe Term
Nothing -> []
    Just Term
v64 -> [
      (TermAccessor
Mantle.TermAccessorOptionalTerm, Term
v64)]) Maybe Term
v63)
  Core.TermProduct [Term]
v65 -> ((Term -> (TermAccessor, Term)) -> [Term] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\Term
e -> (Int -> TermAccessor
Mantle.TermAccessorProductTerm Int
0, Term
e)) [Term]
v65)
  Core.TermRecord Record
v66 -> ((Field -> (TermAccessor, Term))
-> [Field] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\Field
f -> (Name -> TermAccessor
Mantle.TermAccessorRecordField (Field -> Name
Core.fieldName Field
f), (Field -> Term
Core.fieldTerm Field
f))) (Record -> [Field]
Core.recordFields Record
v66))
  Core.TermSet Set Term
v67 -> ((Term -> (TermAccessor, Term)) -> [Term] -> [(TermAccessor, Term)]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\Term
e -> (Int -> TermAccessor
Mantle.TermAccessorListElement Int
0, Term
e)) (Set Term -> [Term]
forall x. Ord x => Set x -> [x]
Sets.toList Set Term
v67))
  Core.TermSum Sum
v68 -> [
    (TermAccessor
Mantle.TermAccessorSumTerm, (Sum -> Term
Core.sumTerm Sum
v68))]
  Core.TermTypeAbstraction TypeAbstraction
v69 -> [
    (TermAccessor
Mantle.TermAccessorTypeAbstractionBody, (TypeAbstraction -> Term
Core.typeAbstractionBody TypeAbstraction
v69))]
  Core.TermTypeApplication TypedTerm
v70 -> [
    (TermAccessor
Mantle.TermAccessorTypeApplicationTerm, (TypedTerm -> Term
Core.typedTermTerm TypedTerm
v70))]
  Core.TermTyped TypedTerm
v71 -> [
    (TermAccessor
Mantle.TermAccessorTypedTerm, (TypedTerm -> Term
Core.typedTermTerm TypedTerm
v71))]
  Core.TermUnion Injection
v72 -> [
    (TermAccessor
Mantle.TermAccessorInjectionTerm, (Field -> Term
Core.fieldTerm (Injection -> Field
Core.injectionField Injection
v72)))]
  Core.TermVariable Name
_ -> []
  Core.TermWrap WrappedTerm
v74 -> [
    (TermAccessor
Mantle.TermAccessorWrappedTerm, (WrappedTerm -> Term
Core.wrappedTermObject WrappedTerm
v74))]

-- | Find the children of a given type expression
subtypes :: (Core.Type -> [Core.Type])
subtypes :: Type -> [Type]
subtypes Type
x = case Type
x of
  Core.TypeAnnotated AnnotatedType
v75 -> [
    AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v75]
  Core.TypeApplication ApplicationType
v76 -> [
    ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v76,
    (ApplicationType -> Type
Core.applicationTypeArgument ApplicationType
v76)]
  Core.TypeFunction FunctionType
v77 -> [
    FunctionType -> Type
Core.functionTypeDomain FunctionType
v77,
    (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v77)]
  Core.TypeLambda LambdaType
v78 -> [
    LambdaType -> Type
Core.lambdaTypeBody LambdaType
v78]
  Core.TypeList Type
v79 -> [
    Type
v79]
  Core.TypeLiteral LiteralType
_ -> []
  Core.TypeMap MapType
v81 -> [
    MapType -> Type
Core.mapTypeKeys MapType
v81,
    (MapType -> Type
Core.mapTypeValues MapType
v81)]
  Core.TypeOptional Type
v82 -> [
    Type
v82]
  Core.TypeProduct [Type]
v83 -> [Type]
v83
  Core.TypeRecord RowType
v84 -> ((FieldType -> Type) -> [FieldType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
Lists.map FieldType -> Type
Core.fieldTypeType (RowType -> [FieldType]
Core.rowTypeFields RowType
v84))
  Core.TypeSet Type
v85 -> [
    Type
v85]
  Core.TypeSum [Type]
v86 -> [Type]
v86
  Core.TypeUnion RowType
v87 -> ((FieldType -> Type) -> [FieldType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
Lists.map FieldType -> Type
Core.fieldTypeType (RowType -> [FieldType]
Core.rowTypeFields RowType
v87))
  Core.TypeVariable Name
_ -> []
  Core.TypeWrap WrappedType
v89 -> [
    WrappedType -> Type
Core.wrappedTypeObject WrappedType
v89]

emptyTrace :: Compute.Trace
emptyTrace :: Trace
emptyTrace = Compute.Trace {
  traceStack :: [String]
Compute.traceStack = [],
  traceMessages :: [String]
Compute.traceMessages = [],
  traceOther :: Map Name Term
Compute.traceOther = Map Name Term
forall k v. Map k v
Maps.empty}

-- | Check whether a flow succeeds
flowSucceeds :: (s -> Compute.Flow s a -> Bool)
flowSucceeds :: forall s a. s -> Flow s a -> Bool
flowSucceeds s
cx Flow s a
f = (Maybe a -> Bool
forall a. Maybe a -> Bool
Optionals.isJust (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
cx Trace
emptyTrace)))

-- | Get the value of a flow, or a default value if the flow fails
fromFlow :: (a -> s -> Compute.Flow s a -> a)
fromFlow :: forall a s. a -> s -> Flow s a -> a
fromFlow a
def s
cx Flow s a
f = ((\Maybe a
x -> case Maybe a
x of
  Maybe a
Nothing -> a
def
  Just a
v90 -> a
v90) (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
cx Trace
emptyTrace)))

mutateTrace :: ((Compute.Trace -> Mantle.Either_ String Compute.Trace) -> (Compute.Trace -> Compute.Trace -> Compute.Trace) -> Compute.Flow s a -> Compute.Flow s a)
mutateTrace :: forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
mutate Trace -> Trace -> Trace
restore Flow s a
f = ((s -> Trace -> FlowState s a) -> Flow s a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s
s0 -> \Trace
t0 ->  
  let forLeft :: String -> FlowState s x
forLeft = (\String
msg -> Compute.FlowState {
          flowStateValue :: Maybe x
Compute.flowStateValue = Maybe x
forall a. Maybe a
Nothing,
          flowStateState :: s
Compute.flowStateState = s
s0,
          flowStateTrace :: Trace
Compute.flowStateTrace = (String -> Trace -> Trace
pushError String
msg Trace
t0)}) 
      forRight :: Trace -> FlowState s a
forRight = (\Trace
t1 ->  
              let f2 :: FlowState s a
f2 = (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
s0 Trace
t1)
              in Compute.FlowState {
                flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s a
f2),
                flowStateState :: s
Compute.flowStateState = (FlowState s a -> s
forall s x. FlowState s x -> s
Compute.flowStateState FlowState s a
f2),
                flowStateTrace :: Trace
Compute.flowStateTrace = (Trace -> Trace -> Trace
restore Trace
t0 (FlowState s a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s a
f2))})
  in ((\Either_ String Trace
x -> case Either_ String Trace
x of
    Mantle.EitherLeft String
v91 -> (String -> FlowState s a
forall {x}. String -> FlowState s x
forLeft String
v91)
    Mantle.EitherRight Trace
v92 -> (Trace -> FlowState s a
forRight Trace
v92)) (Trace -> Either_ String Trace
mutate Trace
t0))))

-- | Push an error message
pushError :: (String -> Compute.Trace -> Compute.Trace)
pushError :: String -> Trace -> Trace
pushError String
msg Trace
t =  
  let errorMsg :: String
errorMsg = ([String] -> String
Strings.cat [
          String
"Error: ",
          String
msg,
          String
" (",
          String -> [String] -> String
Strings.intercalate String
" > " ([String] -> [String]
forall a. [a] -> [a]
Lists.reverse (Trace -> [String]
Compute.traceStack Trace
t)),
          String
")"])
  in Compute.Trace {
    traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
    traceMessages :: [String]
Compute.traceMessages = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons String
errorMsg (Trace -> [String]
Compute.traceMessages Trace
t)),
    traceOther :: Map Name Term
Compute.traceOther = (Trace -> Map Name Term
Compute.traceOther Trace
t)}

-- | Continue the current flow after adding a warning message
warn :: (String -> Compute.Flow s a -> Compute.Flow s a)
warn :: forall s a. String -> Flow s a -> Flow s a
warn String
msg Flow s a
b = ((s -> Trace -> FlowState s a) -> Flow s a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s
s0 -> \Trace
t0 ->  
  let f1 :: FlowState s a
f1 = (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
b s
s0 Trace
t0) 
      addMessage :: Trace -> Trace
addMessage = (\Trace
t -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
              traceMessages :: [String]
Compute.traceMessages = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons ([String] -> String
Strings.cat [
                String
"Warning: ",
                String
msg]) (Trace -> [String]
Compute.traceMessages Trace
t)),
              traceOther :: Map Name Term
Compute.traceOther = (Trace -> Map Name Term
Compute.traceOther Trace
t)})
  in Compute.FlowState {
    flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s a
f1),
    flowStateState :: s
Compute.flowStateState = (FlowState s a -> s
forall s x. FlowState s x -> s
Compute.flowStateState FlowState s a
f1),
    flowStateTrace :: Trace
Compute.flowStateTrace = (Trace -> Trace
addMessage (FlowState s a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s a
f1))}))

-- | Continue the current flow after setting a flag
withFlag :: (Core.Name -> Compute.Flow s a -> Compute.Flow s a)
withFlag :: forall s a. Name -> Flow s a -> Flow s a
withFlag Name
flag =  
  let mutate :: Trace -> Either_ a Trace
mutate = (\Trace
t -> Trace -> Either_ a Trace
forall a b. b -> Either_ a b
Mantle.EitherRight (Compute.Trace {
          traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
          traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t),
          traceOther :: Map Name Term
Compute.traceOther = (Name -> Term -> Map Name Term -> Map Name Term
forall k v. Ord k => k -> v -> Map k v -> Map k v
Maps.insert Name
flag (Literal -> Term
Core.TermLiteral (Bool -> Literal
Core.LiteralBoolean Bool
True)) (Trace -> Map Name Term
Compute.traceOther Trace
t))})) 
      restore :: p -> Trace -> Trace
restore = (\p
ignored -> \Trace
t1 -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t1),
              traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t1),
              traceOther :: Map Name Term
Compute.traceOther = (Name -> Map Name Term -> Map Name Term
forall k v. Ord k => k -> Map k v -> Map k v
Maps.remove Name
flag (Trace -> Map Name Term
Compute.traceOther Trace
t1))})
  in ((Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
forall {a}. Trace -> Either_ a Trace
mutate Trace -> Trace -> Trace
forall {p}. p -> Trace -> Trace
restore)

-- | Continue a flow using a given state
withState :: (s1 -> Compute.Flow s1 a -> Compute.Flow s2 a)
withState :: forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState s1
cx0 Flow s1 a
f = ((s2 -> Trace -> FlowState s2 a) -> Flow s2 a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s2
cx1 -> \Trace
t1 ->  
  let f1 :: FlowState s1 a
f1 = (Flow s1 a -> s1 -> Trace -> FlowState s1 a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s1 a
f s1
cx0 Trace
t1)
  in Compute.FlowState {
    flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s1 a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s1 a
f1),
    flowStateState :: s2
Compute.flowStateState = s2
cx1,
    flowStateTrace :: Trace
Compute.flowStateTrace = (FlowState s1 a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s1 a
f1)}))

-- | Continue the current flow after augmenting the trace
withTrace :: (String -> Compute.Flow s a -> Compute.Flow s a)
withTrace :: forall s a. String -> Flow s a -> Flow s a
withTrace String
msg =  
  let mutate :: Trace -> Either_ String Trace
mutate = (\Trace
t -> Either_ String Trace
-> Either_ String Trace -> Bool -> Either_ String Trace
forall a. a -> a -> Bool -> a
Logic.ifElse (String -> Either_ String Trace
forall a b. a -> Either_ a b
Mantle.EitherLeft String
"maximum trace depth exceeded. This may indicate an infinite loop") (Trace -> Either_ String Trace
forall a b. b -> Either_ a b
Mantle.EitherRight (Compute.Trace {
          traceStack :: [String]
Compute.traceStack = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons String
msg (Trace -> [String]
Compute.traceStack Trace
t)),
          traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t),
          traceOther :: Map Name Term
Compute.traceOther = (Trace -> Map Name Term
Compute.traceOther Trace
t)})) (Int -> Int -> Bool
Equality.gteInt32 ([String] -> Int
forall a. [a] -> Int
Lists.length (Trace -> [String]
Compute.traceStack Trace
t)) Int
Constants.maxTraceDepth)) 
      restore :: Trace -> Trace -> Trace
restore = (\Trace
t0 -> \Trace
t1 -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t0),
              traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t1),
              traceOther :: Map Name Term
Compute.traceOther = (Trace -> Map Name Term
Compute.traceOther Trace
t1)})
  in ((Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
mutate Trace -> Trace -> Trace
restore)