Adapt.hs

-- Note: this is an automatically generated file. Do not edit.

-- | Simple, one-way adapters for types and terms

module Hydra.Adapt where

import qualified Hydra.Annotations as Annotations
import qualified Hydra.Ast as Ast
import qualified Hydra.Coders as Coders
import qualified Hydra.Core as Core
import qualified Hydra.Dependencies as Dependencies
import qualified Hydra.Docs as Docs
import qualified Hydra.Environment as Environment
import qualified Hydra.Error.Checking as Checking
import qualified Hydra.Error.Core as ErrorCore
import qualified Hydra.Error.File as ErrorFile
import qualified Hydra.Error.Packaging as ErrorPackaging
import qualified Hydra.Error.System as ErrorSystem
import qualified Hydra.Errors as Errors
import qualified Hydra.File as File
import qualified Hydra.Graph as Graph
import qualified Hydra.Hoisting as Hoisting
import qualified Hydra.Inference as Inference
import qualified Hydra.Json.Model as Model
import qualified Hydra.Lexical as Lexical
import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers
import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality
import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists
import qualified Hydra.Overlay.Haskell.Lib.Literals as LibLiterals
import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic
import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs
import qualified Hydra.Overlay.Haskell.Lib.Sets as Sets
import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Literals as Literals
import qualified Hydra.Names as Names
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Query as Query
import qualified Hydra.Reduction as Reduction
import qualified Hydra.Reflect as Reflect
import qualified Hydra.Relational as Relational
import qualified Hydra.Resolution as Resolution
import qualified Hydra.Rewriting as Rewriting
import qualified Hydra.Scoping as Scoping
import qualified Hydra.Show.Core as ShowCore
import qualified Hydra.Show.Errors as ShowErrors
import qualified Hydra.Show.Graph as ShowGraph
import qualified Hydra.Strip as Strip
import qualified Hydra.System as System
import qualified Hydra.Tabular as Tabular
import qualified Hydra.Testing as Testing
import qualified Hydra.Time as Time
import qualified Hydra.Topology as Topology
import qualified Hydra.Typed as Typed
import qualified Hydra.Typing as Typing
import qualified Hydra.Util as Util
import qualified Hydra.Validation as Validation
import qualified Hydra.Variables as Variables
import qualified Hydra.Variants as Variants
import Prelude hiding  (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci
import qualified Data.Map as M
import qualified Data.Set as S

-- | Adapt a graph and its schema to the given language constraints. The doExpand flag controls eta expansion of partial applications. Adaptation is type-preserving: binding-level TypeSchemes are adapted (not stripped). Note: case statement hoisting is done separately, prior to adaptation. The els0 parameter provides the original ordered bindings. Returns both the adapted graph and the ordered adapted bindings.
adaptDataGraph :: Coders.LanguageConstraints -> Bool -> [Core.Binding] -> t0 -> Graph.Graph -> Either Errors.Error (Graph.Graph, [Core.Binding])
adaptDataGraph constraints doExpand els0 cx graph0 =

      let transformTerm =
              \g -> \term ->
                let tx = g
                    t1 = Variables.unshadowVariables (pushTypeAppsInward term)
                    t2 = Variables.unshadowVariables (Logic.ifElse doExpand (pushTypeAppsInward (Reduction.etaExpandTerm tx t1)) t1)
                in (Dependencies.liftLambdaAboveLet t2)
          transformBinding =
                  \g -> \el -> Core.Binding {
                    Core.bindingName = (Core.bindingName el),
                    Core.bindingTerm = (transformTerm g (Core.bindingTerm el)),
                    Core.bindingTypeScheme = (Core.bindingTypeScheme el)}
          litmap = adaptLiteralTypesMap constraints
          prims0 = Graph.graphPrimitives graph0
          schemaTypes0 = Graph.graphSchemaTypes graph0
          schemaBindings = Environment.typesToDefinitions (Maps.map (\ts -> Scoping.typeSchemeToFType ts) schemaTypes0)
      in (Eithers.bind (Logic.ifElse (Maps.null schemaTypes0) (Right Maps.empty) (Eithers.bind (Eithers.bimap (\e -> Errors.ErrorDecoding e) (\x -> x) (Environment.graphAsTypes graph0 schemaBindings)) (\tmap0 -> Eithers.bind (adaptGraphSchema constraints litmap tmap0) (\tmap1 -> Right (Maps.map (\t -> Resolution.typeToTypeScheme t) tmap1))))) (\schemaResult ->
        let adaptedSchemaTypes = schemaResult
            adaptBinding =
                    \el ->
                      let transformed = transformBinding graph0 el
                          wrapped =
                                  Core.TermLet (Core.Let {
                                    Core.letBindings = (Lists.pure transformed),
                                    Core.letBody = Core.TermUnit})
                      in (Eithers.bind (adaptTerm constraints litmap cx graph0 wrapped) (\adapted -> Rewriting.rewriteTermM (adaptLambdaDomains constraints litmap) adapted))
        in (Eithers.bind (Eithers.mapList adaptBinding els0) (\adaptedTerms ->
          let els1Raw = Lists.concat (Lists.map Environment.termAsBindings adaptedTerms)
              processBinding =
                      \el -> Eithers.bind (Rewriting.rewriteTermM (adaptNestedTypes constraints litmap) (Core.bindingTerm el)) (\newTerm -> Eithers.bind (Optionals.cases (Core.bindingTypeScheme el) (Right Nothing) (\ts -> Eithers.bind (adaptTypeScheme constraints litmap ts) (\ts1 -> Right (Just ts1)))) (\adaptedType -> Right (Core.Binding {
                        Core.bindingName = (Core.bindingName el),
                        Core.bindingTerm = newTerm,
                        Core.bindingTypeScheme = adaptedType})))
          in (Eithers.bind (Eithers.mapList processBinding els1Raw) (\els1 -> Eithers.bind (Eithers.mapList (\kv -> Eithers.bind (adaptPrimitive constraints litmap (Pairs.second kv)) (\prim1 -> Right (Pairs.first kv, prim1))) (Maps.toList prims0)) (\primPairs ->
            let prims1 = Maps.fromList primPairs
                adaptedGraphRaw = Lexical.buildGraph els1 Maps.empty prims1
                adaptedGraph =
                        Graph.Graph {
                          Graph.graphBoundTerms = (Graph.graphBoundTerms adaptedGraphRaw),
                          Graph.graphBoundTypes = (Graph.graphBoundTypes adaptedGraphRaw),
                          Graph.graphClassConstraints = (Graph.graphClassConstraints adaptedGraphRaw),
                          Graph.graphLambdaVariables = (Graph.graphLambdaVariables adaptedGraphRaw),
                          Graph.graphMetadata = (Graph.graphMetadata adaptedGraphRaw),
                          Graph.graphPrimitives = (Graph.graphPrimitives adaptedGraphRaw),
                          Graph.graphSchemaTypes = adaptedSchemaTypes,
                          Graph.graphTypeVariables = (Graph.graphTypeVariables adaptedGraphRaw)}
            in (Right (adaptedGraph, els1)))))))))

-- | Attempt to adapt a floating-point type using the given language constraints
adaptFloatType :: Coders.LanguageConstraints -> Core.FloatType -> Maybe Core.FloatType
adaptFloatType constraints ft =

      let supported = Sets.member ft (Coders.languageConstraintsFloatTypes constraints)
          alt = adaptFloatType constraints
          forUnsupported =
                  \ft2 -> case ft2 of
                    Core.FloatTypeFloat32 -> alt Core.FloatTypeFloat64
                    Core.FloatTypeFloat64 -> alt Core.FloatTypeFloat32
      in (Logic.ifElse supported (Just ft) (forUnsupported ft))

-- | Adapt a schema graph to the given language constraints
adaptGraphSchema :: Ord t0 => (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> M.Map t0 Core.Type -> Either Errors.Error (M.Map t0 Core.Type))
adaptGraphSchema constraints litmap types0 =

      let mapPair =
              \pair ->
                let name = Pairs.first pair
                    typ = Pairs.second pair
                in (Eithers.bind (adaptType constraints litmap typ) (\typ1 -> Right (name, typ1)))
      in (Eithers.bind (Eithers.mapList mapPair (Maps.toList types0)) (\pairs -> Right (Maps.fromList pairs)))

-- | Attempt to adapt an integer type using the given language constraints
adaptIntegerType :: Coders.LanguageConstraints -> Core.IntegerType -> Maybe Core.IntegerType
adaptIntegerType constraints it =

      let supported = Sets.member it (Coders.languageConstraintsIntegerTypes constraints)
          alt = adaptIntegerType constraints
          forUnsupported =
                  \it2 -> case it2 of
                    Core.IntegerTypeBigint -> Nothing
                    Core.IntegerTypeInt8 -> alt Core.IntegerTypeUint16
                    Core.IntegerTypeInt16 -> alt Core.IntegerTypeUint32
                    Core.IntegerTypeInt32 -> alt Core.IntegerTypeUint64
                    Core.IntegerTypeInt64 -> alt Core.IntegerTypeBigint
                    Core.IntegerTypeUint8 -> alt Core.IntegerTypeInt16
                    Core.IntegerTypeUint16 -> alt Core.IntegerTypeInt32
                    Core.IntegerTypeUint32 -> alt Core.IntegerTypeInt64
                    Core.IntegerTypeUint64 -> alt Core.IntegerTypeBigint
      in (Logic.ifElse supported (Just it) (forUnsupported it))

-- | Rewrite callback for adapting lambda domain types in a term
adaptLambdaDomains :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> (t0 -> Either Errors.Error Core.Term) -> t0 -> Either Errors.Error Core.Term
adaptLambdaDomains constraints litmap recurse term =
    Eithers.bind (recurse term) (\rewritten -> case rewritten of
      Core.TermLambda v0 -> Eithers.bind (Optionals.cases (Core.lambdaDomain v0) (Right Nothing) (\dom -> Eithers.bind (adaptType constraints litmap dom) (\dom1 -> Right (Just dom1)))) (\adaptedDomain -> Right (Core.TermLambda (Core.Lambda {
        Core.lambdaParameter = (Core.lambdaParameter v0),
        Core.lambdaDomain = adaptedDomain,
        Core.lambdaBody = (Core.lambdaBody v0)})))
      _ -> Right rewritten)

-- | Convert a literal to a different type
adaptLiteral :: Core.LiteralType -> Core.Literal -> Core.Literal
adaptLiteral lt l =
    case l of
      Core.LiteralBinary v0 -> case lt of
        Core.LiteralTypeString -> Core.LiteralString (LibLiterals.binaryToString v0)
      Core.LiteralBoolean v0 -> case lt of
        Core.LiteralTypeInteger v1 -> Core.LiteralInteger (Literals.bigintToIntegerValue v1 (Logic.ifElse v0 1 0))
      Core.LiteralDecimal v0 -> case lt of
        Core.LiteralTypeFloat _ -> Core.LiteralFloat (Core.FloatValueFloat64 (LibLiterals.decimalToFloat64 v0))
        Core.LiteralTypeString -> Core.LiteralString (LibLiterals.showDecimal v0)
      Core.LiteralFloat v0 -> case lt of
        Core.LiteralTypeFloat v1 -> Core.LiteralFloat (case v1 of
          Core.FloatTypeFloat32 -> Core.FloatValueFloat32 (case v0 of
            Core.FloatValueFloat32 v3 -> v3
            Core.FloatValueFloat64 v3 -> LibLiterals.float64ToFloat32 v3)
          Core.FloatTypeFloat64 -> Core.FloatValueFloat64 (case v0 of
            Core.FloatValueFloat32 v3 -> LibLiterals.float32ToFloat64 v3
            Core.FloatValueFloat64 v3 -> v3))
      Core.LiteralInteger v0 -> case lt of
        Core.LiteralTypeInteger v1 -> Core.LiteralInteger (Literals.bigintToIntegerValue v1 (Literals.integerValueToBigint v0))

-- | Attempt to adapt a literal type using the given language constraints
adaptLiteralType :: Coders.LanguageConstraints -> Core.LiteralType -> Maybe Core.LiteralType
adaptLiteralType constraints lt =

      let forUnsupported =
              \lt2 -> case lt2 of
                Core.LiteralTypeBinary -> Just Core.LiteralTypeString
                Core.LiteralTypeBoolean -> Optionals.map (\x -> Core.LiteralTypeInteger x) (adaptIntegerType constraints Core.IntegerTypeInt8)
                Core.LiteralTypeDecimal -> Just (Core.LiteralTypeFloat Core.FloatTypeFloat64)
                Core.LiteralTypeFloat v0 -> Optionals.map (\x -> Core.LiteralTypeFloat x) (adaptFloatType constraints v0)
                Core.LiteralTypeInteger v0 -> Optionals.map (\x -> Core.LiteralTypeInteger x) (adaptIntegerType constraints v0)
                _ -> Nothing
      in (Logic.ifElse (literalTypeSupported constraints lt) Nothing (forUnsupported lt))

-- | Derive a map of adapted literal types for the given language constraints
adaptLiteralTypesMap :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType
adaptLiteralTypesMap constraints =

      let tryType = \lt -> Optionals.cases (adaptLiteralType constraints lt) Nothing (\lt2 -> Just (lt, lt2))
      in (Maps.fromList (Optionals.cat (Lists.map tryType Reflect.literalTypes)))

-- | Adapt a literal value using the given language constraints
adaptLiteralValue :: Ord t0 => (M.Map t0 Core.LiteralType -> t0 -> Core.Literal -> Core.Literal)
adaptLiteralValue litmap lt l =
    Optionals.cases (Maps.lookup lt litmap) (Core.LiteralString (ShowCore.literal l)) (\lt2 -> adaptLiteral lt2 l)

-- | Rewrite callback for adapting nested let binding TypeSchemes in a term
adaptNestedTypes :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> (t0 -> Either Errors.Error Core.Term) -> t0 -> Either Errors.Error Core.Term
adaptNestedTypes constraints litmap recurse term =
    Eithers.bind (recurse term) (\rewritten -> case rewritten of
      Core.TermLet v0 ->
        let adaptB =
                \b -> Eithers.bind (Optionals.cases (Core.bindingTypeScheme b) (Right Nothing) (\ts -> Eithers.bind (adaptTypeScheme constraints litmap ts) (\ts1 -> Right (Just ts1)))) (\adaptedBType -> Right (Core.Binding {
                  Core.bindingName = (Core.bindingName b),
                  Core.bindingTerm = (Core.bindingTerm b),
                  Core.bindingTypeScheme = adaptedBType}))
        in (Eithers.bind (Eithers.mapList adaptB (Core.letBindings v0)) (\adaptedBindings -> Right (Core.TermLet (Core.Let {
          Core.letBindings = adaptedBindings,
          Core.letBody = (Core.letBody v0)}))))
      _ -> Right rewritten)

-- | Adapt a primitive to the given language constraints, prior to inference
adaptPrimitive :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Graph.Primitive -> Either Errors.Error Graph.Primitive
adaptPrimitive constraints litmap prim0 =

      let def0 = Graph.primitiveDefinition prim0
      in (Eithers.bind (adaptTermSignature constraints litmap (Packaging.primitiveDefinitionSignature def0)) (\sig1 ->
        let def1 =
                Packaging.PrimitiveDefinition {
                  Packaging.primitiveDefinitionName = (Packaging.primitiveDefinitionName def0),
                  Packaging.primitiveDefinitionMetadata = (Packaging.primitiveDefinitionMetadata def0),
                  Packaging.primitiveDefinitionSignature = sig1,
                  Packaging.primitiveDefinitionIsPure = (Packaging.primitiveDefinitionIsPure def0),
                  Packaging.primitiveDefinitionIsTotal = (Packaging.primitiveDefinitionIsTotal def0),
                  Packaging.primitiveDefinitionDefaultImplementation = (Packaging.primitiveDefinitionDefaultImplementation def0)}
        in (Right (Graph.Primitive {
          Graph.primitiveDefinition = def1,
          Graph.primitiveImplementation = (Graph.primitiveImplementation prim0)}))))

-- | Adapt a term using the given language constraints
adaptTerm :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term
adaptTerm constraints litmap cx graph term0 =

      let rewrite =
              \recurse -> \term02 ->
                let forSupported =
                        \term -> case term of
                          Core.TermLiteral v0 ->
                            let lt = Reflect.literalType v0
                            in (Right (Just (Logic.ifElse (literalTypeSupported constraints lt) term (Core.TermLiteral (adaptLiteralValue litmap lt v0)))))
                          _ -> Right (Just term)
                    forUnsupported =
                            \term ->
                              let tryAlts =
                                      \alts -> Optionals.cases (Lists.uncons alts) (Right Nothing) (\uc -> Eithers.bind (tryTerm (Pairs.first uc)) (\mterm -> Optionals.cases mterm (tryAlts (Pairs.second uc)) (\t -> Right (Just t))))
                              in (Eithers.bind (termAlternatives cx graph term) (\alts0 -> tryAlts alts0))
                    tryTerm =
                            \term ->
                              let supportedVariant = Sets.member (Reflect.termVariant term) (Coders.languageConstraintsTermVariants constraints)
                              in (Logic.ifElse supportedVariant (forSupported term) (forUnsupported term))
                in (Eithers.bind (recurse term02) (\term1 -> case term1 of
                  Core.TermAnnotated _ -> Right term1
                  Core.TermTypeApplication v0 -> Eithers.bind (adaptType constraints litmap (Core.typeApplicationTermType v0)) (\atyp -> Right (Core.TermTypeApplication (Core.TypeApplicationTerm {
                    Core.typeApplicationTermBody = (Core.typeApplicationTermBody v0),
                    Core.typeApplicationTermType = atyp})))
                  Core.TermTypeLambda _ -> Right term1
                  _ -> Eithers.bind (tryTerm term1) (\mterm -> Optionals.cases mterm (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no alternatives for term: " (ShowCore.term term1))))) (\term2 -> Right term2))))
      in (Rewriting.rewriteTermM rewrite term0)

-- | Adapt a term using the constraints of a given language
adaptTermForLanguage :: Coders.Language -> t0 -> Graph.Graph -> Core.Term -> Either Errors.Error Core.Term
adaptTermForLanguage lang cx g term =

      let constraints = Coders.languageConstraints lang
          litmap = adaptLiteralTypesMap constraints
      in (adaptTerm constraints litmap cx g term)

-- | Adapt the types within a term signature to the given language constraints, in place. Parameter names, descriptions, and per-parameter isLazy flags, as well as type parameters, are preserved; only the parameter and result types are adapted. Unlike routing through TypeScheme (the type-only view), this retains the full TermSignature metadata, including primitive laziness flags.
adaptTermSignature :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Typing.TermSignature -> Either Errors.Error Typing.TermSignature
adaptTermSignature constraints litmap sig0 =

      let result0 = Typing.termSignatureResult sig0
      in (Eithers.bind (adaptType constraints litmap (Typing.resultType result0)) (\resultType1 -> Eithers.bind (Eithers.mapList (\p -> Eithers.map (\ty1 -> Typing.Parameter {
        Typing.parameterName = (Typing.parameterName p),
        Typing.parameterDescription = (Typing.parameterDescription p),
        Typing.parameterType = ty1,
        Typing.parameterIsLazy = (Typing.parameterIsLazy p)}) (adaptType constraints litmap (Typing.parameterType p))) (Typing.termSignatureParameters sig0)) (\params1 -> Right (Typing.TermSignature {
        Typing.termSignatureTypeParameters = (Typing.termSignatureTypeParameters sig0),
        Typing.termSignatureParameters = params1,
        Typing.termSignatureResult = Typing.Result {
          Typing.resultDescription = (Typing.resultDescription result0),
          Typing.resultType = resultType1}}))))

-- | Adapt a type using the given language constraints
adaptType :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.Type -> Either Errors.Error Core.Type
adaptType constraints litmap type0 =

      let forSupported =
              \typ -> case typ of
                Core.TypeLiteral v0 -> Logic.ifElse (literalTypeSupported constraints v0) (Just typ) (Optionals.cases (Maps.lookup v0 litmap) (Just (Core.TypeLiteral Core.LiteralTypeString)) (\lt2 -> Just (Core.TypeLiteral lt2)))
                _ -> Just typ
          forUnsupported =
                  \typ ->
                    let tryAlts =
                            \alts -> Optionals.bind (Lists.uncons alts) (\uc -> Optionals.cases (tryType (Pairs.first uc)) (tryAlts (Pairs.second uc)) (\t -> Just t))
                        alts0 = typeAlternatives typ
                    in (tryAlts alts0)
          tryType =
                  \typ ->
                    let supportedVariant = Sets.member (Reflect.typeVariant typ) (Coders.languageConstraintsTypeVariants constraints)
                    in (Logic.ifElse supportedVariant (forSupported typ) (forUnsupported typ))
          rewrite =
                  \recurse -> \typ -> Eithers.bind (recurse typ) (\type1 -> Optionals.cases (tryType type1) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat2 "no alternatives for type: " (ShowCore.type_ typ))))) (\type2 -> Right type2))
      in (Rewriting.rewriteTypeM rewrite type0)

-- | Adapt a type using the constraints of a given language
adaptTypeForLanguage :: Coders.Language -> Core.Type -> Either Errors.Error Core.Type
adaptTypeForLanguage lang typ =

      let constraints = Coders.languageConstraints lang
          litmap = adaptLiteralTypesMap constraints
      in (adaptType constraints litmap typ)

-- | Adapt a type scheme to the given language constraints, prior to inference
adaptTypeScheme :: Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.TypeScheme -> Either Errors.Error Core.TypeScheme
adaptTypeScheme constraints litmap ts0 =

      let vars0 = Core.typeSchemeVariables ts0
          t0 = Core.typeSchemeBody ts0
      in (Eithers.bind (adaptType constraints litmap t0) (\t1 -> Right (Core.TypeScheme {
        Core.typeSchemeVariables = vars0,
        Core.typeSchemeBody = t1,
        Core.typeSchemeConstraints = (Core.typeSchemeConstraints ts0)})))

-- | Compose two coders into a single coder
composeCoders :: Coders.Coder t0 t1 t2 -> Coders.Coder t1 t3 t2 -> Coders.Coder t0 t3 t2
composeCoders c1 c2 =
    Coders.Coder {
      Coders.coderEncode = (\a -> Eithers.bind (Coders.coderEncode c1 a) (\b1 -> Coders.coderEncode c2 b1)),
      Coders.coderDecode = (\c -> Eithers.bind (Coders.coderDecode c2 c) (\b2 -> Coders.coderDecode c1 b2))}

-- | Given a data graph along with language constraints, original ordered bindings, and a designated list of namespaces, adapt the graph to the language constraints, then return the processed graph along with term definitions grouped by namespace (in the order of the input namespaces). Inference is performed before adaptation if bindings lack type annotations. Hoisting must preserve type schemes; if any binding loses its type scheme after hoisting, the pipeline fails. Adaptation preserves type application/lambda wrappers and adapts embedded types. Post-adaptation inference is performed to ensure binding TypeSchemes are fully consistent. The doExpand flag controls eta expansion. The doHoistCaseStatements flag controls case statement hoisting (needed for Python). The doHoistPolymorphicLetBindings flag controls polymorphic let binding hoisting (needed for Java). The originalBindings parameter provides the original ordered bindings (from module elements).
dataGraphToDefinitions :: Coders.LanguageConstraints -> Bool -> Bool -> Bool -> Bool -> [Core.Binding] -> Graph.Graph -> [Packaging.ModuleName] -> Typing.InferenceContext -> Either Errors.Error (Graph.Graph, [[Packaging.TermDefinition]])
dataGraphToDefinitions constraints doInfer doExpand doHoistCaseStatements doHoistPolymorphicLetBindings originalBindings graph0 namespaces cx =

      let namespacesSet = Sets.fromList namespaces
          isParentBinding =
                  \b -> Optionals.cases (Names.moduleNameOf (Core.bindingName b)) False (\ns -> Sets.member ns namespacesSet)
          hoistCases =
                  \bindings ->
                    let stripped =
                            Lists.map (\b -> Core.Binding {
                              Core.bindingName = (Core.bindingName b),
                              Core.bindingTerm = (Strip.stripTypeLambdas (Core.bindingTerm b)),
                              Core.bindingTypeScheme = (Core.bindingTypeScheme b)}) bindings
                        term0 =
                                Core.TermLet (Core.Let {
                                  Core.letBindings = stripped,
                                  Core.letBody = Core.TermUnit})
                        unshadowed0 = Environment.termAsBindings (Variables.unshadowVariables term0)
                        hoisted = Hoisting.hoistCaseStatementsInGraph unshadowed0
                        term1 =
                                Core.TermLet (Core.Let {
                                  Core.letBindings = hoisted,
                                  Core.letBody = Core.TermUnit})
                    in (Environment.termAsBindings (Variables.unshadowVariables term1))
          hoistPoly =
                  \bindings ->
                    let letBefore =
                            Core.Let {
                              Core.letBindings = bindings,
                              Core.letBody = Core.TermUnit}
                        letAfter = Hoisting.hoistPolymorphicLetBindings isParentBinding letBefore
                    in (Core.letBindings letAfter)
          qualifyUntyped =
                  \b ->
                    let nm = Core.unName (Core.bindingName b)
                    in (Optionals.cases (Names.moduleNameOf (Core.bindingName b)) (Strings.cat2 "(no module) " nm) (\ns -> Strings.cat [
                      Packaging.unModuleName ns,
                      " :: ",
                      nm]))
          checkBindingsTyped =
                  \debugLabel -> \bindings ->
                    let untypedBindings =
                            Lists.map qualifyUntyped (Lists.filter (\b -> Logic.not (Optionals.isGiven (Core.bindingTypeScheme b))) bindings)
                    in (Logic.ifElse (Lists.null untypedBindings) (Right bindings) (Left (Errors.ErrorOther (Errors.OtherError (Strings.cat [
                      "Found ",
                      (LibLiterals.showInt32 (Lists.length untypedBindings)),
                      " untyped binding(s) (",
                      debugLabel,
                      "); each must carry a type scheme at this stage. ",
                      "This usually means stale dist/json field shapes after a kernel record rename ",
                      "(regenerate the affected package's JSON). Offending bindings (module :: name): ",
                      (Strings.intercalate ", " untypedBindings)])))))
          normalizeBindings =
                  \bindings -> Lists.map (\b -> Core.Binding {
                    Core.bindingName = (Core.bindingName b),
                    Core.bindingTerm = (pushTypeAppsInward (Core.bindingTerm b)),
                    Core.bindingTypeScheme = (Core.bindingTypeScheme b)}) bindings
          rebuildGraph =
                  \bindings ->
                    let g = Lexical.buildGraph bindings Maps.empty (Graph.graphPrimitives graph0)
                    in Graph.Graph {
                      Graph.graphBoundTerms = (Graph.graphBoundTerms g),
                      Graph.graphBoundTypes = (Graph.graphBoundTypes g),
                      Graph.graphClassConstraints = (Graph.graphClassConstraints g),
                      Graph.graphLambdaVariables = (Graph.graphLambdaVariables g),
                      Graph.graphMetadata = (Graph.graphMetadata g),
                      Graph.graphPrimitives = (Graph.graphPrimitives g),
                      Graph.graphSchemaTypes = (Graph.graphSchemaTypes graph0),
                      Graph.graphTypeVariables = (Graph.graphTypeVariables g)}
          bins0 = originalBindings
          bins1 = Logic.ifElse doHoistCaseStatements (hoistCases bins0) bins0
      in (Eithers.bind (Logic.ifElse doInfer (Eithers.map (\result -> Pairs.second (Pairs.first result)) (Inference.inferGraphTypes cx bins1 (rebuildGraph bins1))) (checkBindingsTyped "after case hoisting" bins1)) (\bins2 -> Eithers.bind (Logic.ifElse doHoistPolymorphicLetBindings (checkBindingsTyped "after let hoisting" (hoistPoly bins2)) (Right bins2)) (\bins3 -> Eithers.bind (adaptDataGraph constraints doExpand bins3 cx (rebuildGraph bins3)) (\adaptResult ->
        let adapted = Pairs.first adaptResult
            adaptedBindings = Pairs.second adaptResult
        in (Eithers.bind (checkBindingsTyped "after adaptation" adaptedBindings) (\bins4 ->
          let bins5Raw = normalizeBindings bins4
              peelOne =
                      \t -> case t of
                        Core.TermTypeLambda v0 -> Core.typeLambdaBody v0
                        Core.TermTypeApplication v0 -> Core.typeApplicationTermBody v0
                        _ -> t
              extractAnn =
                      \t -> case t of
                        Core.TermAnnotated v0 -> Just (Core.annotatedTermAnnotation v0)
                        _ -> Nothing
              findAnn =
                      \t ->
                        let t1 = peelOne t
                            t2 = peelOne t1
                            t3 = peelOne t2
                        in (Optionals.cases (extractAnn t) (Optionals.cases (extractAnn t1) (Optionals.cases (extractAnn t2) (extractAnn t3) (\a -> Just a)) (\a -> Just a)) (\a -> Just a))
              originalAnnotations =
                      Maps.fromList (Optionals.cat (Lists.map (\b -> Optionals.cases (findAnn (Core.bindingTerm b)) Nothing (\ann -> Just (Core.bindingName b, ann))) originalBindings))
              reattachAnnotation =
                      \b -> Optionals.cases (Maps.lookup (Core.bindingName b) originalAnnotations) b (\ann -> Core.Binding {
                        Core.bindingName = (Core.bindingName b),
                        Core.bindingTerm = case (Core.bindingTerm b) of
                          Core.TermAnnotated v0 -> Core.TermAnnotated (Core.AnnotatedTerm {
                            Core.annotatedTermBody = (Core.annotatedTermBody v0),
                            Core.annotatedTermAnnotation = (Annotations.wrapAnnotationMap (Maps.union (Annotations.getAnnotationMap (Core.annotatedTermAnnotation v0)) (Annotations.getAnnotationMap ann)))})
                          _ -> Core.TermAnnotated (Core.AnnotatedTerm {
                            Core.annotatedTermBody = (Core.bindingTerm b),
                            Core.annotatedTermAnnotation = ann}),
                        Core.bindingTypeScheme = (Core.bindingTypeScheme b)})
              bins5 = Lists.map reattachAnnotation bins5Raw
              toDef =
                      \el -> Optionals.map (\ts -> Packaging.TermDefinition {
                        Packaging.termDefinitionName = (Core.bindingName el),
                        Packaging.termDefinitionMetadata = Nothing,
                        Packaging.termDefinitionSignature = (Just (Scoping.typeSchemeToTermSignature ts)),
                        Packaging.termDefinitionBody = (Core.bindingTerm el)}) (Core.bindingTypeScheme el)
              selectedElements =
                      Lists.filter (\el -> Optionals.cases (Names.moduleNameOf (Core.bindingName el)) False (\ns -> Sets.member ns namespacesSet)) bins5
              elementsByNamespace =
                      Lists.foldl (\acc -> \el -> Optionals.cases (Names.moduleNameOf (Core.bindingName el)) acc (\ns ->
                        let existing = Optionals.cases (Maps.lookup ns acc) [] Equality.identity
                        in (Maps.insert ns (Lists.concat2 existing [
                          el]) acc))) Maps.empty selectedElements
              defsGrouped =
                      Lists.map (\ns ->
                        let elsForNs = Optionals.cases (Maps.lookup ns elementsByNamespace) [] Equality.identity
                        in (Optionals.cat (Lists.map toDef elsForNs))) namespaces
              g = Lexical.buildGraph bins5 Maps.empty (Graph.graphPrimitives adapted)
          in (Right (
            Graph.Graph {
              Graph.graphBoundTerms = (Graph.graphBoundTerms g),
              Graph.graphBoundTypes = (Graph.graphBoundTypes g),
              Graph.graphClassConstraints = (Graph.graphClassConstraints g),
              Graph.graphLambdaVariables = (Graph.graphLambdaVariables g),
              Graph.graphMetadata = (Graph.graphMetadata g),
              Graph.graphPrimitives = (Graph.graphPrimitives g),
              Graph.graphSchemaTypes = (Graph.graphSchemaTypes adapted),
              Graph.graphTypeVariables = (Graph.graphTypeVariables g)},
            defsGrouped))))))))

-- | Check if a literal type is supported by the given language constraints
literalTypeSupported :: Coders.LanguageConstraints -> Core.LiteralType -> Bool
literalTypeSupported constraints lt =

      let forType =
              \lt2 -> case lt2 of
                Core.LiteralTypeFloat v0 -> Sets.member v0 (Coders.languageConstraintsFloatTypes constraints)
                Core.LiteralTypeInteger v0 -> Sets.member v0 (Coders.languageConstraintsIntegerTypes constraints)
                _ -> True
      in (Logic.ifElse (Sets.member (Reflect.literalTypeVariant lt) (Coders.languageConstraintsLiteralVariants constraints)) (forType lt) False)

-- | Prepare a float type, substituting unsupported types
prepareFloatType :: Ord t0 => (Core.FloatType -> (Core.FloatType, ((Core.FloatValue -> Core.FloatValue), (S.Set t0))))
prepareFloatType ft =
    case ft of
      Core.FloatTypeFloat32 -> (
        Core.FloatTypeFloat32,
        (
          (\v -> case v of
            Core.FloatValueFloat32 v1 -> Core.FloatValueFloat32 v1
            _ -> v),
          Sets.empty))
      Core.FloatTypeFloat64 -> (
        Core.FloatTypeFloat64,
        (
          (\v -> case v of
            Core.FloatValueFloat64 v1 -> Core.FloatValueFloat64 v1
            _ -> v),
          Sets.empty))

-- | Prepare an integer type, substituting unsupported types
prepareIntegerType :: Core.IntegerType -> (Core.IntegerType, ((Core.IntegerValue -> Core.IntegerValue), (S.Set String)))
prepareIntegerType it =
    case it of
      Core.IntegerTypeBigint -> (
        Core.IntegerTypeInt64,
        (
          (\v -> case v of
            Core.IntegerValueBigint v1 -> Core.IntegerValueInt64 (LibLiterals.bigintToInt64 v1)
            _ -> v),
          (Sets.fromList [
            "replace arbitrary-precision integers with 64-bit integers"])))
      Core.IntegerTypeUint8 -> (
        Core.IntegerTypeInt8,
        (
          (\v -> case v of
            Core.IntegerValueUint8 v1 -> Core.IntegerValueInt8 (LibLiterals.bigintToInt8 (LibLiterals.uint8ToBigint v1))
            _ -> v),
          (Sets.fromList [
            "replace unsigned 8-bit integers with signed 8-bit integers"])))
      Core.IntegerTypeUint32 -> (
        Core.IntegerTypeInt32,
        (
          (\v -> case v of
            Core.IntegerValueUint32 v1 -> Core.IntegerValueInt32 (LibLiterals.bigintToInt32 (LibLiterals.uint32ToBigint v1))
            _ -> v),
          (Sets.fromList [
            "replace unsigned 32-bit integers with signed 32-bit integers"])))
      Core.IntegerTypeUint64 -> (
        Core.IntegerTypeInt64,
        (
          (\v -> case v of
            Core.IntegerValueUint64 v1 -> Core.IntegerValueInt64 (LibLiterals.bigintToInt64 (LibLiterals.uint64ToBigint v1))
            _ -> v),
          (Sets.fromList [
            "replace unsigned 64-bit integers with signed 64-bit integers"])))
      _ -> prepareSame it

-- | Prepare a literal type, substituting unsupported types
prepareLiteralType :: Core.LiteralType -> (Core.LiteralType, ((Core.Literal -> Core.Literal), (S.Set String)))
prepareLiteralType at =
    case at of
      Core.LiteralTypeBinary -> (
        Core.LiteralTypeString,
        (
          (\v -> case v of
            Core.LiteralBinary v1 -> Core.LiteralString (LibLiterals.binaryToString v1)
            _ -> v),
          (Sets.fromList [
            "replace binary strings with character strings"])))
      Core.LiteralTypeDecimal -> (
        Core.LiteralTypeFloat Core.FloatTypeFloat64,
        (
          (\v -> case v of
            Core.LiteralDecimal v1 -> Core.LiteralFloat (Core.FloatValueFloat64 (LibLiterals.decimalToFloat64 v1))
            _ -> v),
          (Sets.fromList [
            "replace arbitrary-precision decimal numbers with 64-bit floating-point numbers (doubles)"])))
      Core.LiteralTypeFloat v0 ->
        let result = prepareFloatType v0
            rtyp = Pairs.first result
            rep = Pairs.first (Pairs.second result)
            msgs = Pairs.second (Pairs.second result)
        in (
          Core.LiteralTypeFloat rtyp,
          (
            (\v -> case v of
              Core.LiteralFloat v1 -> Core.LiteralFloat (rep v1)
              _ -> v),
            msgs))
      Core.LiteralTypeInteger v0 ->
        let result = prepareIntegerType v0
            rtyp = Pairs.first result
            rep = Pairs.first (Pairs.second result)
            msgs = Pairs.second (Pairs.second result)
        in (
          Core.LiteralTypeInteger rtyp,
          (
            (\v -> case v of
              Core.LiteralInteger v1 -> Core.LiteralInteger (rep v1)
              _ -> v),
            msgs))
      _ -> prepareSame at

-- | Return a value unchanged with identity transform and no messages
prepareSame :: Ord t2 => (t0 -> (t0, ((t1 -> t1), (S.Set t2))))
prepareSame x = (x, ((\y -> y), Sets.empty))

-- | Prepare a type, substituting unsupported literal types
prepareType :: t0 -> Core.Type -> (Core.Type, ((Core.Term -> Core.Term), (S.Set String)))
prepareType cx typ =
    case (Strip.deannotateType typ) of
      Core.TypeLiteral v0 ->
        let result = prepareLiteralType v0
            rtyp = Pairs.first result
            rep = Pairs.first (Pairs.second result)
            msgs = Pairs.second (Pairs.second result)
        in (
          Core.TypeLiteral rtyp,
          (
            (\v -> case v of
              Core.TermLiteral v1 -> Core.TermLiteral (rep v1)
              _ -> v),
            msgs))
      _ -> prepareSame typ

-- | Normalize a term by pushing TermTypeApplication inward past TermApplication and TermLambda. This corrects structures produced by poly-let hoisting and eta expansion, where type applications from inference end up wrapping term applications or lambda abstractions instead of being directly on the polymorphic variable.
pushTypeAppsInward :: Core.Term -> Core.Term
pushTypeAppsInward term =

      let push =
              \body -> \typ -> case body of
                Core.TermAnnotated v0 -> Core.TermAnnotated (Core.AnnotatedTerm {
                  Core.annotatedTermBody = (push (Core.annotatedTermBody v0) typ),
                  Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v0)})
                Core.TermApplication v0 -> go (Core.TermApplication (Core.Application {
                  Core.applicationFunction = (Core.TermTypeApplication (Core.TypeApplicationTerm {
                    Core.typeApplicationTermBody = (Core.applicationFunction v0),
                    Core.typeApplicationTermType = typ})),
                  Core.applicationArgument = (Core.applicationArgument v0)}))
                Core.TermLambda v0 -> go (Core.TermLambda (Core.Lambda {
                  Core.lambdaParameter = (Core.lambdaParameter v0),
                  Core.lambdaDomain = (Core.lambdaDomain v0),
                  Core.lambdaBody = (Core.TermTypeApplication (Core.TypeApplicationTerm {
                    Core.typeApplicationTermBody = (Core.lambdaBody v0),
                    Core.typeApplicationTermType = typ}))}))
                Core.TermLet v0 -> go (Core.TermLet (Core.Let {
                  Core.letBindings = (Core.letBindings v0),
                  Core.letBody = (Core.TermTypeApplication (Core.TypeApplicationTerm {
                    Core.typeApplicationTermBody = (Core.letBody v0),
                    Core.typeApplicationTermType = typ}))}))
                _ -> Core.TermTypeApplication (Core.TypeApplicationTerm {
                  Core.typeApplicationTermBody = body,
                  Core.typeApplicationTermType = typ})
          go =
                  \t ->
                    let forField =
                            \fld -> Core.Field {
                              Core.fieldName = (Core.fieldName fld),
                              Core.fieldTerm = (go (Core.fieldTerm fld))}
                        forCaseAlternative =
                                \alt -> Core.CaseAlternative {
                                  Core.caseAlternativeName = (Core.caseAlternativeName alt),
                                  Core.caseAlternativeHandler = (go (Core.caseAlternativeHandler alt))}
                        forLet =
                                \lt ->
                                  let mapBinding =
                                          \b -> Core.Binding {
                                            Core.bindingName = (Core.bindingName b),
                                            Core.bindingTerm = (go (Core.bindingTerm b)),
                                            Core.bindingTypeScheme = (Core.bindingTypeScheme b)}
                                  in Core.Let {
                                    Core.letBindings = (Lists.map mapBinding (Core.letBindings lt)),
                                    Core.letBody = (go (Core.letBody lt))}
                        forMap =
                                \m ->
                                  let forPair = \p -> (go (Pairs.first p), (go (Pairs.second p)))
                                  in (Maps.fromList (Lists.map forPair (Maps.toList m)))
                    in case t of
                      Core.TermAnnotated v0 -> Core.TermAnnotated (Core.AnnotatedTerm {
                        Core.annotatedTermBody = (go (Core.annotatedTermBody v0)),
                        Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v0)})
                      Core.TermApplication v0 -> Core.TermApplication (Core.Application {
                        Core.applicationFunction = (go (Core.applicationFunction v0)),
                        Core.applicationArgument = (go (Core.applicationArgument v0))})
                      Core.TermCases v0 -> Core.TermCases (Core.CaseStatement {
                        Core.caseStatementTypeName = (Core.caseStatementTypeName v0),
                        Core.caseStatementDefault = (Optionals.map go (Core.caseStatementDefault v0)),
                        Core.caseStatementCases = (Lists.map forCaseAlternative (Core.caseStatementCases v0))})
                      Core.TermEither v0 -> Core.TermEither (Eithers.either (\l -> Left (go l)) (\r -> Right (go r)) v0)
                      Core.TermLambda v0 -> Core.TermLambda (Core.Lambda {
                        Core.lambdaParameter = (Core.lambdaParameter v0),
                        Core.lambdaDomain = (Core.lambdaDomain v0),
                        Core.lambdaBody = (go (Core.lambdaBody v0))})
                      Core.TermLet v0 -> Core.TermLet (forLet v0)
                      Core.TermList v0 -> Core.TermList (Lists.map go v0)
                      Core.TermLiteral v0 -> Core.TermLiteral v0
                      Core.TermMap v0 -> Core.TermMap (forMap v0)
                      Core.TermOptional v0 -> Core.TermOptional (Optionals.map go v0)
                      Core.TermPair v0 -> Core.TermPair (go (Pairs.first v0), (go (Pairs.second v0)))
                      Core.TermProject v0 -> Core.TermProject v0
                      Core.TermRecord v0 -> Core.TermRecord (Core.Record {
                        Core.recordTypeName = (Core.recordTypeName v0),
                        Core.recordFields = (Lists.map forField (Core.recordFields v0))})
                      Core.TermSet v0 -> Core.TermSet (Sets.fromList (Lists.map go (Sets.toList v0)))
                      Core.TermTypeApplication v0 ->
                        let body1 = go (Core.typeApplicationTermBody v0)
                        in (push body1 (Core.typeApplicationTermType v0))
                      Core.TermTypeLambda v0 -> Core.TermTypeLambda (Core.TypeLambda {
                        Core.typeLambdaParameter = (Core.typeLambdaParameter v0),
                        Core.typeLambdaBody = (go (Core.typeLambdaBody v0))})
                      Core.TermInject v0 -> Core.TermInject (Core.Injection {
                        Core.injectionTypeName = (Core.injectionTypeName v0),
                        Core.injectionField = (forField (Core.injectionField v0))})
                      Core.TermUnit -> Core.TermUnit
                      Core.TermUnwrap v0 -> Core.TermUnwrap v0
                      Core.TermVariable v0 -> Core.TermVariable v0
                      Core.TermWrap v0 -> Core.TermWrap (Core.WrappedTerm {
                        Core.wrappedTermTypeName = (Core.wrappedTermTypeName v0),
                        Core.wrappedTermBody = (go (Core.wrappedTermBody v0))})
      in (go term)

-- | Given a schema graph along with language constraints and a designated list of element names, adapt the graph to the language constraints, then return a corresponding type definition for each element name.
schemaGraphToDefinitions :: Coders.LanguageConstraints -> Graph.Graph -> [[Core.Name]] -> t0 -> Either Errors.Error (M.Map Core.Name Core.Type, [[Packaging.TypeDefinition]])
schemaGraphToDefinitions constraints graph nameLists cx =

      let litmap = adaptLiteralTypesMap constraints
      in (Eithers.bind (Eithers.bimap (\e -> Errors.ErrorDecoding e) (\x -> x) (Environment.graphAsTypes graph (Lexical.graphToBindings graph))) (\tmap0 -> Eithers.bind (adaptGraphSchema constraints litmap tmap0) (\tmap1 ->
        let toDef =
                \pair -> Packaging.TypeDefinition {
                  Packaging.typeDefinitionName = (Pairs.first pair),
                  Packaging.typeDefinitionMetadata = Nothing,
                  Packaging.typeDefinitionBody = Core.TypeScheme {
                    Core.typeSchemeVariables = [],
                    Core.typeSchemeBody = (Pairs.second pair),
                    Core.typeSchemeConstraints = Nothing}}
        in (Right (
          tmap1,
          (Lists.map (\names -> Lists.map toDef (Optionals.mapOptional (\n -> Optionals.map (\t -> (n, t)) (Maps.lookup n tmap1)) names)) nameLists))))))

-- | Given a target language and a source type, produce an adapter which rewrites the type and its terms according to the language's constraints. The encode direction adapts terms; the decode direction is identity.
simpleLanguageAdapter :: Coders.Language -> t0 -> Graph.Graph -> Core.Type -> Either Errors.Error (Coders.Adapter Core.Type Core.Type Core.Term Core.Term Errors.Error)
simpleLanguageAdapter lang cx g typ =

      let constraints = Coders.languageConstraints lang
          litmap = adaptLiteralTypesMap constraints
      in (Eithers.bind (adaptType constraints litmap typ) (\adaptedType -> Right (Coders.Adapter {
        Coders.adapterIsLossy = False,
        Coders.adapterSource = typ,
        Coders.adapterTarget = adaptedType,
        Coders.adapterCoder = Coders.Coder {
          Coders.coderEncode = (\term -> adaptTerm constraints litmap cx g term),
          Coders.coderDecode = (\term -> Right term)}})))

-- | Find a list of alternatives for a given term, if any
termAlternatives :: t0 -> Graph.Graph -> Core.Term -> Either Errors.Error [Core.Term]
termAlternatives cx graph term =
    case term of
      Core.TermAnnotated v0 ->
        let term2 = Core.annotatedTermBody v0
        in (Right [
          term2])
      Core.TermOptional v0 -> Right [
        Core.TermList (Optionals.cases v0 [] (\term2 -> [
          term2]))]
      Core.TermTypeLambda v0 ->
        let term2 = Core.typeLambdaBody v0
        in (Right [
          term2])
      Core.TermTypeApplication v0 ->
        let term2 = Core.typeApplicationTermBody v0
        in (Right [
          term2])
      Core.TermInject v0 ->
        let tname = Core.injectionTypeName v0
            field = Core.injectionField v0
            fname = Core.fieldName field
            fterm = Core.fieldTerm field
            forFieldType =
                    \ft ->
                      let ftname = Core.fieldTypeName ft
                      in Core.Field {
                        Core.fieldName = fname,
                        Core.fieldTerm = (Core.TermOptional (Logic.ifElse (Equality.equal ftname fname) (Just fterm) Nothing))}
        in (Eithers.bind (Resolution.requireUnionType cx graph tname) (\rt -> Right [
          Core.TermRecord (Core.Record {
            Core.recordTypeName = tname,
            Core.recordFields = (Lists.map forFieldType rt)})]))
      Core.TermUnit -> Right [
        Core.TermLiteral (Core.LiteralBoolean True)]
      Core.TermWrap v0 ->
        let term2 = Core.wrappedTermBody v0
        in (Right [
          term2])
      _ -> Right []

-- | Find a list of alternatives for a given type, if any
typeAlternatives :: Core.Type -> [Core.Type]
typeAlternatives type_ =
    case type_ of
      Core.TypeAnnotated v0 ->
        let type2 = Core.annotatedTypeBody v0
        in [
          type2]
      Core.TypeEffect v0 -> [
        v0]
      Core.TypeOptional v0 -> [
        Core.TypeList v0]
      Core.TypeUnion v0 ->
        let toOptField =
                \f -> Core.FieldType {
                  Core.fieldTypeName = (Core.fieldTypeName f),
                  Core.fieldTypeType = (Core.TypeOptional (Core.fieldTypeType f))}
            optFields = Lists.map toOptField v0
        in [
          Core.TypeRecord optFields]
      Core.TypeUnit -> [
        Core.TypeLiteral Core.LiteralTypeBoolean]
      Core.TypeVoid -> [
        Core.TypeUnit]
      _ -> []